diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index ebff068..328b0fb 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -426,6 +426,183 @@ terminal in a standalone fashion, run under the control of a session handler program, run as a web server, or run in a unix pipe. \chapter{The Fundamental Data Structures} +Axiom currently depends on a lot of global variables. These are generally +listed here along with explanations. + +\section{The global variables} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\defdollar{current-directory} + +The \verb|$current-directory| variable is set to the current directory +at startup. This is used by the \verb|)cd| function and some of the +compile routines. This is the result of the \refto{get-current-directory} +function. This variable is used to set \verb|*default-pathname-defaults*|. +The \refto{reroot} function resets it to \verb|$spadroot|. + +An example of a runtime value is: +\begin{verbatim} +$current-directory = "/research/test/" +\end{verbatim} + +<>= +(defvar $current-directory nil) + +@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\defdollar{defaultMsgDatabaseName} + +The \verb|$defaultMsgDatabaseName| variable contains the location of the +international message database. This can be changed to use a translated +version of the messages. It defaults to the United States English version. +The relative pathname used as the default is hardcoded in the +\refto{reroot} function. +This value is prefixed with the \verb|$spadroot| to make the path absolute. + +In general, all Axiom message text should be stored in this file to +enable internationalization of messages. + +An example of a runtime value is: +\begin{verbatim} +|$defaultMsgDatabaseName| = + #p"/research/test/mnt/ubuntu/doc/msgs/s2-us.msgs" +\end{verbatim} + +<>= +(defvar |$defaultMsgDatabaseName| nil) + +@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\defdollar{directory-list} + +The \verb|$directory-list| is a runtime list of absolute pathnames. +This list is generated by the \refto{reroot} function from the list of +relative paths held in the variable +\verb|$relative-directory-list|. Each entry will be prefixed by +\verb|$spadroot|. + +An example of a runtime value is: +\begin{verbatim} +$directory-list = + ("/research/test/mnt/ubuntu/../../src/input/" + "/research/test/mnt/ubuntu/doc/msgs/" + "/research/test/mnt/ubuntu/../../src/algebra/" + "/research/test/mnt/ubuntu/../../src/interp/" + "/research/test/mnt/ubuntu/doc/spadhelp/") +\end{verbatim} + +<>= +(defvar $directory-list nil) + +@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\defdollar{library-directory-list} + +The \verb|$library-directory-list| variable is the system-wide search +path for library files. It is set up in the \refto{reroot} function by +prepending the \verb|$spadroot| variable to the +\verb|$relative-library-directory-list| variable. + +An example of a runtime value is: +\begin{verbatim} +$library-directory-list = ("/research/test/mnt/ubuntu/algebra/") +\end{verbatim} + +<>= +(defvar $library-directory-list nil) + +@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\defdollar{msgDatabaseName} + +The \verb|$msgDatabaseName| is a locally shared variable among the +message database routines. + +An example of a runtime value is: +\begin{verbatim} +|$msgDatabaseName| = nil +\end{verbatim} + +<>= +(defvar |$msgDatabaseName| nil) + +@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\defdollar{relative-directory-list} + +The \verb|$relative-directory-list| variable contains a hand-generated +list of directories used in the Axiom system. The relative directory +list specifies a search path for files for the current directory +structure. It has been changed from the NAG distribution back to the +original form. + +This list is used by the \refto{reroot} function to generate the absolute list +of paths held in the variable \verb|$directory-list|. Each entry will be +prefixed by \verb|$spadroot|. + +An example of a runtime value is: +\begin{verbatim} +$relative-directory-list = + ("/../../src/input/" + "/doc/msgs/" + "/../../src/algebra/" + "/../../src/interp/" + "/doc/spadhelp/") +\end{verbatim} + +<>= +(defvar $relative-directory-list + '("/../../src/input/" + "/doc/msgs/" + "/../../src/algebra/" + "/../../src/interp/" ; for lisp files (helps fd) + "/doc/spadhelp/" )) + +@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\defdollar{relative-library-directory-list} + +The \verb|$relative-library-directory-list| is a hand-generated list of +directories containing algebra. The \refto{reroot} function will prefix every +path in this list with the value of the \verb|$spadroot| variable +to construct the \verb|$library-directory-list| variable. + +An example of a runtime value is: +\begin{verbatim} +$relative-library-directory-list = ("/algebra/") +\end{verbatim} + +<>= +(defvar $relative-library-directory-list '("/algebra/")) + +@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\defdollar{spadroot} + +The \verb|$spadroot| variable is the internal name for the AXIOM shell +variable. It is set in reroot to the value of the argument. The value +is expected to be a directory name. The \refto{initroot} function +uses this variable if the AXIOM shell variable is not set. The +\refto{make-absolute-filename} function uses this path as a prefix to all of +the relative filenames to make them absolute. + +An example of a runtime value is: +\begin{verbatim} +$spadroot = "/research/test/mnt/ubuntu" +\end{verbatim} + +<>= +(defvar $spadroot nil) + +@ + \chapter{Starting Axiom} Axiom starts by invoking a function value of the lisp symbol \verb|*top-level-hook*|. The function invocation path to from this @@ -511,7 +688,6 @@ information is initialized. \calls{restart}{init-memory-config} -\calls{restart}{getenviron} \calls{restart}{initroot} \calls{restart}{openserver} \calls{restart}{makeInitialModemapFrame} @@ -1308,6 +1484,40 @@ before compiling this file. A correct call looks like: (reroot "/spad/mnt/${SYS}") \end{verbatim} where the \verb|${SYS}| variable is the same one set at build time. + +For the example call: +\begin{verbatim} + (REROOT "/research/test/mnt/ubuntu") +\end{verbatim} +the variables are set as: +\begin{verbatim} +$spadroot = "/research/test/mnt/ubuntu" + +$relative-directory-list = + ("/../../src/input/" + "/doc/msgs/" + "/../../src/algebra/" + "/../../src/interp/" + "/doc/spadhelp/") + +$directory-list = + ("/research/test/mnt/ubuntu/../../src/input/" + "/research/test/mnt/ubuntu/doc/msgs/" + "/research/test/mnt/ubuntu/../../src/algebra/" + "/research/test/mnt/ubuntu/../../src/interp/" + "/research/test/mnt/ubuntu/doc/spadhelp/") + +$relative-library-directory-list = ("/algebra/") + +$library-directory-list = ("/research/test/mnt/ubuntu/algebra/") + +|$defaultMsgDatabaseName| = #p"/research/test/mnt/ubuntu/doc/msgs/s2-us.msgs" + +|$msgDatabaseName| = nil + +$current-directory = "/research/test/" +\end{verbatim} + \calls{reroot}{make-absolute-filename} \usesdollar{reroot}{spadroot} \usesdollar{reroot}{directory-list} @@ -2314,6 +2524,7 @@ sameUnionBranch(uArg, m) == @ \defun{phParse}{phParse} +\tpdhere{The pform function has a leading percent sign. fix this} \begin{verbatim} phParse: carrier[tokens,...] -> carrier[ptree, tokens,...] \end{verbatim} @@ -2358,31 +2569,6 @@ phParse: carrier[tokens,...] -> carrier[ptree, tokens,...] @ -\defun{phMacro}{phMacro} -\begin{verbatim} -carrier[ptree,...] -> carrier[ptree, ptreePremacro,...] -\end{verbatim} -\calls{phMacro}{phBegin} -\calls{phMacro}{ncEltQ} -\calls{phMacro}{ncPutQ} -\calls{phMacro}{macroExpanded} -\calls{phMacro}{intSayKeyedMsg} -\calls{phMacro}{pform} -\usesdollar{phMacro}{ncmMacro} -<>= -(defun |phMacro| (carrier) - (let (ptree) - (declare (special |$ncmMacro|)) - (|phBegin| '|Macroing|) - (setq ptree (|ncEltQ| carrier '|ptree|)) - (|ncPutQ| carrier '|ptreePremacro| ptree) - (setq ptree (|macroExpanded| ptree)) - (when |$ncmMacro| (|intSayKeyedMsg| 'S2CTP007 (list (|%pform| ptree)))) - (|ncPutQ| carrier '|ptree| ptree) - 'ok)) - -@ - \defun{phIntReportMsgs}{phIntReportMsgs} \begin{verbatim} carrier[lines,messages,..]-> carrier[lines,messages,..] @@ -3548,6 +3734,9 @@ This is a list of commands that can be in an include file @ \defdollar{pfMacros} +The \$pfMacros variable is an alist [ [id, state, body-pform], ...] +where state is one of: mbody, mparam, mlambda + User-defined macros are maintained in a stack of definitions. This is the stack sequence resulting from the command lines: \begin{verbatim} @@ -3560,9 +3749,8 @@ b ==> 7 (|a| |mbody| ((|integer| (|posn| (0 "a ==> 3" 1 1 "strings") . 6)) . "3")) ) \end{verbatim} -<>= -(eval-when (eval load) - (setq |$pfMacros| nil)) +<>= +(defvar |$pfMacros| nil)) @ @@ -8187,6 +8375,457 @@ This was rewritten by NAG to remove flet. @ +\section{Macro handling} +\defun{phMacro}{phMacro} +\tpdhere{The pform function has a leading percent sign. fix this} +\begin{verbatim} +carrier[ptree,...] -> carrier[ptree, ptreePremacro,...] +\end{verbatim} +\calls{phMacro}{phBegin} +\calls{phMacro}{ncEltQ} +\calls{phMacro}{ncPutQ} +\calls{phMacro}{macroExpanded} +\calls{phMacro}{intSayKeyedMsg} +\calls{phMacro}{pform} +\usesdollar{phMacro}{ncmMacro} +<>= +(defun |phMacro| (carrier) + (let (ptree) + (declare (special |$ncmMacro|)) + (|phBegin| '|Macroing|) + (setq ptree (|ncEltQ| carrier '|ptree|)) + (|ncPutQ| carrier '|ptreePremacro| ptree) + (setq ptree (|macroExpanded| ptree)) + (when |$ncmMacro| (|intSayKeyedMsg| 'S2CTP007 (list (|%pform| ptree)))) + (|ncPutQ| carrier '|ptree| ptree) + 'ok)) + +@ + +\defun{macroExpanded}{macroExpanded} +\$macActive is a list of the bodies being expanded. +\$posActive is a list of the parse forms where the bodies came from. +\calls{macroExpanded}{macExpand} +\usesdollar{macroExpanded}{posActive} +\usesdollar{macroExpanded}{macActive} +<>= +(defun |macroExpanded| (pf) + (let (|$posActive| |$macActive|) + (declare (special |$posActive| |$macActive|)) + (setq |$macActive| nil) + (setq |$posActive| nil) + (|macExpand| pf))) + +@ + +\defun{macExpand}{macExpand} +\calls{macExpand}{pfWhere?} +\calls{macExpand}{macWhere} +\calls{macExpand}{pfLambda?} +\calls{macExpand}{macLambda} +\calls{macExpand}{pfMacro?} +\calls{macExpand}{macMacro} +\calls{macExpand}{pfId?} +\calls{macExpand}{macId} +\calls{macExpand}{pfApplication?} +\calls{macExpand}{macApplication} +\calls{macExpand}{pfMapParts} +\calls{macExpand}{macExpand} +<>= +(defun |macExpand| (pf) + (cond + ((|pfWhere?| pf) (|macWhere| pf)) + ((|pfLambda?| pf) (|macLambda| pf)) + ((|pfMacro?| pf) (|macMacro| pf)) + ((|pfId?| pf) (|macId| pf)) + ((|pfApplication?| pf) (|macApplication| pf)) + (t (|pfMapParts| #'|macExpand| pf)))) + +@ + +\defun{macApplication}{macApplication} +\calls{macApplication}{pfMapParts} +\calls{macApplication}{macExpand} +\calls{macApplication}{pfApplicationOp} +\calls{macApplication}{pfMLambda?} +\calls{macApplication}{pf0ApplicationArgs} +\calls{macApplication}{mac0MLambdaApply} +\usesdollar{macApplication}{pfMacros} +<>= +(defun |macApplication| (pf) + (let (args op) + (declare (special |$pfMacros|)) + (setq pf (|pfMapParts| #'|macExpand| pf)) + (setq op (|pfApplicationOp| pf)) + (cond + ((null (|pfMLambda?| op)) pf) + (t + (setq args (|pf0ApplicationArgs| pf)) + (|mac0MLambdaApply| op args pf |$pfMacros|))))) + +@ + +\defun{mac0MLambdaApply}{mac0MLambdaApply} +\tpdhere{The pform function has a leading percent sign. fix this} +\calls{mac0MLambdaApply}{pf0MLambdaArgs} +\calls{mac0MLambdaApply}{pfMLambdaBody} +\calls{mac0MLambdaApply}{pfSourcePosition} +\calls{mac0MLambdaApply}{ncHardError} +\calls{mac0MLambdaApply}{pfId?} +\calls{mac0MLambdaApply}{pform} +\calls{mac0MLambdaApply}{mac0Define} +\calls{mac0MLambdaApply}{mac0ExpandBody} +\usesdollar{mac0MLambdaApply}{pfMacros} +\usesdollar{mac0MLambdaApply}{posActive} +\usesdollar{mac0MLambdaApply}{macActive} +<>= +(defun |mac0MLambdaApply| (mlambda args opf |$pfMacros|) + (declare (special |$pfMacros|)) + (let (pos body params) + (declare (special |$posActive| |$macActive|)) + (setq params (|pf0MLambdaArgs| mlambda)) + (setq body (|pfMLambdaBody| mlambda)) + (cond + ((not (eql (length args) (length params))) + (setq pos (|pfSourcePosition| opf)) + (|ncHardError| pos 'S2CM0003 (list (length params) (length args)))) + (t + ((lambda (parms p arrgs a) ; for p in params for a in args repeat + (loop + (cond + ((or (atom parms) + (progn (setq p (car parms)) nil) + (atom arrgs) + (progn (setq a (CAR arrgs)) nil)) + (return nil)) + (t + (cond + ((null (|pfId?| p)) + (setq pos (|pfSourcePosition| opf)) + (|ncHardError| pos 'S2CM0004 (list (|%pform| p)))) + (t + (|mac0Define| (|pfIdSymbol| p) '|mparam| a))))) + (setq parms (cdr parms)) + (setq arrgs (cdr arrgs)))) + params nil args nil) + (|mac0ExpandBody| body opf |$macActive| |$posActive|))))) + +@ + +\defun{mac0ExpandBody}{mac0ExpandBody} +\calls{mac0ExpandBody}{pfSourcePosition} +\calls{mac0ExpandBody}{mac0InfiniteExpansion} +\calls{mac0ExpandBody}{macExpand} +\usesdollar{mac0ExpandBody}{posActive} +\usesdollar{mac0ExpandBody}{macActive} +<>= +(defun |mac0ExpandBody| (body opf |$macActive| |$posActive|) + (declare (special |$macActive| |$posActive|)) + (let (posn pf) + (cond + ((memq body |$macActive|) + (setq pf (cadr |$posActive|)) + (setq posn (|pfSourcePosition| pf)) + (|mac0InfiniteExpansion| posn body |$macActive|)) + (t + (setq |$macActive| (cons body |$macActive|)) + (setq |$posActive| (cons opf |$posActive|)) + (|macExpand| body))))) + +@ + +\defun{mac0InfiniteExpansion}{mac0InfiniteExpansion} +\tpdhere{The pform function has a leading percent sign. fix this} +\calls{mac0InfiniteExpansion}{mac0InfiniteExpansion,name} +\calls{mac0InfiniteExpansion}{ncSoftError} +\calls{mac0InfiniteExpansion}{pform} +<>= +(defun |mac0InfiniteExpansion| (posn body active) + (let (rnames fname tmp1 blist result) + (setq blist (cons body active)) + (setq tmp1 (mapcar #'|mac0InfiniteExpansion,name| blist)) + (setq fname (car tmp1)) ;[fname, :rnames] := [name b for b in blist] + (setq rnames (cdr tmp1)) + (|ncSoftError| posn 'S2CM0005 + (list + (dolist (n (reverse rnames) (nreverse result)) + (setq result (append (reverse (list n "==>")) result))) + fname (|%pform| body))) + body)) + +@ + +\defun{mac0InfiniteExpansion,name}{mac0InfiniteExpansion,name} +\calls{mac0InfiniteExpansion,name}{mac0GetName} +\calls{mac0InfiniteExpansion,name}{pname} +<>= +(defun |mac0InfiniteExpansion,name| (b) + (let (st sy got) + (setq got (|mac0GetName| b)) + (cond + ((null got) "???") + (t + (setq sy (car got)) + (setq st (cadr got)) + (if (eq st '|mlambda|) + (concat (pname sy) "(...)") + (pname sy)))))) + +@ + +\defun{mac0GetName}{mac0GetName} +Returns [state, body] or NIL. +Returns [sy, state] or NIL. +\calls{mac0GetName}{pfMLambdaBody} +\usesdollar{mac0GetName}{pfMacros} +<>= +(defun |mac0GetName| (body) + (let (bd tmp1 st tmp2 sy name) + (declare (special |$pfMacros|)) + ; for [sy,st,bd] in $pfMacros while not name repeat + ((lambda (macros tmplist) + (loop + (cond + ((or (atom macros) + (progn (setq tmplist (car macros)) nil) + name) + (return nil)) + (t + (and (consp tmplist) + (progn + (setq sy (car tmplist)) + (setq tmp2 (cdr tmplist)) + (and (consp tmp2) + (progn + (setq st (car tmp2)) + (setq tmp1 (cdr tmp2)) + (and (consp tmp1) + (eq (cdr tmp1) nil) + (progn + (setq bd (car tmp1)) + t))))) + (progn + (when (eq st '|mlambda|) (setq bd (|pfMLambdaBody| bd))) + (when (eq bd body) (setq name (list sy st))))))) + (setq macros (cdr macros)))) + |$pfMacros| nil) + name)) + +@ + +\defun{macId}{macId} +\calls{macId}{pfIdSymbol} +\calls{macId}{mac0Get} +\calls{macId}{pfCopyWithPos} +\calls{macId}{pfSourcePosition} +\calls{macId}{mac0ExpandBody} +\usesdollar{macId}{posActive} +\usesdollar{macId}{macActive} +<>= +(defun |macId| (pf) + (let (body state got sy) + (declare (special |$posActive| |$macActive|)) + (setq sy (|pfIdSymbol| pf)) + (cond + ((null (setq got (|mac0Get| sy))) pf) + (t + (setq state (car got)) + (setq body (cadr got)) + (cond + ((eq state '|mparam|) body) + ((eq state '|mlambda|) (|pfCopyWithPos| body (|pfSourcePosition| pf))) + (t + (|pfCopyWithPos| + (|mac0ExpandBody| body pf |$macActive| |$posActive|) + (|pfSourcePosition| pf)))))))) + +@ + +\defun{mac0Get}{mac0Get} +\calls{mac0Get}{ifcdr} +\usesdollar{mac0Get}{pfMacros} +<>= +(defun |mac0Get| (sy) + (declare (special |$pfMacros|)) + (ifcdr (assoc sy |$pfMacros|))) + +@ + +\defun{macWhere}{macWhere} +\calls{macWhere}{macWhere,mac} +\usesdollar{macWhere}{pfMacros} +<>= +(defun |macWhere| (pf) + (declare (special |$pfMacros|)) + (|macWhere,mac| pf |$pfMacros|)) + +@ + +\defun{macWhere,mac}{macWhere,mac} +\calls{macWhere,mac}{pfMapParts} +\calls{macWhere,mac}{macExpand} +\usesdollar{macWhere,mac}{pfMacros} +<>= +(defun |macWhere,mac| (pf |$pfMacros|) + (declare (special |$pfMacros|)) + (|pfMapParts| #'|macExpand| pf)) + +@ + +\defun{macLambda}{macLambda} +\calls{macLambda}{macLambda,mac} +\usesdollar{macLambda}{pfMacros} +<>= +(defun |macLambda| (pf) + (declare (special |$pfMacros|)) + (|macLambda,mac| pf |$pfMacros|)) + +@ + +\defun{macLambda,mac}{macLambda,mac} +\calls{macLambda,mac}{pfMapParts} +\calls{macLambda,mac}{macExpand} +\usesdollar{macLambda,mac}{pfMacros} +<>= +(defun |macLambda,mac| (pf |$pfMacros|) + (declare (special |$pfMacros|)) + (|pfMapParts| #'|macExpand| pf)) + +@ + +\defun{macMacro}{Add appropriate definition the a Macro pform} +This function adds the appropriate definition and returns +the original Macro pform. +\tpdhere{The pform function has a leading percent sign. fix this} +\calls{macMacro}{pfMacroLhs} +\calls{macMacro}{pfMacroRhs} +\calls{macMacro}{pfId?} +\calls{macMacro}{ncSoftError} +\calls{macMacro}{pfSourcePosition} +\calls{macMacro}{pfIdSymbol} +\calls{macMacro}{mac0Define} +\calls{macMacro}{pform} +\calls{macMacro}{pfMLambda?} +\calls{macMacro}{macSubstituteOuter} +\calls{macMacro}{pfNothing?} +\calls{macMacro}{pfMacro} +\calls{macMacro}{pfNothing} +<>= +(defun |macMacro| (pf) + (let (sy rhs lhs) + (setq lhs (|pfMacroLhs| pf)) + (setq rhs (|pfMacroRhs| pf)) + (cond + ((null (|pfId?| lhs)) + (|ncSoftError| (|pfSourcePosition| lhs) 'S2CM0001 (list (|%pform| lhs))) + pf) + (t + (setq sy (|pfIdSymbol| lhs)) + (|mac0Define| sy + (cond + ((|pfMLambda?| rhs) '|mlambda|) + (t '|mbody|)) + (|macSubstituteOuter| rhs)) + (cond + ((|pfNothing?| rhs) pf) + (t (|pfMacro| lhs (|pfNothing|)))))))) + +@ + +\defun{mac0Define}{Add a macro to the global pfMacros list} +\usesdollar{mac0Define}{pfMacros} +<>= +(defun |mac0Define| (sy state body) + (declare (special |$pfMacros|)) + (setq |$pfMacros| (cons (list sy state body) |$pfMacros|))) + +@ + +\defun{macSubstituteOuter}{macSubstituteOuter} +\calls{macSubstituteOuter}{mac0SubstituteOuter} +\calls{macSubstituteOuter}{macLambdaParameterHandling} +<>= +(defun |macSubstituteOuter| (pform) + (|mac0SubstituteOuter| (|macLambdaParameterHandling| nil pform) pform)) + +@ + +\defun{mac0SubstituteOuter}{mac0SubstituteOuter} +\calls{mac0SubstituteOuter}{pfId?} +\calls{mac0SubstituteOuter}{macSubstituteId} +\calls{mac0SubstituteOuter}{pfLeaf?} +\calls{mac0SubstituteOuter}{pfLambda?} +\calls{mac0SubstituteOuter}{macLambdaParameterHandling} +\calls{mac0SubstituteOuter}{mac0SubstituteOuter} +\calls{mac0SubstituteOuter}{pfParts} +<>= +(defun |mac0SubstituteOuter| (replist pform) + (let (tmplist) + (cond + ((|pfId?| pform) (|macSubstituteId| replist pform)) + ((|pfLeaf?| pform) pform) + ((|pfLambda?| pform) + (setq tmplist (|macLambdaParameterHandling| replist pform)) + (dolist (p (|pfParts| pform)) (|mac0SubstituteOuter| tmplist p)) + pform) + (t + (dolist (p (|pfParts| pform)) (|mac0SubstituteOuter| replist p)) + pform)))) + +@ + +\defun{macLambdaParameterHandling}{macLambdaParameterHandling} +\calls{macLambdaParameterHandling}{pfLeaf?} +\calls{macLambdaParameterHandling}{pfLambda?} +\calls{macLambdaParameterHandling}{pfTypedId} +\calls{macLambdaParameterHandling}{pf0LambdaArgs} +\calls{macLambdaParameterHandling}{pfIdSymbol} +\calls{macLambdaParameterHandling}{AlistRemoveQ} +\calls{macLambdaParameterHandling}{pfMLambda?} +\calls{macLambdaParameterHandling}{pf0MLambdaArgs} +\calls{macLambdaParameterHandling}{pfLeaf} +\calls{macLambdaParameterHandling}{pfAbSynOp} +\calls{macLambdaParameterHandling}{pfLeafPosition} +\calls{macLambdaParameterHandling}{pfParts} +\calls{macLambdaParameterHandling}{macLambdaParameterHandling} +<>= +(defun |macLambdaParameterHandling| (replist pform) + (let (parlist symlist result) + (cond + ((|pfLeaf?| pform) nil) + ((|pfLambda?| pform) ; remove ( identifier . replacement ) from assoclist + (setq parlist (mapcar #'|pfTypedId| (|pf0LambdaArgs| pform))) + (setq symlist (mapcar #'|pfIdSymbol| parlist)) + (dolist (par symlist) (setq replist (|AlistRemoveQ| par replist))) + replist) + ((|pfMLambda?| pform) ;construct assoclist ( identifier . replacement ) + (setq parlist (|pf0MLambdaArgs| pform)) ; extract parameter list + (dolist (par parlist (nreverse result)) + (push + (cons (|pfIdSymbol| par) + (|pfLeaf| (|pfAbSynOp| par) (gensym) (|pfLeafPosition| par))) + result))) + (t + (dolist (p (|pfParts| pform)) + (|macLambdaParameterHandling| replist p)))))) + +@ + +\defun{macSubstituteId}{macSubstituteId} +\calls{macSubstituteId}{AlistAssocQ} +\calls{macSubstituteId}{pfIdSymbol} +<>= +(defun |macSubstituteId| (replist pform) + (let (ex) + (setq ex (|AlistAssocQ| (|pfIdSymbol| pform) replist)) + (cond + (ex + (rplpair pform (cdr ex)) + pform) + (t pform)))) + +@ + \chapter{Pftrees} \section{Abstract Syntax Trees Overview} @@ -8310,6 +8949,59 @@ of the form ('expression expr position) @ +\defun{pfCharPosn}{pfCharPosn} +\calls{pfCharPosn}{poCharPosn} +<>= +(defun |pfCharPosn| (posn) + (|poCharPosn| posn)) + +@ + +\defun{pfLinePosn}{pfLinePosn} +\calls{pfLinePosn}{poLinePosn} +<>= +(defun |pfLinePosn| (posn) + (|poLinePosn| posn)) + +@ + +\defun{pfFileName}{pfFileName} +\calls{pfFileName}{poFileName} +<>= +(defun |pfFileName| (posn) + (|poFileName| posn)) + +@ + +\defun{pfSourcePosition}{pfSourcePosition} +\calls{pfSourcePosition}{pfLeaf?} +\calls{pfSourcePosition}{pfLeafPosition} +\calls{pfSourcePosition}{poNoPosition?} +\calls{pfSourcePosition}{pfSourcePosition} +\calls{pfSourcePosition}{pfParts} +\usesdollar{pfSourcePosition}{nopos} +<>= +(defun |pfSourcePosition| (form) + (let (pos) + (declare (special |$nopos|)) + (cond + ((|pfLeaf?| form) (|pfLeafPosition| form)) + (t + (setq pos |$nopos|) + ((lambda (theparts p) ; for p in parts while poNoPosition? pos repeat + (loop + (cond + ((or (atom theparts) + (progn (setq p (car theparts)) nil) + (not (|poNoPosition?| pos))) + (return nil)) + (t (setq pos (|pfSourcePosition| p)))) + (setq theparts (cdr theparts)))) + (|pfParts| form) nil) + pos)))) + +@ + \defun{pfSequenceToList}{Convert a Sequence node to a list} \calls{pfSequenceToList}{pfSequence?} \calls{pfSequenceToList}{pfSequenceArgs} @@ -8637,6 +9329,14 @@ of the form ('expression expr position) @ +\defun{pfLeafPosition}{Return the token position of a leaf node} +\calls{pfLeafPosition}{tokPosn} +<>= +(defun |pfLeafPosition| (form) + (|tokPosn| form)) + +@ + \defun{pfLeafToken}{Return the Leaf Token} \calls{pfLeafToken}{tokPart} <>= @@ -8735,11 +9435,11 @@ of the form ('expression expr position) (setq args (|pf0TupleParts| a)) (setq args (list a))) (dolist (p (cons (|pfApplicationOp| pform) args) (nreverse result)) - (push (|pfSexpr,strip| |p|) result))) + (push (|pfSexpr,strip| p) result))) (t (cons (|pfAbSynOp| pform) (dolist (p (|pfParts| pform) (nreverse result)) - (push (|pfSexpr,strip| |p|) result))))))) + (push (|pfSexpr,strip| p) result))))))) @ @@ -8860,8 +9560,8 @@ of the form ('expression expr position) \defun{pfAndRight}{Return the Right part of an And node} <>= -(defun |pfAndRight| (|pf|) - (caddr |pf|)) +(defun |pfAndRight| (pf) + (caddr pf)) @ @@ -8977,8 +9677,8 @@ of the form ('expression expr position) \defun{pfBreakFrom}{Return the From part of a Break node} <>= -(defun |pfBreakFrom| (|pf|) - (cadr |pf|)) +(defun |pfBreakFrom| (pf) + (cadr pf)) @ @@ -9372,8 +10072,8 @@ of the form ('expression expr position) \defun{pfIterate?}{Is this an Iterate node?} \calls{pfIterate?}{pfAbSynOp?} <>= -(defun |pfIterate?| (|pf|) - (|pfAbSynOp?| |pf| '|Iterate|)) +(defun |pfIterate?| (pf) + (|pfAbSynOp?| pf '|Iterate|)) @ @@ -9566,6 +10266,20 @@ of the form ('expression expr position) @ +\defun{pfMacroLhs}{Return the Lhs of a Macro node} +<>= +(defun |pfMacroLhs| (pf) + (cadr pf)) + +@ + +\defun{pfMacroRhs}{Return the Rhs of a Macro node} +<>= +(defun |pfMacroRhs| (pf) + (caddr pf)) + +@ + \defun{pfMLambda}{Construct an MLambda node} \calls{pfMLambda}{pfTree} <>= @@ -9582,6 +10296,28 @@ of the form ('expression expr position) @ +\defun{pfMLambdaArgs}{Return the Args of an MLambda} +<>= +(defun |pfMLambdaArgs| (pf) + (cadr pf)) + +@ + +\defun{pf0MLambdaArgs}{Return the parts of an MLambda argument} +\calls{pf0MLambdaArgs}{pfParts} +<>= +(defun |pf0MLambdaArgs| (pf) + (|pfParts| (|pfMLambdaArgs| pf))) + +@ + +\defun{pfMLambdaBody}{pfMLambdaBody} +<>= +(defun |pfMLambdaBody| (pf) + (caddr pf)) + +@ + \defun{pfNot?}{Is this a Not node?} \calls{pfNot?}{pfAbSynOp?} <>= @@ -11254,7 +11990,7 @@ a standard way of printing abbreviated types. and that ``fn'' is to be called on ``args'' to get the text. \end{itemize} -Look in the file with the name defined in \$defaultMsgDatabaseName +Look in the file with the name defined in \verb|$defaultMsgDatabaseName| above for examples. \defdollar{cacheMessages} @@ -15176,7 +15912,7 @@ Thus: \usesdollar{getWorkspaceNames}{InteractiveFrame} <>= (defun |getWorkspaceNames| () - (PROG (|n|) + (PROG (n) (declare (special |$InteractiveFrame|)) (RETURN (SEQ (NMSORT (PROG (G166322) @@ -15191,15 +15927,15 @@ Thus: NIL) (PROGN (PROGN - (setq |n| (CAR G166313)) + (setq n (CAR G166313)) G166313) NIL)) (NREVERSE0 G166322)) (SEQ (EXIT (COND - ((AND (NEQUAL |n| '|--macros--|) - (NEQUAL |n| '|--flags--|)) + ((AND (NEQUAL n '|--macros--|) + (NEQUAL n '|--flags--|)) (SETQ G166322 - (CONS |n| G166322)))))))))))))) + (CONS n G166322)))))))))))))) @ @@ -38757,6 +39493,26 @@ This needs to work off the internal exposure list, not the file. <> <> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> <> <> <> @@ -39082,6 +39838,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -39114,6 +39871,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -39156,8 +39914,10 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> +<> <> <> <> @@ -39173,8 +39933,12 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> +<> <> <> +<> +<> <> <> <> @@ -39225,6 +39989,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -39269,11 +40034,12 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> <> -<> +<> <> <> <> @@ -39699,12 +40465,8 @@ NAME & SET & USE \\ coerceFailure & & runspad \\ curinstream & ncIntLoop & \\ curoutstream & ncIntLoop & \\ -\$current-directory & restart & \\ - & reroot & \\ \$currentLine & restart & removeUndoLines \\ \$dalymode & & intloopReadConsole \\ -\$defaultMsgDatabaseName & reroot & \\ -\$directory-list & reroot & \\ \$displayStartMsgs & & restart \\ \$e & ncTopLevel & \\ \$erMsgToss & SpadInterpretStream & \\ @@ -39744,7 +40506,6 @@ curoutstream & ncIntLoop & \\ & & i-map \\ \$lastPos & SpadInterpretStream & \\ \$libQuiet & SpadInterpretStream & \\ -\$library-directory-list & reroot & \\ \$msgDatabaseName & reroot * \\ \$ncMsgList & SpadInterpretStream & \\ \$newcompErrorCount & SpadInterpretStream & \\ @@ -39763,13 +40524,8 @@ curoutstream & ncIntLoop & \\ & clearFrame & \\ & recordFrame & recordFrame \\ \$PrintCompilerMessageIfTrue & spad & \\ -\$relative-directory-list & & reroot \\ -\$relative-library-directory-list & & reroot \\ \$reportUndo & initvars & diffAlist \\ \$spad & ncTopLevel & \\ -\$spadroot & reroot & initroot \\ - & & make-absolute-filename \\ - & & reroot \\ \$SpadServer & restart & \\ \$SpadServerName & initvars & restart \\ \$systemCommandFunction & SpadInterpretStream & \\ @@ -39787,28 +40543,10 @@ The \verb|$boot| variable is set to NIL in ncTopLevel. The coerceFailure symbol is a catch tag used in runspad to catch an exit from ncTopLevel. -\subsection{\$current-directory} -This is set to the value returned by the \verb|get-current-directory| -function in \fnref{restart}. It is set to the argument of the -\verb|reroot| function. - -So during execute both \verb|$current-directory| and \verb|$spadroot| reflect -the value of the AXIOM shell variable. - \subsection{\$currentLine} The \verb|$currentLine| line is set to NIL in restart. It is used in removeUndoLines in the undo mechanism. -\subsection{\$defaultMsgDatabaseName} -The \verb|$defaultMsgDatabaseName| is the absolute path to the -s2-us.msgs file which contains all of the english language -messages output by the system. - -\subsection{\$directory-list} -The \verb|$directory-list| is a list of absolute directory names. -These names are made absolute by mapping the make-absolute-filename -over the variable \verb|$relative-directory-list|. - \subsection{\$displayStartMsgs} The \verb|$displayStartMsgs| variable is used in restart but is not set so this is likely a bug. @@ -39962,12 +40700,6 @@ with the value of T. This variable appears to be intended to control the printing of library loading messages which would need to be suppressed if input was coming from a file. -\subsection{\$library-directory-list} -The \verb|$library-directory-list| variable is set by reroot by -mapping the function make-absolute-filename across the -\verb|$relative-library-directory-list| variable which is not yet set so this -is probably a bug. - \subsection{\$msgDatabaseName} The \verb|$msgDatabaseName| is set to NIL in reroot. @@ -40027,16 +40759,6 @@ will be used as an open server, probably for OpenMath use. If an open server is not requested then this variable to NIL -\subsection{\$relative-directory-list} -The \verb|$relative-directory-list| is used in reroot to create -\verb|$directory-list| which is a list of absolute directory names. -It is not yet set and is probably a bug. - -\subsection{\$relative-library-directory-list} -The \verb|$relative-library-directory-list| is used in reroot to create -a list of absolute directory names from \verb|$library-directory-list| -(which is It is not yet set and is probably a bug). - \subsection{\$reportUndo} The \verb|$reportUndo| variable is used in diffAlist. It was not normally bound but has been set to T in initvars. If the variable is set @@ -40044,18 +40766,6 @@ to T then we call reportUndo. It is part of the undo mechanism. -\subsection{\$spadroot} -The \verb|$spadroot| variable is the internal name for the AXIOM -shell variable. - -The \verb|$spadroot| variable is set in reroot to the value of the -argument. The argument is expected to be a directory name. - -The \verb|$spadroot| variable is tested in initroot. - -The \verb|$spadroot| variable is used by the function -make-absolute-filename. It concatenates this variable to the -front of a relative pathname to make it absolute. \subsection{\$spad} The \verb|$spad| variable is set to T in ncTopLevel. diff --git a/changelog b/changelog index cd57a0f..947d7f9 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,10 @@ +20100224 tpd src/axiom-website/patches.html 20100224.02.tpd.patch +20100224 tpd src/interp/util.lisp move global variables to bookvol5 +20100224 tpd src/interp/posit.lisp move position functions to bookvol5 +20100224 tpd src/interp/patches.lisp move global variables to bookvol5 +20100224 tpd src/interp/macex.lisp removed +20100224 tpd src/interp/Makefile remove macex +20100224 tpd books/bookvol5 merge and remove macex, begin documentation 20100224 tpd src/axiom-website/patches.html 20100224.01.tpd.patch 20100224 tpd faq FAQ 51: How can I do unicode in xterm? 20100224 tpd zips/utf-8-demo.txt added to demo utf-8 I/O diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index ae88b95..1337023 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2495,5 +2495,7 @@ src/input/pmint.input add comments
books/bookvol5 merge and remove ptrees.lisp
20100224.01.tpd.patch faq FAQ 51: How can I do unicode in xterm?
+20100224.02.tpd.patch +books/bookvol5 merge and remove macex, begin documentation
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 92d7608..1cc7e62 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -161,7 +161,7 @@ OBJS= ${OUT}/vmlisp.${O} \ ${OUT}/i-spec1.${O} \ ${OUT}/i-spec2.${O} \ ${OUT}/i-util.${O} \ - ${OUT}/lisplib.${O} ${OUT}/macex.${O} \ + ${OUT}/lisplib.${O} \ ${OUT}/match.${O} \ ${OUT}/msgdb.${O} ${OUT}/nci.${O} \ ${OUT}/newaux.${O} ${OUT}/newfort.${O} \ @@ -3134,29 +3134,6 @@ ${MID}/topics.lisp: ${IN}/topics.lisp.pamphlet @ -\subsection{macex.lisp} -<>= -${OUT}/macex.${O}: ${MID}/macex.lisp - @ echo 136 making ${OUT}/macex.${O} from ${MID}/macex.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/macex.lisp"' \ - ':output-file "${OUT}/macex.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/macex.lisp"' \ - ':output-file "${OUT}/macex.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${MID}/macex.lisp: ${IN}/macex.lisp.pamphlet - @ echo 137 making ${MID}/macex.lisp from ${IN}/macex.lisp.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/macex.lisp.pamphlet >macex.lisp ) - -@ - \subsection{ptrop.lisp} <>= ${OUT}/ptrop.${O}: ${MID}/ptrop.lisp @@ -3724,9 +3701,6 @@ clean: <> <> -<> -<> - <> <> diff --git a/src/interp/macex.lisp.pamphlet b/src/interp/macex.lisp.pamphlet deleted file mode 100644 index 1d12887..0000000 --- a/src/interp/macex.lisp.pamphlet +++ /dev/null @@ -1,560 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp macex.lisp} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -<<*>>= -(IN-PACKAGE "BOOT") - -;--% Macro expansion -;-- Functions to transform parse forms. -;-- -;-- Global variables: -;-- $pfMacros is an alist [[id, state, body-pform], ...] -;-- (set in newcompInit). -;-- state is one of: mbody, mparam, mlambda -;-- -;-- $macActive is a list of the bodies being expanded. -;-- $posActive is a list of the parse forms where the bodies came from. -; -;-- Beware: the name macroExpand is used by the old compiler. -;macroExpanded pf == -; $macActive: local := [] -; $posActive: local := [] -; -; macExpand pf - -(DEFUN |macroExpanded| (|pf|) - (PROG (|$posActive| |$macActive|) - (DECLARE (SPECIAL |$posActive| |$macActive|)) - (RETURN - (PROGN - (SETQ |$macActive| NIL) - (SETQ |$posActive| NIL) - (|macExpand| |pf|))))) - -;macExpand pf == -; pfWhere? pf => macWhere pf -; pfLambda? pf => macLambda pf -; pfMacro? pf => macMacro pf -; -; pfId? pf => macId pf -; pfApplication? pf => macApplication pf -; pfMapParts(function macExpand, pf) - -(DEFUN |macExpand| (|pf|) - (PROG () - (RETURN - (COND - ((|pfWhere?| |pf|) (|macWhere| |pf|)) - ((|pfLambda?| |pf|) (|macLambda| |pf|)) - ((|pfMacro?| |pf|) (|macMacro| |pf|)) - ((|pfId?| |pf|) (|macId| |pf|)) - ((|pfApplication?| |pf|) (|macApplication| |pf|)) - ('T (|pfMapParts| #'|macExpand| |pf|)))))) - -;macWhere pf == -; mac(pf,$pfMacros) where -; mac(pf,$pfMacros) == -; -- pfWhereContext is before pfWhereExpr -; pfMapParts(function macExpand, pf) - -(DEFUN |macWhere| (|pf|) - (PROG () - (DECLARE (SPECIAL |$pfMacros|)) - (RETURN (|macWhere,mac| |pf| |$pfMacros|)))) - -(DEFUN |macWhere,mac| (|pf| |$pfMacros|) - (DECLARE (SPECIAL |$pfMacros|)) - (PROG () (RETURN (|pfMapParts| #'|macExpand| |pf|)))) - -;macLambda pf == -; mac(pf,$pfMacros) where -; mac(pf,$pfMacros) == -; pfMapParts(function macExpand, pf) - -(DEFUN |macLambda| (|pf|) - (PROG () - (DECLARE (SPECIAL |$pfMacros|)) - (RETURN (|macLambda,mac| |pf| |$pfMacros|)))) - -(DEFUN |macLambda,mac| (|pf| |$pfMacros|) - (DECLARE (SPECIAL |$pfMacros|)) - (PROG () (RETURN (|pfMapParts| #'|macExpand| |pf|)))) - -;macLambdaParameterHandling( replist , pform ) == -; pfLeaf? pform => [] -; pfLambda? pform => -- remove ( identifier . replacement ) from assoclist -; parlist := [ pfTypedId p for p in pf0LambdaArgs pform ] -- extract parameters -; for par in [ pfIdSymbol par for par in parlist ] repeat -; replist := AlistRemoveQ(par,replist) -; replist -; pfMLambda? pform => -- construct assoclist ( identifier . replacement ) -; parlist := pf0MLambdaArgs pform -- extract parameter list -; [[pfIdSymbol par ,:pfLeaf( pfAbSynOp par,GENSYM(),pfLeafPosition par)] for par in parlist ] -; for p in pfParts pform repeat macLambdaParameterHandling( replist , p ) - -(DEFUN |pf0MLambdaArgs| (|pf|) - (PROG () (RETURN (|pfParts| (|pfMLambdaArgs| |pf|))))) - -(DEFUN |pfMLambdaArgs| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -(DEFUN |pfLeafPosition| (|form|) - (PROG () (RETURN (|tokPosn| |form|)))) - -(DEFUN |macLambdaParameterHandling| (|replist| |pform|) - (PROG (|parlist|) - (RETURN - (COND - ((|pfLeaf?| |pform|) NIL) - ((|pfLambda?| |pform|) - (PROGN - (SETQ |parlist| - ((LAMBDA (|bfVar#2| |bfVar#1| |p|) - (LOOP - (COND - ((OR (ATOM |bfVar#1|) - (PROGN (SETQ |p| (CAR |bfVar#1|)) NIL)) - (RETURN (NREVERSE |bfVar#2|))) - ('T - (SETQ |bfVar#2| - (CONS (|pfTypedId| |p|) |bfVar#2|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))) - NIL (|pf0LambdaArgs| |pform|) NIL)) - ((LAMBDA (|bfVar#5| |par|) - (LOOP - (COND - ((OR (ATOM |bfVar#5|) - (PROGN (SETQ |par| (CAR |bfVar#5|)) NIL)) - (RETURN NIL)) - ('T - (SETQ |replist| (|AlistRemoveQ| |par| |replist|)))) - (SETQ |bfVar#5| (CDR |bfVar#5|)))) - ((LAMBDA (|bfVar#4| |bfVar#3| |par|) - (LOOP - (COND - ((OR (ATOM |bfVar#3|) - (PROGN (SETQ |par| (CAR |bfVar#3|)) NIL)) - (RETURN (NREVERSE |bfVar#4|))) - ('T - (SETQ |bfVar#4| - (CONS (|pfIdSymbol| |par|) |bfVar#4|)))) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - NIL |parlist| NIL) - NIL) - |replist|)) - ((|pfMLambda?| |pform|) - (PROGN - (SETQ |parlist| (|pf0MLambdaArgs| |pform|)) - ((LAMBDA (|bfVar#7| |bfVar#6| |par|) - (LOOP - (COND - ((OR (ATOM |bfVar#6|) - (PROGN (SETQ |par| (CAR |bfVar#6|)) NIL)) - (RETURN (NREVERSE |bfVar#7|))) - ('T - (SETQ |bfVar#7| - (CONS (CONS (|pfIdSymbol| |par|) - (|pfLeaf| (|pfAbSynOp| |par|) - (GENSYM) - (|pfLeafPosition| |par|))) - |bfVar#7|)))) - (SETQ |bfVar#6| (CDR |bfVar#6|)))) - NIL |parlist| NIL))) - ('T - ((LAMBDA (|bfVar#8| |p|) - (LOOP - (COND - ((OR (ATOM |bfVar#8|) - (PROGN (SETQ |p| (CAR |bfVar#8|)) NIL)) - (RETURN NIL)) - ('T (|macLambdaParameterHandling| |replist| |p|))) - (SETQ |bfVar#8| (CDR |bfVar#8|)))) - (|pfParts| |pform|) NIL)))))) - -;macSubstituteId( replist , pform ) == -; ex := AlistAssocQ( pfIdSymbol pform , replist ) -; ex => -; RPLPAIR(pform,CDR ex) -; pform -; pform - -(DEFUN |macSubstituteId| (|replist| |pform|) - (PROG (|ex|) - (RETURN - (PROGN - (SETQ |ex| (|AlistAssocQ| (|pfIdSymbol| |pform|) |replist|)) - (COND - (|ex| (PROGN (RPLPAIR |pform| (CDR |ex|)) |pform|)) - ('T |pform|)))))) - -;macSubstituteOuter( pform ) == -; mac0SubstituteOuter( macLambdaParameterHandling( [] , pform ) , pform ) - -(DEFUN |macSubstituteOuter| (|pform|) - (PROG () - (RETURN - (|mac0SubstituteOuter| (|macLambdaParameterHandling| NIL |pform|) - |pform|)))) - -;mac0SubstituteOuter( replist , pform ) == -; pfId? pform => macSubstituteId( replist , pform ) -; pfLeaf? pform => pform -; pfLambda? pform => -; tmplist := macLambdaParameterHandling( replist , pform ) -; for p in pfParts pform repeat mac0SubstituteOuter( tmplist , p ) -; pform -; for p in pfParts pform repeat mac0SubstituteOuter( replist , p ) -; pform - -(DEFUN |mac0SubstituteOuter| (|replist| |pform|) - (PROG (|tmplist|) - (RETURN - (COND - ((|pfId?| |pform|) (|macSubstituteId| |replist| |pform|)) - ((|pfLeaf?| |pform|) |pform|) - ((|pfLambda?| |pform|) - (PROGN - (SETQ |tmplist| - (|macLambdaParameterHandling| |replist| |pform|)) - ((LAMBDA (|bfVar#9| |p|) - (LOOP - (COND - ((OR (ATOM |bfVar#9|) - (PROGN (SETQ |p| (CAR |bfVar#9|)) NIL)) - (RETURN NIL)) - ('T (|mac0SubstituteOuter| |tmplist| |p|))) - (SETQ |bfVar#9| (CDR |bfVar#9|)))) - (|pfParts| |pform|) NIL) - |pform|)) - ('T - (PROGN - ((LAMBDA (|bfVar#10| |p|) - (LOOP - (COND - ((OR (ATOM |bfVar#10|) - (PROGN (SETQ |p| (CAR |bfVar#10|)) NIL)) - (RETURN NIL)) - ('T (|mac0SubstituteOuter| |replist| |p|))) - (SETQ |bfVar#10| (CDR |bfVar#10|)))) - (|pfParts| |pform|) NIL) - |pform|)))))) - -;-- This function adds the appropriate definition and returns -;-- the original Macro pform. -;macMacro pf == -; lhs := pfMacroLhs pf -; rhs := pfMacroRhs pf -; not pfId? lhs => -; ncSoftError (pfSourcePosition lhs, 'S2CM0001, [%pform lhs] ) -; pf -; sy := pfIdSymbol lhs -; -; mac0Define(sy, if pfMLambda? rhs then 'mlambda else 'mbody, macSubstituteOuter rhs) -; -; if pfNothing? rhs then pf else pfMacro(lhs, pfNothing()) - -(DEFUN |pfMacroRhs| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - -(DEFUN |pfMacroLhs| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -(DEFUN |macMacro| (|pf|) - (PROG (|sy| |rhs| |lhs|) - (RETURN - (PROGN - (SETQ |lhs| (|pfMacroLhs| |pf|)) - (SETQ |rhs| (|pfMacroRhs| |pf|)) - (COND - ((NULL (|pfId?| |lhs|)) - (PROGN - (|ncSoftError| (|pfSourcePosition| |lhs|) 'S2CM0001 - (LIST (|%pform| |lhs|))) - |pf|)) - ('T - (PROGN - (SETQ |sy| (|pfIdSymbol| |lhs|)) - (|mac0Define| |sy| - (COND - ((|pfMLambda?| |rhs|) '|mlambda|) - ('T '|mbody|)) - (|macSubstituteOuter| |rhs|)) - (COND - ((|pfNothing?| |rhs|) |pf|) - ('T (|pfMacro| |lhs| (|pfNothing|))))))))))) - -;mac0Define(sy, state, body) == -; $pfMacros := cons([sy, state, body], $pfMacros) - -(DEFUN |mac0Define| (|sy| |state| |body|) - (PROG () - (DECLARE (SPECIAL |$pfMacros|)) - (RETURN - (SETQ |$pfMacros| (CONS (LIST |sy| |state| |body|) |$pfMacros|))))) - -;-- Returns [state, body] or NIL. -;mac0Get sy == -; IFCDR ASSOC(sy, $pfMacros) - -(DEFUN |mac0Get| (|sy|) - (PROG () - (DECLARE (SPECIAL |$pfMacros|)) - (RETURN (IFCDR (ASSOC |sy| |$pfMacros|))))) - -;-- Returns [sy, state] or NIL. -;mac0GetName body == -; name := nil -; for [sy,st,bd] in $pfMacros while not name repeat -; if st = 'mlambda then -; bd := pfMLambdaBody bd -; EQ(bd, body) => name := [sy,st] -; name - -(DEFUN |pfMLambdaBody| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - -(DEFUN |mac0GetName| (|body|) - (PROG (|bd| |ISTMP#2| |st| |ISTMP#1| |sy| |name|) - (DECLARE (SPECIAL |$pfMacros|)) - (RETURN - (PROGN - (SETQ |name| NIL) - ((LAMBDA (|bfVar#12| |bfVar#11|) - (LOOP - (COND - ((OR (ATOM |bfVar#12|) - (PROGN (SETQ |bfVar#11| (CAR |bfVar#12|)) NIL) - |name|) - (RETURN NIL)) - ('T - (AND (CONSP |bfVar#11|) - (PROGN - (SETQ |sy| (CAR |bfVar#11|)) - (SETQ |ISTMP#1| (CDR |bfVar#11|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |st| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) - (PROGN - (SETQ |bd| (CAR |ISTMP#2|)) - 'T))))) - (PROGN - (COND - ((EQ |st| '|mlambda|) - (SETQ |bd| (|pfMLambdaBody| |bd|)))) - (COND - ((EQ |bd| |body|) - (SETQ |name| (LIST |sy| |st|)))))))) - (SETQ |bfVar#12| (CDR |bfVar#12|)))) - |$pfMacros| NIL) - |name|)))) - -;macId pf == -; sy := pfIdSymbol pf -; not (got := mac0Get sy) => pf -; [state, body] := got -; -; state = 'mparam => body -- expanded already -; state = 'mlambda => pfCopyWithPos( body , pfSourcePosition pf ) -- expanded later -; -; pfCopyWithPos( mac0ExpandBody(body, pf, $macActive, $posActive) , pfSourcePosition pf ) - -(DEFUN |macId| (|pf|) - (PROG (|body| |state| |got| |sy|) - (DECLARE (SPECIAL |$posActive| |$macActive|)) - (RETURN - (PROGN - (SETQ |sy| (|pfIdSymbol| |pf|)) - (COND - ((NULL (SETQ |got| (|mac0Get| |sy|))) |pf|) - ('T - (PROGN - (SETQ |state| (CAR |got|)) - (SETQ |body| (CADR |got|)) - (COND - ((EQ |state| '|mparam|) |body|) - ((EQ |state| '|mlambda|) - (|pfCopyWithPos| |body| (|pfSourcePosition| |pf|))) - ('T - (|pfCopyWithPos| - (|mac0ExpandBody| |body| |pf| |$macActive| - |$posActive|) - (|pfSourcePosition| |pf|))))))))))) - -;macApplication pf == -; pf := pfMapParts(function macExpand, pf) -; -; op := pfApplicationOp pf -; not pfMLambda? op => pf -; -; args := pf0ApplicationArgs pf -; mac0MLambdaApply(op, args, pf, $pfMacros) - -(DEFUN |macApplication| (|pf|) - (PROG (|args| |op|) - (DECLARE (SPECIAL |$pfMacros|)) - (RETURN - (PROGN - (SETQ |pf| (|pfMapParts| #'|macExpand| |pf|)) - (SETQ |op| (|pfApplicationOp| |pf|)) - (COND - ((NULL (|pfMLambda?| |op|)) |pf|) - ('T - (PROGN - (SETQ |args| (|pf0ApplicationArgs| |pf|)) - (|mac0MLambdaApply| |op| |args| |pf| |$pfMacros|)))))))) - -;mac0MLambdaApply(mlambda, args, opf, $pfMacros) == -; params := pf0MLambdaArgs mlambda -; body := pfMLambdaBody mlambda -; #args ^= #params => -; pos := pfSourcePosition opf -; ncHardError(pos,'S2CM0003, [#params,#args]) -; for p in params for a in args repeat -; not pfId? p => -; pos := pfSourcePosition opf -; ncHardError(pos, 'S2CM0004, [%pform p]) -; mac0Define(pfIdSymbol p, 'mparam, a) -; -; mac0ExpandBody( body , opf, $macActive, $posActive) - -(DEFUN |mac0MLambdaApply| (|mlambda| |args| |opf| |$pfMacros|) - (DECLARE (SPECIAL |$pfMacros|)) - (PROG (|pos| |body| |params|) - (DECLARE (SPECIAL |$posActive| |$macActive|)) - (RETURN - (PROGN - (SETQ |params| (|pf0MLambdaArgs| |mlambda|)) - (SETQ |body| (|pfMLambdaBody| |mlambda|)) - (COND - ((NOT (EQL (LENGTH |args|) (LENGTH |params|))) - (PROGN - (SETQ |pos| (|pfSourcePosition| |opf|)) - (|ncHardError| |pos| 'S2CM0003 - (LIST (LENGTH |params|) (LENGTH |args|))))) - ('T - (PROGN - ((LAMBDA (|bfVar#13| |p| |bfVar#14| |a|) - (LOOP - (COND - ((OR (ATOM |bfVar#13|) - (PROGN (SETQ |p| (CAR |bfVar#13|)) NIL) - (ATOM |bfVar#14|) - (PROGN (SETQ |a| (CAR |bfVar#14|)) NIL)) - (RETURN NIL)) - ('T - (COND - ((NULL (|pfId?| |p|)) - (PROGN - (SETQ |pos| (|pfSourcePosition| |opf|)) - (|ncHardError| |pos| 'S2CM0004 - (LIST (|%pform| |p|))))) - ('T - (|mac0Define| (|pfIdSymbol| |p|) '|mparam| |a|))))) - (SETQ |bfVar#13| (CDR |bfVar#13|)) - (SETQ |bfVar#14| (CDR |bfVar#14|)))) - |params| NIL |args| NIL) - (|mac0ExpandBody| |body| |opf| |$macActive| |$posActive|)))))))) - -;mac0ExpandBody(body, opf, $macActive, $posActive) == -; MEMQ(body,$macActive) => -; [.,pf] := $posActive -; posn := pfSourcePosition pf -; mac0InfiniteExpansion(posn, body, $macActive) -; $macActive := [body, :$macActive] -; $posActive := [opf, :$posActive] -; macExpand body - -(DEFUN |mac0ExpandBody| (|body| |opf| |$macActive| |$posActive|) - (DECLARE (SPECIAL |$macActive| |$posActive|)) - (PROG (|posn| |pf|) - (DECLARE (SPECIAL |$posActive| |$macActive|)) - (RETURN - (COND - ((MEMQ |body| |$macActive|) - (PROGN - (SETQ |pf| (CADR |$posActive|)) - (SETQ |posn| (|pfSourcePosition| |pf|)) - (|mac0InfiniteExpansion| |posn| |body| |$macActive|))) - ('T - (PROGN - (SETQ |$macActive| (CONS |body| |$macActive|)) - (SETQ |$posActive| (CONS |opf| |$posActive|)) - (|macExpand| |body|))))))) - -;mac0InfiniteExpansion(posn, body, active) == -; blist := [body, :active] -; [fname, :rnames] := [name b for b in blist] where -; name b == -; got := mac0GetName b -; not got => '"???" -; [sy,st] := got -; st = 'mlambda => CONCAT(PNAME sy, '"(...)") -; PNAME sy -; ncSoftError (posn, 'S2CM0005, _ -; [ [:[n,'"==>"] for n in reverse rnames], fname, %pform body ] ) -; -; body -(DEFUN |mac0InfiniteExpansion| (|posn| |body| |active|) - (PROG (|rnames| |fname| |LETTMP#1| |blist|) - (RETURN - (PROGN - (SETQ |blist| (CONS |body| |active|)) - (SETQ |LETTMP#1| - ((LAMBDA (|bfVar#16| |bfVar#15| |b|) - (LOOP - (COND - ((OR (ATOM |bfVar#15|) - (PROGN (SETQ |b| (CAR |bfVar#15|)) NIL)) - (RETURN (NREVERSE |bfVar#16|))) - ('T - (SETQ |bfVar#16| - (CONS (|mac0InfiniteExpansion,name| |b|) - |bfVar#16|)))) - (SETQ |bfVar#15| (CDR |bfVar#15|)))) - NIL |blist| NIL)) - (SETQ |fname| (CAR |LETTMP#1|)) - (SETQ |rnames| (CDR |LETTMP#1|)) - (|ncSoftError| |posn| 'S2CM0005 - (LIST ((LAMBDA (|bfVar#18| |bfVar#17| |n|) - (LOOP - (COND - ((OR (ATOM |bfVar#17|) - (PROGN (SETQ |n| (CAR |bfVar#17|)) NIL)) - (RETURN (NREVERSE |bfVar#18|))) - ('T - (SETQ |bfVar#18| - (APPEND (REVERSE (LIST |n| "==>")) - |bfVar#18|)))) - (SETQ |bfVar#17| (CDR |bfVar#17|)))) - NIL (REVERSE |rnames|) NIL) - |fname| (|%pform| |body|))) - |body|)))) - -(DEFUN |mac0InfiniteExpansion,name| (|b|) - (PROG (|st| |sy| |got|) - (RETURN - (PROGN - (SETQ |got| (|mac0GetName| |b|)) - (COND - ((NULL |got|) "???") - ('T - (PROGN - (SETQ |sy| (CAR |got|)) - (SETQ |st| (CADR |got|)) - (COND - ((EQ |st| '|mlambda|) (CONCAT (PNAME |sy|) "(...)")) - ('T (PNAME |sy|)))))))))) - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet index 12fe959..1ee8443 100644 --- a/src/interp/patches.lisp.pamphlet +++ b/src/interp/patches.lisp.pamphlet @@ -300,14 +300,6 @@ It used to read: (setq returncode 0)) (unless (zerop returncode) (bye returncode))))) -#+:dos -(setq vmlisp::$current-directory (truename ".")) -#+:dos -(setq vmlisp::$spadroot "/spad/mnt/dos") -#+:dos -(defun user-homedir-pathname () - (truename ".")) - (defun boot::|printCopyright| () (format t "there is no such thing as a simple job -- ((iHy))~%")) diff --git a/src/interp/posit.lisp.pamphlet b/src/interp/posit.lisp.pamphlet index e39d839..b9e7444 100644 --- a/src/interp/posit.lisp.pamphlet +++ b/src/interp/posit.lisp.pamphlet @@ -38,12 +38,6 @@ (AND (CONSP |pos|) (CONSP (CAR |pos|)) (EQL (LENGTH (CAR |pos|)) 5))))) -;lnSetGlobalNum(lineObject, num) == -; lineObject.2 := num - -(DEFUN |lnSetGlobalNum| (|lineObject| |num|) - (PROG () (RETURN (SETF (ELT |lineObject| 2) |num|)))) - ;pfGetLineObject posn == poGetLineObject posn (DEFUN |pfGetLineObject| (|posn|) @@ -68,37 +62,6 @@ (DEFUN |pfPosn| (|pf|) (PROG () (RETURN (|pfSourcePosition| |pf|)))) -;pfSourcePosition form == -; --null form => pfNoPosition() -; pfLeaf? form => pfLeafPosition form -; parts := pfParts form -; pos := $nopos -; for p in parts while poNoPosition? pos repeat -; pos := pfSourcePosition p -; pos - -(DEFUN |pfSourcePosition| (|form|) - (PROG (|pos| |parts|) - (DECLARE (SPECIAL |$nopos|)) - (RETURN - (COND - ((|pfLeaf?| |form|) (|pfLeafPosition| |form|)) - ('T - (PROGN - (SETQ |parts| (|pfParts| |form|)) - (SETQ |pos| |$nopos|) - ((LAMBDA (|bfVar#1| |p|) - (LOOP - (COND - ((OR (ATOM |bfVar#1|) - (PROGN (SETQ |p| (CAR |bfVar#1|)) NIL) - (NOT (|poNoPosition?| |pos|))) - (RETURN NIL)) - ('T (SETQ |pos| (|pfSourcePosition| |p|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))) - |parts| NIL) - |pos|)))))) - ;pfSourcePositions form == ; if pfLeaf? form ; then @@ -130,18 +93,6 @@ (APPEND (|pfSourcePositions| (CAR |x|)) (|pfSourcePositionlist| (CDR |x|)))))))) -;pfCharPosn posn == poCharPosn posn - -(DEFUN |pfCharPosn| (|posn|) (PROG () (RETURN (|poCharPosn| |posn|)))) - -;pfLinePosn posn == poLinePosn posn - -(DEFUN |pfLinePosn| (|posn|) (PROG () (RETURN (|poLinePosn| |posn|)))) - -;pfFileName posn == poFileName posn - -(DEFUN |pfFileName| (|posn|) (PROG () (RETURN (|poFileName| |posn|)))) - ;poFileName? posn == ; posn = ['noposition] => NIL ; posn => lnFileName? poGetLineObject posn diff --git a/src/interp/util.lisp.pamphlet b/src/interp/util.lisp.pamphlet index 3bf4379..107a3e2 100644 --- a/src/interp/util.lisp.pamphlet +++ b/src/interp/util.lisp.pamphlet @@ -336,40 +336,7 @@ on the system we are using. #+:ccl "not done this way at all") @ -\subsubsection{directory-list} -This is the system-wide list of directories to search. -It is set up in the {\bf reroot} function. -<>= -(defvar $directory-list ()) -@ -\subsubsection{relative-directory-list} -The relative directory list specifies a search path for files -for the current directory structure. It has been changed from the -NAG distribution back to the original form. -<>= -(defvar $relative-directory-list - '("/../../src/input/" - "/doc/msgs/" - "/../../src/algebra/" - "/../../src/interp/" ; for boot and lisp files (helps fd) - "/doc/spadhelp/" )) - -@ -\subsubsection{library-directory-list} -This is the system-wide search path for library files. -It is set up in the {\bf reroot} function. -<>= -(defvar $library-directory-list ()) - -@ -\subsubsection{relative-library-directory-list} -The relative directory list specifies how to find the algebra -directory from the current {\bf AXIOM} shell variable. -<>= -(defvar $relative-library-directory-list '("/algebra/")) - -@ \subsection{The autoload list} There are several subsystems within {\bf AXIOM} that are not normally loaded into a running system. They will be loaded only if you invoke @@ -1496,10 +1463,6 @@ function assumes that \\ can only appear as first character of name. <> <> <> -<> -<> -<> -<> <> <> @@ -1533,7 +1496,6 @@ function assumes that \\ can only appear as first character of name. #+:ieee-floating-point (setq $ieee t) #-:ieee-floating-point (setq $ieee nil) (setq |$opSysName| '"shell") -#+:CCL (defun machine-type () "unknown") (setq |$machineType| (machine-type)) ; spad-clear-input patches around fact that akcl clear-input leaves newlines chars (defun spad-clear-input (st) (clear-input st) (if (listen st) (read-char st)))