[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Axiom-developer] 20090308.03.tpd.patch (bookvol5 move summary, copyrigh
|
From: |
daly |
|
Subject: |
[Axiom-developer] 20090308.03.tpd.patch (bookvol5 move summary, copyright, help roots) |
|
Date: |
Sun, 8 Mar 2009 21:24:19 -0600 |
Move more roots into book volume 5 with rewrites from boot to lisp.
=======================================================================
diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet
index 8f4470a..f1a64a2 100644
--- a/books/bookvol5.pamphlet
+++ b/books/bookvol5.pamphlet
@@ -1990,9 +1990,9 @@ system function and constructor caches.
\end{list}
\par\noindent{\bf Command Description:}
-This command is used to close down interpreter client processes.
-Such processes are started by HyperDoc to run Axiom examples
-when you click on their text. When you have finished examining or modifying the
+This command is used to close down interpreter client processes. Such
+processes are started by HyperDoc to run Axiom examples when you click
+on their text. When you have finished examining or modifying the
example and you do not want the extra window around anymore, issue
\begin{verbatim}
)close
@@ -2000,9 +2000,8 @@ example and you do not want the extra window around
anymore, issue
to the Axiom prompt in the window.
If you try to close down the last remaining interpreter client
-process, Axiom will offer to close down the entire Axiom
-session and return you to the operating system by displaying something
-like
+process, Axiom will offer to close down the entire Axiom session and
+return you to the operating system by displaying something like
\begin{verbatim}
This is the last AXIOM session. Do you want to kill AXIOM?
\end{verbatim}
@@ -2017,6 +2016,92 @@ the entire Axiom session.
\fnref{quit} and
\fnref{pquit}
+\subsection{defun queryClients}
+Returns the number of active scratchpad clients
+<<defun queryClients>>=
+(defun |queryClients| ()
+ (progn
+ (|sockSendInt| |$SessionManager| |$QueryClients|)
+ (|sockGetInt| |$SessionManager|)))
+
+@
+
+\section{defun close}
+\begin{verbatim}
+;close args ==
+; $saturn =>
+; sayErrorly('"Obsolete system command", _
+; ['" The )close system command is obsolete in this version of AXIOM.",
+; '" Please use Close from the File menu instead."])
+; quiet:local:= false
+; null $SpadServer =>
+; throwKeyedMsg('"S2IZ0071", [])
+; numClients := queryClients()
+; numClients > 1 =>
+; sockSendInt($SessionManager, $CloseClient)
+; sockSendInt($SessionManager, $currentFrameNum)
+; closeInterpreterFrame(NIL)
+; for [opt,:.] in $options repeat
+; fullopt := selectOptionLC(opt, '(quiet), 'optionError)
+; fullopt = 'quiet =>
+; quiet:=true
+; quiet =>
+; sockSendInt($SessionManager, $CloseClient)
+; sockSendInt($SessionManager, $currentFrameNum)
+; closeInterpreterFrame(NIL)
+; x := UPCASE queryUserKeyedMsg('"S2IZ0072", nil)
+; MEMQ(STRING2ID_-N(x,1), '(YES Y)) =>
+; BYE()
+; nil
+\end{verbatim}
+
+<<defun close>>=
+(defun |close| (args)
+ (prog (numClients opt fullopt quiet x)
+ (return
+ (seq
+ (cond
+ (|$saturn|
+ (|sayErrorly| "Obsolete system command" (cons
+ " The )close system command is obsolete in this version of AXIOM."
+ (cons " Please use Close from the File menu instead." nil))))
+ (t
+ (spadlet quiet nil)
+ (cond
+ ((null |$SpadServer|) (|throwKeyedMsg| 's2iz0071 nil))
+ (t
+ (spadlet numClients (|queryClients|))
+ (cond
+ ((> numClients 1)
+ (|sockSendInt| |$SessionManager| |$CloseClient|)
+ (|sockSendInt| |$SessionManager| |$currentFrameNum|)
+ (|closeInterpreterFrame| NIL))
+ (t
+ (do ((t0 |$options| (cdr t0)) (t1 nil))
+ ((or (atom t0)
+ (progn (setq t1 (car t0)) nil)
+ (progn (progn (spadlet opt (car t1)) t1) nil))
+ nil)
+ (seq
+ (exit
+ (progn
+ (spadlet fullopt
+ (|selectOptionLC| opt '(|quiet|) '|optionError|))
+ (cond ((boot-equal fullopt '|quiet|)
+ (spadlet quiet t)))))))
+ (cond
+ (quiet
+ (|sockSendInt| |$SessionManager| |$CloseClient|)
+ (|sockSendInt| |$SessionManager| |$currentFrameNum|)
+ (|closeInterpreterFrame| NIL))
+ (t
+ (spadlet x (upcase (|queryUserKeyedMsg| 's2iz0072 nil)))
+ (cond
+ ((memq (string2id-n x 1) '(yes y)) (bye))
+ (t nil))))))))))))))
+
+@
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\cmdhead{compiler}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -2331,14 +2416,722 @@ The value of the {\tt )set break} variable then
controls what happens.
{\tt )edit}, and
{\tt )library}
+\subsection{defun compiler}
+\begin{verbatim}
+;compiler args ==
+; $newConlist: local := nil --reset by compDefineLisplib and astran
+; null args and null $options and null _/EDITFILE => helpSpad2Cmd
'(compiler)
+; if null args then args := [_/EDITFILE]
+; -- first see if the user has explicitly specified the compiler
+; -- to use.
+; optlist := '(new old translate constructor)
+; haveNew := nil
+; haveOld := nil
+; for opt in $options while ^(haveNew and haveOld) repeat
+; [optname,:optargs] := opt
+; fullopt := selectOptionLC(optname,optlist,nil)
+; fullopt = 'new => haveNew := true
+; fullopt = 'translate => haveOld := true
+; fullopt = 'constructor => haveOld := true
+; fullopt = 'old => haveOld := true
+; haveNew and haveOld => throwKeyedMsg("S2IZ0081", nil)
+; af := pathname args
+; aft := pathnameType af
+;-- Whats this for? MCD/PAB 21-9-95
+;-- if haveNew and (null(aft) or (aft = '"")) then
+;-- af := pathname [af, '"as"]
+;-- aft = '"as"
+;-- if haveOld and (null(aft) or (aft = '"")) then
+;-- af := pathname [af, '"spad"]
+;-- aft = '"spad"
+; haveNew or (aft = '"as") =>
+; not (af1 := $FINDFILE (af, '(as))) =>
+; throwKeyedMsg("S2IL0003",[NAMESTRING af])
+; compileAsharpCmd [af1]
+; haveOld or (aft = '"spad") =>
+; not (af1 := $FINDFILE (af, '(spad))) =>
+; throwKeyedMsg("S2IL0003",[NAMESTRING af])
+; compileSpad2Cmd [af1]
+; aft = '"lsp" =>
+; not (af1 := $FINDFILE (af, '(lsp))) =>
+; throwKeyedMsg("S2IL0003",[NAMESTRING af])
+; compileAsharpLispCmd [af1]
+; aft = '"nrlib" =>
+; not (af1 := $FINDFILE (af, '(nrlib))) =>
+; throwKeyedMsg("S2IL0003",[NAMESTRING af])
+; compileSpadLispCmd [af1]
+; aft = '"ao" =>
+; not (af1 := $FINDFILE (af, '(ao))) =>
+; throwKeyedMsg("S2IL0003",[NAMESTRING af])
+; compileAsharpCmd [af1]
+; aft = '"al" => -- archive library of .ao files
+; not (af1 := $FINDFILE (af, '(al))) =>
+; throwKeyedMsg("S2IL0003",[NAMESTRING af])
+; compileAsharpArchiveCmd [af1]
+; -- see if we something with the appropriate file extension
+; -- lying around
+; af1 := $FINDFILE (af, '(as spad ao asy))
+; af1 and pathnameType(af1) = '"as" => compileAsharpCmd [af1]
+; af1 and pathnameType(af1) = '"ao" => compileAsharpCmd [af1]
+; af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd [af1]
+; af1 and pathnameType(af1) = '"asy" => compileAsharpArchiveCmd [af1]
+; -- maybe /EDITFILE has some stuff that can help us
+; ef := pathname _/EDITFILE
+; ef := mergePathnames(af,ef)
+; ef = af => throwKeyedMsg("S2IZ0039", nil)
+; af := ef
+; pathnameType(af) = '"as" => compileAsharpCmd args
+; pathnameType(af) = '"ao" => compileAsharpCmd args
+; pathnameType(af) = '"spad" => compileSpad2Cmd args
+; -- see if we something with the appropriate file extension
+; -- lying around
+; af1 := $FINDFILE (af, '(as spad ao asy))
+; af1 and pathnameType(af1) = '"as" => compileAsharpCmd [af1]
+; af1 and pathnameType(af1) = '"ao" => compileAsharpCmd [af1]
+; af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd [af1]
+; af1 and pathnameType(af1) = '"asy" => compileAsharpArchiveCmd [af1]
+; throwKeyedMsg("S2IZ0039", nil)
+\end{verbatim}
+
+<<defun compiler>>=
+(defun |compiler| (args)
+ (prog (|$newConlist| optlist optname optargs fullopt havenew haveold
+ aft ef af af1)
+ (declare (special |$newConlist|))
+ (return
+ (seq
+ (progn
+ (spadlet |$newConlist| nil)
+ (cond
+ ((and (null args) (null |$options|) (null /editfile))
+ (|helpSpad2Cmd| '(|compiler|)))
+ (t
+ (cond ((null args) (spadlet args (cons /editfile nil))))
+ (spadlet optlist '(|new| |old| |translate| |constructor|))
+ (spadlet havenew nil)
+ (spadlet haveold nil)
+ (do ((t0 |$options| (CDR t0)) (|opt| NIL))
+ ((or (atom t0)
+ (progn (setq |opt| (car t0)) nil)
+ (null (null (and havenew haveold))))
+ nil)
+ (seq
+ (exit
+ (progn
+ (spadlet optname (car |opt|))
+ (spadlet optargs (cdr |opt|))
+ (spadlet fullopt (|selectOptionLC| optname optlist nil))
+ (cond
+ ((boot-equal fullopt '|new|) (spadlet havenew t))
+ ((boot-equal fullopt '|translate|) (spadlet haveold t))
+ ((boot-equal fullopt '|constructor|) (spadlet haveold t))
+ ((boot-equal fullopt '|old|) (spadlet haveold t)))))))
+ (cond
+ ((and havenew haveold) (|throwKeyedMsg| 's2iz0081 nil))
+ (t
+ (spadlet af (|pathname| args))
+ (spadlet aft (|pathnameType| af))
+ (cond
+ ((or havenew (boot-equal aft "as"))
+ (cond
+ ((null (spadlet af1 ($findfile af '(|as|))))
+ (|throwKeyedMsg| 's2il0003 (cons (namestring af) nil)))
+ (t
+ (|compileAsharpCmd| (cons af1 nil)))))
+ ((or haveold (boot-equal aft "spad"))
+ (cond
+ ((null (spadlet af1 ($findfile af '(|spad|))))
+ (|throwKeyedMsg| 's2il0003 (cons (namestring af) nil)))
+ (t
+ (|compileSpad2Cmd| (cons af1 nil)))))
+ ((boot-equal aft "lsp")
+ (cond
+ ((null (spadlet af1 ($findfile af '(|lsp|))))
+ (|throwKeyedMsg| 's2il0003 (cons (namestring af) nil)))
+ (t
+ (|compileAsharpLispCmd| (CONS af1 NIL)))))
+ ((boot-equal aft "nrlib")
+ (cond
+ ((null (spadlet af1 ($findfile af '(|nrlib|))))
+ (|throwKeyedMsg| 'S2IL0003 (cons (namestring af) nil)))
+ (t
+ (|compileSpadLispCmd| (cons af1 nil)))))
+ ((boot-equal aft "ao")
+ (cond
+ ((null (spadlet af1 ($findfile af '(|ao|))))
+ (|throwKeyedMsg| 's2il0003 (cons (namestring af) nil)))
+ (t (|compileAsharpCmd| (cons af1 nil)))))
+ ((boot-equal aft "al")
+ (cond
+ ((null (spadlet af1 ($findfile af '(|al|))))
+ (|throwKeyedMsg| 's2il0003 (cons (namestring af) nil)))
+ (t (|compileAsharpArchiveCmd| (cons af1 nil)))))
+ (t
+ (spadlet af1 ($findfile af '(|as| |spad| |ao| |asy|)))
+ (cond
+ ((and af1 (boot-equal (|pathnameType| af1) "as"))
+ (|compileAsharpCmd| (CONS af1 NIL)))
+ ((and af1 (boot-equal (|pathnameType| af1) "ao"))
+ (|compileAsharpCmd| (CONS af1 NIL)))
+ ((and af1 (boot-equal (|pathnameType| af1) "spad"))
+ (|compileSpad2Cmd| (CONS af1 NIL)))
+ ((and af1 (boot-equal (|pathnameType| af1) "asy"))
+ (|compileAsharpArchiveCmd| (CONS af1 NIL)))
+ (t
+ (spadlet ef (|pathname| /editfile))
+ (spadlet ef (|mergePathnames| af ef))
+ (cond
+ ((boot-equal ef af) (|throwKeyedMsg| 's2iz0039 nil))
+ (t
+ (spadlet af ef)
+ (cond
+ ((boot-equal (|pathnameType| af) "as")
+ (|compileAsharpCmd| args))
+ ((boot-equal (|pathnameType| af) "ao")
+ (|compileAsharpCmd| args))
+ ((boot-equal (|pathnameType| af) "spad")
+ (|compileSpad2Cmd| args))
+ (t
+ (spadlet af1 ($findfile af '(|as| |spad| |ao| |asy|)))
+ (cond
+ ((and af1 (boot-equal (|pathnameType| af1) "as"))
+ (|compileAsharpCmd| (CONS af1 NIL)))
+ ((and af1 (boot-equal (|pathnameType| af1) "ao"))
+ (|compileAsharpCmd| (CONS af1 NIL)))
+ ((and af1 (boot-equal (|pathnameType| af1) "spad"))
+ (|compileSpad2Cmd| (CONS af1 NIL)))
+ ((and af1 (boot-equal (|pathnameType| af1) "asy"))
+ (|compileAsharpArchiveCmd| (CONS af1 NIL)))
+ (t (|throwKeyedMsg| 's2iz0039 nil))))))))))))))))))))
+
+@
+
+\subsection{defun compileAsharpCmd}
+<<defun compileAsharpCmd>>=
+(defun |compileAsharpCmd| (args)
+ (|compileAsharpCmd1| args)
+ (|terminateSystemCommand|)
+ (|spadPrompt|))
+
+@
+
+\subsection{defun compileAsharpCmd1}
+\begin{verbatim}
+;compileAsharpCmd1 args ==
+; -- Assume we entered from the "compiler" function, so args ^= nil
+; -- and is a file with file extension .as or .ao
+; path := pathname args
+; pathType := pathnameType path
+; (pathType ^= '"as") and (pathType ^= '"ao") => throwKeyedMsg("S2IZ0083",
nil)
+; ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
+; SETQ(_/EDITFILE, path)
+; updateSourceFiles path
+; optList := '( _
+; new _
+; old _
+; translate _
+; onlyargs _
+; moreargs _
+; quiet _
+; nolispcompile _
+; noquiet _
+; library _
+; nolibrary _
+; )
+; beQuiet := false -- be verbose here
+; doLibrary := true -- so a )library after compilation
+; doCompileLisp := true -- do compile generated lisp code
+; moreArgs := NIL
+; onlyArgs := NIL
+; for opt in $options repeat
+; [optname,:optargs] := opt
+; fullopt := selectOptionLC(optname,optList,nil)
+; fullopt = 'new => nil
+; fullopt = 'old => error "Internal error: compileAsharpCmd got
)old"
+; fullopt = 'translate => error "Internal error: compileAsharpCmd got
)translate"
+; fullopt = 'quiet => beQuiet := true
+; fullopt = 'noquiet => beQuiet := false
+; fullopt = 'nolispcompile => doCompileLisp := false
+; fullopt = 'moreargs => moreArgs := optargs
+; fullopt = 'onlyargs => onlyArgs := optargs
+; fullopt = 'library => doLibrary := true
+; fullopt = 'nolibrary => doLibrary := false
+; throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
+; tempArgs :=
+; pathType = '"ao" =>
+; -- want to strip out -Fao
+; (p := STRPOS('"-Fao", $asharpCmdlineFlags, 0, NIL)) =>
+; p = 0 => SUBSTRING($asharpCmdlineFlags, 5, NIL)
+; STRCONC(SUBSTRING($asharpCmdlineFlags, 0, p), '" ",
+; SUBSTRING($asharpCmdlineFlags, p+5, NIL))
+; $asharpCmdlineFlags
+; $asharpCmdlineFlags
+; asharpArgs :=
+; onlyArgs =>
+; s := ""
+; for a in onlyArgs repeat
+; s := STRCONC(s, '" ", object2String a)
+; s
+; moreArgs =>
+; s := tempArgs
+; for a in moreArgs repeat
+; s := STRCONC(s, '" ", object2String a)
+; s
+; tempArgs
+; if ^beQuiet then sayKeyedMsg("S2IZ0038A",[namestring args, asharpArgs])
+; command :=
+; STRCONC(STRCONC(GETENV('"ALDORROOT"),'"/bin/"),_
+; "aldor ", asharpArgs, '" ", namestring args)
+; rc := OBEY command
+; if (rc = 0) and doCompileLisp then
+; lsp := fnameMake('".", pathnameName args, '"lsp")
+; if fnameReadable?(lsp) then
+; if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
+; compileFileQuietly(lsp)
+; else
+; sayKeyedMsg("S2IL0003", [namestring lsp])
+; if rc = 0 and doLibrary then
+; -- do we need to worry about where the compilation output went?
+; if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
+; withAsharpCmd [ pathnameName path ]
+; else if ^beQuiet then
+; sayKeyedMsg("S2IZ0084", nil)
+; extendLocalLibdb $newConlist
+\end{verbatim}
+
+<<defun compileAsharpCmd1>>=
+(defun |compileAsharpCmd1| (args)
+ (prog (path pathtype optlist optname optargs fullopt bequiet docompilelisp
+ moreargs onlyargs dolibrary p tempargs s asharpargs command rc lsp)
+ (return
+ (seq
+ (progn
+ (spadlet path (|pathname| args))
+ (spadlet pathtype (|pathnameType| path))
+ (cond
+ ((and (nequal pathtype "as") (nequal pathtype "ao"))
+ (|throwKeyedMsg| 's2iz0083 nil))
+ ((null (probe-file path))
+ (|throwKeyedMsg| 's2il0003 (cons (|namestring| args) nil)))
+ (t
+ (setq /editfile path)
+ (|updateSourceFiles| path)
+ (spadlet optlist
+ '(|new| |old| |translate| |onlyargs| |moreargs| |quiet|
+ |nolispcompile| |noquiet| |library| |nolibrary|))
+ (spadlet bequiet nil)
+ (spadlet dolibrary t)
+ (spadlet docompilelisp t)
+ (spadlet moreargs nil)
+ (spadlet onlyargs nil)
+ (do ((t0 |$options| (cdr t0)) (|opt| nil))
+ ((or (atom t0) (progn (setq |opt| (car t0)) nil)) nil)
+ (seq
+ (exit
+ (progn
+ (spadlet optname (car |opt|))
+ (spadlet optargs (cdr |opt|))
+ (spadlet fullopt (|selectOptionLC| optname optlist nil))
+ (cond
+ ((boot-equal fullopt '|new|) nil)
+ ((boot-equal fullopt '|old|)
+ (|error| '|Internal error: compileAsharpCmd got )old|))
+ ((boot-equal fullopt '|translate|)
+ (|error| '|Internal error: compileAsharpCmd got )translate|))
+ ((boot-equal fullopt '|quiet|) (spadlet bequiet t))
+ ((boot-equal fullopt '|noquiet|) (spadlet bequiet nil))
+ ((boot-equal fullopt '|nolispcompile|)
+ (spadlet docompilelisp nil))
+ ((boot-equal fullopt '|moreargs|) (spadlet moreargs optargs))
+ ((boot-equal fullopt '|onlyargs|) (spadlet onlyargs optargs))
+ ((boot-equal fullopt '|library|) (spadlet dolibrary t))
+ ((boot-equal fullopt '|nolibrary|) (spadlet dolibrary nil))
+ (t
+ (|throwKeyedMsg| 's2iz0036
+ (cons (strconc ")" (|object2String| optname)) nil))))))))
+ (spadlet tempargs
+ (cond
+ ((boot-equal pathtype "ao")
+ (cond
+ ((spadlet p (strpos "-Fao" |$asharpCmdlineFlags| 0 nil))
+ (cond
+ ((eql p 0) (substring |$asharpCmdlineFlags| 5 nil))
+ (t
+ (strconc (substring |$asharpCmdlineFlags| 0 p)
+ " " (substring |$asharpCmdlineFlags| (plus p 5) nil)))))
+ (t |$asharpCmdlineFlags|)))
+ (t |$asharpCmdlineFlags|)))
+ (spadlet asharpargs
+ (cond
+ (onlyargs
+ (spadlet s '||)
+ (do ((t1 onlyargs (cdr t1)) (|a| nil))
+ ((or (atom t1) (progn (setq |a| (car t1)) nil)) nil)
+ (seq
+ (exit
+ (spadlet s (strconc s " " (|object2String| |a|))))))
+ s)
+ (moreargs
+ (spadlet s tempargs)
+ (do ((t2 moreargs (cdr t2)) (|a| nil))
+ ((or (atom t2) (progn (setq |a| (car t2)) nil)) nil)
+ (seq
+ (exit
+ (spadlet s (strconc s " " (|object2String| |a|))))))
+ s)
+ (t tempargs)))
+ (cond ((null bequiet)
+ (|sayKeyedMsg| 's2iz0038a
+ (cons (|namestring| args) (cons asharpargs nil)))))
+ (spadlet command
+ (strconc
+ (strconc (getenv "ALDORROOT") "/bin/")
+ '|aldor | asharpargs " " (|namestring| args)))
+ (spadlet rc (obey command))
+ (cond
+ ((and (eql rc 0) docompilelisp)
+ (spadlet lsp (|fnameMake| "." (|pathnameName| args) "lsp"))
+ (cond
+ ((|fnameReadable?| lsp)
+ (cond
+ ((null bequiet)
+ (|sayKeyedMsg| 's2iz0089 (cons (|namestring| lsp) nil))))
+ (|compileFileQuietly| lsp))
+ (t (|sayKeyedMsg| 's2il0003 (cons (|namestring| lsp) nil))))))
+ (cond
+ ((and (eql rc 0) dolibrary)
+ (cond
+ ((null bequiet)
+ (|sayKeyedMsg| 's2iz0090 (cons (|pathnameName| path) nil))))
+ (|withAsharpCmd| (cons (|pathnameName| path) nil)))
+ ((null bequiet) (|sayKeyedMsg| 's2iz0084 nil))
+ (t nil))
+ (|extendLocalLibdb| |$newConlist|))))))))
+
+@
+
+\subsection{defun compileAsharpArchiveCmd}
+\begin{verbatim}
+;compileAsharpArchiveCmd args ==
+; -- Assume we entered from the "compiler" function, so args ^= nil
+; -- and is a file with file extension .al. We also assume that
+; -- the name is fully qualified.
+; path := pathname args
+; ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
+; -- here is the plan:
+; -- 1. extract the file name and try to make a directory based
+; -- on that name.
+; -- 2. cd to that directory and ar x the .al file
+; -- 3. for each .ao file that shows up, compile it
+; -- 4. delete the generated .ao files
+; -- First try to make the directory in the current directory
+; dir := fnameMake('".", pathnameName path, '"axldir")
+; exists := PROBE_-FILE dir
+; isDir := directoryp namestring dir
+; exists and isDir ^= 1=>
+; throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
+; if isDir ^= 1 then
+; cmd := STRCONC('"mkdir ", namestring dir)
+; rc := OBEY cmd
+; rc ^= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
+; curDir := $CURRENT_-DIRECTORY
+; -- cd to that directory and try to unarchive the .al file
+; cd [ object2Identifier namestring dir ]
+; cmd := STRCONC( '"ar x ", namestring path )
+; rc := OBEY cmd
+; rc ^= 0 =>
+; cd [ object2Identifier namestring curDir ]
+; throwKeyedMsg("S2IL0028",[namestring dir, namestring args])
+; -- Look for .ao files
+; asos := DIRECTORY '"*.ao"
+; null asos =>
+; cd [ object2Identifier namestring curDir ]
+; throwKeyedMsg("S2IL0029",[namestring dir, namestring args])
+; -- Compile the .ao files
+; for aso in asos repeat
+; compileAsharpCmd1 [ namestring aso ]
+; -- Reset the current directory
+; cd [ object2Identifier namestring curDir ]
+; terminateSystemCommand()
+; spadPrompt()
+\end{verbatim}
+
+<<defun compileAsharpArchiveCmd>>=
+(defun |compileAsharpArchiveCmd| (args)
+ (prog (path dir exists isdir curdir cmd rc asos)
+ (return
+ (seq
+ (progn
+ (spadlet path (|pathname| args))
+ (cond
+ ((null (probe-file path))
+ (|throwKeyedMsg| 's2il0003 (cons (|namestring| args) nil)))
+ (t
+ (spadlet dir (|fnameMake| "." (|pathnameName| path) "axldir"))
+ (spadlet exists (probe-file dir))
+ (spadlet isdir (|directoryp| (|namestring| dir)))
+ (cond
+ ((and exists (nequal isdir 1))
+ (|throwKeyedMsg| 's2il0027
+ (cons (|namestring| dir) (cons (|namestring| args) nil))))
+ (t
+ (cond
+ ((nequal isdir 1)
+ (spadlet cmd (strconc "mkdir " (|namestring| dir)))
+ (spadlet rc (obey cmd))
+ (cond
+ ((nequal rc 0)
+ (|throwKeyedMsg| 's2il0027
+ (cons (|namestring| dir) (cons (|namestring| args) nil)))))))
+ (spadlet curdir $current-directory)
+ (|cd| (cons (|object2Identifier| (|namestring| dir)) nil))
+ (spadlet cmd (strconc "ar x " (|namestring| path)))
+ (spadlet rc (obey cmd))
+ (cond
+ ((nequal rc 0)
+ (|cd| (cons (|object2Identifier| (|namestring| curdir)) nil))
+ (|throwKeyedMsg| 's2il0028
+ (cons (|namestring| dir) (cons (|namestring| args) nil))))
+ (t
+ (spadlet asos (directory (makestring "*.ao")))
+ (cond
+ ((null asos)
+ (|cd| (cons (|object2Identifier| (|namestring| curdir)) nil))
+ (|throwKeyedMsg| 's2il0029
+ (cons (|namestring| dir) (cons (|namestring| args) nil))))
+ (t
+ (do ((t0 asos (cdr t0)) (|aso| nil))
+ ((or (atom t0) (progn (setq |aso| (car t0)) nil)) nil)
+ (seq
+ (exit
+ (|compileAsharpCmd1| (cons (|namestring| |aso|) nil)))))
+ (|cd| (CONS (|object2Identifier| (|namestring| curdir)) NIL))
+ (|terminateSystemCommand|)
+ (|spadPrompt|))))))))))))))
+
+@
+
+\subsection{defun compileAsharpLispCmd}
+\begin{verbatim}
+;compileAsharpLispCmd args ==
+; -- Assume we entered from the "compiler" function, so args ^= nil
+; -- and is a file with file extension .lsp
+; path := pathname args
+; ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
+; optList := '( _
+; quiet _
+; noquiet _
+; library _
+; nolibrary _
+; )
+; beQuiet := false -- be verbose here
+; doLibrary := true -- so a )library after compilation
+; for opt in $options repeat
+; [optname,:optargs] := opt
+; fullopt := selectOptionLC(optname,optList,nil)
+; fullopt = 'quiet => beQuiet := true
+; fullopt = 'noquiet => beQuiet := false
+; fullopt = 'library => doLibrary := true
+; fullopt = 'nolibrary => doLibrary := false
+; throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
+; lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType
path)
+; if fnameReadable?(lsp) then
+; if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
+; compileFileQuietly(lsp)
+; else
+; sayKeyedMsg("S2IL0003", [namestring lsp])
+; if doLibrary then
+; -- do we need to worry about where the compilation output went?
+; if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
+; withAsharpCmd [ pathnameName path ]
+; else if ^beQuiet then
+; sayKeyedMsg("S2IZ0084", nil)
+; terminateSystemCommand()
+; spadPrompt()
+\end{verbatim}
+
+<<defun compileAsharpLispCmd>>=
+(defun |compileAsharpLispCmd| (args)
+ (prog (path optlist optname optargs fullopt bequiet
+ dolibrary lsp)
+ (return
+ (seq
+ (progn
+ (spadlet path (|pathname| args))
+ (cond
+ ((null (probe-file path))
+ (|throwKeyedMsg| 's2il0003 (CONS (|namestring| args) NIL)))
+ (t
+ (spadlet optlist '(|quiet| |noquiet| |library| |nolibrary|))
+ (spadlet bequiet nil)
+ (spadlet dolibrary t)
+ (do ((t0 |$options| (cdr t0)) (|opt| nil))
+ ((or (atom t0) (progn (setq |opt| (car t0)) nil)) nil)
+ (seq
+ (exit
+ (progn
+ (spadlet optname (car |opt|))
+ (spadlet optargs (cdr |opt|))
+ (spadlet fullopt (|selectOptionLC| optname optlist nil))
+ (cond
+ ((boot-equal fullopt '|quiet|) (spadlet bequiet t))
+ ((boot-equal fullopt '|noquiet|) (spadlet bequiet nil))
+ ((boot-equal fullopt '|library|) (spadlet dolibrary t))
+ ((boot-equal fullopt '|nolibrary|) (spadlet dolibrary nil))
+ (t
+ (|throwKeyedMsg| 's2iz0036
+ (cons (strconc ")" (|object2String| optname)) nil))))))))
+ (spadlet lsp
+ (|fnameMake|
+ (|pathnameDirectory| path)
+ (|pathnameName| path)
+ (|pathnameType| path)))
+ (cond
+ ((|fnameReadable?| lsp)
+ (cond
+ ((null bequiet)
+ (|sayKeyedMsg| 's2iz0089 (cons (|namestring| lsp) NIL))))
+ (|compileFileQuietly| lsp))
+ (t (|sayKeyedMsg| 's2il0003 (cons (|namestring| lsp) nil))))
+ (cond
+ (dolibrary
+ (cond
+ ((null bequiet)
+ (|sayKeyedMsg| 's2iz0090 (cons (|pathnameName| path) nil))))
+ (|withAsharpCmd| (CONS (|pathnameName| path) NIL)))
+ ((null bequiet) (|sayKeyedMsg| 's2iz0084 nil))
+ (t nil))
+ (|terminateSystemCommand|)
+ (|spadPrompt|))))))))
+
+@
+
+\subsection{defun compileSpadLispCmd}
+\begin{verbatim}
+;compileSpadLispCmd args ==
+; -- Assume we entered from the "compiler" function, so args ^= nil
+; -- and is a file with file extension .nrlib
+; path := pathname fnameMake(first args, '"code", '"lsp")
+; ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
+; optList := '( _
+; quiet _
+; noquiet _
+; library _
+; nolibrary _
+; )
+; beQuiet := false -- be verbose here
+; doLibrary := true -- so a )library after compilation
+; for opt in $options repeat
+; [optname,:optargs] := opt
+; fullopt := selectOptionLC(optname,optList,nil)
+; fullopt = 'quiet => beQuiet := true
+; fullopt = 'noquiet => beQuiet := false
+; fullopt = 'library => doLibrary := true
+; fullopt = 'nolibrary => doLibrary := false
+; throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
+; lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType
path)
+; if fnameReadable?(lsp) then
+; if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
+; --compileFileQuietly(lsp)
+; RECOMPILE_-LIB_-FILE_-IF_-NECESSARY lsp
+; else
+; sayKeyedMsg("S2IL0003", [namestring lsp])
+; if doLibrary then
+; -- do we need to worry about where the compilation output went?
+; if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
+; LOCALDATABASE([ pathnameName first args ],[])
+; else if ^beQuiet then
+; sayKeyedMsg("S2IZ0084", nil)
+; terminateSystemCommand()
+; spadPrompt()
+\end{verbatim}
+
+<<defun compileSpadLispCmd>>=
+(defun |compileSpadLispCmd| (args)
+ (prog (path optlist optname optargs fullopt beQuiet dolibrary lsp)
+ (return
+ (seq
+ (progn
+ (spadlet path (|pathname| (|fnameMake| (car args) "code" "lsp")))
+ (cond
+ ((null (probe-file path))
+ (|throwKeyedMsg| 's2il0003 (cons (|namestring| args) nil)))
+ (t
+ (spadlet optlist '(|quiet| |noquiet| |library| |nolibrary|))
+ (spadlet beQuiet nil)
+ (spadlet dolibrary t)
+ (do ((t0 |$options| (cdr t0)) (|opt| nil))
+ ((or (atom t0) (progn (setq |opt| (car t0)) nil)) nil)
+ (seq
+ (exit
+ (progn
+ (spadlet optname (car |opt|))
+ (spadlet optargs (cdr |opt|))
+ (spadlet fullopt (|selectOptionLC| optname optlist nil))
+ (cond
+ ((boot-equal fullopt '|quiet|) (spadlet beQuiet t))
+ ((boot-equal fullopt '|noquiet|) (spadlet beQuiet nil))
+ ((boot-equal fullopt '|library|) (spadlet dolibrary t))
+ ((boot-equal fullopt '|nolibrary|) (spadlet dolibrary nil))
+ (t
+ (|throwKeyedMsg| 's2iz0036
+ (cons (strconc ")" (|object2String| optname)) nil))))))))
+ (spadlet lsp
+ (|fnameMake|
+ (|pathnameDirectory| path)
+ (|pathnameName| path)
+ (|pathnameType| path)))
+ (cond
+ ((|fnameReadable?| lsp)
+ (cond
+ ((null beQuiet)
+ (|sayKeyedMsg| 's2iz0089 (cons (|namestring| lsp) nil))))
+ (recompile-lib-file-if-necessary lsp))
+ (t
+ (|sayKeyedMsg| 's2il0003 (cons (|namestring| lsp) nil))))
+ (cond
+ (dolibrary
+ (cond
+ ((null beQuiet)
+ (|sayKeyedMsg| 's2iz0090 (cons (|pathnameName| path) nil))))
+ (localdatabase (cons (|pathnameName| (car args)) nil) nil))
+ ((null beQuiet) (|sayKeyedMsg| 's2iz0084 nil))
+ (t nil))
+ (|terminateSystemCommand|)
+ (|spadPrompt|))))))))
+
+@
+
+\subsection{defun withAsharpCmd}
+<<defun withAsharpCmd>>=
+(defun |withAsharpCmd| (args)
+ (let (|$options|)
+ (declare (special |$options|))
+ (localdatabase args |$options|)))
+
+@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\cmdhead{copyright}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{defun copyright}
+<<defun copyright>>=
+(defun |copyright| ()
+ (obey (strconc "cat " (|getEnv| "AXIOM") "/lib/copyright")))
+
+@
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\cmdhead{credits}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{defun credits}
+<<defun credits>>=
+(defun |credits| ()
+ (mapcar #'(lambda (x) (princ x) (terpri)) credits))
+
+@
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\cmdhead{display}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -3718,6 +4511,94 @@ and in HyperDoc.
In HyperDoc, choose the {\bf Commands} item from the
{\bf Reference} menu.
+\subsection{defun help}
+<<defun help>>=
+(defun |help| (l)
+ (|helpSpad2Cmd| l))
+
+@
+
+\subsection{defun helpSpad2Cmd}
+<<defun helpSpad2Cmd>>=
+(defun |helpSpad2Cmd| (|args|)
+ (unless (|newHelpSpad2Cmd| |args|)
+ (|sayKeyedMsg| 's2iz0025 (cons |args| nil))))
+
+@
+
+\subsection{defun newHelpSpad2Cmd}
+\begin{verbatim}
+;newHelpSpad2Cmd args ==
+; if null args then args := ["?"]
+; # args > 1 =>
+; sayKeyedMsg("S2IZ0026",NIL)
+; true
+; sarg := PNAME first args
+; if sarg = '"?" then args := ['help]
+; else if sarg = '"%" then args := ['history]
+; else if sarg = '"%%" then args := ['history]
+; arg := selectOptionLC(first args,$SYSCOMMANDS,nil)
+; if null arg then arg := first args
+; if arg = 'compiler then arg := 'compile
+; -- see if new help file exists
+; narg := PNAME arg
+; null (helpFile := MAKE_-INPUT_-FILENAME [narg,'HELPSPAD,'_*]) => NIL
+; $useFullScreenHelp =>
+; OBEY STRCONC('"$AXIOM/lib/SPADEDIT ",namestring helpFile)
+; true
+; filestream := MAKE_-INSTREAM(helpFile)
+; repeat
+; line := read_-line(filestream,false)
+; NULL line =>
+; SHUT filestream
+; return true
+; SAY line
+; true
+\end{verbatim}
+
+<<defun newHelpSpad2Cmd>>=
+(defun |newHelpSpad2Cmd| (|args|)
+ (prog (|sarg| |arg| |narg| |helpFile| |filestream| |line|)
+ (return
+ (seq
+ (progn
+ (cond ((null |args|) (spadlet |args| (cons '? nil))))
+ (cond
+ ((> (|#| |args|) 1) (|sayKeyedMsg| 's2iz0026 nil) t)
+ (t
+ (spadlet |sarg| (pname (car |args|)))
+ (cond
+ ((boot-equal |sarg| "?") (spadlet |args| (cons '|help| nil)))
+ ((boot-equal |sarg| "%") (spadlet |args| (cons '|history| nil)))
+ ((boot-equal |sarg| "%%") (spadlet |args| (cons '|history| nil)))
+ (t nil))
+ (spadlet |arg| (|selectOptionLC| (car |args|) $syscommands nil))
+ (cond ((null |arg|) (spadlet |arg| (car |args|))))
+ (cond ((boot-equal |arg| '|compiler|) (spadlet |arg| '|compile|)))
+ (spadlet |narg| (pname |arg|))
+ (cond
+ ((null
+ (spadlet |helpFile|
+ (make-input-filename
+ (cons |narg| (cons 'helpspad (cons '* nil))))))
+ nil)
+ (|$useFullScreenHelp|
+ (obey (strconc "$AXIOM/lib/SPADEDIT " (|namestring| |helpFile|))) t)
+ (t
+ (spadlet |filestream| (make-instream |helpFile|))
+ (do ()
+ (nil nil)
+ (seq
+ (exit
+ (progn
+ (spadlet |line| (|read-line| |filestream| nil))
+ (cond
+ ((null |line|) (shut |filestream|) (return t))
+ (t (say |line|)))))))
+ t)))))))))
+
+@
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\cmdhead{history}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -6748,6 +7629,13 @@ Axiom or is the directory you specified using the
\cmdhead{summary}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{defun summary}
+<<defun summary>>=
+(defun |summary| (l)
+ (obey (strconc "cat " (|getEnv| "AXIOM") "/lib/summary")))
+
+@
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\cmdhead{synonym}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -8043,11 +8931,11 @@ This reports the traced functions
(prog (t0)
(spadlet t0 nil)
(return
- (do ((t1 arg (cdr t1)) (|x| nil))
- ((or (atom t1) (progn (setq |x| (car t1)) nil)) (nreverse0 t0))
+ (do ((t1 arg (cdr t1)) (x nil))
+ ((or (atom t1) (progn (setq x (car t1)) nil)) (nreverse0 t0))
(seq
(exit
- (setq t0 (cons (|transTraceItem| |x|) t0))))))))
+ (setq t0 (cons (|transTraceItem| x) t0))))))))
(|/UNTRACE,0|
(prog (t2)
(spadlet t2 nil)
@@ -8086,33 +8974,33 @@ This reports the traced functions
\end{verbatim}
<<defun transTraceItem>>=
-(defun |transTraceItem| (|x|)
+(defun |transTraceItem| (x)
(prog (|$doNotAddEmptyModeIfTrue| |value| |y|)
(declare (special |$doNotAddEmptyModeIfTrue|))
(return
(progn
(spadlet |$doNotAddEmptyModeIfTrue| t)
(cond
- ((atom |x|)
+ ((atom x)
(cond
- ((and (spadlet |value| (|get| |x| '|value| |$InteractiveFrame|))
+ ((and (spadlet |value| (|get| x '|value| |$InteractiveFrame|))
(|member| (|objMode| |value|)
'((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))))
- (spadlet |x| (|objVal| |value|))
+ (spadlet x (|objVal| |value|))
(cond
- ((spadlet |y| (|domainToGenvar| |x|)) |y|)
- (t |x|)))
- ((upper-case-p (elt (stringimage |x|) 0))
- (spadlet |y| (|unabbrev| |x|))
+ ((spadlet |y| (|domainToGenvar| x)) |y|)
+ (t x)))
+ ((upper-case-p (elt (stringimage x) 0))
+ (spadlet |y| (|unabbrev| x))
(cond
((|constructor?| |y|) |y|)
((and (pairp |y|) (|constructor?| (car |y|))) (car |y|))
- ((spadlet |y| (|domainToGenvar| |x|)) |y|)
- (t |x|)))
- (t |x|)))
- ((vecp (car |x|)) (|transTraceItem| (|devaluate| (car |x|))))
- ((spadlet |y| (|domainToGenvar| |x|)) |y|)
- (t (|throwKeyedMsg| 's2it0018 (cons |x| nil))))))))
+ ((spadlet |y| (|domainToGenvar| x)) |y|)
+ (t x)))
+ (t x)))
+ ((vecp (car x)) (|transTraceItem| (|devaluate| (car x))))
+ ((spadlet |y| (|domainToGenvar| x)) |y|)
+ (t (|throwKeyedMsg| 's2it0018 (cons x nil))))))))
@
@@ -8148,7 +9036,7 @@ This reports the traced functions
\end{verbatim}
<<defun coerceTraceArgs2E>>=
-(defun |coerceTraceArgs2E| (|traceName| |subName| |args|)
+(defun |coerceTraceArgs2E| (|traceName| |subName| args)
(prog (|name|)
(return
(seq
@@ -8156,7 +9044,7 @@ This reports the traced functions
((memq (spadlet |name| |subName|) |$mathTraceList|)
(cond
((spadsysnamep (pname |name|))
- (|coerceSpadArgs2E| (reverse (cdr (reverse |args|)))))
+ (|coerceSpadArgs2E| (reverse (cdr (reverse args)))))
(t
(prog (t0)
(spadlet t0 nil)
@@ -8165,7 +9053,7 @@ This reports the traced functions
|arg9| |arg10| |arg11| |arg12| |arg13| |arg14| |arg15|
|arg16| |arg17| |arg18| |arg19|) (cdr t1))
(|name| nil)
- (t2 |args| (cdr t2))
+ (t2 args (cdr t2))
(|arg| nil)
(t3 (cdr (lassoc |subName| |$tracedMapSignatures|)) (cdr t3))
(type nil))
@@ -8187,8 +9075,8 @@ This reports the traced functions
(|objNewWrap| |arg| type) |$OutputForm|))
nil)))
t0))))))))))
- ((spadsysnamep (pname |name|)) (reverse (cdr (reverse |args|))))
- (t |args|))))))
+ ((spadsysnamep (pname |name|)) (reverse (cdr (reverse args))))
+ (t args))))))
@
@@ -8203,7 +9091,7 @@ This reports the traced functions
\end{verbatim}
<<defun coerceSpadArgs2E>>=
-(defun |coerceSpadArgs2E| (|args|)
+(defun |coerceSpadArgs2E| (args)
(prog (|$streamCount|)
(declare (special |$streamCount|))
(return
@@ -8217,7 +9105,7 @@ This reports the traced functions
|arg9| |arg10| |arg11| |arg12| |arg13| |arg14| |arg15|
|arg16| |arg17| |arg18| |arg19|) (cdr t1))
(|name| nil)
- (t2 |args| (cdr t2))
+ (t2 args (cdr t2))
(|arg| nil)
(t3 (cdr |$tracedSpadModemap|) (cdr t3))
(type nil))
@@ -8253,12 +9141,12 @@ This reports the traced functions
<<defun subTypes>>=
(defun |subTypes| (|mm| |sublist|)
- (prog (|s|)
+ (prog (s)
(return
(seq
(cond
((atom |mm|)
- (cond ((spadlet |s| (lassoc |mm| |sublist|)) |s|) (t |mm|)))
+ (cond ((spadlet s (lassoc |mm| |sublist|)) s) (t |mm|)))
(t
(prog (t0)
(spadlet t0 nil)
@@ -8336,11 +9224,11 @@ This reports the traced functions
(prog (t0)
(spadlet t0 t)
(return
- (do ((t1 nil (null t0)) (t2 arg (cdr t2)) (|x| nil))
- ((or t1 (atom t2) (progn (setq |x| (car t2)) nil)) t0)
+ (do ((t1 nil (null t0)) (t2 arg (cdr t2)) (x nil))
+ ((or t1 (atom t2) (progn (setq x (car t2)) nil)) t0)
(seq
(exit
- (setq t0 (and t0 (identp |x|))))))))))))
+ (setq t0 (and t0 (identp x))))))))))))
@
@@ -8357,11 +9245,11 @@ This reports the traced functions
(prog (t0)
(spadlet t0 t)
(return
- (do ((t1 nil (null t0)) (t2 arg (cdr t2)) (|x| nil))
- ((or t1 (atom t2) (progn (setq |x| (car t2)) nil)) t0)
+ (do ((t1 nil (null t0)) (t2 arg (cdr t2)) (x nil))
+ ((or t1 (atom t2) (progn (setq x (car t2)) nil)) t0)
(seq
(exit
- (setq t0 (and t0 (or (identp |x|) (stringp |x|)))))))))))))
+ (setq t0 (and t0 (or (identp x) (stringp x)))))))))))))
@
@@ -8459,12 +9347,12 @@ This reports the traced functions
\end{verbatim}
<<defun lassocSub>>=
-(defun |lassocSub| (|x| |subs|)
+(defun |lassocSub| (x |subs|)
(prog (|y|)
(return
(cond
- ((spadlet |y| (lassq |x| |subs|)) |y|)
- (t |x|)))))
+ ((spadlet |y| (lassq x |subs|)) |y|)
+ (t x)))))
@
@@ -8476,12 +9364,12 @@ This reports the traced functions
\end{verbatim}
<<defun rassocSub>>=
-(defun |rassocSub| (|x| |subs|)
+(defun |rassocSub| (x |subs|)
(prog (|y|)
(return
(cond
- ((spadlet |y| (|rassoc| |x| |subs|)) |y|)
- (t |x|)))))
+ ((spadlet |y| (|rassoc| x |subs|)) |y|)
+ (t x)))))
@
@@ -8751,30 +9639,30 @@ This reports the traced functions
\end{verbatim}
<<defun spadTrace,g>>=
-(defun |spadTrace,g| (|x|)
+(defun |spadTrace,g| (x)
(seq
- (if (stringp |x|) (exit (intern |x|)))
- (exit |x|)))
+ (if (stringp x) (exit (intern x)))
+ (exit x)))
@
<<defun spadTrace,isTraceable>>=
-(defun |spadTrace,isTraceable| (|x| |domain|)
+(defun |spadTrace,isTraceable| (x |domain|)
(prog (|n| |functionSlot|)
(return
(seq
(progn
- (spadlet |n| (caddr |x|))
- |x|
+ (spadlet |n| (caddr x))
+ x
(seq
(if (atom (elt |domain| |n|)) (exit nil))
(spadlet |functionSlot| (car (elt |domain| |n|)))
(if (gensymp |functionSlot|)
- (exit (seq (|reportSpadTrace| '|Already Traced| |x|) (exit nil))))
+ (exit (seq (|reportSpadTrace| '|Already Traced| x) (exit nil))))
(if (null (bpiname |functionSlot|))
(exit
(seq
- (|reportSpadTrace| '|No function for| |x|)
+ (|reportSpadTrace| '|No function for| x)
(exit nil))))
(exit t)))))))
@@ -8804,11 +9692,11 @@ This reports the traced functions
(prog (t0)
(spadlet t0 nil)
(return
- (do ((t1 (|getOption| 'ops |options|) (cdr t1)) (|x| nil))
- ((or (atom t1) (progn (setq |x| (car t1)) nil)) (nreverse0 t0))
+ (do ((t1 (|getOption| 'ops |options|) (cdr t1)) (x nil))
+ ((or (atom t1) (progn (setq x (car t1)) nil)) (nreverse0 t0))
(seq
(exit
- (setq t0 (cons (|spadTrace,g| |x|) t0))))))))
+ (setq t0 (cons (|spadTrace,g| x) t0))))))))
(cond
((spadlet |listOfVariables| (|getOption| 'vars |options|))
(spadlet |options| (|removeOption| 'vars |options|))))
@@ -8901,20 +9789,20 @@ This reports the traced functions
(prog (t10)
(spadlet t10 nil)
(return
- (do ((t11 |sigSlotNumberAlist| (cdr t11)) (|x| nil))
- ((or (atom t11) (progn (setq |x| (car t11)) nil)) (nreverse0 t10))
+ (do ((t11 |sigSlotNumberAlist| (cdr t11)) (x nil))
+ ((or (atom t11) (progn (setq x (car t11)) nil)) (nreverse0 t10))
(seq
(exit
- (cond ((cdddr |x|) (setq t10 (cons |x| t10))))))))))
+ (cond ((cdddr x) (setq t10 (cons x t10))))))))))
(cond
(|$reportSpadTrace|
(cond (|$traceNoisely| (|printDashedLine|)))
(do ((t12 (|orderBySlotNumber| |sigSlotNumberAlist|) (cdr t12))
- (|x| nil))
+ (x nil))
((or (atom t12)
- (progn (setq |x| (car t12)) nil))
+ (progn (setq x (car t12)) nil))
nil)
- (seq (exit (|reportSpadTrace| 'tracing |x|))))))
+ (seq (exit (|reportSpadTrace| 'tracing x))))))
(cond (|$letAssoc| (setletprintflag t)))
(cond
(|currentEntry|
@@ -9078,7 +9966,7 @@ This reports the traced functions
(cons 'lambda
(cons
(cons '&rest
- (cons '|args| nil))
+ (cons 'args nil))
(cons
(cons 'prog
(cons
@@ -9088,7 +9976,7 @@ This reports the traced functions
(cons '|domain|
(cons
(cons 'apply (cons |domainConstructor|
- (cons '|args| nil))) nil)))
+ (cons 'args nil))) nil)))
(cons
(cons '|spadTrace|
(cons '|domain|
@@ -9236,7 +10124,7 @@ This reports the traced functions
\end{verbatim}
<<defun letPrint>>=
-(defun |letPrint| (|x| |val| |currentFunction|)
+(defun |letPrint| (x |val| |currentFunction|)
(prog (|y|)
(return
(progn
@@ -9246,24 +10134,24 @@ This reports the traced functions
(spadlet |y| (lassoc '|all| |$letAssoc|))))
(cond
((and (or (boot-equal |y| '|all|)
- (memq |x| |y|))
+ (memq x |y|))
(null
- (or (is_genvar |x|) (|isSharpVarWithNum| |x|) (gensymp |x|))))
- (|sayBrightlyNT| (append (|bright| |x|) (cons '|: | nil)))
+ (or (is_genvar x) (|isSharpVarWithNum| x) (gensymp x))))
+ (|sayBrightlyNT| (append (|bright| x) (cons '|: | nil)))
(prin0 (|shortenForPrinting| |val|))
(terpri)))
(cond
((and (spadlet |y| (|hasPair| 'break |y|))
(or (boot-equal |y| '|all|)
- (and (memq |x| |y|)
- (null (memq (elt (pname |x|) 0) '($ |#|)))
- (null (gensymp |x|)))))
+ (and (memq x |y|)
+ (null (memq (elt (pname x) 0) '($ |#|)))
+ (null (gensymp x)))))
(|break|
(append
(|bright| |currentFunction|)
(cons "breaks after"
(append
- (|bright| |x|)
+ (|bright| x)
(cons ":= " (cons (|shortenForPrinting| |val|) nil)))))))
(t nil))))
|val|))))
@@ -9293,7 +10181,7 @@ This reports the traced functions
\end{verbatim}
<<defun letPrint2>>=
-(defun |letPrint2| (|x| |printform| |currentFunction|)
+(defun |letPrint2| (x |printform| |currentFunction|)
(prog (|$BreakMode| |flag| |y|)
(declare (special |$BreakMode|))
(return
@@ -9305,12 +10193,12 @@ This reports the traced functions
(spadlet |y| (lassoc '|all| |$letAssoc|))))
(cond
((and
- (or (boot-equal |y| '|all|) (memq |x| |y|))
- (null (or (is_genvar |x|) (|isSharpVarWithNum| |x|) (gensymp |x|))))
+ (or (boot-equal |y| '|all|) (memq x |y|))
+ (null (or (is_genvar x) (|isSharpVarWithNum| x) (gensymp x))))
(spadlet |$BreakMode| '|letPrint2|)
(spadlet |flag| nil)
(catch '|letPrint2|
- (|mathprint| (cons '= (cons |x| (cons |printform| nil)))) |flag|)
+ (|mathprint| (cons '= (cons x (cons |printform| nil)))) |flag|)
(cond
((boot-equal |flag| '|letPrint2|) (|print| |printform|))
(t nil))))
@@ -9319,16 +10207,16 @@ This reports the traced functions
(spadlet |y| (|hasPair| 'break |y|))
(or (boot-equal |y| '|all|)
(and
- (memq |x| |y|)
- (null (memq (elt (pname |x|) 0) '($ |#|)))
- (null (gensymp |x|)))))
+ (memq x |y|)
+ (null (memq (elt (pname x) 0) '($ |#|)))
+ (null (gensymp x)))))
(|break|
(append
(|bright| |currentFunction|)
(cons "breaks after"
- (append (|bright| |x|) (cons '|:= | (cons |printform| nil)))))))
+ (append (|bright| x) (cons '|:= | (cons |printform| nil)))))))
(t nil))))
- |x|))))
+ x))))
@
@@ -9355,7 +10243,7 @@ This reports the traced functions
\end{verbatim}
<<defun letPrint3>>=
-(defun |letPrint3| (|x| |xval| |printfn| |currentFunction|)
+(defun |letPrint3| (x |xval| |printfn| |currentFunction|)
(prog (|$BreakMode| |flag| |y|)
(declare (special |$BreakMode|))
(return
@@ -9367,13 +10255,13 @@ This reports the traced functions
(spadlet |y| (lassoc '|all| |$letAssoc|))))
(cond
((and
- (or (boot-equal |y| '|all|) (memq |x| |y|))
- (null (or (is_genvar |x|) (|isSharpVarWithNum| |x|) (gensymp |x|))))
+ (or (boot-equal |y| '|all|) (memq x |y|))
+ (null (or (is_genvar x) (|isSharpVarWithNum| x) (gensymp x))))
(spadlet |$BreakMode| '|letPrint2|)
(spadlet |flag| nil)
(catch '|letPrint2|
(|mathprint|
- (cons '= (cons |x| (cons (spadcall |xval| |printfn|) nil))))
+ (cons '= (cons x (cons (spadcall |xval| |printfn|) nil))))
|flag|)
(cond
((boot-equal |flag| '|letPrint2|) (|print| |xval|))
@@ -9384,16 +10272,16 @@ This reports the traced functions
(or
(boot-equal |y| '|all|)
(and
- (memq |x| |y|)
- (null (memq (elt (pname |x|) 0) '($ |#|)))
- (null (gensymp |x|)))))
+ (memq x |y|)
+ (null (memq (elt (pname x) 0) '($ |#|)))
+ (null (gensymp x)))))
(|break|
(append
(|bright| |currentFunction|)
(cons "breaks after"
- (append (|bright| |x|) (cons ":= " (cons |xval| nil)))))))
+ (append (|bright| x) (cons ":= " (cons |xval| nil)))))))
(t nil))))
- |x|))))
+ x))))
@
\subsection{defun getAliasIfTracedMapParameter}
@@ -9406,20 +10294,20 @@ This reports the traced functions
\end{verbatim}
<<defun getAliasIfTracedMapParameter>>=
-(defun |getAliasIfTracedMapParameter| (|x| |currentFunction|)
+(defun |getAliasIfTracedMapParameter| (x |currentFunction|)
(prog (|aliasList|)
(return
(seq
(cond
- ((|isSharpVarWithNum| |x|)
+ ((|isSharpVarWithNum| x)
(cond
((spadlet |aliasList|
(|get| |currentFunction| '|alias| |$InteractiveFrame|))
(exit
(elt |aliasList|
(spaddifference
- (string2pint-n (substring (pname |x|) 1 nil) 1) 1))))))
- (t |x|))))))
+ (string2pint-n (substring (pname x) 1 nil) 1) 1))))))
+ (t x))))))
@
@@ -9577,14 +10465,14 @@ This reports the traced functions
(prog (t0)
(spadlet t0 nil)
(return
- (do ((t1 arg (cdr t1)) (|x| nil))
+ (do ((t1 arg (cdr t1)) (x nil))
((or (atom t1)
- (progn (setq |x| (car t1)) nil)
- (progn (progn (spadlet |n| (caddr |x|)) |x|) nil))
+ (progn (setq x (car t1)) nil)
+ (progn (progn (spadlet |n| (caddr x)) x) nil))
(nreverse0 t0))
(seq
(exit
- (setq t0 (cons (cons |n| |x|) t0)))))))))))))
+ (setq t0 (cons (cons |n| x) t0)))))))))))))
@
@@ -9607,17 +10495,17 @@ This reports the traced functions
(cond
((null /tracenames) " Nothing is traced.")
(t
- (do ((t0 /tracenames (cdr t0)) (|x| nil))
- ((or (atom t0) (progn (setq |x| (car t0)) nil)) nil)
+ (do ((t0 /tracenames (cdr t0)) (x nil))
+ ((or (atom t0) (progn (setq x (car t0)) nil)) nil)
(seq
(exit
(cond
- ((and (pairp |x|)
- (progn (spadlet |d| (qcar |x|)) t)
+ ((and (pairp x)
+ (progn (spadlet |d| (qcar x)) t)
(|isDomainOrPackage| |d|))
(spadlet |domainList| (cons (|devaluate| |d|) |domainList|)))
(t
- (spadlet |functionList| (cons |x| |functionList|)))))))
+ (spadlet |functionList| (cons x |functionList|)))))))
(append |functionList|
(append |domainList| (cons '|traced| nil)))))))))
@@ -9633,14 +10521,14 @@ This reports the traced functions
\end{verbatim}
<<defun spadReply,printName>>=
-(defun |spadReply,printName| (|x|)
+(defun |spadReply,printName| (x)
(prog (|d|)
(return
(seq
- (if (and (and (pairp |x|) (progn (spadlet |d| (qcar |x|)) t))
+ (if (and (and (pairp x) (progn (spadlet |d| (qcar x)) t))
(|isDomainOrPackage| |d|))
(exit (|devaluate| |d|)))
- (exit |x|)))))
+ (exit x)))))
@
@@ -9652,11 +10540,11 @@ This reports the traced functions
(prog (t0)
(spadlet t0 nil)
(return
- (do ((t1 /tracenames (cdr t1)) (|x| nil))
- ((or (atom t1) (progn (setq |x| (car t1)) nil)) (nreverse0 t0))
+ (do ((t1 /tracenames (cdr t1)) (x nil))
+ ((or (atom t1) (progn (setq x (car t1)) nil)) (nreverse0 t0))
(seq
(exit
- (setq t0 (cons (|spadReply,printName| |x|) t0)))))))))))
+ (setq t0 (cons (|spadReply,printName| x) t0)))))))))))
@
@@ -9743,11 +10631,11 @@ This reports the traced functions
(prog (t1)
(spadlet t1 nil)
(return
- (do ((t2 |sigSlotNumberAlist| (cdr t2)) (|x| nil))
- ((or (atom t2) (progn (setq |x| (car t2)) nil)) (nreverse0 t1))
+ (do ((t2 |sigSlotNumberAlist| (cdr t2)) (x nil))
+ ((or (atom t2) (progn (setq x (car t2)) nil)) (nreverse0 t1))
(seq
(exit
- (cond ((cdddr |x|) (setq t1 (cons |x| t1))))))))))
+ (cond ((cdddr x) (setq t1 (cons x t1))))))))))
(cond
(|newSigSlotNumberAlist|
(rplac (cdr |pair|) |newSigSlotNumberAlist|))
@@ -9766,15 +10654,15 @@ This reports the traced functions
\end{verbatim}
<<defun prTraceNames,fn>>=
-(defun |prTraceNames,fn| (|x|)
+(defun |prTraceNames,fn| (x)
(prog (|d| |t|)
(return
(seq
- (if (and (and (pairp |x|)
- (progn (spadlet |d| (qcar |x|)) (spadlet |t| (qcdr |x|)) t))
+ (if (and (and (pairp x)
+ (progn (spadlet |d| (qcar x)) (spadlet |t| (qcdr x)) t))
(|isDomainOrPackage| |d|))
(exit (cons (|devaluate| |d|) |t|)))
- (exit |x|)))))
+ (exit x)))))
@
@@ -9782,11 +10670,11 @@ This reports the traced functions
(defun |prTraceNames| ()
(seq
(progn
- (do ((t0 /tracenames (cdr t0)) (|x| nil))
- ((or (atom t0) (progn (setq |x| (car t0)) nil)) nil)
+ (do ((t0 /tracenames (cdr t0)) (x nil))
+ ((or (atom t0) (progn (setq x (car t0)) nil)) nil)
(seq
(exit
- (print (|prTraceNames,fn| |x|))))) nil)))
+ (print (|prTraceNames,fn| x))))) nil)))
@
@@ -9850,33 +10738,33 @@ This reports the traced functions
((null /tracenames) (|sayMessage| " Nothing is traced now."))
(t
(|sayBrightly| " ")
- (do ((t0 /tracenames (cdr t0)) (|x| nil))
- ((or (atom t0) (progn (setq |x| (car t0)) nil)) nil)
+ (do ((t0 /tracenames (cdr t0)) (x nil))
+ ((or (atom t0) (progn (setq x (car t0)) nil)) nil)
(seq
(exit
(cond
- ((and (pairp |x|)
- (progn (spadlet |d| (qcar |x|)) t) (|isDomainOrPackage| |d|))
+ ((and (pairp x)
+ (progn (spadlet |d| (qcar x)) t) (|isDomainOrPackage| |d|))
(|addTraceItem| |d|))
- ((atom |x|)
+ ((atom x)
(cond
- ((|isFunctor| |x|) (|addTraceItem| |x|))
- ((is_genvar |x|) (|addTraceItem| (EVAL |x|)))
- (t (spadlet |functionList| (CONS |x| |functionList|)))))
+ ((|isFunctor| x) (|addTraceItem| x))
+ ((is_genvar x) (|addTraceItem| (EVAL x)))
+ (t (spadlet |functionList| (CONS x |functionList|)))))
(t (|userError| "bad argument to trace"))))))
(spadlet |functionList|
(prog (t1)
(spadlet t1 nil)
(return
- (do ((t2 |functionList| (cdr t2)) (|x| nil))
- ((or (atom t2) (progn (setq |x| (car t2)) nil)) t1)
+ (do ((t2 |functionList| (cdr t2)) (x nil))
+ ((or (atom t2) (progn (setq x (car t2)) nil)) t1)
(seq
(exit
(cond
- ((null (|isSubForRedundantMapName| |x|))
+ ((null (|isSubForRedundantMapName| x))
(setq t1
(append t1
- (cons (|rassocSub| |x| |$mapSubNameAlist|)
+ (cons (|rassocSub| x |$mapSubNameAlist|)
(cons " " nil))))))))))))
(cond
(|functionList|
@@ -9897,12 +10785,12 @@ This reports the traced functions
(prog (t3)
(spadlet t3 nil)
(return
- (do ((t4 (cdr |$domains|) (cdr t4)) (|x| nil))
- ((or (atom t4) (progn (setq |x| (car t4)) nil)) t3)
+ (do ((t4 (cdr |$domains|) (cdr t4)) (x nil))
+ ((or (atom t4) (progn (setq x (car t4)) nil)) t3)
(seq
(exit
(setq t3
- (append t3 (|concat| "," " " (|prefix2String| |x|)))))))))))
+ (append t3 (|concat| "," " " (|prefix2String| x)))))))))))
(cond
((atom |displayList|)
(spadlet |displayList| (cons |displayList| nil))))
@@ -9916,12 +10804,12 @@ This reports the traced functions
(prog (t5)
(spadlet t5 nil)
(return
- (do ((t6 (cdr |$packages|) (cdr t6)) (|x| nil))
- ((or (atom t6) (progn (setq |x| (car t6)) nil)) t5)
+ (do ((t6 (cdr |$packages|) (cdr t6)) (x nil))
+ ((or (atom t6) (progn (setq x (car t6)) nil)) t5)
(seq
(exit
(setq t5
- (append t5 (|concat| '|, | (|prefix2String| |x|)))))))))))
+ (append t5 (|concat| '|, | (|prefix2String| x)))))))))))
(cond ((atom |displayList|)
(spadlet |displayList| (cons |displayList| nil))))
(|sayBrightly| " Packages traced: ")
@@ -9934,12 +10822,12 @@ This reports the traced functions
(prog (t7)
(spadlet t7 nil)
(return
- (do ((t8 (cdr |$constructors|) (cdr t8)) (|x| nil))
- ((or (atom t8) (progn (setq |x| (car t8)) nil)) t7)
+ (do ((t8 (cdr |$constructors|) (cdr t8)) (x nil))
+ ((or (atom t8) (progn (setq x (car t8)) nil)) t7)
(seq
(exit
(setq t7
- (append t7 (|concat| '|, | (|abbreviate| |x|)))))))))))
+ (append t7 (|concat| '|, | (|abbreviate| x)))))))))))
(cond ((atom |displayList|)
(spadlet |displayList| (CONS |displayList| nil))))
(|sayBrightly| " Parameterized constructors traced:")
@@ -9987,34 +10875,34 @@ This reports the traced functions
<<defun ?t>>=
(defun |?t| ()
- (prog (|llm| |x| |d| |l| |suffix|)
+ (prog (|llm| x |d| |l| |suffix|)
(return
(seq
(cond
((null /tracenames) (|sayMSG| (|bright| "nothing is traced")))
(t
- (do ((t0 /tracenames (cdr t0)) (|x| nil))
- ((or (atom t0) (progn (setq |x| (car t0)) nil)) nil)
+ (do ((t0 /tracenames (cdr t0)) (x nil))
+ ((or (atom t0) (progn (setq x (car t0)) nil)) nil)
(seq
(exit
(cond
- ((and (atom |x|) (null (is_genvar |x|)))
+ ((and (atom x) (null (is_genvar x)))
(progn
(cond
- ((spadlet |llm| (|get| |x| '|localModemap| |$InteractiveFrame|))
- (spadlet |x| (list (cadar |llm|)))))
+ ((spadlet |llm| (|get| x '|localModemap| |$InteractiveFrame|))
+ (spadlet x (list (cadar |llm|)))))
(|sayMSG|
(cons "Function"
(append
- (|bright| (|rassocSub| |x| |$mapSubNameAlist|))
+ (|bright| (|rassocSub| x |$mapSubNameAlist|))
(cons "traced" nil))))))))))
- (do ((t1 /tracenames (cdr t1)) (|x| nil))
- ((or (atom t1) (progn (setq |x| (car t1)) nil)) nil)
+ (do ((t1 /tracenames (cdr t1)) (x nil))
+ ((or (atom t1) (progn (setq x (car t1)) nil)) nil)
(seq
(exit
(cond
- ((and (pairp |x|)
- (progn (spadlet |d| (qcar |x|)) (spadlet |l| (qcdr |x|)) t)
+ ((and (pairp x)
+ (progn (spadlet |d| (qcar x)) (spadlet |l| (qcdr x)) t)
(|isDomainOrPackage| |d|))
(progn
(spadlet |suffix| (cond ((|isDomain| |d|) "domain") (t "package")))
@@ -10025,11 +10913,11 @@ This reports the traced functions
(cons (|devaluate| |d|)
(cons '|%d|
(cons ":" nil)))))))
- (do ((t2 (|orderBySlotNumber| |l|) (cdr t2)) (|x| nil))
- ((or (atom t2) (progn (setq |x| (car t2)) nil)) nil)
+ (do ((t2 (|orderBySlotNumber| |l|) (cdr t2)) (x nil))
+ ((or (atom t2) (progn (setq x (car t2)) nil)) nil)
(seq
(exit
- (|reportSpadTrace| '| | (TAKE 4 |x|)))))
+ (|reportSpadTrace| '| | (TAKE 4 x)))))
(terpri)))))))))))))
@
@@ -11160,20 +12048,20 @@ whatSpad2Cmd l ==
\subsection{defun whatSpad2Cmd,fixpat}
<<defun whatSpad2Cmd,fixpat>>=
-(defun |whatSpad2Cmd,fixpat| (|x|)
+(defun |whatSpad2Cmd,fixpat| (x)
(prog (|x'|)
(return
(seq
- (if (and (pairp |x|) (progn (spadlet |x'| (qcar |x|)) t))
+ (if (and (pairp x) (progn (spadlet |x'| (qcar x)) t))
(exit (downcase |x'|)))
- (exit (downcase |x|))))))
+ (exit (downcase x))))))
@
\subsection{defun whatSpad2Cmd}
<<defun whatSpad2Cmd>>=
(defun |whatSpad2Cmd| (arg)
- (prog (|$e| |key0| key |args|)
+ (prog (|$e| |key0| key args)
(declare (special |$e|))
(return
(seq
@@ -11183,22 +12071,22 @@ whatSpad2Cmd l ==
((null arg) (|reportWhatOptions|))
(t
(spadlet |key0| (car arg))
- (spadlet |args| (cdr arg))
+ (spadlet args (cdr arg))
(spadlet key (|selectOptionLC| |key0| |$whatOptions| nil))
(cond
((null key) (|sayKeyedMsg| 's2iz0043 nil))
(t
- (spadlet |args|
+ (spadlet args
(prog (t0)
(spadlet t0 nil)
(return
- (do ((t1 |args| (cdr t1)) (|p| nil))
+ (do ((t1 args (cdr t1)) (p nil))
((or (atom t1)
- (progn (setq |p| (car t1)) nil))
+ (progn (setq p (car t1)) nil))
(nreverse0 t0))
(seq
(exit
- (setq t0 (cons (|whatSpad2Cmd,fixpat| |p|) t0))))))))
+ (setq t0 (cons (|whatSpad2Cmd,fixpat| p) t0))))))))
(seq
(cond
((boot-equal key '|things|)
@@ -11208,19 +12096,19 @@ whatSpad2Cmd l ==
(exit
(cond
((null (memq opt '(|things|)))
- (exit (|whatSpad2Cmd| (cons opt |args|)))))))))
+ (exit (|whatSpad2Cmd| (cons opt args)))))))))
((boot-equal key '|categories|)
- (|filterAndFormatConstructors| '|category| "Categories" |args|))
- ((boot-equal key '|commands|) (|whatCommands| |args|))
+ (|filterAndFormatConstructors| '|category| "Categories" args))
+ ((boot-equal key '|commands|) (|whatCommands| args))
((boot-equal key '|domains|)
- (|filterAndFormatConstructors| '|domain| "Domains" |args|))
+ (|filterAndFormatConstructors| '|domain| "Domains" args))
((boot-equal key '|operations|)
- (|apropos| |args|))
+ (|apropos| args))
((boot-equal key '|packages|)
- (|filterAndFormatConstructors| '|package| "Packages" |args|))
+ (|filterAndFormatConstructors| '|package| "Packages" args))
(t
(cond ((boot-equal key '|synonyms|)
- (|printSynonyms| |args|)))))))))))))))
+ (|printSynonyms| args)))))))))))))))
@
@@ -11338,10 +12226,10 @@ apropos l ==
(prog (t0)
(spadlet t0 nil)
(return
- (do ((t1 arg (cdr t1)) (|p| nil))
- ((or (atom t1) (progn (setq |p| (car t1)) nil))
+ (do ((t1 arg (cdr t1)) (p nil))
+ ((or (atom t1) (progn (setq p (car t1)) nil))
(nreverse0 t0))
- (seq (exit (setq t0 (cons (downcase (stringimage |p|)) t0)))))))
+ (seq (exit (setq t0 (cons (downcase (stringimage p)) t0)))))))
(|allOperations|)))))
(cond
(|ops|
@@ -11406,12 +12294,12 @@ workfilesSpad2Cmd args ==
for fl in $sourceFiles repeat sayBrightly [" " ,namestring fl]
\end{verbatim}
<<defun workfilesSpad2Cmd>>=
-(defun |workfilesSpad2Cmd| (|args|)
+(defun |workfilesSpad2Cmd| (args)
(prog (|deleteFlag| type |flist| |type1| |fl|)
(return
(seq
(cond
- (|args| (|throwKeyedMsg| 's2iz0047 nil))
+ (args (|throwKeyedMsg| 's2iz0047 nil))
(t
(spadlet |deleteFlag| nil)
(do ((t0 |$options| (cdr t0)) (t1 nil))
@@ -11546,7 +12434,7 @@ zsystemdevelopment1(l,im) ==
\end{verbatim}
<<defun zsystemdevelopment1>>=
(defun |zsystemdevelopment1| (arg |im|)
- (prog (|$InteractiveMode| |fromopt| opt |optargs| |newopt| |opt1|
+ (prog (|$InteractiveMode| |fromopt| opt optargs |newopt| |opt1|
|conStream| |upf| |fun|)
(declare (special |$InteractiveMode|))
(return
@@ -11560,7 +12448,7 @@ zsystemdevelopment1(l,im) ==
(progn
(progn
(spadlet opt (CAR t1))
- (spadlet |optargs| (CDR t1))
+ (spadlet optargs (CDR t1))
t1)
nil))
nil)
@@ -11570,22 +12458,22 @@ zsystemdevelopment1(l,im) ==
(spadlet |opt1| (|selectOptionLC| opt '(|from|) nil))
(cond
((boot-equal |opt1| '|from|)
- (spadlet |fromopt| (cons (cons 'from |optargs|) nil))))))))
+ (spadlet |fromopt| (cons (cons 'from optargs) nil))))))))
(do ((t2 |$options| (cdr t2)) (t3 nil))
((or (atom t2)
(progn (setq t3 (car t2)) nil)
(progn
(progn
(spadlet opt (car t3))
- (spadlet |optargs| (cdr t3))
+ (spadlet optargs (cdr t3))
t3)
nil))
nil)
(seq
(exit
(progn
- (cond ((null |optargs|) (spadlet |optargs| arg)))
- (spadlet |newopt| (append |optargs| |fromopt|))
+ (cond ((null optargs) (spadlet optargs arg)))
+ (spadlet |newopt| (append optargs |fromopt|))
(spadlet |opt1| (|selectOptionLC| opt '(|from|) nil))
(cond
((boot-equal |opt1| '|from|)
@@ -11619,17 +12507,17 @@ zsystemdevelopment1(l,im) ==
(spadlet |$InteractiveMode| nil)
(spadlet |upf|
(cons
- (or (kar |optargs|) /version)
+ (or (kar optargs) /version)
(cons
- (or (kadr |optargs|) /wsname)
- (cons (or (kaddr |optargs|) '*) nil))))
+ (or (kadr optargs) /wsname)
+ (cons (or (kaddr optargs) '*) nil))))
(spadlet |fun|
(cond
((boot-equal opt '|patch|) '/update-lib-1)
(t '/update-1)))
(catch 'filenam (funcall |fun| |upf|))
(|sayMessage| " Update/patch is completed."))
- ((null |optargs|)
+ ((null optargs)
(|sayBrightly|
(cons
" An argument is required for"
@@ -11789,13 +12677,20 @@ load the file \verb|exposed.lsp| to set up the
exposure group information.
<<defun clearCmdSortedCaches>>
<<defun clearSpad2Cmd>>
<<defun clearFrame>>
+<<defun close>>
<<defun closeInterpreterFrame>>
+<<defun compileAsharpCmd>>
+<<defun compileAsharpCmd1>>
+<<defun compileAsharpArchiveCmd>>
<<defun compileBoot>>
+<<defun compiler>>
+<<defun compileSpadLispCmd>>
<<defun coerceSpadArgs2E>>
<<defun coerceSpadFunValue2E>>
<<defun coerceTraceArgs2E>>
<<defun coerceTraceFunValue2E>>
<<defun createCurrentInterpreterFrame>>
+<<defun credits>>
<<defun dewritify>>
<<defun dewritify,dewritifyInner>>
@@ -11908,6 +12803,8 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun ptimers>>
<<defun putHist>>
+<<defun queryClients>>
+
<<defun rassocSub>>
<<defun readHiFi>>
<<defun reclaim>>
@@ -11961,6 +12858,7 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun statisticsInitialization>>
<<defun stupidIsSpadFunction>>
<<defun subTypes>>
+<<defun summary>>
<<defun ?t>>
<<defun trace>>
@@ -12000,6 +12898,7 @@ load the file \verb|exposed.lsp| to set up the exposure
group information.
<<defun whatSpad2Cmd>>
<<defun whatSpad2Cmd,fixpat>>
<<defun with>>
+<<defun withAsharpCmd>>
<<defun workfiles>>
<<defun workfilesSpad2Cmd>>
<<defun writify>>
diff --git a/changelog b/changelog
index 13496a6..244900f 100644
--- a/changelog
+++ b/changelog
@@ -1,4 +1,8 @@
-20090408 tpd src/axiom-website/patches.html 20090308.02.tpd.patch
+20090308 tpd src/axiom-website/patches.html 20090308.03.tpd.patch
+20090308 tpd src/input/unittest1.input unit test commands
+20090308 tpd src/interp/i-syscmd.boot move commands to bookvol5
+20090308 tpd books/bookvol5 move summary, copyright, help roots
+20090308 tpd src/axiom-website/patches.html 20090308.02.tpd.patch
20090308 tpd src/interp/i-syscmd.boot move clear to bookvol5
20090308 tpd books/bookvol5 add )clear root
20090308 tpd src/axiom-website/patches.html 20090308.01.tpd.patch
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 1d7f8eb..80e328c 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -995,5 +995,7 @@ bookvol5 add trace root<br/>
bookvol5 add include, abbreviation roots<br/>
<a href="patches/20090308.02.tpd.patch">20090308.02.tpd.patch</a>
bookvol5 add clear root<br/>
+<a href="patches/20090308.03.tpd.patch">20090308.03.tpd.patch</a>
+bookvol5 add summary, copyright, help roots<br/>
</body>
</html>
diff --git a/src/input/unittest1.input.pamphlet
b/src/input/unittest1.input.pamphlet
index c5c9bd3..ac70ef0 100644
--- a/src/input/unittest1.input.pamphlet
+++ b/src/input/unittest1.input.pamphlet
@@ -21,7 +21,7 @@ Unit test the user level commands
The )with command is the same as the )library command and really
should be a synonym.
<<*>>=
---S 1
+--S 1 0f 28
)with API
--R )library cannot find the file API.
--E 1
@@ -30,7 +30,7 @@ should be a synonym.
The )apropos command is the same as a )what command
<<*>>=
---S 2
+--S 2 0f 28
)apropos matrix
--R
--R
@@ -103,7 +103,7 @@ The )apropos command is the same as a )what command
--R
--E 2
---S 3
+--S 3 0f 28
)what categories set
--R
--R------------------------------- Categories --------------------------------
@@ -122,7 +122,7 @@ The )apropos command is the same as a )what command
--R TSETCAT TriangularSetCategory
--E 3
---S 4
+--S 4 0f 28
)what commands set
--R
--R--------------- System Commands for User Level: development ---------------
@@ -134,7 +134,7 @@ The )apropos command is the same as a )what command
--R
--E 4
---S 5
+--S 5 0f 28
)what domains set
--R
--R--------------------------------- Domains ---------------------------------
@@ -157,7 +157,7 @@ The )apropos command is the same as a )what command
--R WUTSET WuWenTsunTriangularSet
--E 5
---S 6
+--S 6 0f 28
)what operations set
--R
--R
@@ -262,7 +262,7 @@ The )apropos command is the same as a )what command
--R setAttributeButtonStep
--E 6
---S 7
+--S 7 0f 28
)what packages set
--R
--R-------------------------------- Packages ---------------------------------
@@ -279,7 +279,7 @@ The )apropos command is the same as a )what command
--R SRDCMPK SquareFreeRegularSetDecompositionPackage
--E 7
---S 8
+--S 8 0f 28
)what synonym set
--R
--R------------------------- System Command Synonyms -------------------------
@@ -289,7 +289,7 @@ The )apropos command is the same as a )what command
--R
--E 8
---S 9
+--S 9 0f 28
)what things set
--R
--R
@@ -450,7 +450,7 @@ The )apropos command is the same as a )what command
--R
--E 9
---S 10
+--S 10 0f 28
)apropos set
--R
--ROperations whose names satisfy the above pattern(s):
@@ -609,7 +609,7 @@ The )apropos command is the same as a )what command
--R
--E 10
---S 11
+--S 11 0f 28
)prompt
--R---------------------------- The prompt Option ----------------------------
--R
@@ -627,13 +627,13 @@ The )apropos command is the same as a )what command
--R
--E 11
---S 12
+--S 12 0f 28
)version
--R
--IValue = "Saturday February 21, 2009 at 17:59:27 "
--E 12
---S 13
+--S 13 0f 28
)zsys )from )c
--R
--R
@@ -644,7 +644,7 @@ The )apropos command is the same as a )what command
--R
--E 13
---S 14
+--S 14 0f 28
)zsys )from )d
--R
--R
@@ -655,7 +655,7 @@ The )apropos command is the same as a )what command
--R
--E 14
---S 15
+--S 15 0f 28
)zsys )from )dt
--R
--R
@@ -666,7 +666,7 @@ The )apropos command is the same as a )what command
--R
--E 15
---S 16
+--S 16 0f 28
)zsys )from )ct
--R
--R
@@ -677,7 +677,7 @@ The )apropos command is the same as a )what command
--R
--E 16
---S 17
+--S 17 0f 28
)zsys )from )ctl
--R
--R
@@ -688,7 +688,7 @@ The )apropos command is the same as a )what command
--R
--E 17
---S 18
+--S 18 0f 28
)zsys )from )ec
--R
--R
@@ -699,7 +699,7 @@ The )apropos command is the same as a )what command
--R
--E 18
---S 19
+--S 19 0f 28
)zsys )from )ect
--R
--R
@@ -710,7 +710,7 @@ The )apropos command is the same as a )what command
--R
--E 19
---S 20
+--S 20 0f 28
)zsys )from )e
--R
--R
@@ -721,12 +721,12 @@ The )apropos command is the same as a )what command
--R
--E 20
---S 21
+--S 21 0f 28
)zsys )from )version
--R
--E 21
---S 22
+--S 22 0f 28
)zsys )from )update
--R
--R
@@ -737,7 +737,7 @@ The )apropos command is the same as a )what command
--R
--E 22
---S 23
+--S 23 0f 28
)zsys )from )patch
--R
--R
@@ -748,7 +748,7 @@ The )apropos command is the same as a )what command
--R
--E 23
---S 24
+--S 24 0f 28
)zsys )from )there 1
--R
--R
@@ -757,18 +757,134 @@ The )apropos command is the same as a )what command
--R
--E 24
---S 25
+--S 25 0f 28
)zsys )from )compare
--R
--R An argument is required for compare
--E 25
---S 26
+--S 26 0f 28
)zsys )from )record
--R
--R An argument is required for record
--E 26
+--S 27 0f 28
+)summary
+ )credits : list the people who have contributed to Axiom
+
+ )help <command> gives more information
+ )quit : exit AXIOM
+
+ )abbreviation : query, set and remove abbreviations for constructors
+ )cd : set working directory
+ )clear : remove declarations, definitions or values
+ )close : throw away an interpreter client and workspace
+ )compile : invoke constructor compiler
+ )display : display Library operations and objects in your workspace
+ )edit : edit a file
+ )frame : manage interpreter workspaces
+ )history : manage aspects of interactive session
+ )library : introduce new constructors
+ )lisp : evaluate a LISP expression
+ )read : execute AXIOM commands from a file
+ )savesystem : save LISP image to a file
+ )set : view and set system variables
+ )show : show constructor information
+ )spool : log input and output to a file
+ )synonym : define an abbreviation for system commands
+ )system : issue shell commands
+ )trace : trace execution of functions
+ )undo : restore workspace to earlier state
+ )what : search for various things by name
+
+--E 27
+
+--S 28 0f 28
+)credits
+An alphabetical listing of contributors to AXIOM:
+Cyril Alberga Roy Adler Christian Aistleitner
+Richard Anderson George Andrews S.J. Atkins
+Henry Baker Stephen Balzac Yurij Baransky
+David R. Barton Gerald Baumgartner Gilbert Baumslag
+Jay Belanger David Bindel Fred Blair
+Vladimir Bondarenko Mark Botch
+Alexandre Bouyer Peter A. Broadbery Martin Brock
+Manuel Bronstein Stephen Buchwald Florian Bundschuh
+Luanne Burns William Burge
+Quentin Carpent Robert Caviness Bruce Char
+Ondrej Certik Cheekai Chin David V. Chudnovsky
+Gregory V. Chudnovsky Josh Cohen Christophe Conil
+Don Coppersmith George Corliss Robert Corless
+Gary Cornell Meino Cramer Claire Di Crescenzo
+David Cyganski
+Timothy Daly Sr. Timothy Daly Jr. James H. Davenport
+Didier Deshommes Michael Dewar
+Jean Della Dora Gabriel Dos Reis Claire DiCrescendo
+Sam Dooley Lionel Ducos Martin Dunstan
+Brian Dupee Dominique Duval
+Robert Edwards Heow Eide-Goodman Lars Erickson
+Richard Fateman Bertfried Fauser Stuart Feldman
+Brian Ford Albrecht Fortenbacher George Frances
+Constantine Frangos Timothy Freeman Korrinn Fu
+Marc Gaetano Rudiger Gebauer Kathy Gerber
+Patricia Gianni Samantha Goldrich Holger Gollan
+Teresa Gomez-Diaz Laureano Gonzalez-Vega Stephen Gortler
+Johannes Grabmeier Matt Grayson Klaus Ebbe Grue
+James Griesmer Vladimir Grinberg Oswald Gschnitzer
+Jocelyn Guidry
+Steve Hague Satoshi Hamaguchi Mike Hansen
+Richard Harke Vilya Harvey Martin Hassner
+Arthur S. Hathaway Dan Hatton Waldek Hebisch
+Karl Hegbloom Ralf Hemmecke Henderson
+Antoine Hersen Gernot Hueber
+Pietro Iglio
+Alejandro Jakubi Richard Jenks
+Kai Kaminski Grant Keady Tony Kennedy
+Paul Kosinski Klaus Kusche Bernhard Kutzler
+Tim Lahey Larry Lambe Franz Lehner
+Frederic Lehobey Michel Levaud Howard Levy
+Liu Xiaojun Rudiger Loos Michael Lucks
+Richard Luczak
+Camm Maguire Francois Maltey Alasdair McAndrew
+Bob McElrath Michael McGettrick Ian Meikle
+David Mentre Victor S. Miller Gerard Milmeister
+Mohammed Mobarak H. Michael Moeller Michael Monagan
+Marc Moreno-Maza Scott Morrison Joel Moses
+Mark Murray
+William Naylor C. Andrew Neff John Nelder
+Godfrey Nolan Arthur Norman Jinzhong Niu
+Michael O'Connor Summat Oemrawsingh Kostas Oikonomou
+Humberto Ortiz-Zuazaga
+Julian A. Padget Bill Page Susan Pelzel
+Michel Petitot Didier Pinchon Ayal Pinkus
+Jose Alfredo Portes
+Claude Quitte
+Arthur C. Ralfs Norman Ramsey Anatoly Raportirenko
+Michael Richardson Renaud Rioboo Jean Rivlin
+Nicolas Robidoux Simon Robinson Raymond Rogers
+Michael Rothstein Martin Rubey
+Philip Santas Alfred Scheerhorn William Schelter
+Gerhard Schneider Martin Schoenert Marshall Schor
+Frithjof Schulze Fritz Schwarz Nick Simicich
+William Sit Elena Smirnova Jonathan Steinbach
+Fabio Stumbo Christine Sundaresan Robert Sutor
+Moss E. Sweedler Eugene Surowitz
+Max Tegmark James Thatcher Balbir Thomas
+Mike Thomas Dylan Thurston Barry Trager
+Themos T. Tsikas
+Gregory Vanuxem
+Bernhard Wall Stephen Watt Jaap Weel
+Juergen Weiss M. Weller Mark Wegman
+James Wen Thorsten Werther Michael Wester
+John M. Wiley Berhard Will Clifton J. Williamson
+Stephen Wilson Shmuel Winograd Robert Wisbauer
+Sandra Wityak Waldemar Wiwianka Knut Wolf
+Clifford Yapp David Yun
+Vadim Zhytnikov Richard Zippel Evelyn Zoernack
+Bruno Zuercher Dan Zwillinger
+--E 28
+
)spool
)lisp (bye)
diff --git a/src/interp/i-syscmd.boot.pamphlet
b/src/interp/i-syscmd.boot.pamphlet
index 771c0ae..4597564 100644
--- a/src/interp/i-syscmd.boot.pamphlet
+++ b/src/interp/i-syscmd.boot.pamphlet
@@ -270,408 +270,6 @@ getSystemCommandLine() ==
------------ start of commands ------------------------------------------
---% )close
-
-queryClients () ==
- -- Returns the number of active scratchpad clients
- sockSendInt($SessionManager, $QueryClients)
- sockGetInt $SessionManager
-
-
-close args ==
- $saturn =>
- sayErrorly('"Obsolete system command", _
- ['" The )close system command is obsolete in this version of AXIOM.",
- '" Please use Close from the File menu instead."])
- quiet:local:= false
- null $SpadServer =>
- throwKeyedMsg('"S2IZ0071", [])
- numClients := queryClients()
- numClients > 1 =>
- sockSendInt($SessionManager, $CloseClient)
- sockSendInt($SessionManager, $currentFrameNum)
- closeInterpreterFrame(NIL)
- for [opt,:.] in $options repeat
- fullopt := selectOptionLC(opt, '(quiet), 'optionError)
- fullopt = 'quiet =>
- quiet:=true
- quiet =>
- sockSendInt($SessionManager, $CloseClient)
- sockSendInt($SessionManager, $currentFrameNum)
- closeInterpreterFrame(NIL)
- x := UPCASE queryUserKeyedMsg('"S2IZ0072", nil)
- MEMQ(STRING2ID_-N(x,1), '(YES Y)) =>
- BYE()
- nil
-
---% )constructor
-
-constructor args ==
- sayMessage '" Not implemented yet."
- NIL
-
---% )compiler
-
-compiler args ==
- $newConlist: local := nil --reset by compDefineLisplib and astran
- null args and null $options and null _/EDITFILE => helpSpad2Cmd '(compiler)
- if null args then args := [_/EDITFILE]
-
- -- first see if the user has explicitly specified the compiler
- -- to use.
-
- optlist := '(new old translate constructor)
- haveNew := nil
- haveOld := nil
- for opt in $options while ^(haveNew and haveOld) repeat
- [optname,:optargs] := opt
- fullopt := selectOptionLC(optname,optlist,nil)
- fullopt = 'new => haveNew := true
- fullopt = 'translate => haveOld := true
- fullopt = 'constructor => haveOld := true
- fullopt = 'old => haveOld := true
-
- haveNew and haveOld => throwKeyedMsg("S2IZ0081", nil)
-
- af := pathname args
- aft := pathnameType af
--- Whats this for? MCD/PAB 21-9-95
--- if haveNew and (null(aft) or (aft = '"")) then
--- af := pathname [af, '"as"]
--- aft = '"as"
--- if haveOld and (null(aft) or (aft = '"")) then
--- af := pathname [af, '"spad"]
--- aft = '"spad"
-
- haveNew or (aft = '"as") =>
- not (af1 := $FINDFILE (af, '(as))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileAsharpCmd [af1]
- haveOld or (aft = '"spad") =>
- not (af1 := $FINDFILE (af, '(spad))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileSpad2Cmd [af1]
- aft = '"lsp" =>
- not (af1 := $FINDFILE (af, '(lsp))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileAsharpLispCmd [af1]
- aft = '"nrlib" =>
- not (af1 := $FINDFILE (af, '(nrlib))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileSpadLispCmd [af1]
- aft = '"ao" =>
- not (af1 := $FINDFILE (af, '(ao))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileAsharpCmd [af1]
- aft = '"al" => -- archive library of .ao files
- not (af1 := $FINDFILE (af, '(al))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileAsharpArchiveCmd [af1]
-
- -- see if we something with the appropriate file extension
- -- lying around
-
- af1 := $FINDFILE (af, '(as spad ao asy))
-
- af1 and pathnameType(af1) = '"as" => compileAsharpCmd [af1]
- af1 and pathnameType(af1) = '"ao" => compileAsharpCmd [af1]
- af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd [af1]
- af1 and pathnameType(af1) = '"asy" => compileAsharpArchiveCmd [af1]
-
- -- maybe /EDITFILE has some stuff that can help us
- ef := pathname _/EDITFILE
- ef := mergePathnames(af,ef)
-
- ef = af => throwKeyedMsg("S2IZ0039", nil)
- af := ef
-
- pathnameType(af) = '"as" => compileAsharpCmd args
- pathnameType(af) = '"ao" => compileAsharpCmd args
- pathnameType(af) = '"spad" => compileSpad2Cmd args
-
- -- see if we something with the appropriate file extension
- -- lying around
- af1 := $FINDFILE (af, '(as spad ao asy))
-
- af1 and pathnameType(af1) = '"as" => compileAsharpCmd [af1]
- af1 and pathnameType(af1) = '"ao" => compileAsharpCmd [af1]
- af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd [af1]
- af1 and pathnameType(af1) = '"asy" => compileAsharpArchiveCmd [af1]
-
- throwKeyedMsg("S2IZ0039", nil)
-
-compileAsharpCmd args ==
- compileAsharpCmd1 args
- terminateSystemCommand()
- spadPrompt()
-
-compileAsharpCmd1 args ==
- -- Assume we entered from the "compiler" function, so args ^= nil
- -- and is a file with file extension .as or .ao
-
- path := pathname args
- pathType := pathnameType path
- (pathType ^= '"as") and (pathType ^= '"ao") => throwKeyedMsg("S2IZ0083",
nil)
- ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
- SETQ(_/EDITFILE, path)
- updateSourceFiles path
-
- optList := '( _
- new _
- old _
- translate _
- onlyargs _
- moreargs _
- quiet _
- nolispcompile _
- noquiet _
- library _
- nolibrary _
- )
-
- beQuiet := false -- be verbose here
- doLibrary := true -- so a )library after compilation
- doCompileLisp := true -- do compile generated lisp code
-
- moreArgs := NIL
- onlyArgs := NIL
-
- for opt in $options repeat
- [optname,:optargs] := opt
- fullopt := selectOptionLC(optname,optList,nil)
-
- fullopt = 'new => nil
- fullopt = 'old => error "Internal error: compileAsharpCmd got
)old"
- fullopt = 'translate => error "Internal error: compileAsharpCmd got
)translate"
-
- fullopt = 'quiet => beQuiet := true
- fullopt = 'noquiet => beQuiet := false
-
- fullopt = 'nolispcompile => doCompileLisp := false
-
- fullopt = 'moreargs => moreArgs := optargs
- fullopt = 'onlyargs => onlyArgs := optargs
-
- fullopt = 'library => doLibrary := true
- fullopt = 'nolibrary => doLibrary := false
-
- throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
-
- tempArgs :=
- pathType = '"ao" =>
- -- want to strip out -Fao
- (p := STRPOS('"-Fao", $asharpCmdlineFlags, 0, NIL)) =>
- p = 0 => SUBSTRING($asharpCmdlineFlags, 5, NIL)
- STRCONC(SUBSTRING($asharpCmdlineFlags, 0, p), '" ",
- SUBSTRING($asharpCmdlineFlags, p+5, NIL))
- $asharpCmdlineFlags
- $asharpCmdlineFlags
-
- asharpArgs :=
- onlyArgs =>
- s := ""
- for a in onlyArgs repeat
- s := STRCONC(s, '" ", object2String a)
- s
- moreArgs =>
- s := tempArgs
- for a in moreArgs repeat
- s := STRCONC(s, '" ", object2String a)
- s
- tempArgs
-
- if ^beQuiet then sayKeyedMsg("S2IZ0038A",[namestring args, asharpArgs])
-
- command :=
-<<remove TRUENAME>>
- rc := OBEY command
-
- if (rc = 0) and doCompileLisp then
- lsp := fnameMake('".", pathnameName args, '"lsp")
- if fnameReadable?(lsp) then
- if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
- compileFileQuietly(lsp)
- else
- sayKeyedMsg("S2IL0003", [namestring lsp])
-
- if rc = 0 and doLibrary then
- -- do we need to worry about where the compilation output went?
- if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
- withAsharpCmd [ pathnameName path ]
- else if ^beQuiet then
- sayKeyedMsg("S2IZ0084", nil)
-
- extendLocalLibdb $newConlist
-
-compileAsharpArchiveCmd args ==
- -- Assume we entered from the "compiler" function, so args ^= nil
- -- and is a file with file extension .al. We also assume that
- -- the name is fully qualified.
-
- path := pathname args
- ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
- -- here is the plan:
- -- 1. extract the file name and try to make a directory based
- -- on that name.
- -- 2. cd to that directory and ar x the .al file
- -- 3. for each .ao file that shows up, compile it
- -- 4. delete the generated .ao files
-
- -- First try to make the directory in the current directory
-
- dir := fnameMake('".", pathnameName path, '"axldir")
- exists := PROBE_-FILE dir
- isDir := directoryp namestring dir
- exists and isDir ^= 1=>
- throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
-
- if isDir ^= 1 then
- cmd := STRCONC('"mkdir ", namestring dir)
- rc := OBEY cmd
- rc ^= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
-
- curDir := $CURRENT_-DIRECTORY
-
- -- cd to that directory and try to unarchive the .al file
-
- cd [ object2Identifier namestring dir ]
-
- cmd := STRCONC( '"ar x ", namestring path )
- rc := OBEY cmd
- rc ^= 0 =>
- cd [ object2Identifier namestring curDir ]
- throwKeyedMsg("S2IL0028",[namestring dir, namestring args])
-
- -- Look for .ao files
-
- asos := DIRECTORY '"*.ao"
- null asos =>
- cd [ object2Identifier namestring curDir ]
- throwKeyedMsg("S2IL0029",[namestring dir, namestring args])
-
- -- Compile the .ao files
-
- for aso in asos repeat
- compileAsharpCmd1 [ namestring aso ]
-
- -- Reset the current directory
-
- cd [ object2Identifier namestring curDir ]
-
- terminateSystemCommand()
- spadPrompt()
-
-compileAsharpLispCmd args ==
- -- Assume we entered from the "compiler" function, so args ^= nil
- -- and is a file with file extension .lsp
-
- path := pathname args
- ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
- optList := '( _
- quiet _
- noquiet _
- library _
- nolibrary _
- )
-
- beQuiet := false -- be verbose here
- doLibrary := true -- so a )library after compilation
-
- for opt in $options repeat
- [optname,:optargs] := opt
- fullopt := selectOptionLC(optname,optList,nil)
-
- fullopt = 'quiet => beQuiet := true
- fullopt = 'noquiet => beQuiet := false
-
- fullopt = 'library => doLibrary := true
- fullopt = 'nolibrary => doLibrary := false
-
- throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
-
- lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType
path)
- if fnameReadable?(lsp) then
- if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
- compileFileQuietly(lsp)
- else
- sayKeyedMsg("S2IL0003", [namestring lsp])
-
- if doLibrary then
- -- do we need to worry about where the compilation output went?
- if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
- withAsharpCmd [ pathnameName path ]
- else if ^beQuiet then
- sayKeyedMsg("S2IZ0084", nil)
- terminateSystemCommand()
- spadPrompt()
-
-compileSpadLispCmd args ==
- -- Assume we entered from the "compiler" function, so args ^= nil
- -- and is a file with file extension .nrlib
-
- path := pathname fnameMake(first args, '"code", '"lsp")
- ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
- optList := '( _
- quiet _
- noquiet _
- library _
- nolibrary _
- )
-
- beQuiet := false -- be verbose here
- doLibrary := true -- so a )library after compilation
-
- for opt in $options repeat
- [optname,:optargs] := opt
- fullopt := selectOptionLC(optname,optList,nil)
-
- fullopt = 'quiet => beQuiet := true
- fullopt = 'noquiet => beQuiet := false
-
- fullopt = 'library => doLibrary := true
- fullopt = 'nolibrary => doLibrary := false
-
- throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
-
- lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType
path)
- if fnameReadable?(lsp) then
- if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
- --compileFileQuietly(lsp)
- RECOMPILE_-LIB_-FILE_-IF_-NECESSARY lsp
- else
- sayKeyedMsg("S2IL0003", [namestring lsp])
-
- if doLibrary then
- -- do we need to worry about where the compilation output went?
- if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
- LOCALDATABASE([ pathnameName first args ],[])
- else if ^beQuiet then
- sayKeyedMsg("S2IZ0084", nil)
- terminateSystemCommand()
- spadPrompt()
-
-withAsharpCmd args ==
- $options: local := nil
- LOCALDATABASE(args, $options)
-
---% )copyright -- display copyright notice
-
-summary l ==
- OBEY STRCONC ('"cat ",getEnv('"AXIOM"),'"/lib/summary")
-copyright () ==
- OBEY STRCONC ('"cat ",getEnv('"AXIOM"),'"/lib/copyright")
-
---% )credits -- display credit list
-
-credits() ==
- for i in CREDITS repeat
- PRINC(i)
- TERPRI()
-
--% )display
getParserMacroNames() ==
@@ -886,48 +484,6 @@ editSpad2Cmd l ==
updateSourceFiles l
rc
---% )help
-
-help l == helpSpad2Cmd l
-
-helpSpad2Cmd args ==
- -- try to use new stuff first
- if newHelpSpad2Cmd(args) then return nil
-
- sayKeyedMsg("S2IZ0025",[args])
- nil
-
-newHelpSpad2Cmd args ==
- if null args then args := ["?"]
- # args > 1 =>
- sayKeyedMsg("S2IZ0026",NIL)
- true
- sarg := PNAME first args
- if sarg = '"?" then args := ['help]
- else if sarg = '"%" then args := ['history]
- else if sarg = '"%%" then args := ['history]
- arg := selectOptionLC(first args,$SYSCOMMANDS,nil)
- if null arg then arg := first args
- if arg = 'compiler then arg := 'compile
-
- -- see if new help file exists
-
- narg := PNAME arg
- null (helpFile := MAKE_-INPUT_-FILENAME [narg,'HELPSPAD,'_*]) => NIL
-
- $useFullScreenHelp =>
- OBEY STRCONC('"$AXIOM/lib/SPADEDIT ",namestring helpFile)
- true
-
- filestream := MAKE_-INSTREAM(helpFile)
- repeat
- line := read_-line(filestream,false)
- NULL line =>
- SHUT filestream
- return true
- SAY line
- true
-
--% )load
load args == loadSpad2Cmd args
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Axiom-developer] 20090308.03.tpd.patch (bookvol5 move summary, copyright, help roots),
daly <=