diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index ba91b7b..8f4470a 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -1623,6 +1623,360 @@ system function and constructor caches. \fnref{frame}, and \fnref{undo} +\subsection{defun clear} +<>= +(defun |clear| (l) + (|clearSpad2Cmd| l)) + +@ + +\subsection{defun clearSpad2Cmd} +\begin{verbatim} +;clearSpad2Cmd l == +; -- new version which changes the environment and updates history +; $clearExcept: local := nil +; if $options then $clearExcept := +; "and"/[selectOptionLC(opt,'(except),'optionError) = +; 'except for [opt,:.] in $options] +; null l => +; optList:= "append"/[ ['%l,'" ",x] for x in $clearOptions] +; sayKeyedMsg("S2IZ0010",[optList]) +; arg := selectOptionLC(first l,'(all completely scaches),NIL) +; arg = 'all => clearCmdAll() +; arg = 'completely => clearCmdCompletely() +; arg = 'scaches => clearCmdSortedCaches() +; $clearExcept => clearCmdExcept(l) +; clearCmdParts(l) +; updateCurrentInterpreterFrame() +\end{verbatim} + +<>= +(defun |clearSpad2Cmd| (|l|) + (prog (|$clearExcept| |opt| |optList| |arg|) + (declare (special |$clearExcept|)) + (return + (seq + (progn + (spadlet |$clearExcept| nil) + (cond + (|$options| + (spadlet |$clearExcept| + (prog (t0) + (spadlet t0 t) + (return + (do ((t1 nil (null t0)) + (t2 |$options| (cdr t2)) + (t3 nil)) + ((or t1 + (atom t2) + (progn (setq t3 (car t2)) nil) + (progn (progn (spadlet |opt| (car t3)) t3) nil)) + t0) + (seq + (exit + (setq t0 + (and t0 + (boot-equal + (|selectOptionLC| |opt| '(|except|) '|optionError|) + '|except|))))))))))) + (cond + ((null |l|) + (spadlet |optList| + (prog (t4) + (spadlet t4 nil) + (return + (do ((t5 |$clearOptions| (cdr t5)) (|x| nil)) + ((or (atom t5) (progn (setq |x| (car t5)) nil)) t4) + (seq + (exit + (setq t4 + (append t4 (cons '|%l| (cons " " (cons |x| nil))))))))))) + (|sayKeyedMsg| 's2iz0010 (cons |optList| nil))) + (t + (spadlet |arg| + (|selectOptionLC| (car |l|) '(|all| |completely| |scaches|) nil)) + (cond + ((boot-equal |arg| '|all|) (|clearCmdAll|)) + ((boot-equal |arg| '|completely|) (|clearCmdCompletely|)) + ((boot-equal |arg| '|scaches|) (|clearCmdSortedCaches|)) + (|$clearExcept| (|clearCmdExcept| |l|)) + (t + (|clearCmdParts| |l|) (|updateCurrentInterpreterFrame|)))))))))) + +@ + +\subsection{defun clearCmdSortedCaches} +\begin{verbatim} +;clearCmdSortedCaches() == +; $lookupDefaults: local := false +; for [.,.,:domain] in HGET($ConstructorCache,'SortedCache) repeat +; pair := compiledLookupCheck('clearCache,[$Void],domain) +; SPADCALL pair +\end{verbatim} + +<>= +(defun |clearCmdSortedCaches| () + (prog (|$lookupDefaults| |domain| |pair|) + (declare (special |$lookupDefaults|)) + (return + (seq + (progn + (spadlet |$lookupDefaults| nil) + (do ((t0 (hget |$ConstructorCache| '|SortedCache|) (cdr t0)) + (t1 nil)) + ((or (atom t0) + (progn (setq t1 (car t0)) nil) + (progn (progn (spadlet |domain| (cddr t1)) t1) nil)) + nil) + (seq + (exit + (progn + (spadlet |pair| + (|compiledLookupCheck| '|clearCache| (cons |$Void| nil) |domain|)) + (spadcall |pair|)))))))))) + +@ + +\subsection{defun clearCmdCompletely} +\begin{verbatim} +;clearCmdCompletely() == +; clearCmdAll() +; $localExposureData := COPY_-SEQ $localExposureDataDefault +; $xdatabase := NIL +; $CatOfCatDatabase := NIL +; $DomOfCatDatabase := NIL +; $JoinOfCatDatabase := NIL +; $JoinOfDomDatabase := NIL +; $attributeDb := NIL +; $functionTable := NIL +; sayKeyedMsg("S2IZ0013",NIL) +; clearClams() +; clearConstructorCaches() +; $existingFiles := MAKE_-HASHTABLE 'UEQUAL +; sayKeyedMsg("S2IZ0014",NIL) +; RECLAIM() +; sayKeyedMsg("S2IZ0015",NIL) +; NIL +\end{verbatim} + +<>= +(defun |clearCmdCompletely| () + (progn (|clearCmdAll|) + (spadlet |$localExposureData| (copy-seq |$localExposureDataDefault|)) + (spadlet |$xdatabase| nil) + (spadlet |$CatOfCatDatabase| nil) + (spadlet |$DomOfCatDatabase| nil) + (spadlet |$JoinOfCatDatabase| nil) + (spadlet |$JoinOfDomDatabase| nil) + (spadlet |$attributeDb| nil) + (spadlet |$functionTable| nil) + (|sayKeyedMsg| 's2iz0013 nil) + (|clearClams|) + (|clearConstructorCaches|) + (spadlet |$existingFiles| (make-hashtable 'UEQUAL)) + (|sayKeyedMsg| 's2iz0014 nil) + (reclaim) + (|sayKeyedMsg| 's2iz0015 nil) + nil)) + +@ + +\subsection{defun clearCmdAll} +\begin{verbatim} +;clearCmdAll() == +; clearCmdSortedCaches() +; ------undo special variables------ +; $frameRecord := nil +; $previousBindings := nil +; $variableNumberAlist := nil +; untraceMapSubNames _/TRACENAMES +; $InteractiveFrame := LIST LIST NIL +; resetInCoreHist() +; if $useInternalHistoryTable +; then $internalHistoryTable := NIL +; else deleteFile histFileName() +; $IOindex := 1 +; updateCurrentInterpreterFrame() +; $currentLine := '")clear all" --restored 3/94; needed for undo (RDJ) +; clearMacroTable() +; if $frameMessages then sayKeyedMsg("S2IZ0011",[$interpreterFrameName]) +; else sayKeyedMsg("S2IZ0012",NIL) +\end{verbatim} + +<>= +(defun |clearCmdAll| () + (progn + (|clearCmdSortedCaches|) + (spadlet |$frameRecord| nil) + (spadlet |$previousBindings| nil) + (spadlet |$variableNumberAlist| nil) + (|untraceMapSubNames| /tracenames) + (spadlet |$InteractiveFrame| (list (list nil))) + (|resetInCoreHist|) + (cond + (|$useInternalHistoryTable| (spadlet |$internalHistoryTable| nil)) + (t (|deleteFile| (|histFileName|)))) + (spadlet |$IOindex| 1) + (|updateCurrentInterpreterFrame|) + (spadlet |$currentLine| ")clear all") + (|clearMacroTable|) + (cond + (|$frameMessages| + (|sayKeyedMsg| 's2iz0011 (cons |$interpreterFrameName| nil))) + (t (|sayKeyedMsg| 's2iz0012 nil))))) + +@ + +\subsection{defun clearCmdExcept} +\begin{verbatim} +;clearCmdExcept(l is [opt,:vl]) == +; --clears elements of vl of all options EXCEPT opt +; for option in $clearOptions | +; ^stringPrefix?(object2String opt,object2String option) +; repeat clearCmdParts [option,:vl] +\end{verbatim} + +<>= +(defun |clearCmdExcept| (arg) + (prog (opt vl) + (return + (seq + (progn + (spadlet opt (car arg)) + (spadlet vl (cdr arg)) + (do ((t0 |$clearOptions| (cdr t0)) (option nil)) + ((or (atom t0) (progn (setq option (car t0)) nil)) nil) + (seq + (exit + (cond + ((null + (|stringPrefix?| + (|object2String| opt) + (|object2String| option))) + (|clearCmdParts| (cons option vl)))))))))))) + +@ + +\subsection{defun clearCmdParts} +\begin{verbatim} +;clearCmdParts(l is [opt,:vl]) == +; -- clears the bindings indicated by opt of all variables in vl +; option:= selectOptionLC(opt,$clearOptions,'optionError) +; option:= INTERN PNAME option +; -- the option can be plural but the key in the alist is sometimes +; -- singular +; option := +; option = 'types => 'mode +; option = 'modes => 'mode +; option = 'values => 'value +; option +; null vl => sayKeyedMsg("S2IZ0055",NIL) +; pmacs := getParserMacroNames() +; imacs := getInterpMacroNames() +; if vl='(all) then +; vl := ASSOCLEFT CAAR $InteractiveFrame +; vl := REMDUP(append(vl, pmacs)) +; $e : local := $InteractiveFrame +; for x in vl repeat +; clearDependencies(x,true) +; if option='properties and x in pmacs then clearParserMacro(x) +; if option='properties and x in imacs and ^(x in pmacs) then +; sayMessage ['" You cannot clear the definition of the system-defined macro ", +; fixObjectForPrinting x,"."] +; p1 := ASSOC(x,CAAR $InteractiveFrame) => +; option='properties => +; if isMap x then +; (lm := get(x,'localModemap,$InteractiveFrame)) => +; PAIRP lm => untraceMapSubNames [CADAR lm] +; NIL +; for p2 in CDR p1 repeat +; prop:= CAR p2 +; recordOldValue(x,prop,CDR p2) +; recordNewValue(x,prop,NIL) +; SETF(CAAR $InteractiveFrame,deleteAssoc(x,CAAR $InteractiveFrame)) +; p2:= ASSOC(option,CDR p1) => +; recordOldValue(x,option,CDR p2) +; recordNewValue(x,option,NIL) +; RPLACD(p2,NIL) +; nil +\end{verbatim} + +<>= +(defun |clearCmdParts| (arg) + (prog (|$e| |opt| |option| |pmacs| |imacs| |vl| |p1| |lm| |prop| |p2|) + (declare (special |$e|)) + (return + (seq + (progn + (spadlet |opt| (car arg)) + (spadlet |vl| (cdr arg)) + (spadlet |option| (|selectOptionLC| |opt| |$clearOptions| '|optionError|)) + (spadlet |option| (intern (pname |option|))) + (spadlet |option| + (cond + ((boot-equal |option| '|types|) '|mode|) + ((boot-equal |option| '|modes|) '|mode|) + ((boot-equal |option| '|values|) '|value|) + (t |option|))) + (cond + ((null |vl|) (|sayKeyedMsg| 's2iz0055 nil)) + (t + (spadlet |pmacs| (|getParserMacroNames|)) + (spadlet |imacs| (|getInterpMacroNames|)) + (cond + ((boot-equal |vl| '(|all|)) + (spadlet |vl| (assocleft (caar |$InteractiveFrame|))) + (spadlet |vl| (remdup (append |vl| |pmacs|))))) + (spadlet |$e| |$InteractiveFrame|) + (do ((t0 |vl| (cdr t0)) (|x| nil)) + ((or (atom t0) (progn (setq |x| (car t0)) nil)) nil) + (seq + (exit + (progn + (|clearDependencies| |x| t) + (cond + ((and (boot-equal |option| '|properties|) (|member| |x| |pmacs|)) + (|clearParserMacro| |x|))) + (cond + ((and (boot-equal |option| '|properties|) + (|member| |x| |imacs|) + (null (|member| |x| |pmacs|))) + (|sayMessage| (cons + " You cannot clear the definition of the system-defined macro " + (cons (|fixObjectForPrinting| |x|) + (cons (intern "." "BOOT") nil)))))) + (cond + ((spadlet |p1| (|assoc| |x| (caar |$InteractiveFrame|))) + (cond + ((boot-equal |option| '|properties|) + (cond + ((|isMap| |x|) + (seq + (cond + ((spadlet |lm| + (|get| |x| '|localModemap| |$InteractiveFrame|)) + (cond + ((pairp |lm|) + (exit (|untraceMapSubNames| (cons (cadar |lm|) nil)))))) + (t nil))))) + (do ((t1 (cdr |p1|) (cdr t1)) (|p2| nil)) + ((or (atom t1) (progn (setq |p2| (car t1)) nil)) nil) + (seq + (exit + (progn + (spadlet |prop| (car |p2|)) + (|recordOldValue| |x| |prop| (cdr |p2|)) + (|recordNewValue| |x| |prop| nil))))) + (setf (caar |$InteractiveFrame|) + (|deleteAssoc| |x| (caar |$InteractiveFrame|)))) + ((spadlet |p2| (|assoc| |option| (cdr |p1|))) + (|recordOldValue| |x| |option| (cdr |p2|)) + (|recordNewValue| |x| |option| nil) + (rplacd |p2| nil))))))))) + nil))))))) + +@ + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{close} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -11427,6 +11781,13 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> <> +<> +<> +<> +<> +<> +<> +<> <> <> <> diff --git a/changelog b/changelog index 21aee6c..13496a6 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20090408 tpd src/axiom-website/patches.html 20090308.02.tpd.patch +20090308 tpd src/interp/i-syscmd.boot move clear to bookvol5 +20090308 tpd books/bookvol5 add )clear root 20090308 tpd src/axiom-website/patches.html 20090308.01.tpd.patch 20090308 tpd src/interp/i-syscmd.boot move abbreviation to bookvol5 20090308 tpd books/bookvol5 add abbreviation, include roots diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 5552b92..1d7f8eb 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -993,5 +993,7 @@ bookvol10.3 add Grabmeier/Waldek fixes to Float
bookvol5 add trace root
20090308.01.tpd.patch bookvol5 add include, abbreviation roots
+20090308.02.tpd.patch +bookvol5 add clear root
diff --git a/src/interp/i-syscmd.boot.pamphlet b/src/interp/i-syscmd.boot.pamphlet index dfcf93c..771c0ae 100644 --- a/src/interp/i-syscmd.boot.pamphlet +++ b/src/interp/i-syscmd.boot.pamphlet @@ -270,122 +270,6 @@ getSystemCommandLine() == ------------ start of commands ------------------------------------------ ---% )clear - -clear l == clearSpad2Cmd l - -clearSpad2Cmd l == - -- new version which changes the environment and updates history - $clearExcept: local := nil - if $options then $clearExcept := - "and"/[selectOptionLC(opt,'(except),'optionError) = - 'except for [opt,:.] in $options] - null l => - optList:= "append"/[['%l,'" ",x] for x in $clearOptions] - sayKeyedMsg("S2IZ0010",[optList]) - arg := selectOptionLC(first l,'(all completely scaches),NIL) - arg = 'all => clearCmdAll() - arg = 'completely => clearCmdCompletely() - arg = 'scaches => clearCmdSortedCaches() - $clearExcept => clearCmdExcept(l) - clearCmdParts(l) - updateCurrentInterpreterFrame() - -clearCmdSortedCaches() == - $lookupDefaults: local := false - for [.,.,:domain] in HGET($ConstructorCache,'SortedCache) repeat - pair := compiledLookupCheck('clearCache,[$Void],domain) - SPADCALL pair - -clearCmdCompletely() == - clearCmdAll() - $localExposureData := COPY_-SEQ $localExposureDataDefault - $xdatabase := NIL - $CatOfCatDatabase := NIL - $DomOfCatDatabase := NIL - $JoinOfCatDatabase := NIL - $JoinOfDomDatabase := NIL - $attributeDb := NIL - $functionTable := NIL - sayKeyedMsg("S2IZ0013",NIL) - clearClams() - clearConstructorCaches() - $existingFiles := MAKE_-HASHTABLE 'UEQUAL - sayKeyedMsg("S2IZ0014",NIL) - RECLAIM() - sayKeyedMsg("S2IZ0015",NIL) - NIL - -clearCmdAll() == - clearCmdSortedCaches() - ------undo special variables------ - $frameRecord := nil - $previousBindings := nil - $variableNumberAlist := nil - untraceMapSubNames _/TRACENAMES - $InteractiveFrame := LIST LIST NIL - resetInCoreHist() - if $useInternalHistoryTable - then $internalHistoryTable := NIL - else deleteFile histFileName() - $IOindex := 1 - updateCurrentInterpreterFrame() - $currentLine := '")clear all" --restored 3/94; needed for undo (RDJ) - clearMacroTable() - if $frameMessages then sayKeyedMsg("S2IZ0011",[$interpreterFrameName]) - else sayKeyedMsg("S2IZ0012",NIL) - -clearCmdExcept(l is [opt,:vl]) == - --clears elements of vl of all options EXCEPT opt - for option in $clearOptions | - ^stringPrefix?(object2String opt,object2String option) - repeat clearCmdParts [option,:vl] - -clearCmdParts(l is [opt,:vl]) == - -- clears the bindings indicated by opt of all variables in vl - - option:= selectOptionLC(opt,$clearOptions,'optionError) - option:= INTERN PNAME option - - -- the option can be plural but the key in the alist is sometimes - -- singular - - option := - option = 'types => 'mode - option = 'modes => 'mode - option = 'values => 'value - option - - null vl => sayKeyedMsg("S2IZ0055",NIL) - pmacs := getParserMacroNames() - imacs := getInterpMacroNames() - if vl='(all) then - vl := ASSOCLEFT CAAR $InteractiveFrame - vl := REMDUP(append(vl, pmacs)) - $e : local := $InteractiveFrame - for x in vl repeat - clearDependencies(x,true) - if option='properties and x in pmacs then clearParserMacro(x) - if option='properties and x in imacs and ^(x in pmacs) then - sayMessage ['" You cannot clear the definition of the system-defined macro ", - fixObjectForPrinting x,"."] - p1 := ASSOC(x,CAAR $InteractiveFrame) => - option='properties => - if isMap x then - (lm := get(x,'localModemap,$InteractiveFrame)) => - PAIRP lm => untraceMapSubNames [CADAR lm] - NIL - for p2 in CDR p1 repeat - prop:= CAR p2 - recordOldValue(x,prop,CDR p2) - recordNewValue(x,prop,NIL) - SETF(CAAR $InteractiveFrame,deleteAssoc(x,CAAR $InteractiveFrame)) - p2:= ASSOC(option,CDR p1) => - recordOldValue(x,option,CDR p2) - recordNewValue(x,option,NIL) - RPLACD(p2,NIL) - nil - --% )close queryClients () ==