[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Axiom-developer] 20090319.01.tpd.patch (bookvol5 move top level command
|
From: |
daly |
|
Subject: |
[Axiom-developer] 20090319.01.tpd.patch (bookvol5 move top level command handling) |
|
Date: |
Fri, 20 Mar 2009 11:01:20 -0600 |
More of the top level command machinery was moved into book volume 5.
======================================================================
diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet
index 1b42dec..2875b50 100644
--- a/books/bookvol5.pamphlet
+++ b/books/bookvol5.pamphlet
@@ -511,38 +511,31 @@ has the default function
\verb|InterpExecuteSpadSystemCommand|.
Thus, when a system command is entered this function is called.
<<defun SpadInterpretStream>>=
(defun |SpadInterpretStream| (str source interactive?)
- (prog (|$promptMsg| |$shoeReadLineFunction| |$systemCommandFunction|
- |$ncMsgList| |$erMsgToss| |$lastPos| |$inclAssertions|
- |$okToExecuteMachineCode| |$newcompErrorCount| |$newcompMode|
- |$libQuiet| |$fn|)
+ (let (|$promptMsg| |$shoeReadLineFunction| |$systemCommandFunction|
+ |$ncMsgList| |$erMsgToss| |$lastPos| |$inclAssertions|
+ |$okToExecuteMachineCode| |$newcompErrorCount| |$newcompMode|
+ |$libQuiet| |$fn|)
(declare (special |$promptMsg| |$shoeReadLineFunction|
|$systemCommandFunction| |$ncMsgList| |$erMsgToss| |$lastPos|
|$inclAssertions| |$okToExecuteMachineCode| |$newcompErrorCount|
|$newcompMode| |$libQuiet| |$fn| |$nopos|))
- (return
- (progn
- (setq |$fn| source)
- (setq |$libQuiet| (null interactive?))
- (setq |$newcompMode| nil)
- (setq |$newcompErrorCount| 0)
- (setq |$okToExecuteMachineCode| t)
- (setq |$inclAssertions| (list 'aix '|CommonLisp|))
- (setq |$lastPos| |$nopos|)
- (setq |$erMsgToss| nil)
- (setq |$ncMsgList| nil)
- (setq |$systemCommandFunction| #'|InterpExecuteSpadSystemCommand|)
- (setq |$shoeReadLineFunction| #'|serverReadLine|)
- (setq |$promptMsg| 'S2CTP023)
- (cond
- (interactive?
- (progn
- (princ (mkprompt))
- (|intloopReadConsole| "" str)
- nil))
- (t
- (progn
- (|intloopInclude| source 0)
- nil)))))))
+ (setq |$fn| source)
+ (setq |$libQuiet| (null interactive?))
+ (setq |$newcompMode| nil)
+ (setq |$newcompErrorCount| 0)
+ (setq |$okToExecuteMachineCode| t)
+ (setq |$inclAssertions| (list 'aix '|CommonLisp|))
+ (setq |$lastPos| |$nopos|)
+ (setq |$erMsgToss| nil)
+ (setq |$ncMsgList| nil)
+ (setq |$systemCommandFunction| #'|InterpExecuteSpadSystemCommand|)
+ (setq |$shoeReadLineFunction| #'|serverReadLine|)
+ (setq |$promptMsg| 'S2CTP023)
+ (if interactive?
+ (progn
+ (princ (mkprompt))
+ (|intloopReadConsole| "" str))
+ (|intloopInclude| source 0))))
@
\section{The Read-Eval-Print Loop}
@@ -855,9 +848,12 @@ See:\\
\item The \fnref{zsystemdevelopment} command
\end{itemize}
+\defdollar{systemCommands}
<<initvars>>=
(defvar |$systemCommands| nil)
+@
+<<postvars>>=
(eval-when (eval load)
(setq |$systemCommands|
'(
@@ -901,12 +897,16 @@ See:\\
@
-\defdollar{SYSCOMMANDS}
+\defdollar{syscommands}
This table is used to look up a symbol to see if it might be a command.
<<initvars>>=
-(defvar $SYSCOMMANDS nil)
+(defvar $syscommands nil)
+
+@
+
+<<postvars>>=
(eval-when (eval load)
- (setq $SYSCOMMANDS (mapcar #'car |$systemCommands|)))
+ (setq $syscommands (mapcar #'car |$systemCommands|)))
@
\defdollar{noParseCommands}
@@ -930,6 +930,68 @@ all kinds of input that will not be acceptable to the
interpreter.
)))
@
+\defun{handleNoParseCommands}
+The system commands given by the global variable
+\verb|$noParseCommands| require essentially no preprocessing/parsing
+of their arguments. Here we dispatch the functions which implement
+these commands.
+
+There are four standard commands which receive arguments
+\begin{itemize}
+\item boot
+\item lisp
+\item synonym
+\item system
+\end{itemize}
+
+There are five standard commands
+which do not receive arguments --
+\begin{itemize}
+\item quit
+\item fin
+\item pquit
+\item credits
+\item copyright
+\end{itemize}
+
+As these commands do not necessarily
+exhaust those mentioned in \verb|$noParseCommands|, we provide a
+generic dispatch based on two conventions: commands which do not
+require an argument name themselves, those which do have their names
+prefixed by ``np''. This makes it possible to dynamically define
+new system commands provided you handle the argument parsing.
+
+<<defun handleNoParseCommands>>=
+(defun |handleNoParseCommands| (unab string)
+ (let (spaceindex funname)
+ (setq string (|stripSpaces| string))
+ (setq spaceindex (search " " string))
+ (cond
+ ((eq unab '|lisp|)
+ (if spaceindex
+ (|nplisp| (|stripLisp| string))
+ (|sayKeyedMsg| 's2iv0005 nil)))
+ ((eq unab '|boot|)
+ (if spaceindex
+ (|npboot| (subseq string (1+ spaceindex)))
+ (|sayKeyedMsg| 's2iv0005 nil)))
+ ((eq unab '|system|)
+ (if spaceindex
+ (|npsystem| unab string)
+ (|sayKeyedMsg| 's2iv0005 nil)))
+ ((eq unab '|synonym|)
+ (if spaceindex
+ (|npsynonym| unab (subseq string (1+ spaceindex)))
+ (|npsynonym| unab "")))
+ ((null spaceindex)
+ (funcall unab))
+ ((|member| unab '(|quit| |fin| |pquit| |credits| |copyright|))
+ (|sayKeyedMsg| 's2iv0005 nil))
+ (t
+ (setq funname (intern (concat "np" (string unab))))
+ (funcall funname (subseq string (1+ spaceindex)))))))
+
+@
\defdollar{tokenCommands}
This is a list of the commands that expect the interpreter to parse
their arguments. Thus the history command expects that Axiom will have
@@ -1033,6 +1095,10 @@ above initial list of synonyms. The user synonyms that
are added
during a session are pushed onto this list for later lookup.
<<initvars>>=
(defvar |$CommandSynonymAlist| nil)
+
+@
+
+<<postvars>>=
(eval-when (eval load)
(setq |$CommandSynonymAlist| (copy-alist |$InitialCommandSynonymAlist|)))
@@ -1061,6 +1127,7 @@ for processing \verb|)read| of input files.
n))))
@
+
\defun{ncloopPrefix?}
If we find the prefix string in the whole string starting at position zero
we return the remainder of the string without the leading prefix.
@@ -1070,6 +1137,37 @@ we return the remainder of the string without the
leading prefix.
(subseq whole (length prefix))))
@
+
+\defun{selectOptionLC}
+<<defun selectOptionLC>>=
+(defun |selectOptionLC| (x l errorFunction)
+ (|selectOption| (downcase (|object2Identifier| x)) l errorFunction))
+
+@
+
+\defun{selectOption}
+<<defun selectOption>>=
+(defun |selectOption| (x l errorfunction)
+ (let (u y)
+ (cond
+ ((|member| x l) x)
+ ((null (identp x))
+ (cond
+ (errorfunction (funcall errorfunction x u))
+ (t nil)))
+ (t
+ (setq u
+ (let (t0)
+ (do ((t1 l (CDR t1)) (y NIL))
+ ((or (atom t1) (progn (setq y (car t1)) nil)) (nreverse0 t0))
+ (if (|stringPrefix?| (pname x) (pname y))
+ (setq t0 (cons y t0))))))
+ (cond
+ ((and (pairp u) (eq (qcdr u) nil) (progn (setq y (qcar u)) t)) y)
+ (errorfunction (funcall errorfunction x u))
+ (t nil))))))
+
+@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\cmdhead{abbreviations}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1167,36 +1265,6 @@ constructor name {\tt VectorFunctions2} from the system:
@
\defun{abbreviationsSpad2Cmd}
-\begin{verbatim}
-;abbreviationsSpad2Cmd l ==
-; null l => helpSpad2Cmd '(abbreviations)
-; abopts := '(query domain category package remove)
-; quiet := nil
-; for [opt] in $options repeat
-; opt := selectOptionLC(opt,'(quiet),'optionError)
-; opt = 'quiet => quiet := true
-; l is [opt,:al] =>
-; key := opOf CAR al
-; type := selectOptionLC(opt,abopts,'optionError)
-; type is 'query =>
-; null al => listConstructorAbbreviations()
-; constructor := abbreviation?(key) => abbQuery(constructor)
-; abbQuery(key)
-; type is 'remove =>
-; DELDATABASE(key,'ABBREVIATION)
-; ODDP SIZE al => sayKeyedMsg("S2IZ0002",[type])
-; repeat
-; null al => return 'fromLoop
-; [a,b,:al] := al
-; mkUserConstructorAbbreviation(b,a,type)
-; SETDATABASE(b,'ABBREVIATION,a)
-; SETDATABASE(b,'CONSTRUCTORKIND,type)
-; null quiet =>
-; sayKeyedMsg("S2IZ0001",[a,type,opOf b])
-; nil
-; nil
-\end{verbatim}
-
<<defun abbreviationsSpad2Cmd>>=
(defun |abbreviationsSpad2Cmd| (arg)
(let (abopts quiet opt key type constructor t2 a b al)
@@ -1211,22 +1279,16 @@ constructor name {\tt VectorFunctions2} from the system:
(progn (setq t1 (car t0)) nil)
(progn (progn (setq opt (car t1)) t1) nil))
nil)
- (seq
- (exit
- (progn
- (setq opt
- (|selectOptionLC| opt '(|quiet|) '|optionError|))
- (cond ((eq opt '|quiet|)
- (setq quiet t)))))))
- (cond
- ((and (pairp arg)
+ (setq opt (|selectOptionLC| opt '(|quiet|) '|optionError|))
+ (when (eq opt '|quiet|) (setq quiet t)))
+ (when
+ (and (pairp arg)
(progn
(setq opt (qcar arg))
(setq al (qcdr arg))
t))
(setq key (|opOf| (car al)))
- (setq type
- (|selectOptionLC| opt abopts '|optionError|))
+ (setq type (|selectOptionLC| opt abopts '|optionError|))
(cond
((eq type '|query|)
(cond
@@ -1237,7 +1299,7 @@ constructor name {\tt VectorFunctions2} from the system:
((eq type '|remove|)
(deldatabase key 'abbreviation))
((oddp (size al))
- (|sayKeyedMsg| 's2iz0002 (cons type nil)))
+ (|sayKeyedMsg| 's2iz0002 (list type)))
(t
(do () (nil nil)
(seq
@@ -1252,11 +1314,8 @@ constructor name {\tt VectorFunctions2} from the system:
(|mkUserConstructorAbbreviation| b a type)
(setdatabase b 'abbreviation a)
(setdatabase b 'constructorkind type))))))
- (cond ((null quiet)
- (progn
- (|sayKeyedMsg| 's2iz0001
- (cons a (cons type (cons (|opOf| b) nil)))) nil))))))
- (t nil))))))
+ (unless quiet
+ (|sayKeyedMsg| 's2iz0001 (list a type (|opOf| b)))))))))))
@
@@ -1658,6 +1717,12 @@ system function and constructor caches.
\fnref{frame}, and
\fnref{undo}
+\defdollar{clearOptions}
+<<initvars>>=
+(defvar |$clearOptions| '(|modes| |operations| |properties| |types| |values|))
+
+@
+
\defun{clear}
<<defun clear>>=
(defun |clear| (l)
@@ -1687,9 +1752,8 @@ system function and constructor caches.
<<defun clearSpad2Cmd>>=
(defun |clearSpad2Cmd| (l)
- (let (|$clearExcept| |opt| |optList| |arg|)
+ (let (|$clearExcept| opt optlist arg)
(declare (special |$clearExcept| |$options| |$clearOptions|))
- (setq |$clearExcept| nil)
(cond
(|$options|
(setq |$clearExcept|
@@ -1702,31 +1766,31 @@ system function and constructor caches.
((or t1
(atom t2)
(progn (setq t3 (car t2)) nil)
- (progn (progn (setq |opt| (car t3)) t3) nil))
+ (progn (progn (setq opt (car t3)) t3) nil))
t0)
(setq t0
(and t0
(eq
- (|selectOptionLC| |opt| '(|except|) '|optionError|)
+ (|selectOptionLC| opt '(|except|) '|optionError|)
'|except|)))))))))
(cond
((null l)
- (setq |optList|
+ (setq optlist
(prog (t4)
(setq t4 nil)
(return
(do ((t5 |$clearOptions| (cdr t5)) (x nil))
((or (atom t5) (progn (setq x (car t5)) nil)) t4)
(setq t4 (append t4 `(|%l| " " ,x)))))))
- (|sayKeyedMsg| 's2iz0010 (cons |optList| nil)))
+ (|sayKeyedMsg| 's2iz0010 (list optlist)))
(t
- (setq |arg|
+ (setq arg
(|selectOptionLC| (car l) '(|all| |completely| |scaches|) nil))
(cond
- ((eq |arg| '|all|) (|clearCmdAll|))
- ((eq |arg| '|completely|) (|clearCmdCompletely|))
- ((eq |arg| '|scaches|) (|clearCmdSortedCaches|))
- (|$clearExcept| (|clearCmdExcept| l))
+ ((eq arg '|all|) (|clearCmdAll|))
+ ((eq arg '|completely|) (|clearCmdCompletely|))
+ ((eq arg '|scaches|) (|clearCmdSortedCaches|))
+ (|$clearExcept| (|clearCmdExcept| l))
(t
(|clearCmdParts| l)
(|updateCurrentInterpreterFrame|)))))))
@@ -3174,7 +3238,8 @@ All of the other options are just subcases.
There is a slight mismatch between the \$displayOptions list of
symbols and the options this command accepts so we have a cond
-branch to clean up the option variable.
+branch to clean up the option variable. This allows for the options
+to be plural.
If we fall all the way thru we use the \$displayOptions list
to construct a list of strings for the sayMessage function
@@ -3213,6 +3278,20 @@ and tell the user what options are available.
(format nil "~% or abbreviations thereof"))))))
@
+
+\defun{abbQuery}
+<<defun abbQuery>>=
+(defun |abbQuery| (x)
+ (let (abb)
+ (cond
+ ((setq abb (getdatabase x 'abbreviation))
+ (|sayKeyedMsg| 's2iz0001 (list abb (getdatabase x 'constructorkind) x)))
+ ((setq abb (getdatabase x 'constructor))
+ (|sayKeyedMsg| 's2iz0001 (list x (getdatabase abb 'constructorkind) abb)))
+ (t
+ (|sayKeyedMsg| 's2iz0003 (list x))))))
+
+@
\defun{displayOperations}
This function takes a list of operation names. If the list is null
we query the user to see if they want all operations printed. Otherwise
@@ -3479,6 +3558,38 @@ calls {\tt emacs} to edit the file.
\fnref{compiler}, and
\fnref{read}
+\defun{edit}
+<<defun edit>>=
+(defun |edit| (l) (|editSpad2Cmd| l))
+
+@
+
+\defun{editSpad2Cmd}
+<<defun editSpad2Cmd>>=
+(defun |editSpad2Cmd| (l)
+ (let (olddir filetypes ll rc)
+ (setq l (cond ((null l) /editfile) (t (car l))))
+ (setq l (|pathname| l))
+ (setq olddir (|pathnameDirectory| l))
+ (setq filetypes
+ (cond
+ ((|pathnameType| l) (list (|pathnameType| l)))
+ ((eq |$UserLevel| '|interpreter|) '("input" "INPUT" "spad" "SPAD"))
+ ((eq |$UserLevel| '|compiler|) '("input" "INPUT" "spad" "SPAD"))
+ (t '("input" "INPUT" "spad" "SPAD" "boot" "BOOT"
+ "lisp" "LISP" "meta" "META"))))
+ (setq ll
+ (cond
+ ((string= olddir "")
+ (|pathname| ($findfile (|pathnameName| l) filetypes)))
+ (t l)))
+ (setq l (|pathname| ll))
+ (setq /editfile l)
+ (setq rc (|editFile| l))
+ (|updateSourceFiles| l)
+ rc))
+
+@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\cmdhead{fin}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -7496,7 +7607,7 @@ explanations see the list structure section
\ref{Theliststructure}.
(dolist (setdata settree)
(case (fourth setdata)
(FUNCTION
- (if (|functionp| (fifth setdata))
+ (if (functionp (fifth setdata))
(funcall (fifth setdata) '|%initialize%|))
(|sayMSG| " Function not implemented."))
(INTEGER (set (fifth setdata) (seventh setdata)))
@@ -7554,7 +7665,7 @@ explanations see the list structure section
\ref{Theliststructure}.
(case (fourth setdata)
(FUNCTION
(terpri)
- (if (|functionp| (fifth setdata))
+ (if (functionp (fifth setdata))
(funcall (fifth setdata) '|%describe%|)
(|sayMSG| " Function not implemented.")))
(INTEGER
@@ -7612,7 +7723,7 @@ explanations see the list structure section
\ref{Theliststructure}.
(case (fourth setdata)
(FUNCTION
(setq opt
- (if (|functionp| (fifth setdata))
+ (if (functionp (fifth setdata))
(funcall (fifth setdata) '|%display%|)
"unimplemented"))
(cond
@@ -8706,6 +8817,57 @@ linker linker arguments (e.g. libraries to search)
-lxlf
"/tmp/"))
NIL)
@
+
+\defun{setFortTmpDir}
+<<defun setFortTmpDir>>=
+(defun |setFortTmpDir| (arg)
+ (let (mode)
+ (cond
+ ((eq arg '|%initialize%|) (setq |$fortranTmpDir| "/tmp/"))
+ ((eq arg '|%display%|)
+ (if (stringp |$fortranTmpDir|)
+ |$fortranTmpDir|
+ (pname |$fortranTmpDir|)))
+ ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?))
+ (|describeSetFortTmpDir|))
+ ((null (setq mode (|validateOutputDirectory| arg)))
+ (|sayBrightly|
+ `(" Sorry, but your argument(s)" ,@(|bright| arg)
+ "is(are) not valid." |%l|))
+ (|describeSetFortTmpDir|))
+ (t (setq |$fortranTmpDir| mode)))))
+
+@
+
+\defun{validateOutputDirectory}
+<<defun validateOutputDirectory>>=
+(defun |validateOutputDirectory| (x)
+ (let ((dirname (car x)))
+ (when (and (pathname-directory dirname) (null (probe-file dirname)))
+ dirname)))
+
+@
+
+\defun{describeSetFortTmpDir}
+<<defun describeSetFortTmpDir>>=
+(defun |describeSetFortTmpDir| ()
+ (|sayBrightly| (list
+ '|%b| ")set fortran calling tempfile"
+ '|%d| " is used to tell AXIOM where"
+ '|%l| " to place intermediate FORTRAN data files . This must be the "
+ '|%l| " name of a valid existing directory to which you have permission "
+ '|%l| " to write (including the final slash)."
+ '|%l|
+ '|%l| " Syntax:"
+ '|%l| " )set fortran calling tempfile DIRECTORYNAME"
+ '|%l|
+ '|%l| " The current setting is"
+ '|%b| |$fortranTmpDir|
+ '|%d|)))
+
+@
+
+
\subsubsection{directory}
\begin{verbatim}
-------------------- The directory Option ---------------------
@@ -8735,6 +8897,47 @@ linker linker arguments (e.g. libraries to search)
-lxlf
"./"))
NIL)
@
+
+\defun{setFortDir}
+<<defun setFortDir>>=
+(defun |setFortDir| (arg)
+ (declare (special |$fortranDirectory|))
+ (let (mode)
+ (COND
+ ((eq arg '|%initialize%|) (setq |$fortranDirectory| "./"))
+ ((eq arg '|%display%|)
+ (if (stringp |$fortranDirectory|)
+ |$fortranDirectory|
+ (pname |$fortranDirectory|)))
+ ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?))
+ (|describeSetFortDir|))
+ ((null (setq mode (|validateOutputDirectory| arg)))
+ (|sayBrightly|
+ `(" Sorry, but your argument(s)" ,@(|bright| arg)
+ "is(are) not valid." |%l|))
+ (|describeSetFortDir|))
+ (t (setq |$fortranDirectory| mode)))))
+
+@
+\defun{describeSetFortDir}
+<<defun describeSetFortDir>>=
+(defun |describeSetFortDir| ()
+ (declare (special |$fortranDirectory|))
+ (|sayBrightly| (list
+ '|%b| ")set fortran calling directory"
+ '|%d| " is used to tell AXIOM where"
+ '|%l| " to place generated FORTRAN files. This must be the name "
+ '|%l| " of a valid existing directory to which you have permission "
+ '|%l| " to write (including the final slash)."
+ '|%l|
+ '|%l| " Syntax:"
+ '|%l| " )set fortran calling directory DIRECTORYNAME"
+ '|%l|
+ '|%l| " The current setting is"
+ '|%b| |$fortranDirectory|
+ '|%d|)))
+
+@
\subsubsection{linker}
\begin{verbatim}
---------------------- The linker Option ----------------------
@@ -8766,6 +8969,45 @@ linker linker arguments (e.g. libraries to search)
-lxlf
NIL
)
@
+
+\defun{setLinkerArgs}
+<<defun setLinkerArgs>>=
+(defun |setLinkerArgs| (arg)
+ (declare (special |$fortranLibraries|))
+ (cond
+ ((eq arg '|%initialize%|) (setq |$fortranLibraries| "-lxlf"))
+ ((eq arg '|%display%|) (|object2String| |$fortranLibraries|))
+ ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?))
+ (|describeSetLinkerArgs|))
+ ((and (listp arg) (stringp (car arg)))
+ (setq |$fortranLibraries| (car arg)))
+ (t (|describeSetLinkerArgs|))))
+
+@
+
+\defun{describeSetLinkerArgs}
+<<defun describeSetLinkerArgs>>=
+(defun |describeSetLinkerArgs| ()
+ (declare (special |$fortranLibraries|))
+ (|sayBrightly| (list
+ '|%b| ")set fortran calling linkerargs"
+ '|%d| " is used to pass arguments to the linker"
+ '|%l| " when using "
+ '|%b| "mkFort"
+ '|%d| " to create functions which call Fortran code."
+ '|%l| " For example, it might give a list of libraries to be searched,"
+ '|%l| " and their locations."
+ '|%l| " The string is passed verbatim, so must be the correct syntax for"
+ '|%l| " the particular linker being used."
+ '|%l|
+ '|%l| " Example: )set fortran calling linker \"-lxlf\""
+ '|%l|
+ '|%l| " The current setting is"
+ '|%b| |$fortranLibraries|
+ '|%d|)))
+
+@
+
\section{kernel}
\begin{verbatim}
Current Values of kernel Variables
@@ -10436,7 +10678,7 @@ prettyprint prettyprint BOOT func's as they compile
off
<<postvars>>=
(eval-when (eval load)
- (|initializeSetVariables| |$setOptions|)
+ (|initializeSetVariables| |$setOptions|))
@
@@ -10480,11 +10722,11 @@ which gets called with \verb|%describe%|
((null l) (|displaySetVariableSettings| settree '||))
(t
(setq |$setOptionNames|
- (do ((t1 settree (cdr t1)) t0 (|x| nil))
- ((or (atom t1) (progn (setq |x| (car t1)) nil)) (nreverse0 t0))
+ (do ((t1 settree (cdr t1)) t0 (x nil))
+ ((or (atom t1) (progn (setq x (car t1)) nil)) (nreverse0 t0))
(seq
(exit
- (setq t0 (cons (elt |x| 0) t0))))))
+ (setq t0 (cons (elt x 0) t0))))))
(setq arg
(|selectOption| (downcase (car l)) |$setOptionNames| '|optionError|))
(setq setdata (cons arg (lassoc arg settree)))
@@ -10500,7 +10742,7 @@ which gets called with \verb|%describe%|
(if (eq (elt l 1) 'default)
'|%initialize%|
(kdr l)))
- (if (|functionp| (fifth setdata))
+ (if (functionp (fifth setdata))
(funcall (fifth setdata) setfunarg)
(|sayMSG| " Function not implemented."))
(when |$displaySetValue|
@@ -11208,7 +11450,7 @@ This reports the traced functions
(defun |trace1| (arg)
(prog (|$traceNoisely| constructor |ops| |lops| temp1 opt a
|oldL| |newOptions| |domain| |traceList| |optionList| |domainList|
- |opList| |y| |varList| |argument|)
+ |opList| y |varList| |argument|)
(declare (special |$traceNoisely|))
(return
(seq
@@ -11327,8 +11569,8 @@ This reports the traced functions
(t nil)))
(setq |varList|
(cond
- ((setq |y| (lassoc '|vars| |optionList|))
- (list (cons '|vars| |y|)))
+ ((setq y (lassoc '|vars| |optionList|))
+ (list (cons '|vars| y)))
(t nil)))
(append |domainList| (append |opList| |varList|)))))
(|optionList| (append |traceList| |optionList|))
@@ -11534,59 +11776,59 @@ This reports the traced functions
<<defun getTraceOption>>=
(defun |getTraceOption| (arg)
- (prog (|l| |opts| key a |n|)
+ (prog (l |opts| key a |n|)
(return
(seq
(progn
(setq key (car arg))
- (setq |l| (cdr arg))
+ (setq l (cdr arg))
(setq key
(|selectOptionLC| key |$traceOptionList| '|traceOptionError|))
- (setq arg (cons key |l|))
+ (setq arg (cons key l))
(cond
((memq key '(|nonquietly| |timer| |nt|)) arg)
((eq key '|break|)
(cond
- ((null |l|) (cons '|break| (cons '|before| nil)))
+ ((null l) (cons '|break| (cons '|before| nil)))
(t
(setq |opts|
(prog (t0)
(setq t0 nil)
(return
- (do ((t1 |l| (cdr t1)) (|y| nil))
+ (do ((t1 l (cdr t1)) (y nil))
((or (atom t1)
- (progn (setq |y| (car t1)) nil))
+ (progn (setq y (car t1)) nil))
(nreverse0 t0))
(seq
(exit
(setq t0
(cons
- (|selectOptionLC| |y| '(|before| |after|) nil) t0))))))))
+ (|selectOptionLC| y '(|before| |after|) nil) t0))))))))
(cond
((prog (t2)
(setq t2 t)
(return
- (do ((t3 nil (null t2)) (t4 |opts| (cdr t4)) (|y| nil))
- ((or t3 (atom t4) (progn (setq |y| (car t4)) nil)) t2)
+ (do ((t3 nil (null t2)) (t4 |opts| (cdr t4)) (y nil))
+ ((or t3 (atom t4) (progn (setq y (car t4)) nil)) t2)
(seq
(exit
- (setq t2 (and t2 (identp |y|))))))))
+ (setq t2 (and t2 (identp y))))))))
(cons '|break| |opts|))
(t
(|stackTraceOptionError| (cons 's2it0008 (cons nil nil))))))))
((eq key '|restore|)
(cond
- ((null |l|) arg)
+ ((null l) arg)
(t
(|stackTraceOptionError|
(cons 's2it0009
(cons (cons (strconc ")" (|object2String| key)) nil) nil))))))
- ((eq key '|only|) (cons '|only| (|transOnlyOption| |l|)))
+ ((eq key '|only|) (cons '|only| (|transOnlyOption| l)))
((eq key '|within|)
(cond
- ((and (pairp |l|)
- (eq (qcdr |l|) nil)
- (progn (setq a (qcar |l|)) t)
+ ((and (pairp l)
+ (eq (qcdr l) nil)
+ (progn (setq a (qcar l)) t)
(identp a))
arg)
(t
@@ -11598,10 +11840,10 @@ This reports the traced functions
((eq key '|cond|) '|when|)
(t key)))
(cond
- ((and (pairp |l|)
- (eq (qcdr |l|) nil)
- (progn (setq a (qcar |l|)) t))
- (cons key |l|))
+ ((and (pairp l)
+ (eq (qcdr l) nil)
+ (progn (setq a (qcar l)) t))
+ (cons key l))
(t
(|stackTraceOptionError|
(cons 's2it0011
@@ -11610,9 +11852,9 @@ This reports the traced functions
(|object2String| key)) nil) nil))))))
((eq key '|depth|)
(cond
- ((and (pairp |l|)
- (eq (qcdr |l|) nil)
- (progn (setq |n| (qcar |l|)) t)
+ ((and (pairp l)
+ (eq (qcdr l) nil)
+ (progn (setq |n| (qcar l)) t)
(fixp |n|))
arg)
(t
@@ -11620,10 +11862,10 @@ This reports the traced functions
(cons 's2it0012 (cons (cons ")depth" nil) nil))))))
((eq key '|count|)
(cond
- ((or (null |l|)
- (and (pairp |l|)
- (eq (qcdr |l|) nil)
- (progn (setq |n| (qcar |l|)) t)
+ ((or (null l)
+ (and (pairp l)
+ (eq (qcdr l) nil)
+ (progn (setq |n| (qcar l)) t)
(fixp |n|)))
arg)
(t
@@ -11634,17 +11876,17 @@ This reports the traced functions
(prog (t5)
(setq t5 nil)
(return
- (do ((t6 |l| (cdr t6)) (|y| nil))
- ((or (atom t6) (progn (setq |y| (car t6)) nil)) (nreverse0 t5))
+ (do ((t6 l (cdr t6)) (y nil))
+ ((or (atom t6) (progn (setq y (car t6)) nil)) (nreverse0 t5))
(seq
(exit
- (setq t5 (cons (|getTraceOption,hn| |y|) t5)))))))))
+ (setq t5 (cons (|getTraceOption,hn| y) t5)))))))))
((memq key '(|local| |ops| |vars|))
(cond
- ((or (null |l|)
- (and (pairp |l|) (eq (qcdr |l|) nil) (eq (qcar |l|) '|all|)))
+ ((or (null l)
+ (and (pairp l) (eq (qcdr l) nil) (eq (qcar l) '|all|)))
(cons key '|all|))
- ((|isListOfIdentifiersOrStrings| |l|) arg)
+ ((|isListOfIdentifiersOrStrings| l) arg)
(t
(|stackTraceOptionError|
(cons 's2it0015
@@ -11652,10 +11894,10 @@ This reports the traced functions
(cons (strconc ")" (|object2String| key)) nil) nil))))))
((eq key '|varbreak|)
(cond
- ((or (null |l|)
- (and (pairp |l|) (eq (qcdr |l|) nil) (eq (qcar |l|) '|all|)))
+ ((or (null l)
+ (and (pairp l) (eq (qcdr l) nil) (eq (qcar l) '|all|)))
(cons '|varbreak| '|all|))
- ((|isListOfIdentifiers| |l|) arg)
+ ((|isListOfIdentifiers| l) arg)
(t
(|stackTraceOptionError|
(cons 's2it0016
@@ -11663,7 +11905,7 @@ This reports the traced functions
(cons (strconc ")" (|object2String| key)) nil) nil))))))
((eq key '|mathprint|)
(cond
- ((null |l|) arg)
+ ((null l) arg)
(t
(|stackTraceOptionError|
(cons 's2it0009
@@ -11851,20 +12093,20 @@ This reports the traced functions
<<defun transOnlyOption>>=
(defun |transOnlyOption| (arg)
- (prog (|y| |n|)
+ (prog (y |n|)
(return
(cond
((and (pairp arg)
- (progn (setq |n| (qcar arg)) (setq |y| (qcdr arg)) t))
+ (progn (setq |n| (qcar arg)) (setq y (qcdr arg)) t))
(cond
((fixp |n|)
- (cons |n| (|transOnlyOption| |y|)))
+ (cons |n| (|transOnlyOption| y)))
((memq (setq |n| (upcase |n|)) '(V A C))
- (cons |n| (|transOnlyOption| |y|)))
+ (cons |n| (|transOnlyOption| y)))
(t
(|stackTraceOptionError|
(cons 's2it0006 (cons (cons |n| nil) nil)))
- (|transOnlyOption| |y|))))
+ (|transOnlyOption| y))))
(t nil)))))
@
@@ -11915,17 +12157,17 @@ This reports the traced functions
<<defun domainToGenvar>>=
(defun |domainToGenvar| (arg)
- (prog (|$doNotAddEmptyModeIfTrue| |y| |g|)
+ (prog (|$doNotAddEmptyModeIfTrue| y |g|)
(declare (special |$doNotAddEmptyModeIfTrue|))
(return
(progn
(setq |$doNotAddEmptyModeIfTrue| t)
(cond
- ((and (setq |y| (|unabbrevAndLoad| arg))
- (eq (getdatabase (|opOf| |y|) 'constructorkind) '|domain|))
+ ((and (setq y (|unabbrevAndLoad| arg))
+ (eq (getdatabase (|opOf| y) 'constructorkind) '|domain|))
(progn
- (setq |g| (|genDomainTraceName| |y|))
- (set |g| (|evalDomain| |y|)) |g|)))))))
+ (setq |g| (|genDomainTraceName| y))
+ (set |g| (|evalDomain| y)) |g|)))))))
@
@@ -12020,7 +12262,7 @@ This reports the traced functions
<<defun transTraceItem>>=
(defun |transTraceItem| (x)
- (prog (|$doNotAddEmptyModeIfTrue| |value| |y|)
+ (prog (|$doNotAddEmptyModeIfTrue| |value| y)
(declare (special |$doNotAddEmptyModeIfTrue|))
(return
(progn
@@ -12033,18 +12275,18 @@ This reports the traced functions
'((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))))
(setq x (|objVal| |value|))
(cond
- ((setq |y| (|domainToGenvar| x)) |y|)
+ ((setq y (|domainToGenvar| x)) y)
(t x)))
((upper-case-p (elt (stringimage x) 0))
- (setq |y| (|unabbrev| x))
+ (setq y (|unabbrev| x))
(cond
- ((|constructor?| |y|) |y|)
- ((and (pairp |y|) (|constructor?| (car |y|))) (car |y|))
- ((setq |y| (|domainToGenvar| x)) |y|)
+ ((|constructor?| y) y)
+ ((and (pairp y) (|constructor?| (car y))) (car y))
+ ((setq y (|domainToGenvar| x)) y)
(t x)))
(t x)))
((vecp (car x)) (|transTraceItem| (|devaluate| (car x))))
- ((setq |y| (|domainToGenvar| x)) |y|)
+ ((setq y (|domainToGenvar| x)) y)
(t (|throwKeyedMsg| 's2it0018 (cons x nil))))))))
@
@@ -12217,16 +12459,16 @@ This reports the traced functions
<<defun coerceTraceFunValue2E>>=
(defun |coerceTraceFunValue2E| (|traceName| |subName| |value|)
- (prog (name |u|)
+ (prog (name u)
(return
(cond
((memq (setq name |subName|) |$mathTraceList|)
(cond
((spadsysnamep (pname |traceName|)) (|coerceSpadFunValue2E| |value|))
- ((setq |u| (lassoc |subName| |$tracedMapSignatures|))
+ ((setq u (lassoc |subName| |$tracedMapSignatures|))
(|objValUnwrap|
(|coerceInteractive|
- (|objNewWrap| |value| (CAR |u|))
+ (|objNewWrap| |value| (CAR u))
|$OutputForm|)))
(t |value|)))
(t |value|)))))
@@ -12393,10 +12635,10 @@ This reports the traced functions
<<defun lassocSub>>=
(defun |lassocSub| (x |subs|)
- (prog (|y|)
+ (prog (y)
(return
(cond
- ((setq |y| (lassq x |subs|)) |y|)
+ ((setq y (lassq x |subs|)) y)
(t x)))))
@
@@ -12410,10 +12652,10 @@ This reports the traced functions
<<defun rassocSub>>=
(defun |rassocSub| (x |subs|)
- (prog (|y|)
+ (prog (y)
(return
(cond
- ((setq |y| (|rassoc| x |subs|)) |y|)
+ ((setq y (|rassoc| x |subs|)) y)
(t x)))))
@
@@ -12576,16 +12818,16 @@ This reports the traced functions
(prog (t0)
(setq t0 nil)
(return
- (do ((t1 ops (cdr t1)) (|u| nil))
- ((or (atom t1) (progn (setq |u| (car t1)) nil)) (nreverse0 t0))
+ (do ((t1 ops (cdr t1)) (u nil))
+ ((or (atom t1) (progn (setq u (car t1)) nil)) (nreverse0 t0))
(seq
(exit
(cond
- ((and (pairp |u|)
+ ((and (pairp u)
(progn
- (setq tmp1 (qcar |u|))
+ (setq tmp1 (qcar u))
(and (pairp tmp1) (equal (qcar tmp1) opname))))
- (setq t0 (cons |u| t0))))))))))))))
+ (setq t0 (cons u t0))))))))))))))
@
@@ -13171,25 +13413,25 @@ This reports the traced functions
<<defun letPrint>>=
(defun |letPrint| (x |val| |currentFunction|)
- (prog (|y|)
+ (prog (y)
(return
(progn
(cond ((and |$letAssoc|
(or
- (setq |y| (lassoc |currentFunction| |$letAssoc|))
- (setq |y| (lassoc '|all| |$letAssoc|))))
+ (setq y (lassoc |currentFunction| |$letAssoc|))
+ (setq y (lassoc '|all| |$letAssoc|))))
(cond
- ((and (or (eq |y| '|all|)
- (memq x |y|))
+ ((and (or (eq y '|all|)
+ (memq x y))
(null
(or (is_genvar x) (|isSharpVarWithNum| x) (gensymp x))))
(|sayBrightlyNT| (append (|bright| x) (cons '|: | nil)))
(prin0 (|shortenForPrinting| |val|))
(terpri)))
(cond
- ((and (setq |y| (|hasPair| 'break |y|))
- (or (eq |y| '|all|)
- (and (memq x |y|)
+ ((and (setq y (|hasPair| 'break y))
+ (or (eq y '|all|)
+ (and (memq x y)
(null (memq (elt (pname x) 0) '($ |#|)))
(null (gensymp x)))))
(|break|
@@ -13228,18 +13470,18 @@ This reports the traced functions
<<defun letPrint2>>=
(defun |letPrint2| (x |printform| |currentFunction|)
- (prog (|$BreakMode| |flag| |y|)
+ (prog (|$BreakMode| |flag| y)
(declare (special |$BreakMode|))
(return
(progn
(setq |$BreakMode| nil)
(cond
((and |$letAssoc|
- (or (setq |y| (lassoc |currentFunction| |$letAssoc|))
- (setq |y| (lassoc '|all| |$letAssoc|))))
+ (or (setq y (lassoc |currentFunction| |$letAssoc|))
+ (setq y (lassoc '|all| |$letAssoc|))))
(cond
((and
- (or (eq |y| '|all|) (memq x |y|))
+ (or (eq y '|all|) (memq x y))
(null (or (is_genvar x) (|isSharpVarWithNum| x) (gensymp x))))
(setq |$BreakMode| '|letPrint2|)
(setq |flag| nil)
@@ -13250,10 +13492,10 @@ This reports the traced functions
(t nil))))
(cond
((and
- (setq |y| (|hasPair| 'break |y|))
- (or (eq |y| '|all|)
+ (setq y (|hasPair| 'break y))
+ (or (eq y '|all|)
(and
- (memq x |y|)
+ (memq x y)
(null (memq (elt (pname x) 0) '($ |#|)))
(null (gensymp x)))))
(|break|
@@ -13290,18 +13532,18 @@ This reports the traced functions
<<defun letPrint3>>=
(defun |letPrint3| (x |xval| |printfn| |currentFunction|)
- (prog (|$BreakMode| |flag| |y|)
+ (prog (|$BreakMode| |flag| y)
(declare (special |$BreakMode|))
(return
(progn
(setq |$BreakMode| nil)
(cond
((and |$letAssoc|
- (or (setq |y| (lassoc |currentFunction| |$letAssoc|))
- (setq |y| (lassoc '|all| |$letAssoc|))))
+ (or (setq y (lassoc |currentFunction| |$letAssoc|))
+ (setq y (lassoc '|all| |$letAssoc|))))
(cond
((and
- (or (eq |y| '|all|) (memq x |y|))
+ (or (eq y '|all|) (memq x y))
(null (or (is_genvar x) (|isSharpVarWithNum| x) (gensymp x))))
(setq |$BreakMode| '|letPrint2|)
(setq |flag| nil)
@@ -13314,11 +13556,11 @@ This reports the traced functions
(t nil))))
(cond
((and
- (setq |y| (|hasPair| 'break |y|))
+ (setq y (|hasPair| 'break y))
(or
- (eq |y| '|all|)
+ (eq y '|all|)
(and
- (memq x |y|)
+ (memq x y)
(null (memq (elt (pname x) 0) '($ |#|)))
(null (gensymp x)))))
(|break|
@@ -13461,7 +13703,7 @@ This reports the traced functions
<<defun reportSpadTrace>>=
(defun |reportSpadTrace| (|header| t0)
- (prog (|op| |sig| |n| |t| |msg| |namePart| |y| |tracePart|)
+ (prog (|op| |sig| |n| |t| |msg| |namePart| y |tracePart|)
(return
(progn
(setq |op| (car t0))
@@ -13485,11 +13727,11 @@ This reports the traced functions
(setq |namePart| nil)
(setq |tracePart|
(cond
- ((and (pairp |t|) (progn (setq |y| (qcar |t|)) t) (null (null |y|)))
+ ((and (pairp |t|) (progn (setq y (qcar |t|)) t) (null (null y)))
(cond
- ((eq |y| '|all|)
+ ((eq y '|all|)
(cons '|%b| (cons '|all| (cons '|%d| (cons '|vars| nil)))))
- (t (cons '| vars: | (cons |y| nil)))))
+ (t (cons '| vars: | (cons y nil)))))
(t nil)))
(|sayBrightly| (append |msg| (append |namePart| |tracePart|)))))))))
@@ -13921,7 +14163,7 @@ This reports the traced functions
<<defun ?t>>=
(defun |?t| ()
- (prog (|llm| x |d| |l| |suffix|)
+ (prog (|llm| x |d| l |suffix|)
(return
(seq
(cond
@@ -13948,7 +14190,7 @@ This reports the traced functions
(exit
(cond
((and (pairp x)
- (progn (setq |d| (qcar x)) (setq |l| (qcdr x)) t)
+ (progn (setq |d| (qcar x)) (setq l (qcdr x)) t)
(|isDomainOrPackage| |d|))
(progn
(setq |suffix| (cond ((|isDomain| |d|) "domain") (t "package")))
@@ -13959,7 +14201,7 @@ This reports the traced functions
(cons (|devaluate| |d|)
(cons '|%d|
(cons ":" nil)))))))
- (do ((t2 (|orderBySlotNumber| |l|) (cdr t2)) (x nil))
+ (do ((t2 (|orderBySlotNumber| l) (cdr t2)) (x nil))
((or (atom t2) (progn (setq x (car t2)) nil)) nil)
(seq
(exit
@@ -13990,7 +14232,7 @@ This reports the traced functions
<<defun tracelet>>=
(defun |tracelet| (|fn| |vars|)
- (prog ($traceletflag |$QuickLet| |l|)
+ (prog ($traceletflag |$QuickLet| l)
(declare (special $traceletflag |$QuickLet|))
(return
(progn
@@ -14006,7 +14248,7 @@ This reports the traced functions
(setq |vars|
(cond
((eq |vars| '|all|) '|all|)
- ((setq |l| (lassoc |fn| |$letAssoc|)) (|union| |vars| |l|))
+ ((setq l (lassoc |fn| |$letAssoc|)) (|union| |vars| l))
(t |vars|)))
(setq |$letAssoc| (cons (cons |fn| |vars|) |$letAssoc|))
(cond (|$letAssoc| (setletprintflag t)))
@@ -14357,13 +14599,13 @@ recordFrame(systemNormal) ==
(prog (tmp2)
(setq tmp2 nil)
(return
- (do ((tmp3 (cdr x) (cdr tmp3)) (|y| nil))
+ (do ((tmp3 (cdr x) (cdr tmp3)) (y nil))
((or (atom tmp3)
- (progn (setq |y| (car tmp3)) nil))
+ (progn (setq y (car tmp3)) nil))
(nreverse0 tmp2))
(seq
(exit
- (setq tmp2 (cons (cons (car |y|) (cdr |y|)) tmp2))))))))
+ (setq tmp2 (cons (cons (car y) (cdr y)) tmp2))))))))
tmp0))))))))
(car |$frameRecord|)))))))
@@ -15053,6 +15295,13 @@ The command synonym {\tt )apropos} is equivalent to
\fnref{set}, and
\fnref{show}
+\defdollar{whatOptions}
+<<initvars>>=
+(defvar |$whatOptions| '(|operations| |categories| |domains| |packages|
+ |commands| |synonyms| |things|))
+
+@
+
\defun{what}
\begin{verbatim}
what l == whatSpad2Cmd l
@@ -15175,17 +15424,17 @@
filterAndFormatConstructors(constrType,label,patterns) ==
<<defun filterAndFormatConstructors>>=
(defun |filterAndFormatConstructors| (|constrType| |label| |patterns|)
- (prog (|l|)
+ (prog (l)
(return
(progn (|centerAndHighlight| |label| $linelength
(|specialChar| '|hbar|))
- (setq |l|
+ (setq l
(|filterListOfStringsWithFn| |patterns|
(|whatConstructors| |constrType|)
(|function| cdr)))
(cond (|patterns|
(cond
- ((null |l|)
+ ((null l)
(|sayMessage|
(cons " No "
(cons |label|
@@ -15204,7 +15453,7 @@ filterAndFormatConstructors(constrType,label,patterns)
==
(cons '|%b|
(append (|blankList| |patterns|)
(cons '|%d| nil))))))))))))
- (cond (|l| (|pp2Cols| |l|)))))))
+ (cond (l (|pp2Cols| l)))))))
@
@@ -15695,13 +15944,131 @@ load the file \verb|exposed.lsp| to set up the
exposure group information.
@
+\chapter{Special Lisp Functions}
+
+\defmacro{identp}
+<<defmacro identp>>=
+(defmacro identp (x)
+ (if (atom x)
+ `(and ,x (symbolp ,x))
+ (let ((xx (gensym)))
+ `(let ((,xx ,x))
+ (and ,xx (symbolp ,xx))))))
+
+@
+
+\defun{concat}
+<<defun concat>>=
+(defun concat (a b &rest l)
+ (if (bit-vector-p a)
+ (if l
+ (apply #'concatenate 'bit-vector a b l)
+ (concatenate 'bit-vector a b))
+ (if l
+ (apply #'system:string-concatenate a b l)
+ (system:string-concatenate a b))))
+
+@
+
+\defun{functionp}
+<<defun functionp>>=
+(defun |functionp| (fn)
+ (if (identp fn)
+ (and (fboundp fn) (not (macro-function fn)))
+ (functionp fn)))
+
+@
+
+;; --------------------> NEW DEFINITION (override in msgdb.boot.pamphlet)
+\defun{brightprint}
+<<defun brightprint>>=
+(defun brightprint (x)
+ (messageprint x))
+
+@
+
+;; --------------------> NEW DEFINITION (override in msgdb.boot.pamphlet)
+\defun{brightprint-0}
+<<defun brightprint-0>>=
+(defun brightprint-0 (x)
+ (messageprint-1 x))
+
+@
+
+\defun{member}
+<<defun member>>=
+(defun |member| (item sequence)
+ (cond
+ ((symbolp item) (member item sequence :test #'eq))
+ ((stringp item) (member item sequence :test #'equal))
+ ((and (atom item) (not (arrayp item))) (member item sequence))
+ (t (member item sequence :test #'equalp))))
+
+@
+
+\defun{messageprint}
+<<defun messageprint>>=
+(defun messageprint (x)
+ (mapc #'messageprint-1 x))
+
+@
+
+\defun{messageprint-1}
+<<defun messageprint-1>>=
+(defun messageprint-1 (x)
+ (cond
+ ((or (eq x '|%l|) (equal x "%l")) (terpri))
+ ((stringp x) (princ x))
+ ((identp x) (princ x))
+ ((atom x) (princ x))
+ ((princ "(")
+ (messageprint-1 (car x))
+ (messageprint-2 (cdr x))
+ (princ ")"))))
+
+@
+
+\defun{messageprint-2}
+<<defun messageprint-2>>=
+(defun messageprint-2 (x)
+ (if (atom x)
+ (unless x (progn (princ " . ") (messageprint-1 x)))
+ (progn (princ " ") (messageprint-1 (car x)) (messageprint-2 (cdr x)))))
+
+@
+
+\defun{sayBrightly1}
+<<defun sayBrightly1>>=
+(defun sayBrightly1 (x *standard-output*)
+ (if (atom x)
+ (progn (brightprint-0 x) (terpri) (force-output))
+ (progn (brightprint x) (terpri) (force-output))))
+
+@
+
+\defdollar{algebraOutputStream}
+<<initvars>>=
+(defvar |$algebraOutputStream| *standard-output*)
+
+@
+
+\defun{sayMSG}
+<<defun sayMSG>>=
+(defun |sayMSG| (x)
+ (declare (special |$algebraOutputStream|))
+ (when x (sayBrightly1 x |$algebraOutputStream|)))
+
+@
+
\chapter{The Interpreter}
<<Interpreter>>=
(in-package "BOOT")
<<initvars>>
<<defmacro funfind>>
+<<defmacro identp>>
+<<defun abbQuery>>
<<defun abbreviations>>
<<defun abbreviationsSpad2Cmd>>
<<defun addInputLibrary>>
@@ -15712,6 +16079,8 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun break>>
<<defun breaklet>>
+<<defun brightprint>>
+<<defun brightprint-0>>
<<defun browse>>
<<defun changeHistListLen>>
@@ -15739,6 +16108,7 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun compileBoot>>
<<defun compiler>>
<<defun compileSpadLispCmd>>
+<<defun concat>>
<<defun copyright>>
<<defun createCurrentInterpreterFrame>>
<<defun credits>>
@@ -15746,6 +16116,9 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun describeAsharpArgs>>
<<defun describeInputLibraryArgs>>
<<defun describeOutputLibraryArgs>>
+<<defun describeSetFortDir>>
+<<defun describeSetFortTmpDir>>
+<<defun describeSetLinkerArgs>>
<<defun dewritify>>
<<defun dewritify,dewritifyInner>>
<<defun dewritify,is?>>
@@ -15764,6 +16137,8 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun domainToGenvar>>
<<defun dropInputLibrary>>
+<<defun edit>>
+<<defun editSpad2Cmd>>
<<defun emptyInterpreterFrame>>
<<defun fetchOutput>>
@@ -15784,6 +16159,7 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun frameName>>
<<defun frameNames>>
<<defun frameSpad2Cmd>>
+<<defun functionp>>
<<defun funfind,LAM>>
<<defun genDomainTraceName>>
@@ -15799,6 +16175,7 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun getTraceOption,hn>>
<<defun getTraceOptions>>
+<<defun handleNoParseCommands>>
<<defun hasPair>>
<<defun help>>
<<defun helpSpad2Cmd>>
@@ -15840,6 +16217,10 @@ load the file \verb|exposed.lsp| to set up the
exposure group information.
<<defun makeHistFileName>>
<<defun makeInitialModemapFrame>>
<<defun mapLetPrint>>
+<<defun member>>
+<<defun messageprint>>
+<<defun messageprint-1>>
+<<defun messageprint-2>>
<<defun ncIntLoop>>
<<defun ncloopCommand>>
@@ -15897,8 +16278,12 @@ load the file \verb|exposed.lsp| to set up the
exposure group information.
<<defun safeWritify>>
<<defun saveHistory>>
<<defun saveMapSig>>
+<<defun sayBrightly1>>
<<defun sayExample>>
+<<defun sayMSG>>
<<defun ScanOrPairVec>>
+<<defun selectOption>>
+<<defun selectOptionLC>>
<<defun set>>
<<defun set1>>
<<defun setAsharpArgs>>
@@ -15910,8 +16295,11 @@ load the file \verb|exposed.lsp| to set up the
exposure group information.
<<defun setExposeDrop>>
<<defun setExposeDropConstr>>
<<defun setExposeDropGroup>>
+<<defun setFortDir>>
+<<defun setFortTmpDir>>
<<defun setHistoryCore>>
<<defun setInputLibrary>>
+<<defun setLinkerArgs>>
<<defun setIOindex>>
<<defun setOutputLibrary>>
<<defun set-restart-hook>>
@@ -15974,6 +16362,8 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun updateHist>>
<<defun updateInCoreHist>>
+<<defun validateOutputDirectory>>
+
<<defun what>>
<<defun whatConstructors>>
<<defun whatSpad2Cmd>>
@@ -15995,6 +16385,8 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun zsystemdevelopment1>>
<<defun zsystemDevelopmentSpad2Cmd>>
+<<postvars>>
+
@
\chapter{The Global Variables}
\section{Star Global Variables}
diff --git a/changelog b/changelog
index 5c3e7c9..4f0404f 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,13 @@
+20090319 tpd src/axiom-website/patches.html 20090319.01.tpd.patch
+20090319 tpd src/interp/vmlisp.lisp move top level cmd handling
+20090319 tpd src/interp/setvars.boot move top level cmd handling
+20090319 tpd src/interp/macros.lisp move top level cmd handling
+20090319 tpd src/interp/intint.lisp move top level cmd handling
+20090319 tpd src/interp/i-syscmd.boot move top level cmd handling
+20090319 tpd src/interp/g-cndata.boot move top level cmd handling
+20090319 tpd src/interp/bootfuns.lisp move top level cmd handling
+20090319 tpd src/input/unittest1.input move top level cmd handling
+20090319 tpd books/bookvol5 move top level cmd handling
20090317 tpd src/axiom-website/patches.html 20090317.01.tpd.patch
20090317 tpd books/bookvol5 rewrite generated lisp into readable form
20090316 tpd src/axiom-website/patches.html 20090316.02.tpd.patch
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 74c25dd..acb665a 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -1011,5 +1011,7 @@ bookvol5 add )expose, add )set break resume<br/>
sockio.lisp restore sock-send-int<br/>
<a href="patches/20090317.01.tpd.patch">20090317.01.tpd.patch</a>
bookvol5 rewrite generated lisp into readable form<br/>
+<a href="patches/20090319.01.tpd.patch">20090319.01.tpd.patch</a>
+bookvol5 move top level command handling<br/>
</body>
</html>
diff --git a/src/input/unittest1.input.pamphlet
b/src/input/unittest1.input.pamphlet
index de5d841..c5d0dfa 100644
--- a/src/input/unittest1.input.pamphlet
+++ b/src/input/unittest1.input.pamphlet
@@ -17,12 +17,12 @@ Unit test the user level commands
)set mes auto off
)clear all
---S 1 of 47
+--S 1 of 70
)with API
--R )library cannot find the file API.
--E 1
---S 2 of 47
+--S 2 of 70
)apropos matrix
--R
--ROperations whose names satisfy the above pattern(s):
@@ -93,7 +93,7 @@ Unit test the user level commands
--R
--E 2
---S 3 of 47
+--S 3 of 70
)what categories set
--R
--R------------------------------- Categories --------------------------------
@@ -112,7 +112,7 @@ Unit test the user level commands
--R TSETCAT TriangularSetCategory
--E 3
---S 4 of 47
+--S 4 of 70
)what commands set
--R
--R--------------- System Commands for User Level: development ---------------
@@ -124,7 +124,7 @@ Unit test the user level commands
--R
--E 4
---S 5 of 47
+--S 5 of 70
)what domains set
--R
--R--------------------------------- Domains ---------------------------------
@@ -147,7 +147,7 @@ Unit test the user level commands
--R WUTSET WuWenTsunTriangularSet
--E 5
---S 6 of 47
+--S 6 of 70
)what operations set
--R
--R
@@ -251,7 +251,7 @@ Unit test the user level commands
--R issue the command )display op ruleset
--E 6
---S 7 of 47
+--S 7 of 70
)what packages set
--R
--R-------------------------------- Packages ---------------------------------
@@ -268,7 +268,7 @@ Unit test the user level commands
--R SRDCMPK SquareFreeRegularSetDecompositionPackage
--E 7
---S 8 of 47
+--S 8 of 70
)what synonym set
--R
--R------------------------- System Command Synonyms -------------------------
@@ -278,7 +278,7 @@ Unit test the user level commands
--R
--E 8
---S 9 of 47
+--S 9 of 70
)what things set
--R
--R
@@ -438,7 +438,7 @@ Unit test the user level commands
--R
--E 9
---S 10 of 47
+--S 10 of 70
)apropos set
--R
--R
@@ -598,7 +598,7 @@ Unit test the user level commands
--R
--E 10
---S 11 of 47
+--S 11 of 70
)prompt
--R---------------------------- The prompt Option ----------------------------
--R
@@ -616,13 +616,13 @@ Unit test the user level commands
--R
--E 11
---S 12 of 47
+--S 12 of 70
)version
--R
--IValue = "Saturday February 21, 2009 at 17:59:27 "
--E 12
---S 13 of 47
+--S 13 of 70
)zsys )from )c
--R
--R
@@ -633,7 +633,7 @@ Unit test the user level commands
--R
--E 13
---S 14 of 47
+--S 14 of 70
)zsys )from )d
--R
--R
@@ -644,7 +644,7 @@ Unit test the user level commands
--R
--E 14
---S 15 of 47
+--S 15 of 70
)zsys )from )dt
--R
--R
@@ -655,7 +655,7 @@ Unit test the user level commands
--R
--E 15
---S 16 of 47
+--S 16 of 70
)zsys )from )ct
--R
--R
@@ -666,7 +666,7 @@ Unit test the user level commands
--R
--E 16
---S 17 of 47
+--S 17 of 70
)zsys )from )ctl
--R
--R
@@ -677,7 +677,7 @@ Unit test the user level commands
--R
--E 17
---S 18 of 47
+--S 18 of 70
)zsys )from )ec
--R
--R
@@ -688,7 +688,7 @@ Unit test the user level commands
--R
--E 18
---S 19 of 47
+--S 19 of 70
)zsys )from )ect
--R
--R
@@ -699,7 +699,7 @@ Unit test the user level commands
--R
--E 19
---S 20 of 47
+--S 20 of 70
)zsys )from )e
--R
--R
@@ -710,12 +710,12 @@ Unit test the user level commands
--R
--E 20
---S 21 of 47
+--S 21 of 70
)zsys )from )version
--R
--E 21
---S 22 of 47
+--S 22 of 70
)zsys )from )update
--R
--R
@@ -726,7 +726,7 @@ Unit test the user level commands
--R
--E 22
---S 23 of 47
+--S 23 of 70
)zsys )from )patch
--R
--R
@@ -737,7 +737,7 @@ Unit test the user level commands
--R
--E 23
---S 24 of 47
+--S 24 of 70
)zsys )from )there 1
--R
--R
@@ -746,24 +746,24 @@ Unit test the user level commands
--R
--E 24
---S 25 of 47
+--S 25 of 70
)zsys )from )compare
--R
--R An argument is required for compare
--E 25
---S 26 of 47
+--S 26 of 70
)zsys )from )record
--R
--R An argument is required for record
--E 26
---S 27 of 47
+--S 27 of 70
)summary
--R
--E 27
---S 28 of 47
+--S 28 of 70
--R)credits
--RAn alphabetical listing of contributors to AXIOM:
--RCyril Alberga Roy Adler Christian Aistleitner
@@ -848,7 +848,7 @@ Unit test the user level commands
--RBruno Zuercher Dan Zwillinger
--E 28
---S 29 of 47
+--S 29 of 70
)set expose
--R---------------------------- The expose Option ----------------------------
--R
@@ -879,7 +879,7 @@ Unit test the user level commands
--R for more information.
--E 29
---S 30 of 47
+--S 30 of 70
)set expose add
--R----------------------------- The add Option ------------------------------
--R The following groups are explicitly exposed in the current frame
@@ -903,7 +903,7 @@ Unit test the user level commands
--R for more information.
--E 30
---S 31 of 47
+--S 31 of 70
)set expose drop
--R----------------------------- The drop Option -----------------------------
--R The following constructors are explicitly hidden in the current
@@ -920,7 +920,7 @@ Unit test the user level commands
--R for more information.
--E 31
---S 32 of 47
+--S 32 of 70
)set expose add group
--R---------------------------- The group Option -----------------------------
--R The following groups are explicitly exposed in the current frame
@@ -941,7 +941,7 @@ Unit test the user level commands
--Rdefaults
--E 32
---S 33 of 47
+--S 33 of 70
)set expose add constructor
--R------------------------- The constructor Option --------------------------
--R The following constructors are explicitly exposed in the current
@@ -949,7 +949,7 @@ Unit test the user level commands
--R there are no explicitly exposed constructors
--E 33
---S 34 of 47
+--S 34 of 70
)set expose drop group
--R---------------------------- The group Option -----------------------------
--R When followed by one or more exposure group names, this option
@@ -964,7 +964,7 @@ Unit test the user level commands
--R anna
--E 34
---S 35 of 47
+--S 35 of 70
)set expose drop constructor
--R------------------------- The constructor Option --------------------------
--R When followed by one or more constructor names, this option allows
@@ -979,7 +979,7 @@ Unit test the user level commands
--R there are no explicitly hidden constructors
--E 35
---S 36 of 47
+--S 36 of 70
)show SQMATRIX
--R SquareMatrix(ndim: NonNegativeInteger,R: Ring) is a domain constructor
--R Abbreviation for SquareMatrix is SQMATRIX
@@ -1078,12 +1078,12 @@ Unit test the user level commands
--R
--E 36
---S 37 of 47
+--S 37 of 70
)set expose add constructor SQMATRIX
--I SquareMatrix is now explicitly exposed in frame frame0
--E 37
---S 38 of 47
+--S 38 of 70
)show SQMATRIX
--R SquareMatrix(ndim: NonNegativeInteger,R: Ring) is a domain constructor
--R Abbreviation for SquareMatrix is SQMATRIX
@@ -1182,7 +1182,7 @@ Unit test the user level commands
--R
--E 38
---S 39 of 47
+--S 39 of 70
)set expose add
--R----------------------------- The add Option ------------------------------
--R The following groups are explicitly exposed in the current frame
@@ -1206,12 +1206,12 @@ Unit test the user level commands
--R for more information.
--E 39
---S 40 of 47
+--S 40 of 70
)set expose drop constructor SQMATRIX
--I SquareMatrix is now explicitly hidden in frame frame0
--E 40
---S 41 of 47
+--S 41 of 70
)show SQMATRIX
--R SquareMatrix(ndim: NonNegativeInteger,R: Ring) is a domain constructor
--R Abbreviation for SquareMatrix is SQMATRIX
@@ -1310,7 +1310,7 @@ Unit test the user level commands
--R
--E 41
---S 42 of 47
+--S 42 of 70
)set expose
--R---------------------------- The expose Option ----------------------------
--R
@@ -1341,12 +1341,12 @@ Unit test the user level commands
--R for more information.
--E 42
---S 43 of 47
+--S 43 of 70
)set expose drop group anna
--I anna is no longer an exposure group for frame frame0
--E 43
---S 44 of 47
+--S 44 of 70
)set expose
--R---------------------------- The expose Option ----------------------------
--R
@@ -1376,7 +1376,7 @@ Unit test the user level commands
--R for more information.
--E 44
---S 45 of 47
+--S 45 of 70
)set expose add group
--R---------------------------- The group Option -----------------------------
--R The following groups are explicitly exposed in the current frame
@@ -1396,12 +1396,12 @@ Unit test the user level commands
--Rdefaults
--E 45
---S 46 of 47
+--S 46 of 70
)set expose add group anna
--I anna is now an exposure group for frame frame0
--E 46
---S 47 of 47
+--S 47 of 70
)set expose
--R---------------------------- The expose Option ----------------------------
--R
@@ -1432,6 +1432,301 @@ Unit test the user level commands
--R for more information.
--E 47
+--S 48 of 70
+)display
+
+ )display keyword arguments are
+ abbreviations
+ all
+ macros
+ modes
+ names
+ operations
+ properties
+ types
+ values
+ or abbreviations thereof
+
+--E 48
+
+--S 49 of 70
+)display abb
+ You have requested that all abbreviations be displayed. As there are
+ several hundred abbreviations, please confirm your request by
+ typing y or yes and then pressing Enter :
+n
+ Since you did not respond with y or yes the list of abbreviations
+ will not be displayed.
+--E 49
+
+--S 50 of 70
+)display all
+Properties of %e :
+ This is a system-defined macro.
+ macro %e () == exp(1)
+Properties of %i :
+ This is a system-defined macro.
+ macro %i () == complex(0,1)
+Properties of %infinity :
+ This is a system-defined macro.
+ macro %infinity () == infinity()
+Properties of %minusInfinity :
+ This is a system-defined macro.
+ macro %minusInfinity () == minusInfinity()
+Properties of %pi :
+ This is a system-defined macro.
+ macro %pi () == pi()
+Properties of %plusInfinity :
+ This is a system-defined macro.
+ macro %plusInfinity () == plusInfinity()
+Properties of SF :
+ This is a system-defined macro.
+ macro SF () == DoubleFloat()
+--E 50
+
+--S 51 of 70
+)display macros
+
+System-defined macros:
+ macro %e () == exp(1)
+ macro %i () == complex(0,1)
+ macro %infinity () == infinity()
+ macro %minusInfinity () == minusInfinity()
+ macro %pi () == pi()
+ macro %plusInfinity () == plusInfinity()
+ macro SF () == DoubleFloat()
+--E 51
+
+--S 52 of 70
+)display modes
+ Type of value of %e: (none)
+ Type of value of %i: (none)
+ Type of value of %infinity: (none)
+ Type of value of %minusInfinity: (none)
+ Type of value of %pi: (none)
+ Type of value of %plusInfinity: (none)
+ Type of value of SF: (none)
+--E 52
+
+--S 53 of 70
+)display names
+
+Names of User-Defined Objects in the Workspace:
+
+ * None *
+
+Names of System-Defined Objects in the Workspace:
+
+%e %i %infinity %minusInfinity
+%pi %plusInfinity SF
+--E 53
+
+--S 54 of 70
+)display operations
+ You have requested that all information about all AXIOM operations
+ (functions) be displayed. As there are several hundred
+ operations, please confirm your request by typing y or yes and
+ then pressing Enter :
+n
+ Since you did not respond with y or yes the list of operations will
+ not be displayed.
+--E 54
+
+--S 55 of 70
+)display properties
+Properties of %e :
+ This is a system-defined macro.
+ macro %e () == exp(1)
+Properties of %i :
+ This is a system-defined macro.
+ macro %i () == complex(0,1)
+Properties of %infinity :
+ This is a system-defined macro.
+ macro %infinity () == infinity()
+Properties of %minusInfinity :
+ This is a system-defined macro.
+ macro %minusInfinity () == minusInfinity()
+Properties of %pi :
+ This is a system-defined macro.
+ macro %pi () == pi()
+Properties of %plusInfinity :
+ This is a system-defined macro.
+ macro %plusInfinity () == plusInfinity()
+Properties of SF :
+ This is a system-defined macro.
+ macro SF () == DoubleFloat()
+--E 55
+
+--S 56 of 70
+)display types
+ Type of value of %e: (none)
+ Type of value of %i: (none)
+ Type of value of %infinity: (none)
+ Type of value of %minusInfinity: (none)
+ Type of value of %pi: (none)
+ Type of value of %plusInfinity: (none)
+ Type of value of SF: (none)
+--E 56
+
+--S 57 of 70
+)display values
+ Value of %e: (none)
+ Value of %i: (none)
+ Value of %infinity: (none)
+ Value of %minusInfinity: (none)
+ Value of %pi: (none)
+ Value of %plusInfinity: (none)
+ Value of SF: (none)
+--E 57
+
+--S 58 of 70
+)display abb DHMATRIX
+ DHMATRIX abbreviates domain DenavitHartenbergMatrix
+--E 58
+
+--S 59 of 70
+)display abb DenavitHartenbergMatrix
+ DHMATRIX abbreviates domain DenavitHartenbergMatrix
+--E 59
+
+--S 60 of 70
+)display operations rotatex
+
+There is one exposed function called rotatex :
+ [1] D1 -> DenavitHartenbergMatrix D1 from DenavitHartenbergMatrix D1
+ if D1 has Join(Field,TranscendentalFunctionCategory)
+
+Examples of rotatex from DenavitHartenbergMatrix
+
+--E 60
+
+--S 61 of 70
+)set fortran calling
+ Current Values of calling Variables
+
+Variable Description Current Value
+-----------------------------------------------------------------------------
+tempfile set location of temporary data files /tmp/
+directory set location of generated FORTRAN files ./
+linker linker arguments (e.g. libraries to search) -lxlf
+
+--E 61
+
+--S 62 of 70
+)set fortran calling tempfile
+--------------------------- The tempfile Option ---------------------------
+
+ Description: set location of temporary data files
+
+ )set fortran calling tempfile is used to tell AXIOM where
+ to place intermediate FORTRAN data files . This must be the
+ name of a valid existing directory to which you have permission
+ to write (including the final slash).
+
+ Syntax:
+ )set fortran calling tempfile DIRECTORYNAME
+
+ The current setting is /tmp/
+--E 62
+
+--S 63 of 70
+)set fortran calling tempfile /home/daly
+--E 63
+
+--S 64 of 70
+)set fortran calling tempfile
+--------------------------- The tempfile Option ---------------------------
+
+ Description: set location of temporary data files
+
+ )set fortran calling tempfile is used to tell AXIOM where
+ to place intermediate FORTRAN data files . This must be the
+ name of a valid existing directory to which you have permission
+ to write (including the final slash).
+
+ Syntax:
+ )set fortran calling tempfile DIRECTORYNAME
+
+ The current setting is /home/daly/
+--E 64
+
+--S 65 of 70
+)set fortran calling directory
+-------------------------- The directory Option ---------------------------
+
+ Description: set location of generated FORTRAN files
+
+ )set fortran calling directory is used to tell AXIOM where
+ to place generated FORTRAN files. This must be the name
+ of a valid existing directory to which you have permission
+ to write (including the final slash).
+
+ Syntax:
+ )set fortran calling directory DIRECTORYNAME
+
+ The current setting is ./
+--E 65
+
+--S 66 of 70
+)set fortran calling directory /home/daly/
+--E 66
+
+--S 67 of 70
+)set fortran calling directory
+-------------------------- The directory Option ---------------------------
+
+ Description: set location of generated FORTRAN files
+
+ )set fortran calling directory is used to tell AXIOM where
+ to place generated FORTRAN files. This must be the name
+ of a valid existing directory to which you have permission
+ to write (including the final slash).
+
+ Syntax:
+ )set fortran calling directory DIRECTORYNAME
+
+ The current setting is /home/daly/
+--E 67
+
+--S 68 of 70
+)set fortran calling linker
+---------------------------- The linker Option ----------------------------
+
+ Description: linker arguments (e.g. libraries to search)
+
+ )set fortran calling linkerargs is used to pass arguments to the linker
+ when using mkFort to create functions which call Fortran code.
+ For example, it might give a list of libraries to be searched,
+ and their locations.
+ The string is passed verbatim, so must be the correct syntax for
+ the particular linker being used.
+
+ Example: )set fortran calling linker "-lxlf"
+
+ The current setting is -lxlf
+--E 68
+
+--S 69 of 70
+)set fortran calling linker "-TPD"
+--E 69
+
+--S 70 of 70
+)set fortran calling linker
+---------------------------- The linker Option ----------------------------
+
+ Description: linker arguments (e.g. libraries to search)
+
+ )set fortran calling linkerargs is used to pass arguments to the linker
+ when using mkFort to create functions which call Fortran code.
+ For example, it might give a list of libraries to be searched,
+ and their locations.
+ The string is passed verbatim, so must be the correct syntax for
+ the particular linker being used.
+
+ Example: )set fortran calling linker "-lxlf"
+
+ The current setting is -TPD
+--E 70
)spool
)lisp (bye)
diff --git a/src/interp/bootfuns.lisp.pamphlet
b/src/interp/bootfuns.lisp.pamphlet
index e94b453..654856c 100644
--- a/src/interp/bootfuns.lisp.pamphlet
+++ b/src/interp/bootfuns.lisp.pamphlet
@@ -85,9 +85,6 @@ which will walk the structure $Y$ looking for this constant.
#-:CCL
(def-boot-val |$timerTicksPerSecond| INTERNAL-TIME-UNITS-PER-SECOND
"for TEMPUS-FUGIT and $TOTAL-ELAPSED-TIME")
-#+:CCL
-(def-boot-val |$timerTicksPerSecond| 1000
- "for TEMPUS-FUGIT and $TOTAL-ELAPSED-TIME")
(def-boot-val $boxString
(concatenate 'string (list (code-char #x1d) (code-char #xe2)))
"this string of 2 chars displays as a box")
@@ -391,7 +388,6 @@ for primitive domains. Also used by
putInLocalDomainReferences and optCal.")
(def-boot-var |$suffix| "???")
(def-boot-val |$Symbol| '(|Symbol|) "???")
(def-boot-val |$SymbolOpt| '(|Symbol| . OPT) "???")
-;(def-boot-var |$systemCommands|
"Interpreter>System.boot")
(def-boot-val |$systemCreation| (currenttime) "???")
(def-boot-val |$systemLastChanged|
|$systemCreation| "???")
@@ -459,9 +455,7 @@ for primitive domains. Also used by
putInLocalDomainReferences and optCal.")
(if (memq u '(|%display%| |%describe%|))
(if |$printLoadMsgs| "on" "off")
(seq
- (setq |$printLoadMsgs| (and (listp u) (equal (car u) '|on|)))
-#+:CCL (verbos (if |$printLoadMsgs| 2 0))
-)))
+ (setq |$printLoadMsgs| (and (listp u) (equal (car u) '|on|))))))
@
\eject
diff --git a/src/interp/g-cndata.boot.pamphlet
b/src/interp/g-cndata.boot.pamphlet
index 7e09df9..4469086 100644
--- a/src/interp/g-cndata.boot.pamphlet
+++ b/src/interp/g-cndata.boot.pamphlet
@@ -126,11 +126,6 @@ mkUserConstructorAbbreviation(c,a,type) ==
installConstructor(c,type)
setAutoLoadProperty(c)
-abbQuery(x) ==
- abb := GETDATABASE(x,'ABBREVIATION) =>
- sayKeyedMsg("S2IZ0001",[abb,GETDATABASE(x,'CONSTRUCTORKIND),x])
- sayKeyedMsg("S2IZ0003",[x])
-
installConstructor(cname,type) ==
(entry := getCDTEntry(cname,true)) => entry
item := [cname,GETDATABASE(cname,'ABBREVIATION),nil]
diff --git a/src/interp/i-syscmd.boot.pamphlet
b/src/interp/i-syscmd.boot.pamphlet
index 19de874..a73b79d 100644
--- a/src/interp/i-syscmd.boot.pamphlet
+++ b/src/interp/i-syscmd.boot.pamphlet
@@ -9,82 +9,6 @@
\eject
\tableofcontents
\eject
-\begin{verbatim}
-This file contains the BOOT code for the Axiom system command
-and synonym processing facility. The code for )trace is in the file
-TRACE BOOT. The list of system commands is $SYSCOMMANDS which is
-initialized in SETQ LISP.
-
-\end{verbatim}
-\section{Filenames change}
-It appears that probe-file is now case-sensitive. In order to get around
-this we include the file extensions in both upper and lower case in the
-search lists. Lower case names are preferred.
-
-\section{handleNoParseCommands}
-The system commands given by the global variable
-[[|$noParseCommands|]]\cite{1} require essentially no
-preprocessing/parsing of their arguments. Here we dispatch the
-functions which implement these commands.
-
-There are four standard commands which receive arguments -- [[lisp]],
-[[synonym]], [[system]] and [[boot]]. There are five standard commands
-which do not receive arguments -- [[quit]], [[fin]], [[pquit]],
-[[credits]] and [[copyright]]. As these commands do not necessarily
-exhaust those mentioned in [[|$noParseCommands|]], we provide a
-generic dispatch based on two conventions: commands which do not
-require an argument name themselves, those which do have their names
-prefixed by [[np]].
-
-<<handleNoParseCommands>>=
-handleNoParseCommands(unab, string) ==
- string := stripSpaces string
- spaceIndex := SEARCH('" ", string)
- unab = "lisp" =>
- if (null spaceIndex) then
- sayKeyedMsg("S2IV0005", NIL)
- nil
- else nplisp(stripLisp string)
- unab = "boot" =>
- if (null spaceIndex) then
- sayKeyedMsg("S2IV0005", NIL)
- nil
- else npboot(SUBSEQ(string, spaceIndex+1))
- unab = "system" =>
- if (null spaceIndex) then
- sayKeyedMsg("S2IV0005", NIL)
- nil
- else npsystem(unab, string)
- unab = "synonym" =>
- npsynonym(unab, (null spaceIndex => '""; SUBSEQ(string, spaceIndex+1)))
- null spaceIndex =>
- FUNCALL unab
- MEMBER(unab, '( quit _
- fin _
- pquit _
- credits _
- copyright )) =>
- sayKeyedMsg("S2IV0005", NIL)
- nil
- funName := INTERN CONCAT('"np",STRING unab)
- FUNCALL(funName, SUBSEQ(string, spaceIndex+1))
-
-@
-\section{TRUENAME change}
-This change was made to make the open source Axiom work with the
-new aldor compiler.z
-This used to read:
-\begin{verbatim}
- STRCONC(TRUENAME(STRCONC(GETENV('"AXIOM"),'"/compiler/bin/")),"axiomxl ",
asharpArgs, '" ", namestring args)
-\end{verbatim}
-but now reads:
-<<remove TRUENAME>>=
- STRCONC(STRCONC(GETENV('"ALDORROOT"),'"/bin/"),_
- "aldor ", asharpArgs, '" ", namestring args)
-@
-Notice that we've introduced the [[ALDORROOT]] shell variable.
-This will have to be pushed down from the top level Makefile.
-
\section{License}
<<license>>=
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
@@ -130,24 +54,6 @@ SETANDFILEQ($compileRecurrence,true)
SETANDFILEQ($errorReportLevel,'warning)
SETANDFILEQ($sourceFileTypes,'(INPUT SPAD BOOT LISP LISP370 META))
-SETANDFILEQ($whatOptions, '( _
- operations _
- categories _
- domains _
- packages _
- commands _
- synonyms _
- things _
- ))
-
-SETANDFILEQ($clearOptions, '( _
- modes _
- operations _
- properties _
- types _
- values _
- ))
-
SETANDFILEQ($countAssoc,'( (cache countCache) ))
--% Top level system command
@@ -211,19 +117,6 @@ hasOption(al,opt) ==
stringPrefix?(PNAME CAR pair,optPname) => found := pair
found
-selectOptionLC(x,l,errorFunction) ==
- selectOption(DOWNCASE object2Identifier x,l,errorFunction)
-
-selectOption(x,l,errorFunction) ==
- MEMBER(x,l) => x --exact spellings are always OK
- null IDENTP x =>
- errorFunction => FUNCALL(errorFunction,x,u)
- nil
- u := [y for y in l | stringPrefix?(PNAME x,PNAME y)]
- u is [y] => y
- errorFunction => FUNCALL(errorFunction,x,u)
- nil
-
terminateSystemCommand() == TERSYSCOMMAND()
commandUserLevelError(x,u) == userLevelErrorMessage("command",x,u)
@@ -460,30 +353,6 @@ displayValue($op,u,omitVariableNameIfTrue) ==
outputFormat(expr,objMode(u))]
NIL
---% )edit
-
-edit l == editSpad2Cmd l
-
-editSpad2Cmd l ==
- l:=
- null l => _/EDITFILE
- CAR l
- l := pathname l
- oldDir := pathnameDirectory l
- fileTypes :=
- pathnameType l => [pathnameType l]
- $UserLevel = 'interpreter => '("input" "INPUT" "spad" "SPAD")
- $UserLevel = 'compiler => '("input" "INPUT" "spad" "SPAD")
- '("input" "INPUT" "spad" "SPAD" "boot" "BOOT" "lisp" "LISP" "meta" "META")
- ll :=
- oldDir = '"" => pathname $FINDFILE (pathnameName l, fileTypes)
- l
- l := pathname ll
- SETQ(_/EDITFILE,l)
- rc := editFile l
- updateSourceFiles l
- rc
-
--% )load
load args == loadSpad2Cmd args
@@ -960,8 +829,6 @@ doSystemCommand string ==
nil
nil
-<<handleNoParseCommands>>
-
npboot str ==
sex := string2BootTree str
FORMAT(true, '"~&~S~%", sex)
diff --git a/src/interp/intint.lisp.pamphlet b/src/interp/intint.lisp.pamphlet
index a4e29f5..c3973f8 100644
--- a/src/interp/intint.lisp.pamphlet
+++ b/src/interp/intint.lisp.pamphlet
@@ -48,104 +48,68 @@
(in-package "BOOT")
+(eval-when (eval load)
+ (setq |$useNewParser| T))
+
+(defun |rePackageTran| (sex package)
+ (let (*package*)
+ (declare (special *package*))
+ (setq *package* (find-package (string package)))
+ (|packageTran| sex)))
+
+(defun |packageTran| (sex)
+ (prog ()
+ (return
+ (cond
+ ((symbolp sex)
+ (cond
+ ((eq *package* (symbol-package sex)) sex)
+ (t (intern (string sex)))))
+ ((consp sex)
+ (rplaca sex (|packageTran| (car sex)))
+ (rplacd sex (|packageTran| (cdr sex)))
+ sex)
+ (t sex)))))
+
+(defun |zeroOneTran| (sex)
+ (nsubst '|$EmptyMode| '? sex))
+
(defun |intSayKeyedMsg| (key args)
(|sayKeyedMsg| (|packageTran| key) (|packageTran| args)))
-;;(defun |intMakeFloat| (int frac len exp)
-;; (MAKE-FLOAT int frac len exp))
-
-;;(defun |intSystemCommand| (command)
-;; (catch 'SPAD_READER
-;; (|systemCommand| (|packageTran| command))))
-
-;;(defun |intUnAbbreviateKeyword| (keyword)
-;; (|unAbbreviateKeyword| (|packageTran| keyword)))
-
(defun |intProcessSynonyms| (str)
(let ((LINE str))
(declare (special LINE))
(|processSynonyms|)
LINE))
-;; (defun |intNoParseCommands| ()
-;; |$noParseCommands|)
-
-;;(defun |intTokenCommands| ()
-;; |$tokenCommands|)
-
(defun |intInterpretPform| (pf)
(|processInteractive| (|zeroOneTran| (|packageTran| (|pf2Sex| pf))) pf))
-;;(defun |intSpadThrow| ()
-;; (|spadThrow|))
-
-;;(defun |intMKPROMPT| (should? step)
-;; (if should? (PRINC (MKPROMPT))))
-
(defvar |$intCoerceFailure| '|coerceFailure|)
(defvar |$intTopLevel| '|top_level|)
(defvar |$intSpadReader| 'SPAD_READER)
(defvar |$intRestart| '|restart|)
-;;(defun |intString2BootTree| (str)
-;; (|string2BootTree| str))
-
-;;(defun |intPackageTran| (sex)
-;; (|packageTran| sex))
-
-;;(defvar |$SessionManager| |$SessionManager|)
-;;(defvar |$EndOfOutput| |$EndOfOutput|)
-
-;;(defun |intServerReadLine| (foo)
-;; (|serverReadLine| foo))
-
-;; (defun |intProcessSynonym| (str)
-;; (|npProcessSynonym| str))
-
(defun |SpadInterpretFile| (fn)
(|SpadInterpretStream| 1 fn nil) )
(defun |intNewFloat| ()
(list '|Float|))
-;; (defun |intDoSystemCommand| (string)
-;; (|doSystemCommand| string))
-
(defun |intSetNeedToSignalSessionManager| ()
(setq |$NeedToSignalSessionManager| T))
-;; (defun |intKeyedSystemError| (msg args)
-;; (|keyedSystemError| msg args))
-
-;;#-:CCL
-;;(defun |stashInputLines| (l)
-;; (|stashInputLines| l))
-
-;;(defun |setCurrentLine| (s)
-;; (setq |$currentLine| s))
-
(defun |intnplisp| (s)
(setq |$currentLine| s)
(|nplisp| |$currentLine|))
-;; (defun |intResetStackLimits| () (|resetStackLimits|))
-
(defun |intSetQuiet| ()
(setq |$QuietCommand| T))
(defun |intUnsetQuiet| ()
(setq |$QuietCommand| NIL))
-;; (defun |expandTabs| (s)
-;; (expand-tabs s))
-
-;; #-:CCL
-;; (defun |leaveScratchpad| ()
-;; (|leaveScratchpad|))
-
-;;(defun |readingFile?| ()
-;; |$ReadingFile|)
-
@
\eject
\begin{thebibliography}{99}
diff --git a/src/interp/macros.lisp.pamphlet b/src/interp/macros.lisp.pamphlet
index 117408c..3b06048 100644
--- a/src/interp/macros.lisp.pamphlet
+++ b/src/interp/macros.lisp.pamphlet
@@ -149,8 +149,6 @@ ends up being [[CONTAINED |$EmptyMode| Y]].
(defmacro |function| (name) `(FUNCTION ,name))
(defmacro |dispatchFunction| (name) `(FUNCTION ,name))
-(defun |functionp| (fn)
- (if (identp fn) (and (fboundp fn) (not (macro-function fn))) (functionp
fn)))
(defun |macrop| (fn) (and (identp fn) (macro-function fn)))
; 6 PREDICATES
@@ -1261,22 +1259,12 @@ LP (COND ((NULL X)
(defun sayBrightlyNT1 (X *standard-output*)
(if (ATOM X) (BRIGHTPRINT-0 X) (BRIGHTPRINT X)))
-(defun sayBrightly1 (X *standard-output*)
- (if (ATOM X)
- (progn (BRIGHTPRINT-0 X) (TERPRI) (force-output))
- (progn (BRIGHTPRINT X) (TERPRI) (force-output))))
-
-(defvar |$algebraOutputStream| *standard-output*)
-
(defun |saySpadMsg| (X)
(if (NULL X) NIL (sayBrightly1 X |$algebraOutputStream|)))
(defun |sayALGEBRA| (X) "Prints on Algebra output stream."
(if (NULL X) NIL (sayBrightly1 X |$algebraOutputStream|)))
-(defun |sayMSG| (X)
- (if (NULL X) NIL (sayBrightly1 X |$algebraOutputStream|)))
-
(defun |sayMSGNT| (X)
(if (NULL X) NIL (sayBrightlyNT1 X |$algebraOutputStream|)))
@@ -1307,29 +1295,8 @@ LP (COND ((NULL X)
;; the following are redefined in MSGDB BOOT
-;; --------------------> NEW DEFINITION (override in msgdb.boot.pamphlet)
-(DEFUN BRIGHTPRINT (X) (MESSAGEPRINT X))
-
-;; --------------------> NEW DEFINITION (override in msgdb.boot.pamphlet)
-(DEFUN BRIGHTPRINT-0 (x) (MESSAGEPRINT-1 X))
-
(defun SAY (&rest x) (progn (MESSAGEPRINT X) (TERPRI)))
-(DEFUN MESSAGEPRINT (X) (mapc #'messageprint-1 X))
-
-(DEFUN MESSAGEPRINT-1 (X)
- (COND ((OR (EQ X '|%l|) (EQUAL X "%l")) (TERPRI))
- ((STRINGP X) (PRINC X))
- ((IDENTP X) (PRINC X))
- ((ATOM X) (PRINC X))
- ((PRINC "(") (MESSAGEPRINT-1 (CAR X))
- (MESSAGEPRINT-2 (CDR X)) (PRINC ")"))))
-
-(DEFUN MESSAGEPRINT-2 (X)
- (if (ATOM X)
- (if (NULL X) NIL (progn (PRINC " . ") (MESSAGEPRINT-1 X)))
- (progn (PRINC " ") (MESSAGEPRINT-1 (CAR X)) (MESSAGEPRINT-2 (CDR X)))))
-
(DEFUN BLANKS (N &optional (stream *standard-output*)) "Print N blanks."
(do ((i 1 (the fixnum(1+ i))))
((> i N))(declare (fixnum i n)) (princ " " stream)))
diff --git a/src/interp/setvars.boot.pamphlet b/src/interp/setvars.boot.pamphlet
index f5e8b35..6d2e935 100644
--- a/src/interp/setvars.boot.pamphlet
+++ b/src/interp/setvars.boot.pamphlet
@@ -74,140 +74,6 @@ See the section expose in setvart.boot.pamphlet\cite{1}
for more information.
\end{verbatim}
-\section{fortran calling}
-See the section calling in servart.boot.pamphlet.
-\begin{verbatim}
- Current Values of calling Variables
-
-Variable Description Current Value
------------------------------------------------------------------
-tempfile set location of temporary data files /tmp/
-directory set location of generated FORTRAN files ./
-linker linker arguments (e.g. libraries to search) -lxlf
-
-\end{verbatim}
-<<fortrancallingCode>>=
-<<setFortTmpDir>>
-<<validateOutputDirectory>>
-<<describeSetFortTmpDir>>
-<<setFortDir>>
-<<describeSetFortDir>>
-<<setLinkerArgs>>
-<<describeSetLinkerArgs>>
-@
-\subsection{setFortTmpDir}
-<<setFortTmpDir>>=
-setFortTmpDir arg ==
-
- arg = "%initialize%" =>
- $fortranTmpDir := '"/tmp/"
-
- arg = "%display%" =>
- STRINGP $fortranTmpDir => $fortranTmpDir
- PNAME $fortranTmpDir
-
- (null arg) or (arg = "%describe%") or (first arg = '_?) =>
- describeSetFortTmpDir()
-
- -- try to figure out what the argument is
-
- -- VM code - must be an accessed disk mode [mode]
- not (mode := validateOutputDirectory arg) =>
- sayBrightly ['" Sorry, but your argument(s)",:bright arg,
- '"is(are) not valid.",'%l]
- describeSetFortTmpDir()
- $fortranTmpDir := mode
-
-@
-\subsection{validateOutputDirectory}
-<<validateOutputDirectory>>=
-validateOutputDirectory x ==
- AND(PATHNAME_-DIRECTORY(PROBE_-FILE(CAR(x))), NOT PATHNAME_-NAME
(PROBE_-FILE(CAR(x)))) =>
- CAR(x)
- NIL
-
-@
-\subsection{describeSetFortTmpDir}
-<<describeSetFortTmpDir>>=
-describeSetFortTmpDir() ==
- sayBrightly LIST (
- '%b,'")set fortran calling tempfile",'%d,_
- '" is used to tell AXIOM where",'%l,_
- '" to place intermediate FORTRAN data files . This must be the ",'%l,_
- '" name of a valid existing directory to which you have permission ",'%l,_
- '" to write (including the final slash).",'%l,'%l,_
- '" Syntax:",'%l,_
- '" )set fortran calling tempfile DIRECTORYNAME",'%l,'%l,_
- '" The current setting is",'%b,$fortranTmpDir,'%d)
-
-@
-\subsection{setFortDir}
-<<setFortDir>>=
-setFortDir arg ==
- arg = "%initialize%" =>
- $fortranDirectory := '"./"
-
- arg = "%display%" =>
- STRINGP $fortranDirectory => $fortranDirectory
- PNAME $fortranDirectory
-
- (null arg) or (arg = "%describe%") or (first arg = '_?) =>
- describeSetFortDir()
-
- -- try to figure out what the argument is
-
- -- VM code - must be an accessed disk mode [mode]
- not (mode := validateOutputDirectory arg) =>
- sayBrightly ['" Sorry, but your argument(s)",:bright arg,
- '"is(are) not valid.",'%l]
- describeSetFortDir()
- $fortranDirectory := mode
-
-@
-\subsection{describeSetFortDir}
-<<describeSetFortDir>>=
-describeSetFortDir() ==
- sayBrightly LIST (
- '%b,'")set fortran calling directory",'%d,_
- '" is used to tell AXIOM where",'%l,_
- '" to place generated FORTRAN files. This must be the name ",'%l,_
- '" of a valid existing directory to which you have permission ",'%l,_
- '" to write (including the final slash).",'%l,'%l,_
- '" Syntax:",'%l,_
- '" )set fortran calling directory DIRECTORYNAME",'%l,'%l,_
- '" The current setting is",'%b,$fortranDirectory,'%d)
-
-@
-\subsection{setLinkerArgs}
-<<setLinkerArgs>>=
-setLinkerArgs arg ==
-
- arg = "%initialize%" =>
- $fortranLibraries := '"-lxlf"
- arg = "%display%" => object2String $fortranLibraries
- (null arg) or (arg = "%describe%") or (first arg = '_?) =>
- describeSetLinkerArgs()
- LISTP(arg) and STRINGP(first arg) =>
- $fortranLibraries := first(arg)
- describeSetLinkerArgs()
-
-@
-\subsection{describeSetLinkerArgs}
-<<describeSetLinkerArgs>>=
-describeSetLinkerArgs() ==
- sayBrightly LIST (
- '%b,'")set fortran calling linkerargs",'%d,_
- '" is used to pass arguments to the linker",'%l,_
- '" when using ",'%b,'"mkFort",'%d,_
- '" to create functions which call Fortran code.",'%l,_
- '" For example, it might give a list of libraries to be searched,",'%l,_
- '" and their locations.",'%l,_
- '" The string is passed verbatim, so must be the correct syntax for",'%l,_
- '" the particular linker being used.",'%l,'%l,_
- '" Example: )set fortran calling linker _"-lxlf_"",'%l,'%l,_
- '" The current setting is",'%b,$fortranLibraries,'%d)
-
-@
\section{functions}
See the section functions in setvart.boot.pamphlet\cite{1}
\begin{verbatim}
@@ -1377,7 +1243,6 @@ describeSetStreamsCalculate() ==
sayKeyedMsg("S2IV0001",[$streamCount])
@
<<*>>=
<<license>>
-<<fortrancallingCode>>
<<functionsCode>>
<<historyCode>>
<<kernelCode>>
@@ -1396,95 +1261,6 @@ describeSetStreamsCalculate() ==
sayKeyedMsg("S2IV0001",[$streamCount])
(IN-PACKAGE "BOOT" )
-;setFortTmpDir arg ==
-; arg = "%initialize%" =>
-; $fortranTmpDir := '"/tmp/"
-; arg = "%display%" =>
-; STRINGP $fortranTmpDir => $fortranTmpDir
-; PNAME $fortranTmpDir
-; (null arg) or (arg = "%describe%") or (first arg = '_?) =>
-; describeSetFortTmpDir()
-; -- try to figure out what the argument is
-; -- VM code - must be an accessed disk mode [mode]
-; not (mode := validateOutputDirectory arg) =>
-; sayBrightly ['" Sorry, but your argument(s)",:bright arg,
-; '"is(are) not valid.",'%l]
-; describeSetFortTmpDir()
-; $fortranTmpDir := mode
-
-(DEFUN |setFortTmpDir| (|arg|) (PROG (|mode|) (RETURN (COND ((BOOT-EQUAL |arg|
(QUOTE |%initialize%|)) (SPADLET |$fortranTmpDir| (MAKESTRING "/tmp/")))
((BOOT-EQUAL |arg| (QUOTE |%display%|)) (COND ((STRINGP |$fortranTmpDir|)
|$fortranTmpDir|) ((QUOTE T) (PNAME |$fortranTmpDir|)))) ((OR (NULL |arg|)
(BOOT-EQUAL |arg| (QUOTE |%describe%|)) (BOOT-EQUAL (CAR |arg|) (QUOTE ?)))
(|describeSetFortTmpDir|)) ((NULL (SPADLET |mode| (|validateOutputDirectory|
|arg|))) (|sayBrightly| (CONS (MAKESTRING " Sorry, but your argument(s)")
(APPEND (|bright| |arg|) (CONS (MAKESTRING "is(are) not valid.") (CONS (QUOTE
|%l|) NIL))))) (|describeSetFortTmpDir|)) ((QUOTE T) (SPADLET |$fortranTmpDir|
|mode|))))))
-;validateOutputDirectory x ==
-; AND(PATHNAME_-DIRECTORY(PROBE_-FILE(CAR(x))), NOT PATHNAME_-NAME
(PROBE_-FILE(CAR(x)))) =>
-; CAR(x)
-; NIL
-
-(DEFUN |validateOutputDirectory| (|x|) (COND ((AND (PATHNAME-DIRECTORY
(PROBE-FILE (CAR |x|))) (NULL (PATHNAME-NAME (PROBE-FILE (CAR |x|))))) (CAR
|x|)) ((QUOTE T) NIL)))
-;describeSetFortTmpDir() ==
-; sayBrightly LIST (
-; '%b,'")set fortran calling tempfile",'%d,_
-; '" is used to tell AXIOM where",'%l,_
-; '" to place intermediate FORTRAN data files . This must be the ",'%l,_
-; '" name of a valid existing directory to which you have permission ",'%l,_
-; '" to write (including the final slash).",'%l,'%l,_
-; '" Syntax:",'%l,_
-; '" )set fortran calling tempfile DIRECTORYNAME",'%l,'%l,_
-; '" The current setting is",'%b,$fortranTmpDir,'%d)
-
-(DEFUN |describeSetFortTmpDir| NIL (|sayBrightly| (LIST (QUOTE |%b|)
(MAKESTRING ")set fortran calling tempfile") (QUOTE |%d|) (MAKESTRING " is used
to tell AXIOM where") (QUOTE |%l|) (MAKESTRING " to place intermediate FORTRAN
data files . This must be the ") (QUOTE |%l|) (MAKESTRING " name of a valid
existing directory to which you have permission ") (QUOTE |%l|) (MAKESTRING "
to write (including the final slash).") (QUOTE |%l|) (QUOTE |%l|) (MAKESTRING "
Syntax:") (QUOTE |%l|) (MAKESTRING " )set fortran calling tempfile
DIRECTORYNAME") (QUOTE |%l|) (QUOTE |%l|) (MAKESTRING " The current setting
is") (QUOTE |%b|) |$fortranTmpDir| (QUOTE |%d|))))
-;setFortDir arg ==
-; arg = "%initialize%" =>
-; $fortranDirectory := '"./"
-; arg = "%display%" =>
-; STRINGP $fortranDirectory => $fortranDirectory
-; PNAME $fortranDirectory
-; (null arg) or (arg = "%describe%") or (first arg = '_?) =>
-; describeSetFortDir()
-; -- try to figure out what the argument is
-; -- VM code - must be an accessed disk mode [mode]
-; not (mode := validateOutputDirectory arg) =>
-; sayBrightly ['" Sorry, but your argument(s)",:bright arg,
-; '"is(are) not valid.",'%l]
-; describeSetFortDir()
-; $fortranDirectory := mode
-
-(DEFUN |setFortDir| (|arg|) (PROG (|mode|) (RETURN (COND ((BOOT-EQUAL |arg|
(QUOTE |%initialize%|)) (SPADLET |$fortranDirectory| (MAKESTRING "./")))
((BOOT-EQUAL |arg| (QUOTE |%display%|)) (COND ((STRINGP |$fortranDirectory|)
|$fortranDirectory|) ((QUOTE T) (PNAME |$fortranDirectory|)))) ((OR (NULL
|arg|) (BOOT-EQUAL |arg| (QUOTE |%describe%|)) (BOOT-EQUAL (CAR |arg|) (QUOTE
?))) (|describeSetFortDir|)) ((NULL (SPADLET |mode| (|validateOutputDirectory|
|arg|))) (|sayBrightly| (CONS (MAKESTRING " Sorry, but your argument(s)")
(APPEND (|bright| |arg|) (CONS (MAKESTRING "is(are) not valid.") (CONS (QUOTE
|%l|) NIL))))) (|describeSetFortDir|)) ((QUOTE T) (SPADLET |$fortranDirectory|
|mode|))))))
-;describeSetFortDir() ==
-; sayBrightly LIST (
-; '%b,'")set fortran calling directory",'%d,_
-; '" is used to tell AXIOM where",'%l,_
-; '" to place generated FORTRAN files. This must be the name ",'%l,_
-; '" of a valid existing directory to which you have permission ",'%l,_
-; '" to write (including the final slash).",'%l,'%l,_
-; '" Syntax:",'%l,_
-; '" )set fortran calling directory DIRECTORYNAME",'%l,'%l,_
-; '" The current setting is",'%b,$fortranDirectory,'%d)
-
-(DEFUN |describeSetFortDir| NIL (|sayBrightly| (LIST (QUOTE |%b|) (MAKESTRING
")set fortran calling directory") (QUOTE |%d|) (MAKESTRING " is used to tell
AXIOM where") (QUOTE |%l|) (MAKESTRING " to place generated FORTRAN files. This
must be the name ") (QUOTE |%l|) (MAKESTRING " of a valid existing directory to
which you have permission ") (QUOTE |%l|) (MAKESTRING " to write (including the
final slash).") (QUOTE |%l|) (QUOTE |%l|) (MAKESTRING " Syntax:") (QUOTE |%l|)
(MAKESTRING " )set fortran calling directory DIRECTORYNAME") (QUOTE |%l|)
(QUOTE |%l|) (MAKESTRING " The current setting is") (QUOTE |%b|)
|$fortranDirectory| (QUOTE |%d|))))
-;setLinkerArgs arg ==
-; arg = "%initialize%" =>
-; $fortranLibraries := '"-lxlf"
-; arg = "%display%" => object2String $fortranLibraries
-; (null arg) or (arg = "%describe%") or (first arg = '_?) =>
-; describeSetLinkerArgs()
-; LISTP(arg) and STRINGP(first arg) =>
-; $fortranLibraries := first(arg)
-; describeSetLinkerArgs()
-
-(DEFUN |setLinkerArgs| (|arg|) (COND ((BOOT-EQUAL |arg| (QUOTE
|%initialize%|)) (SPADLET |$fortranLibraries| (MAKESTRING "-lxlf")))
((BOOT-EQUAL |arg| (QUOTE |%display%|)) (|object2String| |$fortranLibraries|))
((OR (NULL |arg|) (BOOT-EQUAL |arg| (QUOTE |%describe%|)) (BOOT-EQUAL (CAR
|arg|) (QUOTE ?))) (|describeSetLinkerArgs|)) ((AND (LISTP |arg|) (STRINGP (CAR
|arg|))) (SPADLET |$fortranLibraries| (CAR |arg|))) ((QUOTE T)
(|describeSetLinkerArgs|))))
-;describeSetLinkerArgs() ==
-; sayBrightly LIST (
-; '%b,'")set fortran calling linkerargs",'%d,_
-; '" is used to pass arguments to the linker",'%l,_
-; '" when using ",'%b,'"mkFort",'%d,_
-; '" to create functions which call Fortran code.",'%l,_
-; '" For example, it might give a list of libraries to be searched,",'%l,_
-; '" and their locations.",'%l,_
-; '" The string is passed verbatim, so must be the correct syntax for",'%l,_
-; '" the particular linker being used.",'%l,'%l,_
-; '" Example: )set fortran calling linker _"-lxlf_"",'%l,'%l,_
-; '" The current setting is",'%b,$fortranLibraries,'%d)
-
-(DEFUN |describeSetLinkerArgs| NIL (|sayBrightly| (LIST (QUOTE |%b|)
(MAKESTRING ")set fortran calling linkerargs") (QUOTE |%d|) (MAKESTRING " is
used to pass arguments to the linker") (QUOTE |%l|) (MAKESTRING " when using ")
(QUOTE |%b|) (MAKESTRING "mkFort") (QUOTE |%d|) (MAKESTRING " to create
functions which call Fortran code.") (QUOTE |%l|) (MAKESTRING " For example, it
might give a list of libraries to be searched,") (QUOTE |%l|) (MAKESTRING " and
their locations.") (QUOTE |%l|) (MAKESTRING " The string is passed verbatim, so
must be the correct syntax for") (QUOTE |%l|) (MAKESTRING " the particular
linker being used.") (QUOTE |%l|) (QUOTE |%l|) (MAKESTRING " Example: )set
fortran calling linker \"-lxlf\"") (QUOTE |%l|) (QUOTE |%l|) (MAKESTRING " The
current setting is") (QUOTE |%b|) |$fortranLibraries| (QUOTE |%d|))))
;setFunctionsCache arg ==
; $options : local := NIL
; arg = "%initialize%" =>
diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet
index 2478e04..9ee26d5 100644
--- a/src/interp/vmlisp.lisp.pamphlet
+++ b/src/interp/vmlisp.lisp.pamphlet
@@ -343,13 +343,6 @@ the calculation by repeated divisions using the radix
itself.
(defmacro |idChar?| (x)
`(or (alphanumericp ,x) (member ,x '(#\? #\% #\' #\!) :test #'char=)))
-(defmacro identp (x)
- (if (atom x)
- `(and ,x (symbolp ,x))
- (let ((xx (gensym)))
- `(let ((,xx ,x))
- (and ,xx (symbolp ,xx))))))
-
(defmacro ifcar (x)
(if (atom x)
`(and (consp ,x) (qcar ,x))
@@ -1055,11 +1048,6 @@ the calculation by repeated divisions using the radix
itself.
(defun QSREMAINDER (a b) (the fixnum (rem (the fixnum a) (the fixnum b))))
-
-;(defun IFCAR (x) (if (consp x) (car (the cons x))))
-
-;(defun IFCDR (x) (if (consp x) (cdr (the cons x))))
-
; 13.3 Updating
@@ -1077,20 +1065,6 @@ the calculation by repeated divisions using the radix
itself.
(defun VEC2LIST (vec) (coerce vec 'list))
-; note default test for union, intersection and set-difference is eql
-;; following are defined so as to preserve ordering in union.lisp
-;;(defun SETDIFFERENCE (l1 l2) (set-difference l1 l2 :test #'equalp))
-;;(defun SETDIFFERENCEQ (l1 l2) (set-difference l1 l2 :test #'eq))
-;;(defun |union| (l1 l2) (union l1 l2 :test #'equalp))
-;;(defun UNIONQ (l1 l2) (union l1 l2 :test #'eq))
-;;(defun |intersection| (l1 l2) (intersection l1 l2 :test #'equalp))
-;;(defun INTERSECTIONQ (l1 l2) (intersection l1 l2 :test #'eq))
-(defun |member| (item sequence)
- (cond ((symbolp item) (member item sequence :test #'eq))
- ((stringp item) (member item sequence :test #'equal))
- ((and (atom item) (not (arrayp item))) (member item sequence))
- (T (member item sequence :test #'equalp))))
-
(defun |remove| (list item &optional (count 1))
(if (integerp count)
(remove item list :count count :test #'equalp)
@@ -1103,14 +1077,10 @@ the calculation by repeated divisions using the radix
itself.
; 14.2 Accessing
-;(define-function 'lastnode #'last)
-;(define-function 'lastpair #'last)
(defun |last| (x) (car (lastpair x)))
; 14.3 Searching
-#+:CCL (DEFMACRO |assoc| (X Y) `(ASSOC** ,X ,Y))
-#-:CCL
(DEFUN |assoc| (X Y)
"Return the pair associated with key X in association list Y."
; ignores non-nil list terminators
@@ -1226,29 +1196,10 @@ can be restored.
; 17.1 Creation
-
-#-AKCL
-(defun concat (a b &rest l)
- (let ((type (cond ((bit-vector-p a) 'bit-vector) (t 'string))))
- (cond ((eq type 'string)
- (setq a (string a) b (string b))
- (if l (setq l (mapcar #'string l)))))
- (if l (apply #'concatenate type a b l)
- (concatenate type a b))) )
-#+AKCL
-(defun concat (a b &rest l)
- (if (bit-vector-p a)
- (if l (apply #'concatenate 'bit-vector a b l)
- (concatenate 'bit-vector a b))
- (if l (apply #'system:string-concatenate a b l)
- (system:string-concatenate a b))))
-
(define-function 'strconc #'concat)
(defun make-cvec (sint) (make-array sint :fill-pointer 0 :element-type
'string-char))
-;(define-function 'CVECP #'stringp)
-
(define-function 'getstr #'make-cvec)
(defun make-full-cvec (sint &optional (char #\space))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Axiom-developer] 20090319.01.tpd.patch (bookvol5 move top level command handling),
daly <=
- Prev by Date:
[Axiom-developer] 20090317.01.tpd.patch (bookvol5 rewrite generated lisp)
- Next by Date:
[Axiom-developer] 1st CFP - SYNASC 2009 - 11th International Symposium on Symbolic and Numeric Algorithms for Scientific Computing, Timisoara, Romania, 26-29, Sep, 2009
- Previous by thread:
[Axiom-developer] 20090317.01.tpd.patch (bookvol5 rewrite generated lisp)
- Next by thread:
[Axiom-developer] 1st CFP - SYNASC 2009 - 11th International Symposium on Symbolic and Numeric Algorithms for Scientific Computing, Timisoara, Romania, 26-29, Sep, 2009
- Index(es):