[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Axiom-developer] 20090308.02.tpd.patch (bookvol5 add clear root)
|
From: |
daly |
|
Subject: |
[Axiom-developer] 20090308.02.tpd.patch (bookvol5 add clear root) |
|
Date: |
Sun, 8 Mar 2009 14:28:36 -0600 |
Move the )clear code from i-syscmd.boot to bookvol5
================================================================
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>>=
+(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>>=
+(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>>=
+(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>>=
+(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>>=
+(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>>=
+(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>>=
+(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.
<<defun changeToNamedInterpreterFrame>>
<<defun charDigitVal>>
<<defun cleanupLine>>
+<<defun clear>>
+<<defun clearCmdAll>>
+<<defun clearCmdCompletely>>
+<<defun clearCmdExcept>>
+<<defun clearCmdParts>>
+<<defun clearCmdSortedCaches>>
+<<defun clearSpad2Cmd>>
<<defun clearFrame>>
<<defun closeInterpreterFrame>>
<<defun compileBoot>>
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<br/>
bookvol5 add trace root<br/>
<a href="patches/20090308.01.tpd.patch">20090308.01.tpd.patch</a>
bookvol5 add include, abbreviation roots<br/>
+<a href="patches/20090308.02.tpd.patch">20090308.02.tpd.patch</a>
+bookvol5 add clear root<br/>
</body>
</html>
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 () ==
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Axiom-developer] 20090308.02.tpd.patch (bookvol5 add clear root),
daly <=