[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Axiom-developer] 20090315.01.tpd.patch (bookvol5 collect set support co
|
From: |
daly |
|
Subject: |
[Axiom-developer] 20090315.01.tpd.patch (bookvol5 collect set support code) |
|
Date: |
Mon, 16 Mar 2009 03:42:56 -0600 |
The )set tree data structure has supporting functions for initialization.
These functions were collected into bookvol5, rewritten from boot to lisp,
and documented.
=======================================================================
diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet
index 13ea50b..056019a 100644
--- a/books/bookvol5.pamphlet
+++ b/books/bookvol5.pamphlet
@@ -7594,11 +7594,197 @@ userlevel operation access level of system user
development
Variables with current values of ... have further sub-options.
For example, issue )set system to see what the options are
-for system.
-For more information, issue )help set .
+for system. For more information, issue )help set .
+
+\end{verbatim}
+\section{)set list functions}
+\subsection{defun initializeSetVariables}
+The argument settree is initially the \verb|$setOption| variable.
+The fourth element is a union-style switch symbol.
+The fifth element is usually a variable to set.
+The sixth element is a subtree to recurse for the TREE switch.
+The seventh element is usually the default value. For more detailed
+explanations see the list structure section \ref{Theliststructure}.
+<<defun initializeSetVariables>>=
+(defun |initializeSetVariables| (settree)
+ (dolist (setdata settree)
+ (case (fourth setdata)
+ (FUNCTION
+ (if (|functionp| (fifth setdata))
+ (funcall (fifth setdata) '|%initialize%|))
+ (|sayMSG| " Function not implemented."))
+ (INTEGER (set (fifth setdata) (seventh setdata)))
+ (STRING (set (fifth setdata) (seventh setdata)))
+ (LITERALS
+ (set (fifth setdata) (|translateYesNo2TrueFalse| (seventh setdata))))
+ (TREE (|initializeSetVariables| (sixth setdata))))))
+
+@
+
+\subsection{defun resetWorkspaceVariables}
+<<defun resetWorkspaceVariables>>=
+(defun |resetWorkspaceVariables| ()
+ (setq /countlist nil)
+ (setq /editfile nil)
+ (setq /sourcefiles nil)
+ (setq |$sourceFiles| nil)
+ (setq /pretty nil)
+ (setq /spacelist nil)
+ (setq /timerlist nil)
+ (setq |$existingFiles| (make-hashtable 'uequal))
+ (setq |$functionTable| nil)
+ (setq $boot nil)
+ (setq |$compileMapFlag| nil)
+ (setq |$echoLineStack| nil)
+ (setq |$operationNameList| nil)
+ (setq |$slamFlag| nil)
+ (setq |$CommandSynonymAlist| (copy |$InitialCommandSynonymAlist|))
+ (setq |$UserAbbreviationsAlist| nil)
+ (setq |$msgAlist| nil)
+ (setq |$msgDatabase| nil)
+ (setq |$msgDatabaseName| nil)
+ (setq |$dependeeClosureAlist| nil)
+ (setq |$IOindex| 1)
+ (setq |$coerceIntByMapCounter| 0)
+ (setq |$e| (cons (cons nil nil) nil))
+ (setq |$env| (cons (cons nil nil) nil))
+ (|initializeSetVariables| |$setOptions|))
-\end{verbatim}
-\subsection{The list structure}
+@
+
+\subsection{defun displaySetOptionInformation}
+<<defun displaySetOptionInformation>>=
+(defun |displaySetOptionInformation| (arg setdata)
+ (let (current)
+ (cond
+ ((eq (fourth setdata) 'tree)
+ (|displaySetVariableSettings| (sixth setdata) (first setdata)))
+ (t
+ (|centerAndHighlight|
+ (strconc "The " (|object2String| arg) " Option")
+ $linelength (|specialChar| '|hbar|))
+ (|sayBrightly|
+ `(|%l| ,@(|bright| "Description:") ,(second setdata)))
+ (case (fourth setdata)
+ (FUNCTION
+ (terpri)
+ (cond
+ ((|functionp| (fifth setdata))
+ (funcall (fifth setdata) '|%describe%|))
+ (t (|sayMSG| " Function not implemented."))))
+ (INTEGER
+ (|sayMessage|
+ `(" The" ,@(|bright| arg) "option"
+ " may be followed by an integer in the range"
+ ,@(|bright| (ELT (sixth setdata) 0)) "to"
+ |%l| ,@(|bright| (ELT (sixth setdata) 1)) "inclusive."
+ " The current setting is" ,@(|bright| (|eval| (fifth setdata))))))
+ (STRING
+ (|sayMessage|
+ `(" The" ,@(|bright| arg) "option"
+ " is followed by a string enclosed in double quote marks."
+ '|%l| " The current setting is"
+ ,@(|bright| (list '|"| (|eval| (fifth setdata)) '|"|)))))
+ (LITERALS
+ (|sayMessage|
+ `(" The" ,@(|bright| arg) "option"
+ " may be followed by any one of the following:"))
+ (setq current
+ (|translateTrueFalse2YesNo| (|eval| (fifth setdata))))
+ (dolist (name (sixth setdata))
+ (if (boot-equal name current)
+ (|sayBrightly| `( " ->" ,@(|bright| (|object2String| name))))
+ (|sayBrightly| (list " " (|object2String| name)))))
+ (|sayMessage| " The current setting is indicated.")))))))
+
+@
+
+\subsection{defun displaySetVariableSettings}
+<<defun displaySetVariableSettings>>=
+(defun |displaySetVariableSettings| (settree label)
+ (let (setoption st opt subtree subname)
+ (cond
+ ((eq label '||) (setq label ")set"))
+ (t (setq label (strconc " " (|object2String| label) " "))))
+ (|centerAndHighlight|
+ (strconc "Current Values of" label " Variables") $linelength '| |)
+ (terpri)
+ (|sayBrightly|
+ (list "Variable " "Description "
+ "Current Value" ))
+ (say (|fillerSpaces| $linelength (|specialChar| '|hbar|)))
+ (setq subtree nil)
+ (dolist (setdata settree)
+ (when (|satisfiesUserLevel| (third setdata))
+ (setq setoption (|object2String| (first setdata)))
+ (setq setoption
+ (strconc setoption
+ (|fillerSpaces| (spaddifference 13 (|#| setoption)) " ")
+ (second setdata)))
+ (setq setoption
+ (strconc setoption
+ (|fillerSpaces| (spaddifference 55 (|#| setoption)) " ")))
+ (setq st (fourth setdata))
+ (case (fourth setdata)
+ (FUNCTION
+ (setq opt
+ (if (|functionp| (fifth setdata))
+ (funcall (fifth setdata) '|%display%|)
+ "unimplemented"))
+ (cond
+ ((pairp opt)
+ (setq opt
+ (do ((t2 opt (cdr t2)) t1 (|o| nil))
+ ((or (atom t2) (progn (setq |o| (car t2)) nil)) t1)
+ (setq t1 (append t1 (cons |o| (cons " " nil))))))))
+ (|sayBrightly| (|concat| setoption '|%b| opt '|%d|)))
+ (STRING
+ (setq opt (|object2String| (|eval| (fifth setdata))))
+ (|sayBrightly| `(,setoption ,@(|bright| opt))))
+ (INTEGER
+ (setq opt (|object2String| (|eval| (fifth setdata))))
+ (|sayBrightly| `(,setoption ,@(|bright| opt))))
+ (LITERALS
+ (setq opt (|object2String|
+ (|translateTrueFalse2YesNo| (|eval| (fifth setdata)))))
+ (|sayBrightly| `(,setoption ,@(|bright| opt))))
+ (TREE
+ (|sayBrightly| `(,setoption ,@(|bright| "...")))
+ (setq subtree t)
+ (setq subname (|object2String| (first setdata)))))))
+ (terpri)
+ (when subtree
+ (|sayBrightly|
+ `("Variables with current values of" ,@(|bright| "...")
+ "have further sub-options. For example,"))
+ (|sayBrightly|
+ `("issue" ,@(|bright| ")set ") ,subname
+ " to see what the options are for" ,@(|bright| subname) "."
+ |%l| "For more information, issue" ,@(|bright| ")help set") ".")))))
+
+@
+
+\subsection{defun translateYesNo2TrueFalse}
+<<defun translateYesNo2TrueFalse>>=
+(defun |translateYesNo2TrueFalse| (x)
+ (cond
+ ((|member| x '(|yes| |on|)) t)
+ ((|member| x '(|no| |off|)) nil)
+ (t x)))
+
+@
+
+\subsection{defun translateTrueFalse2YesNo}
+<<defun translateTrueFalse2YesNo>>=
+(defun |translateTrueFalse2YesNo| (x)
+ (cond
+ ((eq x t) '|on|)
+ ((null x) '|off|)
+ (t x)))
+
+@
+\section{The list structure}
+\label{Theliststructure}
The structure of each list item consists of 7 items. Consider this
example:
\begin{verbatim}
@@ -7621,9 +7807,7 @@ the user would see "operation access level of system
user".
accepted. There are three levels: interpreter, compiler, development.
These commands are restricted to keep the user from causing damage.
\item {\bf 4} {\sl Type} a symbol, one of {\bf FUNCTION}, {\bf INTEGER},
-{\bf STRING}, {\bf LITERALS}, {\bf FILENAME} or {\bf TREE}. See the function
-{\bf initializeSetVariables} in the file
-{\bf setvars.boot.pamphlet\cite{2}}.
+{\bf STRING}, {\bf LITERALS}, {\bf FILENAME} or {\bf TREE}.
\item {\bf 5} {\sl Var}
\begin{list}{}
\item FUNCTION is the function to call
@@ -7721,6 +7905,46 @@ args arguments for compiling AXIOM code
|htSetOutputLibrary|
)
@
+\subsection{defun setOutputLibrary}
+<<defun setOutputLibrary>>=
+(defun |setOutputLibrary| (arg)
+ (let (fn)
+ (cond
+ ((eq arg '|%initialize%|) (setq |$outputLibraryName| nil))
+ ((eq arg '|%display%|) (or |$outputLibraryName| "user.lib"))
+ ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?) (/= (|#| arg) 1))
+ (|describeOutputLibraryArgs|))
+ (t
+ (when (filep (setq fn (stringimage (car arg))))
+ (setq fn (truename fn)))
+ (|openOutputLibrary| (setq |$outputLibraryName| fn))))))
+
+@
+
+\subsection{defun describeOutputLibraryArgs}
+<<defun describeOutputLibraryArgs>>=
+(defun |describeOutputLibraryArgs| ()
+ (|sayBrightly| (list
+ '|%b| ")set compiler output library"
+ '|%d| "is used to tell the compiler where to place"
+ '|%l| "compiled code generated by the library compiler. By default it goes"
+ '|%l| "in a file called"
+ '|%b| "user.lib"
+ '|%d| "in the current directory.")))
+
+@
+
+\subsection{defun openOutputLibrary}
+The input-libraries and output-library are now truename based.
+<<defun openOutputLibrary>>=
+(defun |openOutputLibrary| (lib)
+ (declare (special output-library input-libraries))
+ (|dropInputLibrary| lib)
+ (setq output-library (truename lib))
+ (push output-library input-libraries))
+
+@
+
\subsection{input}
\begin{verbatim}
---------------------- The input Option -----------------------
@@ -7742,6 +7966,71 @@ args arguments for compiling AXIOM code
NIL
|htSetInputLibrary|)
@
+
+\subsection{defun setInputLibrary}
+The input-libraries is now maintained as a list of truenames.
+<<defun setInputLibrary>>=
+(defun |setInputLibrary| (arg)
+ (declare (special input-libraries))
+ (let (tmp1 filename act)
+ (cond
+ ((eq arg '|%initialize%|) t)
+ ((eq arg '|%display%|) (mapcar #'namestring input-libraries))
+ ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?))
+ (|describeInputLibraryArgs|))
+ ((and (pairp arg)
+ (progn
+ (setq act (qcar arg))
+ (setq tmp1 (qcdr arg))
+ (and (pairp tmp1)
+ (eq (qcdr tmp1) nil)
+ (progn (setq filename (qcar tmp1)) t)))
+ (setq act (|selectOptionLC| act '(|add| |drop|) nil)))
+ (cond
+ ((eq act '|add|)
+ (|addInputLibrary| (truename (stringimage filename))))
+ ((eq act '|drop|)
+ (|dropInputLibrary| (truename (stringimage filename))))))
+ (t (|setInputLibrary| nil)))))
+
+@
+
+\subsection{defun describeInputLibraryArgs}
+<<defun describeInputLibraryArgs>>=
+(defun |describeInputLibraryArgs| ()
+ (|sayBrightly| (list
+ '|%b| ")set compiler input add library"
+ '|%d| "is used to tell AXIOM to add"
+ '|%b| "library"
+ '|%d| "to"
+ '|%l| "the front of the path used to find compile code."
+ '|%l|
+ '|%b| ")set compiler input drop library"
+ '|%d| "is used to tell AXIOM to remove"
+ '|%b| "library"
+ '|%d|
+ '|%l| "from this path.")))
+
+@
+
+\subsection{defun addInputLibrary}
+The input-libraries variable is now maintained as a list of truenames.
+<<defun addInputLibrary>>=
+(defun |addInputLibrary| (lib)
+ (declare (special input-libraries))
+ (|dropInputLibrary| lib)
+ (push (truename lib) input-libraries))
+
+@
+
+\subsection{defun dropInputLibrary}
+<<defun dropInputLibrary>>=
+(defun |dropInputLibrary| (lib)
+ (declare (special input-libraries))
+ (setq input-libraries (delete (truename lib) input-libraries :test #'equal)))
+
+@
+
\subsection{args}
\begin{verbatim}
----------------------- The args Option -----------------------
@@ -7770,6 +8059,37 @@ args arguments for compiling AXIOM code
"-O -Fasy -Fao -Flsp -laxiom -Mno-AXL__W__WillObsolete -DAxiom -Y
$AXIOM/algebra"))
NIL)
@
+
+\subsection{defun setAsharpArgs}
+<<defun setAsharpArgs>>=
+(defun |setAsharpArgs| (arg)
+ (cond
+ ((eq arg '|%initialize%|)
+ (setq |$asharpCmdlineFlags|
+ "-O -Fasy -Fao -Flsp -laxiom -Mno-AXL_W_WillObsolete -DAxiom -Y
$AXIOM/algebra"))
+ ((eq arg '|%display%|) |$asharpCmdlineFlags|)
+ ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?))
+ (|describeAsharpArgs|))
+ (t (setq |$asharpCmdlineFlags| (car arg)))))
+
+@
+
+\subsection{defun describeAsharpArgs}
+<<defun describeAsharpArgs>>=
+(defun |describeAsharpArgs| ()
+ (|sayBrightly| (list
+ '|%b| ")set compiler args "
+ '|%d| "is used to tell AXIOM how to invoke the library compiler "
+ '|%l| " when compiling code for AXIOM."
+ '|%l| " The args option is followed by a string enclosed in double quotes."
+ '|%l|
+ '|%l| " The current setting is"
+ '|%l|
+ '|%b| "\"" |$asharpCmdlineFlags| "\""
+ '|%d|)))
+
+@
+
\section{expose}
\begin{verbatim}
---------------------- The expose Option ----------------------
@@ -9978,6 +10298,12 @@ prettyprint prettyprint BOOT func's as they compile
off
@
+<<postvars>>=
+(eval-when (eval load)
+ (|initializeSetVariables| |$setOptions|)
+
+@
+
\section{Set code}
\subsection{defun set}
@@ -10027,49 +10353,49 @@ which gets called with \verb|%describe%|
(|selectOption| (downcase (car l)) |$setOptionNames| '|optionError|))
(setq setdata (cons arg (lassoc arg settree)))
(cond
- ((null (|satisfiesUserLevel| (elt setdata 2)))
+ ((null (|satisfiesUserLevel| (third setdata)))
(|sayKeyedMsg| 's2iz0007 (list |$UserLevel| "set option" nil)))
((eql 1 (|#| l)) (|displaySetOptionInformation| arg setdata))
(t
- (setq st (elt setdata 3))
- (cond
- ((eq st 'function)
+ (setq st (fourth setdata))
+ (case (fourth setdata)
+ (FUNCTION
(setq setfunarg
(if (eq (elt l 1) 'default)
'|%initialize%|
(kdr l)))
- (if (|functionp| (elt setdata 4))
- (funcall (elt setdata 4) setfunarg)
+ (if (|functionp| (fifth setdata))
+ (funcall (fifth setdata) setfunarg)
(|sayMSG| " Function not implemented."))
(when |$displaySetValue|
(|displaySetOptionInformation| arg setdata))
NIL)
- ((eq st 'string)
+ (STRING
(setq arg2 (elt l 1))
(cond
- ((eq arg2 'default) (set (elt setdata 4) (elt setdata 6)))
- (arg2 (set (elt setdata 4) arg2))
+ ((eq arg2 'default) (set (fifth setdata) (seventh setdata)))
+ (arg2 (set (fifth setdata) arg2))
(t nil))
(when (or |$displaySetValue| (null arg2))
(|displaySetOptionInformation| arg setdata))
NIL)
- ((eq st 'integer)
+ (INTEGER
(setq arg2
(progn
(setq num (elt l 1))
(cond
((and (fixp num)
- (>= num (elt (elt setdata 5) 0))
- (or (null (setq upperlimit (elt (elt setdata 5) 1)))
+ (>= num (elt (sixth setdata) 0))
+ (or (null (setq upperlimit (elt (sixth setdata) 1)))
(<= num upperlimit)))
num)
(t
(|selectOption|
(elt l 1)
- (cons '|default| (elt setdata 5)) nil)))))
+ (cons '|default| (sixth setdata)) nil)))))
(cond
- ((eq arg2 'default) (set (elt setdata 4) (elt setdata 6)))
- (arg2 (set (elt setdata 4) arg2))
+ ((eq arg2 'default) (set (fifth setdata) (seventh setdata)))
+ (arg2 (set (fifth setdata) arg2))
(t nil))
(cond
((or |$displaySetValue| (null arg2))
@@ -10080,22 +10406,22 @@ which gets called with \verb|%describe%|
`(" Your value" ,@(|bright| (|object2String| (elt l 1)))
"is not among the valid choices.")))
(t nil)))
- ((eq st 'literals)
+ (LITERALS
(cond
((setq arg2
(|selectOption| (elt l 1)
- (cons '|default| (elt setdata 5)) nil))
+ (cons '|default| (sixth setdata)) nil))
(cond
((eq arg2 'default)
- (set (elt setdata 4)
- (|translateYesNo2TrueFalse| (elt setdata 6))))
+ (set (fifth setdata)
+ (|translateYesNo2TrueFalse| (seventh setdata))))
(t
(cond ((eq arg2 '|nobreak|) (use-fast-links t)))
(cond
((eq arg2 '|fastlinks|)
(use-fast-links nil)
(setq arg2 '|break|)))
- (set (elt setdata 4) (|translateYesNo2TrueFalse| arg2))))))
+ (set (fifth setdata) (|translateYesNo2TrueFalse| arg2))))))
(when (or |$displaySetValue| (null arg2))
(|displaySetOptionInformation| arg setdata))
(cond
@@ -10105,7 +10431,7 @@ which gets called with \verb|%describe%|
(append (|bright| (|object2String| (elt l 1)))
(cons "is not among the valid choices." nil)))))
(t nil)))
- ((eq st 'tree) (|set1| (kdr l) (elt setdata 5)) nil)
+ (TREE (|set1| (kdr l) (sixth setdata)) nil)
(t
(|sayMessage|
`("Cannot handle set tree node type" ,@(|bright| st) |yet|))
@@ -10113,79 +10439,6 @@ which gets called with \verb|%describe%|
@
-\subsection{defun displaySetOptionInformation}
-<<defun displaySetOptionInformation>>=
-(defun |displaySetOptionInformation| (arg setdata)
- (let (st current)
- (setq st (elt setdata 3))
- (cond
- ((eq st 'tree)
- (|displaySetVariableSettings| (elt setdata 5) (elt setdata 0)))
- (t
- (|centerAndHighlight|
- (strconc "The " (|object2String| arg) " Option")
- $linelength (|specialChar| '|hbar|))
- (|sayBrightly|
- `(|%l| ,@(|bright| "Description:") ,(elt setdata 1)))
- (cond
- ((eq st 'function)
- (terpri)
- (cond
- ((|functionp| (elt setdata 4))
- (funcall (elt setdata 4) '|%describe%|))
- (t (|sayMSG| " Function not implemented."))))
- ((eq st 'integer)
- (|sayMessage|
- `(" The" ,@(|bright| arg) "option"
- " may be followed by an integer in the range"
- ,@(|bright| (ELT (ELT setdata 5) 0)) "to"
- |%l| ,@(|bright| (ELT (ELT setdata 5) 1)) "inclusive."
- " The current setting is" ,@(|bright| (|eval| (elt setdata 4))))))
- ((eq st 'string)
- (|sayMessage|
- `(" The" ,@(|bright| arg) "option"
- " is followed by a string enclosed in double quote marks."
- '|%l| " The current setting is"
- ,@(|bright| (list '|"| (|eval| (elt setdata 4)) '|"|)))))
- ((eq st 'literals)
- (|sayMessage|
- `(" The" ,@(|bright| arg) "option"
- " may be followed by any one of the following:"))
- (setq current
- (|translateTrueFalse2YesNo| (|eval| (elt setdata 4))))
- (do ((t0 (elt setdata 5) (cdr t0)) (|name| nil))
- ((or (atom t0) (progn (setq |name| (car t0)) nil)) nil)
- (seq
- (exit
- (cond
- ((boot-equal |name| current)
- (|sayBrightly|
- `( " ->" ,@(|bright| (|object2String| |name|)))))
- (t
- (|sayBrightly| (list " " (|object2String| |name|))))))))
- (|sayMessage| " The current setting is indicated.")))))))
-
-@
-
-\subsection{defun translateYesNo2TrueFalse}
-<<defun translateYesNo2TrueFalse>>=
-(defun |translateYesNo2TrueFalse| (x)
- (cond
- ((|member| x '(|yes| |on|)) t)
- ((|member| x '(|no| |off|)) nil)
- (t x)))
-
-@
-
-\subsection{defun translateTrueFalse2YesNo}
-<<defun translateTrueFalse2YesNo>>=
-(defun |translateTrueFalse2YesNo| (x)
- (cond
- ((eq x t) '|on|)
- ((null x) '|off|)
- (t x)))
-
-@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\cmdhead{show}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -15314,6 +15567,7 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun abbreviations>>
<<defun abbreviationsSpad2Cmd>>
+<<defun addInputLibrary>>
<<defun addNewInterpreterFrame>>
<<defun addTraceItem>>
<<defun apropos>>
@@ -15352,6 +15606,9 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun createCurrentInterpreterFrame>>
<<defun credits>>
+<<defun describeAsharpArgs>>
+<<defun describeInputLibraryArgs>>
+<<defun describeOutputLibraryArgs>>
<<defun dewritify>>
<<defun dewritify,dewritifyInner>>
<<defun dewritify,is?>>
@@ -15362,8 +15619,10 @@ load the file \verb|exposed.lsp| to set up the
exposure group information.
<<defun displayMacros>>
<<defun displayOperations>>
<<defun displaySetOptionInformation>>
+<<defun displaySetVariableSettings>>
<<defun displaySpad2Cmd>>
<<defun domainToGenvar>>
+<<defun dropInputLibrary>>
<<defun emptyInterpreterFrame>>
@@ -15415,6 +15674,7 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun initHist>>
<<defun initHistList>>
<<defun initializeInterpreterFrameRing>>
+<<defun initializeSetVariables>>
<<defun init-memory-config>>
<<defun initroot>>
<<defun intloop>>
@@ -15453,6 +15713,7 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun nextInterpreterFrame>>
<<defun oldHistFileName>>
+<<defun openOutputLibrary>>
<<defun openserver>>
<<defun orderBySlotNumber>>
@@ -15488,6 +15749,7 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun resetInCoreHist>>
<<defun resetSpacers>>
<<defun resetTimers>>
+<<defun resetWorkspaceVariables>>
<<defun restart>>
<<defun restoreHistory>>
<<defun runspad>>
@@ -15499,9 +15761,12 @@ load the file \verb|exposed.lsp| to set up the
exposure group information.
<<defun ScanOrPairVec>>
<<defun set>>
<<defun set1>>
+<<defun setAsharpArgs>>
<<defun setCurrentLine>>
<<defun setHistoryCore>>
+<<defun setInputLibrary>>
<<defun setIOindex>>
+<<defun setOutputLibrary>>
<<defun set-restart-hook>>
<<defun shortenForPrinting>>
<<defun showHistory>>
diff --git a/changelog b/changelog
index 5bccecf..1f1e54b 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,11 @@
+20090315 tpd src/axiom-website/patches.html 20090315.01.tpd.patch
+20090315 tpd src/interp/setvars.boot remove set and library handling
+20090315 tpd src/interp/daase.lisp fix input-libraries
+20090315 tpd src/interp/bootfuns.lisp remove initializeSetVariables
+20090315 tpd src/input/setcmd.input update set tests
+20090315 tpd src/input/cmds.input update cmd tests
+20090315 tpd books/bookvol5 collect set support functions
+20090315 tpd src/interp/daase.lisp remove open-library calls
20090314 tpd src/axiom-website/patches.html 20090314.01.tpd.patch
20090314 tpd books/bookvol5 document )set, include root code
20090314 tpd src/input/Makefile add cmds, setcmd unit tests
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index f477e09..fcaf084 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -1003,5 +1003,7 @@ bookvol10.4 add credits, summary to API package<br/>
bookvol5 add quit, pquit roots<br/>
<a href="patches/20090314.01.tpd.patch">20090314.01.tpd.patch</a>
bookvol5 document )set, include root code<br/>
+<a href="patches/20090315.01.tpd.patch">20090315.01.tpd.patch</a>
+bookvol5 document collect set support functions<br/>
</body>
</html>
diff --git a/src/input/cmds.input.pamphlet b/src/input/cmds.input.pamphlet
index 4051b0c..ba7844d 100644
--- a/src/input/cmds.input.pamphlet
+++ b/src/input/cmds.input.pamphlet
@@ -834,6 +834,103 @@
--R ZDSOLVE ZeroDimensionalSolvePackage ZLINDEP IntegerLinearDependence
--E 15
+@
+This exercises setOutputLibrary, setInputLibrary, and setAsharpArgs
+<<*>>=
+--S 16
+)set compiler
+--R Current Values of compiler Variables
+--R
+--RVariable Description Current Value
+--R-----------------------------------------------------------------------------
+--Routput library in which to place compiled code
+--Rinput controls libraries from which to load compiled code
+--Rargs arguments for compiling AXIOM code -O -Fasy -Fao -Flsp
-laxiom -Mno-AXL_W_WillObsolete -DAxiom -Y $AXIOM/algebra
+--R
+--E 16
+
+@
+This exercises setInputLibrary, describeInputLibraryArgs
+<<*>>=
+--S 17
+)set compiler input
+--R---------------------------- The input Option -----------------------------
+--R
+--R Description: controls libraries from which to load compiled code
+--R
+--R )set compiler input add library is used to tell AXIOM to add library to
+--Rthe front of the path which determines where compiled code is loaded from.
+--R )set compiler input drop library is used to tell AXIOM to remove library
+--Rfrom this path.
+--E 17
+
+--S
+)set compiler input add
+--R )set compiler input add library is used to tell AXIOM to add library to
+--Rthe front of the path which determines where compiled code is loaded from.
+--R )set compiler input drop library is used to tell AXIOM to remove library
+--Rfrom this path.
+--E
+
+--S
+)set compiler input add foo
+--R
+--R >> System error:
+--R OPEN-LIBRARY is invalid as a function.
+--R
+--E
+
+@
+This exercises setOutputLibrary
+<<*>>=
+--S 18
+)set compiler output
+--R---------------------------- The output Option ----------------------------
+--R
+--R Description: library in which to place compiled code
+--R
+--R )set compiler output library is used to tell the compiler where to place
+--Rcompiled code generated by the library compiler. By default it goes
+--Rin a file called user.lib in the current directory.
+--E 18
+
+@
+This exercises setAsharpArgs
+<<*>>=
+--S 19
+)set compiler args
+--R----------------------------- The args Option -----------------------------
+--R
+--R Description: arguments for compiling AXIOM code
+--R
+--R )set compiler args is used to tell AXIOM how to invoke the library
compiler
+--R when compiling code for AXIOM.
+--R The args option is followed by a string enclosed in double quotes.
+--R
+--R The current setting is
+--R "-O -Fasy -Fao -Flsp -laxiom -Mno-AXL_W_WillObsolete -DAxiom -Y
$AXIOM/algebra"
+--E 19
+
+This exercises setAsharpArgs
+<<*>>=
+--S 20
+)set compiler args "-TPD"
+--E 20
+
+--S 21
+)set compiler args
+--R----------------------------- The args Option -----------------------------
+--R
+--R Description: arguments for compiling AXIOM code
+--R
+--R )set compiler args is used to tell AXIOM how to invoke the library
compiler
+--R when compiling code for AXIOM.
+--R The args option is followed by a string enclosed in double quotes.
+--R
+--R The current setting is
+--R "-TPD"
+--E 21
+
)spool
)lisp (bye)
diff --git a/src/input/setcmd.input.pamphlet b/src/input/setcmd.input.pamphlet
index cc01582..399bca1 100644
--- a/src/input/setcmd.input.pamphlet
+++ b/src/input/setcmd.input.pamphlet
@@ -39,7 +39,7 @@
--R
--RVariable Description Current Value
--R-----------------------------------------------------------------------------
---Routput library in which to place compiled code
+--Routput library in which to place compiled code user.lib
--Rinput controls libraries from which to load compiled code
--Rargs arguments for compiling AXIOM code -O -Fasy -Fao -Flsp
-laxiom -Mno-AXL_W_WillObsolete -DAxiom -Y $AXIOM/algebra
--R
@@ -51,7 +51,7 @@
--R
--RVariable Description Current Value
--R-----------------------------------------------------------------------------
---Routput library in which to place compiled code
+--Routput library in which to place compiled code user.lib
--Rinput controls libraries from which to load compiled code
--Rargs arguments for compiling AXIOM code -O -Fasy -Fao -Flsp
-laxiom -Mno-AXL_W_WillObsolete -DAxiom -Y $AXIOM/algebra
--R
@@ -64,17 +64,21 @@
--R Description: controls libraries from which to load compiled code
--R
--R )set compiler input add library is used to tell AXIOM to add library to
---Rthe front of the path which determines where compiled code is loaded from.
+--Rthe front of the path used to find compile code.
--R )set compiler input drop library is used to tell AXIOM to remove library
--Rfrom this path.
--E 4
--S 5 of 86
)set compiler output
+--R
--R---------------------------- The output Option ----------------------------
--R
--R Description: library in which to place compiled code
--R
+--R )set compiler output library is used to tell the compiler where to place
+--Rcompiled code generated by the library compiler. By default it goes
+--Rin a file called user.lib in the current directory.
--E 5
--S 6 of 86
diff --git a/src/interp/bootfuns.lisp.pamphlet
b/src/interp/bootfuns.lisp.pamphlet
index 6b57dfe..e94b453 100644
--- a/src/interp/bootfuns.lisp.pamphlet
+++ b/src/interp/bootfuns.lisp.pamphlet
@@ -81,7 +81,6 @@ which will walk the structure $Y$ looking for this constant.
(defparameter ,p ,val ,where)
(export '(,p) "BOOT")))
-(def-boot-fun |initializeSetVariables| (arg) "early temp def")
(def-boot-fun |updateSourceFiles| (x) "temp def")
#-:CCL
(def-boot-val |$timerTicksPerSecond| INTERNAL-TIME-UNITS-PER-SECOND
diff --git a/src/interp/daase.lisp.pamphlet b/src/interp/daase.lisp.pamphlet
index ab1cfcb..4ea1fe5 100644
--- a/src/interp/daase.lisp.pamphlet
+++ b/src/interp/daase.lisp.pamphlet
@@ -949,7 +949,7 @@ database.
;; Open the library
(let (lib)
(if (filep (setq lib (make-pathname :name object :type "lib")) )
- (setq input-libraries (cons (open-library (truename lib))
input-libraries))))
+ (setq input-libraries (cons (truename lib) input-libraries))))
(set-file-getter object) ; sets the autoload property for G-object
(dolist (domain asy)
(setq key (first domain))
@@ -1099,7 +1099,7 @@ database.
#+:CCL
(let (lib)
(if (filep (setq lib (make-pathname :name object :type "lib")) )
- (setq input-libraries (cons (open-library (truename lib))
input-libraries)))
+ (setq input-libraries (cons (truename lib) input-libraries)))
(|unloadOneConstructor| (get abbrev 'abbreviationfor) abbrev) )
(|sayKeyedMsg| 'S2IU0001 (list key object))))))
diff --git a/src/interp/setvars.boot.pamphlet b/src/interp/setvars.boot.pamphlet
index d75cde4..a69b40d 100644
--- a/src/interp/setvars.boot.pamphlet
+++ b/src/interp/setvars.boot.pamphlet
@@ -41,220 +41,7 @@ its arguments, such as describeSetOutputFortran.
\section{Top level set functions}
The {\bf set} function in this file handles the top level {\bf )set}
command line functions.
-<<toplevelsetfunctions>>=
-<<initializeSetVariables>>
-<<resetWorkspaceVariables>>
-<<displaySetVariableSettings>>
-@
-\section{initializeSetVariables}
-<<initializeSetVariables>>=
-initializeSetVariables (setTree) ==
- -- this function passes through the table of set variable information
- -- and initializes the variables to their default definitions.
- for setData in setTree repeat
- st := setData.setType
- st = 'FUNCTION =>
- -- here setVar is really the name of a function to call
- if functionp(setData.setVar)
- then FUNCALL( setData.setVar,"%initialize%")
- else sayMSG '" Function not implemented."
- st = 'INTEGER =>
- SET(setData.setVar, setData.setDef)
- st = 'STRING =>
- SET(setData.setVar, setData.setDef)
- st = 'LITERALS =>
- SET(setData.setVar, translateYesNo2TrueFalse setData.setDef)
- st = 'TREE =>
- initializeSetVariables(setData.setLeaf)
-
-@
-\subsection{resetWorkspaceVariables}
-<<resetWorkspaceVariables>>=
-resetWorkspaceVariables () ==
- -- this replaces def in DEBUG LISP
- -- this function resets many workspace variables to their default
- -- values. Some things are reset by start and not reset by restart.
- SETQ(_/COUNTLIST , NIL)
- SETQ(_/EDITFILE , NIL)
- SETQ(_/SOURCEFILES , NIL)
- SETQ($sourceFiles , NIL)
- SETQ(_/PRETTY , NIL)
- SETQ(_/SPACELIST , NIL)
- SETQ(_/TIMERLIST , NIL)
- SETQ($existingFiles , MAKE_-HASHTABLE 'UEQUAL)
- SETQ($functionTable , NIL)
- SETQ($BOOT , NIL)
- SETQ($compileMapFlag , NIL)
- SETQ($echoLineStack , NIL)
- SETQ($operationNameList , NIL)
- SETQ($slamFlag , NIL)
- SETQ($CommandSynonymAlist , COPY($InitialCommandSynonymAlist))
- SETQ($UserAbbreviationsAlist , NIL)
- SETQ($msgAlist , NIL)
- SETQ($msgDatabase , NIL)
- SETQ($msgDatabaseName , NIL)
- SETQ($dependeeClosureAlist , NIL)
- SETQ($IOindex , 1 )
- SETQ($coerceIntByMapCounter , 0 )
- SETQ($e , [[NIL]])
- SETQ($env , [[NIL]])
-
- -- many variables set by the following
-
- initializeSetVariables($setOptions)
-
-@
-
-\subsection{displaySetVariableSettings}
-<<displaySetVariableSettings>>=
-displaySetVariableSettings(setTree,label) ==
- if label = "" then label := '")set"
- else label := STRCONC('" ",object2String label,'" ")
- centerAndHighlight(STRCONC('"Current Values of ",label,
- '" Variables"),$LINELENGTH," ")
- TERPRI()
- sayBrightly ["Variable ",
- "Description ",
- "Current Value"]
- SAY fillerSpaces($LINELENGTH,specialChar 'hbar)
- subtree := nil
- for setData in setTree repeat
- null satisfiesUserLevel setData.setLevel => nil
- setOption := object2String setData.setName
- setOption := STRCONC(setOption,fillerSpaces(13-#setOption,'" "),
- setData.setLabel)
- setOption := STRCONC(setOption,fillerSpaces(55-#setOption,'" "))
- st := setData.setType
- st = 'FUNCTION =>
- opt :=
- functionp(setData.setVar) => FUNCALL( setData.setVar,"%display%")
- '"unimplemented"
- if PAIRP opt then opt := [:[o,'" "] for o in opt]
- sayBrightly concat(setOption,'%b,opt,'%d)
- st = 'STRING =>
- opt := object2String eval setData.setVar
- sayBrightly [setOption,:bright opt]
- st = 'INTEGER =>
- opt := object2String eval setData.setVar
- sayBrightly [setOption,:bright opt]
- st = 'LITERALS =>
- opt := object2String translateTrueFalse2YesNo eval setData.setVar
- sayBrightly [setOption,:bright opt]
- st = 'TREE =>
- sayBrightly [setOption,:bright '"..."]
- subtree := true
- subname := object2String setData.setName
- TERPRI()
- subtree =>
- sayBrightly ['"Variables with current values of",:bright '"...",
- '"have further sub-options. For example,"]
- sayBrightly ['"issue",:bright '")set ",subname,
- '" to see what the options are for",:bright subname,'".",'%l,
- '"For more information, issue",:bright '")help set",'"."]
-
-@
-\section{compiler}
-See the section compiler in setvart.boot.pamphlet\cite{1}.
-\begin{verbatim}
- Current Values of compiler Variables
-
-Variable Description Current Value
------------------------------------------------------------------
-output library in which to place compiled code
-input controls libraries from which to load compiled code
-args arguments for compiling AXIOM code
- -O -Fasy -Fao -Flsp -laxiom -Mno-AXL_W_WillObsolete
- -DAxiom -Y $AXIOM/algebra
-
-\end{verbatim}
-<<compilerCode>>=
-<<setAsharpArgs>>
-<<describeAsharpArgs>>
-<<setInputLibrary>>
-<<setOutputLibrary>>
-<<describeOutputLibraryArgs>>
-<<describeInputLibraryArgs>>
-@
-\subsection{setAsharpArgs}
-<<setAsharpArgs>>=
-setAsharpArgs arg ==
- arg = "%initialize%" =>
- $asharpCmdlineFlags := '"-O -Fasy -Fao -Flsp -laxiom
-Mno-AXL__W__WillObsolete -DAxiom -Y $AXIOM/algebra"
- arg = "%display%" =>
- $asharpCmdlineFlags
- (null arg) or (arg = "%describe%") or (first arg = '_?) =>
- describeAsharpArgs()
- $asharpCmdlineFlags := first(arg)
-
-@
-\subsection{describeAsharpArgs}
-<<describeAsharpArgs>>=
-describeAsharpArgs() ==
- sayBrightly LIST (
- '%b,'")set compiler args ",'%d,_
- '"is used to tell AXIOM how to invoke the library compiler ",'%l,_
- '" when compiling code for AXIOM.",'%l,_
- '" The args option is followed by a string enclosed in double
quotes.",'%l,'%l,_
- '" The current setting is",'%l,'%b,'"_"",$asharpCmdlineFlags,'"_"",'%d)
-@
-\subsection{setInputLibrary}
-<<setInputLibrary>>=
-setInputLibrary arg ==
- arg = "%initialize%" =>
- true
- arg = "%display%" =>
- [LIBRARY_-NAME(u) for u in INPUT_-LIBRARIES]
- (null arg) or (arg = "%describe%") or (first arg = '_?) =>
- describeInputLibraryArgs()
- arg is [act, filename] and (act := selectOptionLC(act,'(add drop),nil)) =>
- act = 'add => addInputLibrary TRUENAME STRINGIMAGE filename
- act = 'drop => dropInputLibrary TRUENAME STRINGIMAGE filename
- setInputLibrary NIL
-
-@
-\subsection{setOutputLibrary}
-<<setOutputLibrary>>=
-setOutputLibrary arg ==
- -- Hack to avoid initialising libraries in KCL:
- not $cclSystem => false
- arg = "%initialize%" =>
- $outputLibraryName := nil
- arg = "%display%" =>
- $outputLibraryName or '"user.lib"
- (null arg) or (arg = "%describe%") or (first arg = '_?) =>
- describeOutputLibraryArgs()
- not ONEP(#arg) => setOutputLibrary nil
- -- If the file already exists then use the complete pathname to help
- -- keep track of it in the case the user issues )cd commands.
- if FILEP (fn := STRINGIMAGE first arg) then fn := TRUENAME fn
- openOutputLibrary($outputLibraryName := fn)
-
-@
-\subsection{describeOutputLibraryArgs}
-<<describeOutputLibraryArgs>>=
-describeOutputLibraryArgs() ==
- sayBrightly LIST (
- '%b,'")set compiler output library",'%d,_
- '"is used to tell the compiler where to place", '%l,_
- '"compiled code generated by the library compiler. By default it
goes",'%l,_
- '"in a file called",'%b, '"user.lib", '%d, '"in the current directory."
- )
-
-@
-\subsection{describeInputLibraryArgs}
-<<describeInputLibraryArgs>>=
-describeInputLibraryArgs() ==
- sayBrightly LIST (
- '%b,'")set compiler input add library",'%d,_
- '"is used to tell AXIOM to add", '%b, '"library", '%d, '"to",'%l,
- '"the front of the path which determines where compiled code is loaded
from.",_
- '%l, '%b,'")set compiler input drop library",'%d,_
- '"is used to tell AXIOM to remove", '%b, '"library", '%d, '%l,_
- '"from this path."
- )
-
-@
\section{expose}
See the section expose in setvart.boot.pamphlet\cite{1}
\begin{verbatim}
@@ -1775,8 +1562,6 @@ describeSetStreamsCalculate() ==
sayKeyedMsg("S2IV0001",[$streamCount])
@
<<*>>=
<<license>>
-<<toplevelsetfunctions>>
-<<compilerCode>>
<<exposeCode>>
<<fortrancallingCode>>
<<functionsCode>>
@@ -1797,362 +1582,6 @@ describeSetStreamsCalculate() ==
sayKeyedMsg("S2IV0001",[$streamCount])
(IN-PACKAGE "BOOT" )
-(DEFUN |initializeSetVariables| (|setTree|)
- (PROG (|st|)
- (RETURN
- (SEQ
- (DO ((#0=#:G2723 |setTree| (CDR #0#)) (|setData| NIL))
- ((OR (ATOM #0#) (PROGN (SETQ |setData| (CAR #0#)) NIL)) NIL)
- (SEQ
- (EXIT
- (PROGN
- (SPADLET |st| (ELT |setData| 3))
- (COND
- ((BOOT-EQUAL |st| (QUOTE FUNCTION))
- (COND
- ((|functionp| (ELT |setData| 4))
- (FUNCALL (ELT |setData| 4) (QUOTE |%initialize%|)))
- ((QUOTE T) (|sayMSG| (MAKESTRING " Function not implemented.")))))
- ((BOOT-EQUAL |st| (QUOTE INTEGER))
- (SET (ELT |setData| 4) (ELT |setData| 6)))
- ((BOOT-EQUAL |st| (QUOTE STRING))
- (SET (ELT |setData| 4) (ELT |setData| 6)))
- ((BOOT-EQUAL |st| (QUOTE LITERALS))
- (SET (ELT |setData| 4)
- (|translateYesNo2TrueFalse| (ELT |setData| 6))))
- ((BOOT-EQUAL |st| (QUOTE TREE))
- (|initializeSetVariables| (ELT |setData| 5))))))))))))
-
-
-(DEFUN |resetWorkspaceVariables| NIL
- (PROGN
- (SETQ /COUNTLIST NIL)
- (SETQ /EDITFILE NIL)
- (SETQ /SOURCEFILES NIL)
- (SETQ |$sourceFiles| NIL)
- (SETQ /PRETTY NIL)
- (SETQ /SPACELIST NIL)
- (SETQ /TIMERLIST NIL)
- (SETQ |$existingFiles| (MAKE-HASHTABLE (QUOTE UEQUAL)))
- (SETQ |$functionTable| NIL)
- (SETQ $BOOT NIL)
- (SETQ |$compileMapFlag| NIL)
- (SETQ |$echoLineStack| NIL)
- (SETQ |$operationNameList| NIL)
- (SETQ |$slamFlag| NIL)
- (SETQ |$CommandSynonymAlist| (COPY |$InitialCommandSynonymAlist|))
- (SETQ |$UserAbbreviationsAlist| NIL)
- (SETQ |$msgAlist| NIL)
- (SETQ |$msgDatabase| NIL)
- (SETQ |$msgDatabaseName| NIL)
- (SETQ |$dependeeClosureAlist| NIL)
- (SETQ |$IOindex| 1)
- (SETQ |$coerceIntByMapCounter| 0)
- (SETQ |$e| (CONS (CONS NIL NIL) NIL))
- (SETQ |$env| (CONS (CONS NIL NIL) NIL))
- (|initializeSetVariables| |$setOptions|)))
-
-(DEFUN |translateYesNo2TrueFalse| (|x|)
- (COND
- ((|member| |x| (QUOTE (|yes| |on|))) (QUOTE T))
- ((|member| |x| (QUOTE (|no| |off|))) NIL)
- ((QUOTE T) |x|)))
-
-(DEFUN |translateTrueFalse2YesNo| (|x|)
- (COND
- ((BOOT-EQUAL |x| (QUOTE T)) (QUOTE |on|))
- ((NULL |x|) (QUOTE |off|))
- ((QUOTE T) |x|)))
-
-(DEFUN |set| (|l|) (|set1| |l| |$setOptions|))
-
-(DEFUN |set1| (|l| |setTree|)
- (PROG (|$setOptionNames| |arg| |setData| |st| |setfunarg| |num|
- |upperlimit| |arg2|)
- (DECLARE (SPECIAL |$setOptionNames|))
- (RETURN
- (SEQ
- (COND
- ((NULL |l|) (|displaySetVariableSettings| |setTree| (QUOTE ||)))
- ((QUOTE T)
- (SPADLET |$setOptionNames|
- (PROG (#0=#:G2762)
- (SPADLET #0# NIL)
- (RETURN
- (DO
- ((#1=#:G2767 |setTree| (CDR #1#)) (|x| NIL))
- ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#))
- (SEQ (EXIT (SETQ #0# (CONS (ELT |x| 0) #0#))))))))
- (SPADLET |arg|
- (|selectOption| (DOWNCASE (CAR |l|))
- |$setOptionNames| (QUOTE |optionError|)))
- (SPADLET |setData| (CONS |arg| (LASSOC |arg| |setTree|)))
- (COND
- ((NULL (|satisfiesUserLevel| (ELT |setData| 2)))
- (|sayKeyedMsg| (QUOTE S2IZ0007)
- (CONS |$UserLevel| (CONS (MAKESTRING "set option") NIL))))
- ((EQL 1 (|#| |l|)) (|displaySetOptionInformation| |arg| |setData|))
- ((QUOTE T)
- (SPADLET |st| (ELT |setData| 3))
- (COND
- ((BOOT-EQUAL |st| (QUOTE FUNCTION))
- (SPADLET |setfunarg|
- (COND
- ((BOOT-EQUAL (ELT |l| 1) (QUOTE DEFAULT))
- (QUOTE |%initialize%|))
- ((QUOTE T) (KDR |l|))))
- (COND
- ((|functionp| (ELT |setData| 4))
- (FUNCALL (ELT |setData| 4) |setfunarg|))
- ((QUOTE T)
- (|sayMSG| (MAKESTRING " Function not implemented."))))
- (COND
- (|$displaySetValue|
- (|displaySetOptionInformation| |arg| |setData|)))
- NIL)
- ((BOOT-EQUAL |st| (QUOTE STRING))
- (SPADLET |arg2| (ELT |l| 1))
- (COND
- ((BOOT-EQUAL |arg2| (QUOTE DEFAULT))
- (SET (ELT |setData| 4) (ELT |setData| 6)))
- (|arg2| (SET (ELT |setData| 4) |arg2|)) ((QUOTE T) NIL))
- (COND
- ((OR |$displaySetValue| (NULL |arg2|))
- (|displaySetOptionInformation| |arg| |setData|)))
- NIL)
- ((BOOT-EQUAL |st| (QUOTE INTEGER))
- (SPADLET |arg2|
- (PROGN
- (SPADLET |num| (ELT |l| 1))
- (COND
- ((AND
- (FIXP |num|)
- (>= |num| (ELT (ELT |setData| 5) 0))
- (OR
- (NULL (SPADLET |upperlimit| (ELT (ELT |setData| 5) 1)))
- (<= |num| |upperlimit|)))
- |num|)
- ((QUOTE T)
- (|selectOption| (ELT |l| 1)
- (CONS (QUOTE |default|) (ELT |setData| 5)) NIL)))))
- (COND
- ((BOOT-EQUAL |arg2| (QUOTE DEFAULT))
- (SET (ELT |setData| 4) (ELT |setData| 6)))
- (|arg2| (SET (ELT |setData| 4) |arg2|))
- ((QUOTE T) NIL))
- (COND
- ((OR |$displaySetValue| (NULL |arg2|))
- (|displaySetOptionInformation| |arg| |setData|)))
- (COND
- ((NULL |arg2|)
- (|sayMessage|
- (CONS
- (MAKESTRING " Your value")
- (APPEND
- (|bright| (|object2String| (ELT |l| 1)))
- (CONS
- (MAKESTRING "is not among the valid choices.")
- NIL)))))
- ((QUOTE T) NIL)))
- ((BOOT-EQUAL |st| (QUOTE LITERALS))
- (COND
- ((SPADLET |arg2|
- (|selectOption| (ELT |l| 1)
- (CONS (QUOTE |default|) (ELT |setData| 5)) NIL))
- (COND
- ((BOOT-EQUAL |arg2| (QUOTE DEFAULT))
- (SET (ELT |setData| 4)
- (|translateYesNo2TrueFalse| (ELT |setData| 6))))
- ((QUOTE T)
- (COND
- ((BOOT-EQUAL |arg2| (QUOTE |nobreak|))
- (USE-FAST-LINKS (QUOTE T))))
- (COND
- ((BOOT-EQUAL |arg2| (QUOTE |fastlinks|))
- (USE-FAST-LINKS (QUOTE NIL))
- (SPADLET |arg2| (QUOTE |break|))))
- (SET (ELT |setData| 4)
- (|translateYesNo2TrueFalse| |arg2|))))))
- (COND
- ((OR |$displaySetValue| (NULL |arg2|))
- (|displaySetOptionInformation| |arg| |setData|)))
- (COND
- ((NULL |arg2|)
- (|sayMessage|
- (CONS
- (MAKESTRING " Your value")
- (APPEND
- (|bright| (|object2String| (ELT |l| 1)))
- (CONS
- (MAKESTRING "is not among the valid choices.")
- NIL)))))
- ((QUOTE T) NIL)))
- ((BOOT-EQUAL |st| (QUOTE TREE))
- (|set1| (KDR |l|) (ELT |setData| 5))
- NIL)
- ((QUOTE T)
- (|sayMessage|
- (CONS
- (MAKESTRING "Cannot handle set tree node type")
- (APPEND
- (|bright| |st|)
- (CONS (QUOTE |yet|) NIL))))
- NIL))))))))))
-
-;displaySetOptionInformation(arg,setData) ==
-; st := setData.setType
-; -- if the option is a sub-tree, show the full menu
-; st = 'TREE =>
-; displaySetVariableSettings(setData.setLeaf,setData.setName)
-; -- otherwise we want to show the current setting
-; centerAndHighlight (STRCONC('"The ",object2String arg,'" Option"),
-; $LINELENGTH,specialChar 'hbar)
-; sayBrightly ['%l,:bright '"Description:",setData.setLabel]
-; st = 'FUNCTION =>
-; TERPRI()
-; if functionp(setData.setVar)
-; then FUNCALL(setData.setVar,"%describe%")
-; else sayMSG '" Function not implemented."
-; st = 'INTEGER =>
-; sayMessage ['" The",:bright arg,'"option",
-; '" may be followed by an integer in the range",
-; :bright (setData.setLeaf).0,'"to",'%l,
-; :bright (setData.setLeaf).1,'"inclusive.",
-; '" The current setting is",:bright eval setData.setVar]
-; st = 'STRING =>
-; sayMessage ['" The",:bright arg,'"option",
-; '" is followed by a string enclosed in double quote marks.", '%l,
-; '" The current setting is",:bright ["_"",eval setData.setVar, "_""]]
-; st = 'LITERALS =>
-; sayMessage ['" The",:bright arg,'"option",
-; '" may be followed by any one of the following:"]
-; current := translateTrueFalse2YesNo eval setData.setVar
-; for name in setData.setLeaf repeat
-; if name = current
-; then sayBrightly ['" ->",:bright object2String name]
-; else sayBrightly ['" ",object2String name]
-; sayMessage '" The current setting is indicated within the list."
-; if (setData.setLeaf = '(yes no on off)) or
-; (setData.setLeaf = '(yes no on off long)) then
-; sayMessage [:bright '"yes",'"and",:bright '"no",
-; '"have the same effect as",:bright '"on",'"and",:bright '"off",
-; '"respectively."]
-
-(DEFUN |displaySetOptionInformation| (|arg| |setData|) (PROG (|st| |current|)
(RETURN (SEQ (PROGN (SPADLET |st| (ELT |setData| 3)) (COND ((BOOT-EQUAL |st|
(QUOTE TREE)) (|displaySetVariableSettings| (ELT |setData| 5) (ELT |setData|
0))) ((QUOTE T) (|centerAndHighlight| (STRCONC (MAKESTRING "The ")
(|object2String| |arg|) (MAKESTRING " Option")) $LINELENGTH (|specialChar|
(QUOTE |hbar|))) (|sayBrightly| (CONS (QUOTE |%l|) (APPEND (|bright|
(MAKESTRING "Description:")) (CONS (ELT |setData| 1) NIL)))) (COND ((BOOT-EQUAL
|st| (QUOTE FUNCTION)) (TERPRI) (COND ((|functionp| (ELT |setData| 4)) (FUNCALL
(ELT |setData| 4) (QUOTE |%describe%|))) ((QUOTE T) (|sayMSG| (MAKESTRING "
Function not implemented."))))) ((BOOT-EQUAL |st| (QUOTE INTEGER))
(|sayMessage| (CONS (MAKESTRING " The") (APPEND (|bright| |arg|) (CONS
(MAKESTRING "option") (CONS (MAKESTRING " may be followed by an integer in the
range") (APPEND (|bright| (ELT (ELT |setData| 5) 0)) (CONS (MAKESTRING "to")
(CONS (QUOTE !
|%l|) (APPEND (|bright| (ELT (ELT |setData| 5) 1)) (CONS (MAKESTRING
"inclusive.") (CONS (MAKESTRING " The current setting is") (|bright| (|eval|
(ELT |setData| 4))))))))))))))) ((BOOT-EQUAL |st| (QUOTE STRING)) (|sayMessage|
(CONS (MAKESTRING " The") (APPEND (|bright| |arg|) (CONS (MAKESTRING "option")
(CONS (MAKESTRING " is followed by a string enclosed in double quote marks.")
(CONS (QUOTE |%l|) (CONS (MAKESTRING " The current setting is") (|bright| (CONS
(QUOTE |"|) (CONS (|eval| (ELT |setData| 4)) (CONS (QUOTE |"|) NIL))))))))))))
((BOOT-EQUAL |st| (QUOTE LITERALS)) (PROGN (|sayMessage| (CONS (MAKESTRING "
The") (APPEND (|bright| |arg|) (CONS (MAKESTRING "option") (CONS (MAKESTRING "
may be followed by any one of the following:") NIL))))) (SPADLET |current|
(|translateTrueFalse2YesNo| (|eval| (ELT |setData| 4)))) (DO ((#0=#:G2796 (ELT
|setData| 5) (CDR #0#)) (|name| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |name| (CAR
#0#)) NIL)) NIL) (SEQ (EXIT (COND ((BOOT-EQUAL |name| |cur!
rent|) (|sayBrightly| (CONS (MAKESTRING " ->") (|bright| (|ob!
ject2String| |name|))))) ((QUOTE T) (|sayBrightly| (CONS (MAKESTRING " ")
(CONS (|object2String| |name|) NIL)))))))) (|sayMessage| (MAKESTRING " The
current setting is indicated within the list.")) (COND ((OR (BOOT-EQUAL (ELT
|setData| 5) (QUOTE (|yes| |no| |on| |off|))) (BOOT-EQUAL (ELT |setData| 5)
(QUOTE (|yes| |no| |on| |off| |long|)))) (|sayMessage| (APPEND (|bright|
(MAKESTRING "yes")) (CONS (MAKESTRING "and") (APPEND (|bright| (MAKESTRING
"no")) (CONS (MAKESTRING "have the same effect as") (APPEND (|bright|
(MAKESTRING "on")) (CONS (MAKESTRING "and") (APPEND (|bright| (MAKESTRING
"off")) (CONS (MAKESTRING "respectively.") NIL)))))))))) ((QUOTE T)
NIL))))))))))))
-;displaySetVariableSettings(setTree,label) ==
-; if label = "" then label := '")set"
-; else label := STRCONC('" ",object2String label,'" ")
-; centerAndHighlight(STRCONC('"Current Values of ",label,
-; '" Variables"),$LINELENGTH," ")
-; TERPRI()
-; sayBrightly ["Variable ",
-; "Description ",
-; "Current Value"]
-; SAY fillerSpaces($LINELENGTH,specialChar 'hbar)
-; subtree := nil
-; for setData in setTree repeat
-; null satisfiesUserLevel setData.setLevel => nil
-; setOption := object2String setData.setName
-; setOption := STRCONC(setOption,fillerSpaces(13-#setOption,'" "),
-; setData.setLabel)
-; setOption := STRCONC(setOption,fillerSpaces(55-#setOption,'" "))
-; st := setData.setType
-; st = 'FUNCTION =>
-; opt :=
-; functionp(setData.setVar) => FUNCALL( setData.setVar,"%display%")
-; '"unimplemented"
-; if PAIRP opt then opt := [:[o,'" "] for o in opt]
-; sayBrightly concat(setOption,'%b,opt,'%d)
-; st = 'STRING =>
-; opt := object2String eval setData.setVar
-; sayBrightly [setOption,:bright opt]
-; st = 'INTEGER =>
-; opt := object2String eval setData.setVar
-; sayBrightly [setOption,:bright opt]
-; st = 'LITERALS =>
-; opt := object2String translateTrueFalse2YesNo eval setData.setVar
-; sayBrightly [setOption,:bright opt]
-; st = 'TREE =>
-; sayBrightly [setOption,:bright '"..."]
-; subtree := true
-; subname := object2String setData.setName
-; TERPRI()
-; subtree =>
-; sayBrightly ['"Variables with current values of",:bright '"...",
-; '"have further sub-options. For example,"]
-; sayBrightly ['"issue",:bright '")set ",subname,
-; '" to see what the options are for",:bright subname,'".",'%l,
-; '"For more information, issue",:bright '")help set",'"."]
-
-(DEFUN |displaySetVariableSettings| (|setTree| |label|) (PROG (|setOption|
|st| |opt| |subtree| |subname|) (RETURN (SEQ (PROGN (COND ((BOOT-EQUAL |label|
(QUOTE ||)) (SPADLET |label| (MAKESTRING ")set"))) ((QUOTE T) (SPADLET |label|
(STRCONC (MAKESTRING " ") (|object2String| |label|) (MAKESTRING " ")))))
(|centerAndHighlight| (STRCONC (MAKESTRING "Current Values of ") |label|
(MAKESTRING " Variables")) $LINELENGTH (QUOTE | |)) (TERPRI) (|sayBrightly|
(CONS (MAKESTRING "Variable ") (CONS (MAKESTRING "Description
") (CONS (MAKESTRING "Current Value") NIL)))) (SAY
(|fillerSpaces| $LINELENGTH (|specialChar| (QUOTE |hbar|)))) (SPADLET |subtree|
NIL) (DO ((#0=#:G2822 |setTree| (CDR #0#)) (|setData| NIL)) ((OR (ATOM #0#)
(PROGN (SETQ |setData| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (COND ((NULL
(|satisfiesUserLevel| (ELT |setData| 2))) NIL) ((QUOTE T) (SPADLET |setOption|
(|object2String| (ELT |setData| 0))) (SPADLET |setOption| (STRCONC |setOption|
(|!
fillerSpaces| (SPADDIFFERENCE 13 (|#| |setOption|)) (MAKESTRING " ")) (ELT
|setData| 1))) (SPADLET |setOption| (STRCONC |setOption| (|fillerSpaces|
(SPADDIFFERENCE 55 (|#| |setOption|)) (MAKESTRING " ")))) (SPADLET |st| (ELT
|setData| 3)) (COND ((BOOT-EQUAL |st| (QUOTE FUNCTION)) (SPADLET |opt| (COND
((|functionp| (ELT |setData| 4)) (FUNCALL (ELT |setData| 4) (QUOTE
|%display%|))) ((QUOTE T) (MAKESTRING "unimplemented")))) (COND ((PAIRP |opt|)
(SPADLET |opt| (PROG (#1=#:G2828) (SPADLET #1# NIL) (RETURN (DO ((#2=#:G2833
|opt| (CDR #2#)) (|o| NIL)) ((OR (ATOM #2#) (PROGN (SETQ |o| (CAR #2#)) NIL))
#1#) (SEQ (EXIT (SETQ #1# (APPEND #1# (CONS |o| (CONS (MAKESTRING " ")
NIL)))))))))))) (|sayBrightly| (|concat| |setOption| (QUOTE |%b|) |opt| (QUOTE
|%d|)))) ((BOOT-EQUAL |st| (QUOTE STRING)) (SPADLET |opt| (|object2String|
(|eval| (ELT |setData| 4)))) (|sayBrightly| (CONS |setOption| (|bright|
|opt|)))) ((BOOT-EQUAL |st| (QUOTE INTEGER)) (SPADLET |opt| (|object2String|
(|eval| (ELT!
|setData| 4)))) (|sayBrightly| (CONS |setOption| (|bright| |!
opt|)))) ((BOOT-EQUAL |st| (QUOTE LITERALS)) (SPADLET |opt| (|object2String|
(|translateTrueFalse2YesNo| (|eval| (ELT |setData| 4))))) (|sayBrightly| (CONS
|setOption| (|bright| |opt|)))) ((BOOT-EQUAL |st| (QUOTE TREE)) (PROGN
(|sayBrightly| (CONS |setOption| (|bright| (MAKESTRING "...")))) (SPADLET
|subtree| (QUOTE T)) (SPADLET |subname| (|object2String| (ELT |setData|
0))))))))))) (TERPRI) (COND (|subtree| (PROGN (|sayBrightly| (CONS (MAKESTRING
"Variables with current values of") (APPEND (|bright| (MAKESTRING "...")) (CONS
(MAKESTRING "have further sub-options. For example,") NIL)))) (|sayBrightly|
(CONS (MAKESTRING "issue") (APPEND (|bright| (MAKESTRING ")set ")) (CONS
|subname| (CONS (MAKESTRING " to see what the options are for") (APPEND
(|bright| |subname|) (CONS (MAKESTRING ".") (CONS (QUOTE |%l|) (CONS
(MAKESTRING "For more information, issue") (APPEND (|bright| (MAKESTRING ")help
set")) (CONS (MAKESTRING ".") NIL)))))))))))))))))))
-;setAsharpArgs arg ==
-; arg = "%initialize%" =>
-; $asharpCmdlineFlags := '"-O -Fasy -Fao -Flsp -laxiom
-Mno-AXL__W__WillObsolete -DAxiom -Y $AXIOM/algebra"
-; arg = "%display%" =>
-; $asharpCmdlineFlags
-; (null arg) or (arg = "%describe%") or (first arg = '_?) =>
-; describeAsharpArgs()
-; $asharpCmdlineFlags := first(arg)
-
-(DEFUN |setAsharpArgs| (|arg|) (COND ((BOOT-EQUAL |arg| (QUOTE
|%initialize%|)) (SPADLET |$asharpCmdlineFlags| (MAKESTRING "-O -Fasy -Fao
-Flsp -laxiom -Mno-AXL_W_WillObsolete -DAxiom -Y $AXIOM/algebra")))
((BOOT-EQUAL |arg| (QUOTE |%display%|)) |$asharpCmdlineFlags|) ((OR (NULL
|arg|) (BOOT-EQUAL |arg| (QUOTE |%describe%|)) (BOOT-EQUAL (CAR |arg|) (QUOTE
?))) (|describeAsharpArgs|)) ((QUOTE T) (SPADLET |$asharpCmdlineFlags| (CAR
|arg|)))))
-;describeAsharpArgs() ==
-; sayBrightly LIST (
-; '%b,'")set compiler args ",'%d,_
-; '"is used to tell AXIOM how to invoke the library compiler ",'%l,_
-; '" when compiling code for AXIOM.",'%l,_
-; '" The args option is followed by a string enclosed in double
quotes.",'%l,'%l,_
-; '" The current setting is",'%l,'%b,'"_"",$asharpCmdlineFlags,'"_"",'%d)
-
-(DEFUN |describeAsharpArgs| NIL (|sayBrightly| (LIST (QUOTE |%b|) (MAKESTRING
")set compiler args ") (QUOTE |%d|) (MAKESTRING "is used to tell AXIOM how to
invoke the library compiler ") (QUOTE |%l|) (MAKESTRING " when compiling code
for AXIOM.") (QUOTE |%l|) (MAKESTRING " The args option is followed by a string
enclosed in double quotes.") (QUOTE |%l|) (QUOTE |%l|) (MAKESTRING " The
current setting is") (QUOTE |%l|) (QUOTE |%b|) (MAKESTRING "\"")
|$asharpCmdlineFlags| (MAKESTRING "\"") (QUOTE |%d|))))
-;setInputLibrary arg ==
-; arg = "%initialize%" =>
-; true
-; arg = "%display%" =>
-; [LIBRARY_-NAME(u) for u in INPUT_-LIBRARIES]
-; (null arg) or (arg = "%describe%") or (first arg = '_?) =>
-; describeInputLibraryArgs()
-; arg is [act, filename] and (act := selectOptionLC(act,'(add drop),nil)) =>
-; act = 'add => addInputLibrary TRUENAME STRINGIMAGE filename
-; act = 'drop => dropInputLibrary TRUENAME STRINGIMAGE filename
-; setInputLibrary NIL
-
-(DEFUN |setInputLibrary| (|arg|) (PROG (|ISTMP#1| |filename| |act|) (RETURN
(SEQ (COND ((BOOT-EQUAL |arg| (QUOTE |%initialize%|)) (QUOTE T)) ((BOOT-EQUAL
|arg| (QUOTE |%display%|)) (PROG (#0=#:G2881) (SPADLET #0# NIL) (RETURN (DO
((#1=#:G2886 INPUT-LIBRARIES (CDR #1#)) (|u| NIL)) ((OR (ATOM #1#) (PROGN (SETQ
|u| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (LIBRARY-NAME
|u|) #0#)))))))) ((OR (NULL |arg|) (BOOT-EQUAL |arg| (QUOTE |%describe%|))
(BOOT-EQUAL (CAR |arg|) (QUOTE ?))) (|describeInputLibraryArgs|)) ((AND (PAIRP
|arg|) (PROGN (SPADLET |act| (QCAR |arg|)) (SPADLET |ISTMP#1| (QCDR |arg|))
(AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |filename|
(QCAR |ISTMP#1|)) (QUOTE T)))) (SPADLET |act| (|selectOptionLC| |act| (QUOTE
(|add| |drop|)) NIL))) (COND ((BOOT-EQUAL |act| (QUOTE |add|))
(|addInputLibrary| (TRUENAME (STRINGIMAGE |filename|)))) ((BOOT-EQUAL |act|
(QUOTE |drop|)) (|dropInputLibrary| (TRUENAME (STRINGIMAGE |filename|)))))) (!
(QUOTE T) (|setInputLibrary| NIL)))))))
-;setOutputLibrary arg ==
-; -- Hack to avoid initialising libraries in KCL:
-; not $cclSystem => false
-; arg = "%initialize%" =>
-; $outputLibraryName := nil
-; arg = "%display%" =>
-; $outputLibraryName or '"user.lib"
-; (null arg) or (arg = "%describe%") or (first arg = '_?) =>
-; describeOutputLibraryArgs()
-; not ONEP(#arg) => setOutputLibrary nil
-; -- If the file already exists then use the complete pathname to help
-; -- keep track of it in the case the user issues )cd commands.
-; if FILEP (fn := STRINGIMAGE first arg) then fn := TRUENAME fn
-; openOutputLibrary($outputLibraryName := fn)
-
-(DEFUN |setOutputLibrary| (|arg|) (PROG (|fn|) (RETURN (COND ((NULL
|$cclSystem|) NIL) ((BOOT-EQUAL |arg| (QUOTE |%initialize%|)) (SPADLET
|$outputLibraryName| NIL)) ((BOOT-EQUAL |arg| (QUOTE |%display%|)) (OR
|$outputLibraryName| (MAKESTRING "user.lib"))) ((OR (NULL |arg|) (BOOT-EQUAL
|arg| (QUOTE |%describe%|)) (BOOT-EQUAL (CAR |arg|) (QUOTE ?)))
(|describeOutputLibraryArgs|)) ((NULL (ONEP (|#| |arg|))) (|setOutputLibrary|
NIL)) ((QUOTE T) (COND ((FILEP (SPADLET |fn| (STRINGIMAGE (CAR |arg|))))
(SPADLET |fn| (TRUENAME |fn|)))) (|openOutputLibrary| (SPADLET
|$outputLibraryName| |fn|)))))))
-;describeOutputLibraryArgs() ==
-; sayBrightly LIST (
-; '%b,'")set compiler output library",'%d,_
-; '"is used to tell the compiler where to place", '%l,_
-; '"compiled code generated by the library compiler. By default it
goes",'%l,_
-; '"in a file called",'%b, '"user.lib", '%d, '"in the current directory."
-; )
-
-(DEFUN |describeOutputLibraryArgs| NIL (|sayBrightly| (LIST (QUOTE |%b|)
(MAKESTRING ")set compiler output library") (QUOTE |%d|) (MAKESTRING "is used
to tell the compiler where to place") (QUOTE |%l|) (MAKESTRING "compiled code
generated by the library compiler. By default it goes") (QUOTE |%l|)
(MAKESTRING "in a file called") (QUOTE |%b|) (MAKESTRING "user.lib") (QUOTE
|%d|) (MAKESTRING "in the current directory."))))
-;describeInputLibraryArgs() ==
-; sayBrightly LIST (
-; '%b,'")set compiler input add library",'%d,_
-; '"is used to tell AXIOM to add", '%b, '"library", '%d, '"to",'%l,
-; '"the front of the path which determines where compiled code is loaded
from.",_
-; '%l, '%b,'")set compiler input drop library",'%d,_
-; '"is used to tell AXIOM to remove", '%b, '"library", '%d, '%l,_
-; '"from this path."
-; )
-
-(DEFUN |describeInputLibraryArgs| NIL (|sayBrightly| (LIST (QUOTE |%b|)
(MAKESTRING ")set compiler input add library") (QUOTE |%d|) (MAKESTRING "is
used to tell AXIOM to add") (QUOTE |%b|) (MAKESTRING "library") (QUOTE |%d|)
(MAKESTRING "to") (QUOTE |%l|) (MAKESTRING "the front of the path which
determines where compiled code is loaded from.") (QUOTE |%l|) (QUOTE |%b|)
(MAKESTRING ")set compiler input drop library") (QUOTE |%d|) (MAKESTRING "is
used to tell AXIOM to remove") (QUOTE |%b|) (MAKESTRING "library") (QUOTE |%d|)
(QUOTE |%l|) (MAKESTRING "from this path."))))
;setExpose arg ==
; arg = "%initialize%" => loadExposureGroupData()
; arg = "%display%" => '"..."
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Axiom-developer] 20090315.01.tpd.patch (bookvol5 collect set support code),
daly <=