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| (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| () + (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| (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| (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| (x) + (cond + ((|member| x '(|yes| |on|)) t) + ((|member| x '(|no| |off|)) nil) + (t x))) + +@ + +\subsection{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| (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| () + (|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| (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| (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| () + (|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| (lib) + (declare (special input-libraries)) + (|dropInputLibrary| lib) + (push (truename lib) input-libraries)) + +@ + +\subsection{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| (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| () + (|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 @ +<>= +(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| (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| (x) - (cond - ((|member| x '(|yes| |on|)) t) - ((|member| x '(|no| |off|)) nil) - (t x))) - -@ - -\subsection{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. <> <> +<> <> <> <> @@ -15352,6 +15606,9 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> +<> +<> +<> <> <> <> @@ -15362,8 +15619,10 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> <> +<> <> <> +<> <> @@ -15415,6 +15674,7 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> <> +<> <> <> <> @@ -15453,6 +15713,7 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> +<> <> <> @@ -15488,6 +15749,7 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> <> +<> <> <> <> @@ -15499,9 +15761,12 @@ load the file \verb|exposed.lsp| to set up the exposure group information. <> <> <> +<> <> <> +<> <> +<> <> <> <> 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
bookvol5 add quit, pquit roots
20090314.01.tpd.patch bookvol5 document )set, include root code
+20090315.01.tpd.patch +bookvol5 document collect set support functions
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. -<>= -<> -<> -<> -@ -\section{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 () == - -- 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(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} -<>= -<> -<> -<> -<> -<> -<> -@ -\subsection{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() == - 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 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 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() == - 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() == - 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]) @ <<*>>= <> -<> -<> <> <> <> @@ -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| |current|) (|sayBrightly| (CONS (MAKESTRING " ->") (|bright| (|object2String| |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%" => '"..."