diff --git a/books/axiom.sty b/books/axiom.sty index 8fc17b4..1db076d 100644 --- a/books/axiom.sty +++ b/books/axiom.sty @@ -194,6 +194,18 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% +%% defun marks a function definition and adds it to the index +%% + +\newcommand{\Defun}[2]{% e.g. \defun{functionname}{why} +\subsection{#2}% +\label{#1}% +\index{#1}% +\index{defun!#1}% +\index{#1!defun}} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% defplist marks a use of the symbol-plist %% @@ -348,7 +360,7 @@ %% Combine {\bf foo}(\ref{foo}) into a single command since it used a lot \newcommand{\bfref}[1]{% e.g. \bfref{thisfunc} -\mbox{{\bf #1}(\ref{#1})}} +\mbox{{\bf #1}(p\pageref{#1})}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 8070e57..85bc267 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -10,30227 +10,1358 @@ 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} - -\subsection{Credits} -Axiom has a very long history and many people have contributed to the -effort, some in large ways and some in small ways. Any and all effort -deserves recognition. There is no other criteria than contribution -of effort. We would like to acknowledge and thank the following people: -\defvar{creditlist} -\begin{chunk}{initvars} -(defvar creditlist '( -"An alphabetical listing of contributors to AXIOM:" -"Michael Albaugh Cyril Alberga Roy Adler" -"Christian Aistleitner Richard Anderson George Andrews" -"S.J. Atkins Henry Baker Martin Baker" -"Stephen Balzac Yurij Baransky David R. Barton" -"Thomas Baruchel Gerald Baumgartner Gilbert Baumslag" -"Michael Becker Nelson H. F. Beebe Jay Belanger" -"David Bindel Fred Blair Vladimir Bondarenko" -"Mark Botch Raoul Bourquin Alexandre Bouyer" -"Karen Braman Peter A. Broadbery Martin Brock" -"Manuel Bronstein Stephen Buchwald Florian Bundschuh" -"Luanne Burns William Burge Ralph Byers" -"Quentin Carpent Robert Caviness Bruce Char" -"Ondrej Certik Tzu-Yi Chen Cheekai Chin" -"David V. Chudnovsky Gregory V. Chudnovsky Mark Clements" -"James Cloos Jia Zhao Cong Josh Cohen" -"Christophe Conil Don Coppersmith George Corliss" -"Robert Corless Gary Cornell Meino Cramer" -"Jeremy Du Croz David Cyganski Nathaniel Daly" -"Timothy Daly Sr. Timothy Daly Jr. James H. Davenport" -"David Day James Demmel Didier Deshommes" -"Michael Dewar Jack Dongarra Jean Della Dora" -"Gabriel Dos Reis Claire DiCrescendo Sam Dooley" -"Lionel Ducos Iain Duff Lee Duhem" -"Martin Dunstan Brian Dupee Dominique Duval" -"Robert Edwards Heow Eide-Goodman Lars Erickson" -"Richard Fateman Bertfried Fauser Stuart Feldman" -"John Fletcher Brian Ford Albrecht Fortenbacher" -"George Frances Constantine Frangos Timothy Freeman" -"Korrinn Fu Marc Gaetano Rudiger Gebauer" -"Van de Geijn Kathy Gerber Patricia Gianni" -"Gustavo Goertkin 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" -"Ming Gu Jocelyn Guidry Gaetan Hache" -"Steve Hague Satoshi Hamaguchi Sven Hammarling" -"Mike Hansen Richard Hanson Richard Harke" -"Bill Hart Vilya Harvey Martin Hassner" -"Arthur S. Hathaway Dan Hatton Waldek Hebisch" -"Karl Hegbloom Ralf Hemmecke Henderson" -"Antoine Hersen Roger House Gernot Hueber" -"Pietro Iglio Alejandro Jakubi Richard Jenks" -"William Kahan Kyriakos Kalorkoti Kai Kaminski" -"Grant Keady Wilfrid Kendall Tony Kennedy" -"Ted Kosan Paul Kosinski Klaus Kusche" -"Bernhard Kutzler Tim Lahey Larry Lambe" -"Kaj Laurson George L. Legendre Franz Lehner" -"Frederic Lehobey Michel Levaud Howard Levy" -"Ren-Cang Li Rudiger Loos Michael Lucks" -"Richard Luczak Camm Maguire Francois Maltey" -"Alasdair McAndrew Bob McElrath Michael McGettrick" -"Edi Meier 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 Patrice Naudin 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 David Parnas Susan Pelzel" -"Michel Petitot Didier Pinchon Ayal Pinkus" -"Frederick H. Pitts Jose Alfredo Portes Gregorio Quintana-Orti" -"Claude Quitte Arthur C. Ralfs Norman Ramsey" -"Anatoly Raportirenko Albert D. Rich Michael Richardson" -"Guilherme Reis Huan Ren 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 Steven Segletes" -"V. Sima Nick Simicich William Sit" -"Elena Smirnova Jonathan Steinbach Fabio Stumbo" -"Christine Sundaresan Robert Sutor Moss E. Sweedler" -"Eugene Surowitz Max Tegmark T. Doug Telford" -"James Thatcher Balbir Thomas Mike Thomas" -"Dylan Thurston Steve Toleque 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 R. Clint Whaley" -"James T. Wheeler John M. Wiley Berhard Will" -"Clifton J. Williamson Stephen Wilson Shmuel Winograd" -"Robert Wisbauer Sandra Wityak Waldemar Wiwianka" -"Knut Wolf Yanyang Xiao Liu Xiaojun" -"Clifford Yapp David Yun Vadim Zhytnikov" -"Richard Zippel Evelyn Zoernack Bruno Zuercher" -"Dan Zwillinger" +\section{Frames and the Interpreter Frame Ring} +\label{TheFrameMechanism} -)) +Axiom has the notion of ``frames''. A frame is a data structure which +holds all the vital data from an Axiom session. -\end{chunk} +The list of frames is structured as a ring. +New frames can be added which will hold computations of independent +information. The interpreter {\bf )frame} command allows operations +on frames. From the command line the user can create, modify, change, +and delete frames. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -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|. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{frame} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{frame.help} +==================================================================== +A.11. )frame +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )frame new frameName + - )frame drop [frameName] + - )frame next + - )frame last + - )frame names + - )frame import frameName [objectName1 [objectName2 ...] ] + - )set message frame on | off + - )set message prompt frame + +Command Description: + +A frame can be thought of as a logical session within the physical session +that you get when you start the system. You can have as many frames as you +want, within the limits of your computer's storage, paging space, and so on. +Each frame has its own step number, environment and history. You can have a +variable named a in one frame and it will have nothing to do with anything +that might be called a in any other frame. + +Some frames are created by the HyperDoc program and these can have pretty +strange names, since they are generated automatically. To find out the names +of all frames, issue + +)frame names + +It will indicate the name of the current frame. + +You create a new frame ``quark'' by issuing + +)frame new quark + +The history facility can be turned on by issuing either )set history on or +)history )on. If the history facility is on and you are saving history +information in a file rather than in the AXIOM environment then a history +file with filename quark.axh will be created as you enter commands. If you +wish to go back to what you were doing in the ``initial'' frame, use + +)frame next + +or + +)frame last + +to cycle through the ring of available frames to get back to ``initial''. + +If you want to throw away a frame (say ``quark''), issue + +)frame drop quark + +If you omit the name, the current frame is dropped. + +If you do use frames with the history facility on and writing to a file, you +may want to delete some of the older history files. These are directories, so +you may want to issue a command like rm -r quark.axh to the operating system. + +You can bring things from another frame by using )frame import. For example, +to bring the f and g from the frame ``quark'' to the current frame, issue + +)frame import quark f g + +If you want everything from the frame ``quark'', issue + +)frame import quark + +You will be asked to verify that you really want everything. + +There are two )set flags to make it easier to tell where you are. + +)set message frame on | off + +will print more messages about frames when it is set on. By default, it is +off. + +)set message prompt frame + +will give a prompt that looks like + +initial (1) -> + +when you start up. In this case, the frame name and step make up the prompt. + +Also See: +o )history +o )set + +\end{chunk} +\footnote{ +\fnref{history} +\fnref{set}} -An example of a runtime value is: -\begin{verbatim} -$current-directory = "/research/test/" -\end{verbatim} +The frame mechanism uses several dollar variables. -\defdollar{current-directory} -\begin{chunk}{initvars} -(defvar $current-directory nil) +Primary variables are those which exist solely to make the frame +mechanism work. -\end{chunk} +The \$interpreterFrameName contains a symbol which is the name +of the current frame in use. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -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. +The \$interpreterFrameRing contains a list of all of the existing +frames. The first frame on the list is the ``current'' frame. When +Axiom is started directly there is only one frame named ``initial''. -In general, all Axiom message text should be stored in this file to -enable internationalization of messages. +If the system is started under sman (using the axiom shell script, +for example), there are two frames, ``initial'' and ``frame0''. In +this case, ``frame0'' is the current frame. This can cause subtle +problems because functions defined in the axiom initialization file +(.axiom.input) will be defined in frame ``initial'' but the current +frame will be ``frame0''. They will appear to be undefined. However, +if the user does ``)frame next'' they can switch to the ``initial'' +frame and see the functions correctly defined. -An example of a runtime value is: +The \$frameMessages variable controls when frame messages will be +displayed. The variable is initially NIL. It can be set on (T) or off (NIL) +using the system command: \begin{verbatim} -|$defaultMsgDatabaseName| = - #p"/research/test/mnt/ubuntu/doc/msgs/s2-us.msgs" + )set message frame on | off \end{verbatim} +Setting frame messages on will output a line detailing the +current frame after every output is complete. -\defdollar{defaultMsgDatabaseName} -\begin{chunk}{initvars} -(defvar |$defaultMsgDatabaseName| nil) - -\end{chunk} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -The \verb|$directory-list| is a runtime list of absolute pathnames. -This list is generated by \refto{reroot} from the list of -relative paths held in the variable -\verb|$relative-directory-list|. Each entry will be prefixed by -\verb|$spadroot|. +See the {\bf set message frame}\refto{setmessageframe} section +for more details. -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} +The frame collects and uses a few top level variables. These are: +\$InteractiveFrame, \$IOindex, \$HiFiAccess, \$HistList, \$HistListLen, +\$HistListAct, \$HistRecord, \$internalHistoryTable, and \$localExposureData. -\defdollar{directory-list} -\begin{chunk}{initvars} -(defvar $directory-list nil) +These variables can also be changed by the frame mechanism when the user +requests changing to a different frame. -\end{chunk} +\section{Data Structures} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -The \verb|$InitialModemapFrame| is used as the initial value. +The interpreter information is kept in a frame which is a 10 part data +structure of the form (see \ref{emptyInterpreterFrame}). +The parts of a frame and their initial, default values are: +\begin{enumerate} +\item {\bf \$interpreterFrameName}\refto{interpreterFrameName}, +a string, is the name of the current frame. +\item {\bf \$InteractiveFrame}\refto{InteractiveFrame} +which defaults to ((nil)) +\item {\bf \$IOindex}\refto{IOindex} +also known as the step number, which defaults to 1 +\item {\bf \$HiFiAccess}\refto{HiFiAccess} +\item {\bf \$HistList}\refto{HistList} +\item {\bf \$HistListLen}\refto{HistListLen} +\item {\bf \$HistListAct}\refto{HistListAct} +\item {\bf \$HistRecord}\refto{HistRecord} +\item {\bf \$internalHistoryTable}\refto{internalHistoryTable} +which defaults to nil +\item {\bfref{localExposureDataDefault}} is a copy of the current +local exposure data +\end{enumerate} -See the function \fnref{makeInitialModemapFrame}. +There are a set of functions to manipulate frames. +The internal set of frame functions are +\begin{itemize} +\item {\bfref{initializeInterpreterFrameRing}} creates the original +frame ring, inserts an initial frame, and updates all the global +variables from the initial frame. +\item {\bfref{emptyInterpreterFrame}} creates a new, empty frame. +\item {\bfref{createCurrentInterpreterFrame}} collects the environment +into a frame. +\item {\bfref{updateFromCurrentInterpreterFrame}} sets all of the +global variables from the current frame. +\item {\bfref{frameEnvironment}} returns the frameInteractive +component of a named frame or a new, empty environment. +\item {\bfref{findFrameInRing}} given the name, find the named frame +\item {\bfref{updateCurrentInterpreterFrame}} collects the normal +contents of the world into a frame object, places it first on the frame +list, and then sets the current values of the world from the frame object. +\item {\bfref{nextInterpreterFrame}} updates the current frame to make +sure all of the current information is recorded. If there are more frame +elements in the list then this will destructively move the current frame +to the end of the list, that is, assume the frame list reads (1 2 3) +this function will destructively change it to (2 3 1). +\item {\bfref{previousInterpreterFrame}} moves to the previous +frame in the ring. +\item {\bfref{changeToNamedInterpreterFrame}} change to the named +frame. +\item {\bfref{addNewInterpreterFrame}} update the current frame, +initialize the history, make a new empty frame, and initialize all of the +global variables from the empty frame. +\item {\bfref{closeInterpreterFrame}} when there is more than one +frame, delete the current frame and initialize all the global variables +from the next frame in the ring. +\item {\bfref{displayFrameNames}} print all the frame names and +indicate which one is the current frame. +\item {\bfref{importFromFrame}} imports items from a different +frame into the current frame +\end{itemize} -An example of a runtime value is: -\begin{verbatim} -$InitialModemapFrame = '((nil)) -\end{verbatim} +\section{Frame Access Macros} -\defdollar{InitialModemapFrame} -\begin{chunk}{initvars} -(defvar |$InitialModemapFrame| '((nil))) +First Frame Component -- frameName +\defmacro{frameName} +\begin{chunk}{defmacro frameName 0} +(defmacro frameName (frame) + `(first ,frame)) \end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -The \verb|$library-directory-list| variable is the system-wide search -path for library files. \refto{reroot} -prepends the \verb|$spadroot| variable to the -\verb|$relative-library-directory-list| variable. +Second Frame Component -- frameInteractive +\defmacro{frameInteractive} +\begin{chunk}{defmacro frameInteractive 0} +(defmacro frameInteractive (frame) + `(second ,frame)) -An example of a runtime value is: -\begin{verbatim} -$library-directory-list = ("/research/test/mnt/ubuntu/algebra/") -\end{verbatim} +\end{chunk} -\defdollar{library-directory-list} -\begin{chunk}{initvars} -(defvar $library-directory-list '("/algebra/")) +Third Frame Component -- frameIOIndex +\defmacro{frameIOIndex} +\begin{chunk}{defmacro frameIOIndex 0} +(defmacro frameIOIndex (frame) + `(third ,frame)) \end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -The \verb|$msgDatabaseName| is a locally shared variable among the -message database routines. +Fourth Frame Component -- frameHiFiAccess +\defmacro{frameHiFiAccess} +\begin{chunk}{defmacro frameHiFiAccess 0} +(defmacro frameHiFiAccess (frame) + `(fourth ,frame)) -An example of a runtime value is: -\begin{verbatim} -|$msgDatabaseName| = nil -\end{verbatim} +\end{chunk} -\defdollar{msgDatabaseName} -\begin{chunk}{initvars} -(defvar |$msgDatabaseName| nil) +Fifth Frame Component -- frameHistList +\defmacro{frameHistList} +\begin{chunk}{defmacro frameHistList 0} +(defmacro frameHistList (frame) + `(fifth ,frame)) \end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -The \verb|$openServerIfTrue| It appears to control whether the interpreter -will be used as an open server, probably for OpenMath use. +Sixth Frame Component -- frameHistListLen +\defmacro{frameHistListLen} +\begin{chunk}{defmacro frameHistListLen 0} +(defmacro frameHistListLen (frame) + `(sixth ,frame)) -If an open server is not requested then this variable to NIL +\end{chunk} -See the function \fnref{openserver}. +Seventh Frame Component -- frameHistListAct +\defmacro{frameHistListAct} +\begin{chunk}{defmacro frameHistListAct 0} +(defmacro frameHistListAct (frame) + `(seventh ,frame)) -An example of a runtime value is: -\begin{verbatim} -$openServerIfTrue = nil -\end{verbatim} +\end{chunk} -\defdollar{openServerIfTrue} -\begin{chunk}{initvars} -(defvar $openServerIfTrue nil) +Eighth Frame Component -- frameHistRecord +\defmacro{frameHistRecord} +\begin{chunk}{defmacro frameHistRecord 0} +(defmacro frameHistRecord (frame) + `(eighth ,frame)) \end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -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|. +Ninth Frame Component -- frameHistoryTable +\defmacro{frameHistoryTable} +\begin{chunk}{defmacro frameHistoryTable 0} +(defmacro frameHistoryTable (frame) + `(ninth ,frame)) -An example of a runtime value is: -\begin{verbatim} -$relative-directory-list = - ("/../../src/input/" - "/doc/msgs/" - "/../../src/algebra/" - "/../../src/interp/" - "/doc/spadhelp/") -\end{verbatim} +\end{chunk} -\defdollar{relative-directory-list} -\begin{chunk}{initvars} -(defvar $relative-directory-list - '("/../../src/input/" - "/doc/msgs/" - "/../../src/algebra/" - "/../../src/interp/" ; for lisp files (helps fd) - "/doc/spadhelp/" )) +Tenth Frame Component -- frameExposureData +\defmacro{frameExposureData} +\begin{chunk}{defmacro frameExposureData 0} +(defmacro frameExposureData (frame) + `(tenth ,frame)) \end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -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} +\section{Functions to manipulate frames} -\defdollar{relative-library-directory-list} -\begin{chunk}{initvars} -(defvar $relative-library-directory-list '("/algebra/")) +\Defun{frame}{The top level frame command} +\calls{frame}{frameSpad2Cmd} +\begin{chunk}{defun frame} +(defun |frame| (l) + "The top level frame command" + (|frameSpad2Cmd| l)) \end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -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} - -\defdollar{spadroot} -\begin{chunk}{initvars} -(defvar $spadroot nil) +\Defun{frameSpad2Cmd}{The top level frame command handler} +\calls{frameSpad2Cmd}{throwKeyedMsg} +\calls{frameSpad2Cmd}{helpSpad2Cmd} +\calls{frameSpad2Cmd}{selectOptionLC} +\calls{frameSpad2Cmd}{qcdr} +\calls{frameSpad2Cmd}{qcar} +\calls{frameSpad2Cmd}{object2Identifier} +\seebook{frameSpad2Cmd}{drop}{9} +\calls{frameSpad2Cmd}{closeInterpreterFrame} +\calls{frameSpad2Cmd}{import} +\calls{frameSpad2Cmd}{importFromFrame} +\calls{frameSpad2Cmd}{last} +\calls{frameSpad2Cmd}{previousInterpreterFrame} +\calls{frameSpad2Cmd}{names} +\calls{frameSpad2Cmd}{displayFrameNames} +\calls{frameSpad2Cmd}{new} +\calls{frameSpad2Cmd}{addNewInterpreterFrame} +\calls{frameSpad2Cmd}{next} +\calls{frameSpad2Cmd}{nextInterpreterFrame} +\usesdollar{frameSpad2Cmd}{options} +\begin{chunk}{defun frameSpad2Cmd} +(defun |frameSpad2Cmd| (args) + "The top level frame command handler" + (let (frameArgs arg a) + (declare (special |$options|)) + (setq frameArgs '(|drop| |import| |last| |names| |new| |next|)) + (cond + (|$options| + (|throwKeyedMsg| 'S2IZ0016 ; frame command does not take options + (cons ")frame" nil))) + ((null args) (|helpSpad2Cmd| (cons '|frame| nil))) + (t + (setq arg (|selectOptionLC| (car args) frameArgs '|optionError|)) + (setq args (cdr args)) + (when (and (consp args) + (eq (qcdr args) nil) + (progn (setq a (qcar args)) t)) + (setq args a)) + (when (atom args) (setq args (|object2Identifier| args))) + (case arg + (|drop| + (if (and args (consp args)) + (|throwKeyedMsg| 'S2IZ0017 ; not a valid frame name + (cons args nil)) + (|closeInterpreterFrame| args))) + (|import| (|importFromFrame| args)) + (|last| (|previousInterpreterFrame|)) + (|names| (|displayFrameNames|)) + (|new| + (if (and args (consp args)) + (|throwKeyedMsg| 'S2IZ0017 ; not a valid frame name + (cons args nil)) + (|addNewInterpreterFrame| args))) + (|next| (|nextInterpreterFrame|)) + (t nil)))))) \end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -The \verb|$SpadServer| determines whether Axiom acts as a remote server. +\Defun{initializeInterpreterFrameRing}{Initializing the Interpreter Frame Ring} -See the function \fnref{openserver}. +There can be multiple frames and these live in a top-level variable called +{\bf \$interpreterFrameRing}. This variable holds a circular list of frames. -An example of a runtime value is: -\begin{verbatim} -$SpadServer = nil -\end{verbatim} +This function creates an empty, initial frame named ``initial'' and +creates a list of frames containing an empty frame. This list is the +interpreter frame ring and is not actually circular but is managed as +a circular list. -\defdollar{SpadServer} -\begin{chunk}{initvars} -(defvar $SpadServer nil "t means Axiom acts as a remote server") +As a final step we update the world from this frame. This has the +side-effect of resetting all the important global variables to their +initial values. -\end{chunk} +\calls{initializeInterpreterFrameRing}{emptyInterpreterFrame} +\calls{initializeInterpreterFrameRing}{updateFromCurrentInterpreterFrame} +\usesdollar{initializeInterpreterFrameRing}{interpreterFrameName} +\usesdollar{initializeInterpreterFrameRing}{interpreterFrameRing} +\begin{chunk}{defun initializeInterpreterFrameRing} +(defun |initializeInterpreterFrameRing| () + "Initializing the Interpreter Frame Ring" + (declare (special |$interpreterFrameName| |$interpreterFrameRing|)) + (setq |$interpreterFrameName| '|initial|) + (setq |$interpreterFrameRing| + (list (|emptyInterpreterFrame| |$interpreterFrameName|))) + (|updateFromCurrentInterpreterFrame|) + nil) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -The \verb|$SpadServerName| defines the name of the spad server socket. -In unix these exist in the tmp directory as names. +\end{chunk} -See the function \fnref{openserver}. - -An example of a runtime value is: -\begin{verbatim} -$SpadServerName = "/tmp/.d" -\end{verbatim} - -\defdollar{SpadServerName} -\begin{chunk}{initvars} -(defvar $SpadServerName "/tmp/.d" "the name of the spad server socket") +\Defun{emptyInterpreterFrame}{Create a new, empty Interpreter Frame} +\usesdollar{emptyInterpreterFrame}{HiFiAccess} +\usesdollar{emptyInterpreterFrame}{HistList} +\usesdollar{emptyInterpreterFrame}{HistListLen} +\usesdollar{emptyInterpreterFrame}{HistListAct} +\usesdollar{emptyInterpreterFrame}{HistRecord} +\usesdollar{emptyInterpreterFrame}{localExposureDataDefault} +\begin{chunk}{defun emptyInterpreterFrame 0} +(defun |emptyInterpreterFrame| (name) + "Create a new, empty Interpreter Frame" + (declare (special |$HiFiAccess| |$HistList| |$HistListLen| |$HistListAct| + |$HistRecord| |$localExposureDataDefault|)) + (list name ; frame name + (list (list nil)) ; environment + 1 ; $IOindex + |$HiFiAccess| + |$HistList| + |$HistListLen| + |$HistListAct| + |$HistRecord| + nil ; $internalHistoryTable + (copy-seq |$localExposureDataDefault|))) ; $localExposureData \end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -The \verb|$IOindex| variable is the number associated with the input prompt. -Every successful expression evaluated increments this number until a -\verb|)clear all| resets it. Here we set it to the initial value. - -An example of a runtime value is: -\begin{verbatim} -$IOindex = 1 -\end{verbatim} - -\defdollar{IOindex} -\begin{chunk}{initvars} -(defvar $IOindex 1 "The current Axiom prompt number") +\Defun{frameNames}{Create a list of all of the frame names} +This function simply walks across the frame in the frame ring and +returns a list of the name of each frame. +\usesdollar{frameNames}{interpreterFrameRing} +\begin{chunk}{defun frameNames 0} +(defun |frameNames| () + "Creating a List of all of the Frame Names" + (declare (special |$interpreterFrameRing|)) + (mapcar #'(lambda (f) (frameName f)) |$interpreterFrameRing|)) \end{chunk} -\chapter{Starting Axiom} +\Defun{displayFrameNames}{Display the frame name list message} +\calls{displayFrameNames}{bright} +\calls{displayFrameNames}{framename} +\calls{displayFrameNames}{sayKeyedMsg} +\usesdollar{displayFrameNames}{interpreterFrameRing} +\begin{chunk}{defun displayFrameNames 0} +(defun |displayFrameNames| () + "Display the Frame Names" + (declare (special |$interpreterFrameRing|)) + (format t " The names of the existing frames are:~%") + (format t "~{ ~a ~%~^~}" (|frameNames|)) + (format t " The current frame is the first one listed.~%")) -This chapter details the internal processing behind an Axiom console -session where the user types ``1'' and gets a result. +\end{chunk} -\begin{verbatim} -axiom -nox - AXIOM Computer Algebra System - Version: Axiom (August 2014) - Timestamp: Friday September 12, 2014 at 06:24:14 ------------------------------------------------------------------------------ - Issue )copyright to view copyright notices. - Issue )summary for a summary of useful system commands. - Issue )quit to leave AXIOM and return to shell. - Visit http://axiom-developer.org for more information ------------------------------------------------------------------------------ - - Re-reading interp.daase - Re-reading operation.daase - Re-reading category.daase - Re-reading browse.daase -(1) -> -(1) -> 1 +\Defun{createCurrentInterpreterFrame} +{Collect the global variables into a Frame} - (1) 1 - Type: PositiveInteger -(2) -> -\end{verbatim} +We can collect up all the current environment information into +one frame element with this call. It creates a list of the current +values of the global variables and returns this as a frame element. -By working through this example we introduce, motivate, and explain -how the interpreter works, where and why functions are called, how -the system transitions from input strings to algebra, how the databases -are used, and more. +\usesdollar{createCurrentInterpreterFrame}{interpreterFrameName} +\usesdollar{createCurrentInterpreterFrame}{InteractiveFrame} +\usesdollar{createCurrentInterpreterFrame}{IOindex} +\usesdollar{createCurrentInterpreterFrame}{HiFiAccess} +\usesdollar{createCurrentInterpreterFrame}{HistList} +\usesdollar{createCurrentInterpreterFrame}{HistListLen} +\usesdollar{createCurrentInterpreterFrame}{HistListAct} +\usesdollar{createCurrentInterpreterFrame}{HistRecord} +\usesdollar{createCurrentInterpreterFrame}{internalHistoryTable} +\usesdollar{createCurrentInterpreterFrame}{localExposureData} +\begin{chunk}{defun createCurrentInterpreterFrame 0} +(defun |createCurrentInterpreterFrame| () + "Collecting up the Environment into a Frame" + (declare (special |$interpreterFrameName| |$InteractiveFrame| |$IOindex| + |$HiFiAccess| |$HistList| |$HistListLen| |$HistListAct| |$HistRecord| + |$internalHistoryTable| |$localExposureData|)) + (list + |$interpreterFrameName| + |$InteractiveFrame| + |$IOindex| + |$HiFiAccess| + |$HistList| + |$HistListLen| + |$HistListAct| + |$HistRecord| + |$internalHistoryTable| + |$localExposureData|)) -If you plan to maintain or modify the interpreter this information is -necessary. If you really want to know how Axiom works, this information -is useful. +\end{chunk} -Each function call we describe has a link to the actual function so -you can read the detailed code and see why it reacts as it does to -the given input. +\Defun{updateFromCurrentInterpreterFrame} +{Update global variables from the Current Frame} +The frames are kept on a circular list. The first element on that +list is known as ``the current frame''. This will initialize all +of the interesting interpreter data structures from that frame. +\calls{updateFromCurrentInterpreterFrame}{sayMessage} +\usesdollar{updateFromCurrentInterpreterFrame}{interpreterFrameRing} +\usesdollar{updateFromCurrentInterpreterFrame}{interpreterFrameName} +\usesdollar{updateFromCurrentInterpreterFrame}{InteractiveFrame} +\usesdollar{updateFromCurrentInterpreterFrame}{IOindex} +\usesdollar{updateFromCurrentInterpreterFrame}{HiFiAccess} +\usesdollar{updateFromCurrentInterpreterFrame}{HistList} +\usesdollar{updateFromCurrentInterpreterFrame}{HistListLen} +\usesdollar{updateFromCurrentInterpreterFrame}{HistListAct} +\usesdollar{updateFromCurrentInterpreterFrame}{HistRecord} +\usesdollar{updateFromCurrentInterpreterFrame}{internalHistoryTable} +\usesdollar{updateFromCurrentInterpreterFrame}{localExposureData} +\usesdollar{updateFromCurrentInterpreterFrame}{frameMessages} +\begin{chunk}{defun updateFromCurrentInterpreterFrame} +(defun |updateFromCurrentInterpreterFrame| () + "Update from the Current Frame" + (let (tmp1) + (declare (special |$interpreterFrameRing| |$interpreterFrameName| + |$InteractiveFrame| |$IOindex| |$HiFiAccess| |$HistList| |$HistListLen| + |$HistListAct| |$HistRecord| |$internalHistoryTable| |$localExposureData| + |$frameMessages|)) + (setq tmp1 (first |$interpreterFrameRing|)) + (setq |$interpreterFrameName| (frameName tmp1)) + (setq |$InteractiveFrame| (frameInteractive tmp1)) + (setq |$IOindex| (frameIOIndex tmp1)) + (setq |$HiFiAccess| (frameHiFiAccess tmp1)) + (setq |$HistList| (frameHistList tmp1)) + (setq |$HistListLen| (frameHistListLen tmp1)) + (setq |$HistListAct| (frameHistListAct tmp1)) + (setq |$HistRecord| (frameHistRecord tmp1)) + (setq |$internalHistoryTable| (frameHistoryTable tmp1)) + (setq |$localExposureData| (frameExposureData tmp1)) + (when |$frameMessages| + (format t " Current interpreter frame is called ~a" + |$interpreterFrameName|)))) -I've taken the liberty of adding comments that show the function -signature. Some of the types only exist as unnamed data structures -in the interpreter (e.g. "Server", which is really just a small -integer). They are introduced without definition simply as a -documentation aid but may sometimes be defined a Common Lisp -deftypes for performance reasons. +\end{chunk} -{\bf A Note on Common Lisp Circular Notation} +\Defun{updateCurrentInterpreterFrame} +{Replace the current frame and update from the globals} +This function collects the normal contents of the world into a +frame object, places it first on the frame list, and then sets +the current values of the world from the frame object. -You may not be familiar with circular notation in Common Lisp. -If a list contains a pointer back to itself or a sublist then the -output would be an infinite stream. In order to prevent this -the circular notation is used. So for a list X, -\begin{verbatim} - +---|---+ +---|---+ +---|---+ +---|---+ - + A | + --> + B | + --> + C | + --> + D | / + - +---|---+ +---|---+ +---|---+ +---|---+ -\end{verbatim} -which is the list (A . (B . (C . (D . ())))). The printing rule -says that if a period is followed by a parenthesis then both -are suppressed. So this would print as (A B C D). -But it could be that we execute -\begin{verbatim} - (rplaca (last X) (cdr X)) -\end{verbatim} -so the list now is -\begin{verbatim} - +---|---+ +---|---+ +---|---+ +---|---+ - + A | + --> + B | + --> + C | + --> + | / + - +---|---+ +---|---+ +---|---+ +---|---+ - ^ | - +---------------------------+ -\end{verbatim} -and now the list X is cicular. This prints as -\begin{verbatim} - (A . #0=(B C #0#)) -\end{verbatim} -As you can see the \verb|#0=| introduces a unique label for the -cons cell pointed at by (CDR A). We stored that address in the -CAR of the last node. So the last node in the list uses the -previously defined label with the notation \verb|#0#|. +\calls{updateCurrentInterpreterFrame}{createCurrentInterpreterFrame} +\calls{updateCurrentInterpreterFrame}{updateFromCurrentInterpreterFrame} +\usesdollar{updateCurrentInterpreterFrame}{interpreterFrameRing} +\begin{chunk}{defun updateCurrentInterpreterFrame} +(defun |updateCurrentInterpreterFrame| () + "Update the Current Interpreter Frame" + (declare (special |$interpreterFrameRing|)) + (rplaca |$interpreterFrameRing| (|createCurrentInterpreterFrame|)) + (|updateFromCurrentInterpreterFrame|)) -Circular notation is used extensively in Axiom since a lot of the -structures are shared or self-referential. You have to be careful -because, as a result of structure sharing, changing something in one -place can change an apparently unrelated structure by side-effect. +\end{chunk} -Axiom starts by invoking a function value of the lisp symbol -\verb|*top-level-hook*| which is normally unbound. -The normal function invocation path is: -\begin{verbatim} -axiom -nox +\Defun{frameEnvironment}{Get Named Frame Environment (aka Interactive)} +If the frame is found we return the environment portion of the frame +otherwise we construct an empty environment and return it. +The initial values of an empty frame are created here. This function +returns a single frame that will be placed in the frame ring. -lisp - -> restart - -> |spad| - -> |runspad| - -> |ncTopLevel| - -> |ncIntLoop| - -> |intloop| - -> |SpadInterpretStream| - -> mkprompt -- outputs "(1) ->" to the console - -> |intloopReadConsole| -- the Read-Eval-Print loop function - -> |serverReadLine| -- does the actual read to the console - -> process the input and recursively call |intloopReadConsole| -\end{verbatim} +\calls{frameEnvironment}{frameInteractive} +\begin{chunk}{defun frameEnvironment} +(defun |frameEnvironment| (fname) + "Get Named Frame Environment (aka Interactive)" + (let ((frame (|findFrameInRing| fname))) + (if frame + (frameInteractive frame) + (list (list nil))))) -\bfref{SpadInterpretStream} is called with a third arguments, {\bf -interactive?} set to {\bf t} so it sets up an interactive loop to read -from the console. The other two arguments are ignored on the main -interpreter path. +\end{chunk} -\bfref{SpadInterpretStream} can also be called by the compiler, -with the {\bf interactive?} argument {\bf nil} to read from -a file. See bookvol9. +\Defun{findFrameInRing}{Find a Frame in the Frame Ring by Name} +Each frame contains its name as the 0th element. We simply walk all +the frames and if we find one we return it. +\calls{findFrameInRing}{boot-equal} +\calls{findFrameInRing}{frameName} +\usesdollar{findFrameInRing}{interpreterFrameRing} +\begin{chunk}{defun findFrameInRing 0} +(defun |findFrameInRing| (name) + "Find a Frame in the Frame Ring by Name" + (declare (special |$interpreterFrameRing|)) + (dolist (frame |$interpreterFrameRing|) + (when (eq (frameName frame) name) (return frame)))) -\bfref{mkprompt} puts one of several kinds of prompts on the screen. In -the default case we include the step number. The return value is not -used. +\end{chunk} -The \bfref{intloopReadConsole} function does tail-recursive calls to -itself and never exits. It is the primary Read-Eval-Print-Loop (REPL). +\Defun{changeToNamedInterpreterFrame}{Change to the Named Interpreter Frame} +\calls{changeToNamedInterpreterFrame}{updateCurrentInterpreterFrame} +\calls{changeToNamedInterpreterFrame}{findFrameInRing} +\calls{changeToNamedInterpreterFrame}{nremove} +\calls{changeToNamedInterpreterFrame}{updateFromCurrentInterpreterFrame} +\usesdollar{changeToNamedInterpreterFrame}{interpreterFrameRing} +\begin{chunk}{defun changeToNamedInterpreterFrame} +(defun |changeToNamedInterpreterFrame| (name) + "Change to the Named Interpreter Frame" + (let (frame) + (declare (special |$interpreterFrameRing|)) + (|updateCurrentInterpreterFrame|) + (setq frame (|findFrameInRing| name)) + (when frame + (setq |$interpreterFrameRing| + (cons frame (nremove |$interpreterFrameRing| frame))) + (|updateFromCurrentInterpreterFrame|)))) -\bfref{intloopReadConsole} -reads the next line and calls one of three kinds of processors -\begin{enumerate} -\item \bfref{intnplisp} to handle )lisp input -\item \bfref{ncloopCommand} to handle )command input -\item \bfref{intloopProcessString} to handle everything else -\end{enumerate} +\end{chunk} -There are only two ways out of the REPL, either using the command -"{\bf )fin}" which drops into lisp or closing the *standard-input* stream. -If dropped into lisp, the top level loop can be restarted by calling -{\bf (restart)}. +\Defun{nextInterpreterFrame}{Move to the next Interpreter Frame in Ring} +This function updates the current frame to make sure all of the +current information is recorded. If there are more frame elements +in the list then this will destructively move the current frame +to the end of the list, that is, assume the frame list reads (1 2 3) +this function will destructively change it to (2 3 1). -{\bf intloopReadConsole} takes 2 arguments. The first is a String {\bf -prefix} which is usually an empty string but might contain prior lines -that ended with an underscore, the Axiom continuation character. The -second is an Integer which will be the step number printed at the -prompt. +\calls{nextInterpreterFrame}{updateFromCurrentInterpreterFrame} +\usesdollar{nextInterpreterFrame}{interpreterFrameRing} +\begin{chunk}{defun nextInterpreterFrame} +(defun |nextInterpreterFrame| () + "Move to the next Interpreter Frame in Ring" + (declare (special |$interpreterFrameRing|)) + (when (cdr |$interpreterFrameRing|) + (setq |$interpreterFrameRing| + (nconc (cdr |$interpreterFrameRing|) (list (car |$interpreterFrameRing|)))) + (|updateFromCurrentInterpreterFrame|))) -\section{An Overview of a Simple Input} -Here we walk through details of Axiom's default behavior when handling -a simple input, the number 1. Many details are skipped in order to -provide a simple overview of the interpreter operation. Further -details can be found at the specific functions. +\end{chunk} -Axiom is in \bfref{intloopReadConsole}, the Read-Eval-Print-Loop (REPL) function and the user types ``1''. -\begin{verbatim} - 1> (|intloopReadConsole| "" 1) - ; serverReadLine : Stream -> String - 2> (|serverReadLine| #) - ; is-console : Stream -> Boolean - 3> (IS-CONSOLE #) - <3 (IS-CONSOLE T) - ; sockSendInt : (Purpose,Command) -> Integer - ; Purpose 1 is SessionManager, Command 3 is EndOfOutput - ; A return of 0 indicates success. - ; see the socket types purpose list in bookvol7, chunk include/com.h - 3> (|sockSendInt| 1 3) - <3 (|sockSendInt| 0) - ; serverSwitch : Void -> Integer - ; see server_switch in sockio.c - ; this multiplexes the socket connection among front ends - ; CallInterp is the constant 4 (see the table in sockio-c) - ; CallInterp simply returns to the interpreter - 3> (|serverSwitch|) -1 - <3 (|serverSwitch| 4) - ; the action for CallInterp is to call read-line - ; read-line is defined in vmlisp.lisp - 3> (|read-line| #) - <3 (|read-line| "1" NIL) - <2 (|serverReadLine| "1") -\end{verbatim} +\Defun{previousInterpreterFrame} +{Move to the previous Interpreter Frame in Ring} +\calls{previousInterpreterFrame}{updateCurrentInterpreterFrame} +\calls{previousInterpreterFrame}{updateFromCurrentInterpreterFrame} +\usesdollar{previousInterpreterFrame}{interpreterFrameRing} +\begin{chunk}{defun previousInterpreterFrame} +(defun |previousInterpreterFrame| () + "Move to the previous Interpreter Frame in Ring" + (let (tmp1 l b) + (declare (special |$interpreterFrameRing|)) + (|updateCurrentInterpreterFrame|) + (when (cdr |$interpreterFrameRing|) + (setq tmp1 (reverse |$interpreterFrameRing|)) + (setq l (car tmp1)) + (setq b (nreverse (cdr tmp1))) + (setq |$interpreterFrameRing| (nconc (cons l nil) b)) + (|updateFromCurrentInterpreterFrame|)))) -Axiom calls \bfref{serverReadLine} -to read the integer from the console. First it calls {\bf is-console} -(bookvol9) to check that the console stream exists. +\end{chunk} -{\bf sockSendInt} (see sockio.lisp, sockio-c.c) sends on socket 1 -({\bf SessionManager}) a 3, meaning {\bf EndOfOutput}, i.e. a newline. +\Defun{addNewInterpreterFrame}{Add a New Interpreter Frame} +\calls{addNewInterpreterFrame}{boot-equal} +\calls{addNewInterpreterFrame}{framename} +\calls{addNewInterpreterFrame}{throwKeyedMsg} +\calls{addNewInterpreterFrame}{updateCurrentInterpreterFrame} +\calls{addNewInterpreterFrame}{initHistList} +\calls{addNewInterpreterFrame}{emptyInterpreterFrame} +\calls{addNewInterpreterFrame}{updateFromCurrentInterpreterFrame} +\callsdollar{addNewInterpreterFrame}{erase} +\calls{addNewInterpreterFrame}{histFileName} +\usesdollar{addNewInterpreterFrame}{interpreterFrameRing} +\begin{chunk}{defun addNewInterpreterFrame} +(defun |addNewInterpreterFrame| (name) + "Add a New Interpreter Frame" + (declare (special |$interpreterFrameRing|)) + (if (null name) + (|throwKeyedMsg| 's2iz0018 nil) ; you must provide a name for new frame + (progn + (|updateCurrentInterpreterFrame|) + (dolist (f |$interpreterFrameRing|) + (when (eq name (frameName f)) ; existing frame with same name + (|throwKeyedMsg| 's2iz0019 (list name)))) + (|initHistList|) + (setq |$interpreterFrameRing| + (cons (|emptyInterpreterFrame| name) |$interpreterFrameRing|)) + (|updateFromCurrentInterpreterFrame|) + ($erase (|histFileName|))))) -{\bf serverSwitch} (see sockio-c in bookvol7) multitasks among the different -sockets and finds the interpreter socket is available, returning -4 ({\bf CallInterp}) (see sockio-c commands sent table and bookvol8). +\end{chunk} -\bfref{serverReadLine} has a cond switch for action {\bf \$CallInterp}. -In that case it calls {\bf read-line} (see vmlisp.lisp) to read the -input line and returns the result, in this case, the string "1". +\Defun{importFromFrame}{Import items from another frame} +\calls{importFromFrame}{member} +\calls{importFromFrame}{frameNames} +\calls{importFromFrame}{throwKeyedMsg} +\calls{importFromFrame}{boot-equal} +\calls{importFromFrame}{framename} +\calls{importFromFrame}{frameEnvironment} +\calls{importFromFrame}{upcase} +\calls{importFromFrame}{queryUserKeyedMsg} +\calls{importFromFrame}{string2id-n} +\calls{importFromFrame}{importFromFrame} +\calls{importFromFrame}{sayKeyedMsg} +\calls{importFromFrame}{clearCmdParts} +\calls{importFromFrame}{seq} +\calls{importFromFrame}{exit} +\calls{importFromFrame}{putHist} +\calls{importFromFrame}{get} +\calls{importFromFrame}{getalist} +\usesdollar{importFromFrame}{interpreterFrameRing} +\begin{chunk}{defun importFromFrame} +(defun |importFromFrame| (args) + "Import items from another frame" + (prog (temp1 fname fenv x v props vars plist prop val m) + (declare (special |$interpreterFrameRing|)) + (when (and args (atom args)) (setq args (cons args nil))) + (if (null args) + (|throwKeyedMsg| 'S2IZ0073 nil) ; missing frame name + (progn + (setq temp1 args) + (setq fname (car temp1)) + (setq args (cdr temp1)) + (cond + ((null (|member| fname (|frameNames|))) + (|throwKeyedMsg| 'S2IZ0074 (cons fname nil))) ; not frame name + ((boot-equal fname (frameName (car |$interpreterFrameRing|))) + (|throwKeyedMsg| 'S2IZ0075 NIL)) ; cannot import from curr frame + (t + (setq fenv (|frameEnvironment| fname)) + (cond + ((null args) + (setq x + (upcase (|queryUserKeyedMsg| 'S2IZ0076 (cons fname nil)))) + ; import everything? + (cond + ((member (string2id-n x 1) '(y yes)) + (setq vars nil) + (do ((tmp0 (caar fenv) (cdr tmp0)) (tmp1 nil)) + ((or (atom tmp0) + (progn (setq tmp1 (car tmp0)) nil) + (progn + (progn + (setq v (car tmp1)) + (setq props (cdr tmp1)) + tmp1) + nil)) + nil) + (cond + ((eq v '|--macros|) + (do ((tmp2 props (cdr tmp2)) + (tmp3 nil)) + ((or (atom tmp2) + (progn (setq tmp3 (car tmp2)) nil) + (progn + (progn (setq m (car tmp3)) tmp3) + nil)) + nil) + (setq vars (cons m vars)))) + (t (setq vars (cons v vars))))) + (|importFromFrame| (cons fname vars))) + (t + (|sayKeyedMsg| 'S2IZ0077 (cons fname nil))))) + (t + (do ((tmp4 args (cdr tmp4)) (v nil)) + ((or (atom tmp4) (progn (setq v (car tmp4)) nil)) nil) + (seq + (exit + (progn + (setq plist (getalist (caar fenv) v)) + (cond + (plist + (|clearCmdParts| (cons '|propert| (cons v nil))) + (do ((tmp5 plist (cdr tmp5)) (tmp6 nil)) + ((or (atom tmp5) + (progn (setq tmp6 (car tmp5)) nil) + (progn + (progn + (setq prop (car tmp6)) + (setq val (cdr tmp6)) + tmp6) + nil)) + nil) + (seq + (exit (|putHist| v prop val |$InteractiveFrame|))))) + ((setq m (|get| '|--macros--| v fenv)) + (|putHist| '|--macros--| v m |$InteractiveFrame|)) + (t + (|sayKeyedMsg| 'S2IZ0079 ; frame not found + (cons v (cons fname nil))))))))) + (|sayKeyedMsg| 'S2IZ0078 ; import complete + (cons fname nil)))))))))) -\begin{verbatim} - 2> (|intloopPrefix?| ")fi" "1") - <2 (|intloopPrefix?| NIL) - 2> (|intloopPrefix?| ")" "1") - <2 (|intloopPrefix?| NIL) - 2> (CONCAT "" "1") - <2 (CONCAT "1") - 2> (|ncloopEscaped| "1") - <2 (|ncloopEscaped| NIL) -\end{verbatim} +\end{chunk} -\bfref{intloopReadConsole} checks for various -possible special kinds of input. Axiom returned a non-zero length -string. Before processing it we need to check for the ``{\bf )fin}'' -command, which fails. We need to check for a leading ``{\bf )}'', -meaning it is some kind of command input, which fails. We might -have an existing string in the {\bf prefix} argument so we -concatentate it to the input. The {\bf prefix} might contain -text from a previous continued line. Next we check whether the input -line has a trailing underscore, meaning an Axiom line is being -continued, and if so, we recurse in order to read the next line. +\Defun{closeInterpreterFrame}{Close an Interpreter Frame} +\calls{closeInterpreterFrame}{framename} +\calls{closeInterpreterFrame}{throwKeyedMsg} +\callsdollar{closeInterpreterFrame}{erase} +\calls{closeInterpreterFrame}{makeHistFileName} +\calls{closeInterpreterFrame}{updateFromCurrentInterpreterFrame} +\usesdollar{closeInterpreterFrame}{interpreterFrameRing} +\usesdollar{closeInterpreterFrame}{interpreterFrameName} +\begin{chunk}{defun closeInterpreterFrame} +(defun |closeInterpreterFrame| (name) + "Close an Interpreter Frame" + (declare (special |$interpreterFrameRing| |$interpreterFrameName|)) + (let (ifr found) + (if (null (cdr |$interpreterFrameRing|)) + (if (and name (not (equal name |$interpreterFrameName|))) + (|throwKeyedMsg| 's2iz0020 ; 1 frame left. not the correct name. + (cons |$interpreterFrameName| nil)) + (|throwKeyedMsg| 's2iz0021 nil)) ; only 1 frame left, not closed + (progn + (if (null name) + (setq |$interpreterFrameRing| (cdr |$interpreterFrameRing|)) + (progn + (setq found nil) + (setq ifr nil) + (dolist (f |$interpreterFrameRing|) + (if (or found (not (equal name (frameName f)))) + (setq ifr (cons f ifr))) + (setq found t)) + (if (null found) + (|throwKeyedMsg| 's2iz0022 (cons name nil)) + (progn + ($erase (|makeHistFileName| name)) + (setq |$interpreterFrameRing| (nreverse ifr)))))) + (|updateFromCurrentInterpreterFrame|))))) -\bfref{intloopPrefix?} which will return NIL if there is no -match of the prefix characters, otherwise it returns the string -without any leading blanks. +\end{chunk} -None of these special cases occur with the input ``1''. -Axiom calls \bfref{intloopProcessString} -which calls \bfref{setCurrentLine} to add the -input line to the history which is stored in {\bf \$currentLine}. +\section{Global variables associated with the frame} +\defdollar{interpreterFrameRing} +All existing frames are kept in a ring held in this variable. +\begin{chunk}{initvars} +(defvar |$interpreterFrameRing| nil "The ring of all frames") -\begin{verbatim} - 2> (|intloopProcessString| "1" 1) - 3> (|setCurrentLine| "1") - <3 (|setCurrentLine| ("1")) -\end{verbatim} +\end{chunk} -$\cdots$all the magic happens here$\cdots$ +\defdollar{interpreterFrameName} +The \verb|$interpreterFrameName| variable, set in +initializeInterpreterFrameRing to the constant +initial to indicate that this is the initial (default) frame. -$\cdots$ and then {\bf intloopProcessString} will eventually -return the new step number 2. Then Axiom puts up a prompt -and waits for further input. +Frames are structures that capture all of the variables defined in a +session. There can be multiple frames and the user can freely switch +between them. Frames are kept in a ring data structure so you can +move around the ring. -\begin{verbatim} - <2 (|intloopProcessString| 2) - 2> (MKPROMPT) - 3> (CONCAT "(" "2" ") -> ") - <3 (CONCAT "(2) -> ") - <2 (MKPROMPT "(2) -> ") -(2) -> - 2> (|serverReadLine| #) - 3> (IS-CONSOLE #) - <3 (IS-CONSOLE T) - 3> (|sockSendInt| 1 3) - <3 (|sockSendInt| 0) - 3> (|serverSwitch|) +\begin{chunk}{initvars} +(defvar |$interpreterFrameName| '|initial|) -\end{verbatim} -Now Axiom is ready for the next input. +\end{chunk} -\section{Parsing the input} -We now examine the magic portion above which has several phases. -The first phase constructs a data structure called a Delay. This -data structure is the core data structure of the ``zipper'' parser. +\defdollar{InteractiveFrame} +{\bf \verb|$InteractiveFrame|} is the environment where the user +values are stored. Any side effects of evaluation of a top-level +expression are stored in this environment. It is always used as +the starting environment for interpretation. -The ``zipper'' parser is unique to Axiom. It was invented by Bill -Burge who did research in recursive techniques, including parsing. -For insight, see his article on Stream Procesing Functions \cite{Burg74}. +This variable is set in the {\bf restart} function as the value returned +by {\bf makeInitialModemapFrame|}. -\subsection{Creating a Delay -- incString} -The \bfref{intloopProcessString} has the nested function call -\begin{verbatim} - (|intloopProcess| n t - (|next| #'|ncloopParse| - (|next| #'|lineoftoks| (|incString| s)))) -\end{verbatim} -which according to lisp semantics is processed inside out. First we -examine the call to \bfref{incString} which is passed the input -string ``1''. +\begin{chunk}{initvars} +(defvar |$InteractiveFrame| nil) -The \bfref{incString} function gets the string from Axiom's input -line, in this case ``1'' and constructs a set of nested function calls -to process the input line. +\end{chunk} -\begin{verbatim} - 3> (|incString| "1") -\end{verbatim} +The \verb|$IOindex| variable is the number associated with the input prompt. +Every successful expression evaluated increments this number until a +\verb|)clear all| resets it. Here we set it to the initial value. -The \bfref{incString} function calls \bfref{Delay} which changes the -function call into a simple list object prefixed by the symbol tag -{\bf nonnullstream}. +\defdollar{IOindex} +\begin{chunk}{initvars} +(defvar $IOindex 1 "The current Axiom prompt number") -\begin{verbatim} - 4> (|incLude| 0 ("1") 0 ("strings") (1)) - 5> (|Delay| |incLude1| (0 ("1") 0 ("strings") (1))) - <5 (|Delay| (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1))) - <4 (|incLude| (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1))) -\end{verbatim} -That result is passed to \bfref{incRenumber}, which calls \bfref{incIgen} -which returns a \bfref{Delay}. It then calls \bfref{incZip} to ``zips'' -together the function \bfref{incRenumberLine} and the two delays into -a single delay. This gets put into a delay with \bfref{incZip1} as the -function. -\begin{verbatim} - 4> (|incRenumber| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1))) - 5> (|incIgen| 0) - 6> (|Delay| |incIgen1| (0)) - <6 (|Delay| (|nonnullstream| |incIgen1| 0)) - <5 (|incIgen| (|nonnullstream| |incIgen1| 0)) +\end{chunk} - 5> (|incZip| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0)) - 6> (|Delay| |incZip1| |incRenumberLine|) - <6 (|Delay| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))) - <5 (|incZip| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))) +\section{Interpreter Functions using Frames} - <4 (|incRenumber| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))) +The {\bf \ref{restart}} function - <3 (|incString| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))) -\end{verbatim} +The {\bfref undoSteps} function, part of the undo mechanism can +reset the \verb|$InteractiveFrame|. -We are building a stream of functions and arguments stored in a delay -structure which will eventually be evaluated. We continue this process -with the call to \bfref{next} which builds a delay with the function -\bfref{next1} and the current delay. -\subsection{Creating a Delay -- next} +\chapter{The History Mechanism} +\defdollar{HiFiAccess} +The \verb|$HiFiAccess| is set by initHist to T. It is a flag +used by the history mechanism to record whether the history function +is currently on. It can be reset by using the axiom +command \begin{verbatim} - 3> (|next| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))) - 4> (|Delay| |next1| - (|lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0)))) - <4 (|Delay| (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0)))) - <3 (|next| - (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0)))) + )history off \end{verbatim} +It appears that the name means ``History File Access''. -\subsection{Creating a Delay -- ncloopParse} -`We continue building a larger delay, this time with a call to -\bfref{next} with the function argument \bfref{ncloopParse} and the -existing delay. +The \verb|$HiFiAccess| variable is used by historySpad2Cmd to check +whether history is turned on. T means it is, NIL means it is not. +This is remembered in the current frame. -\begin{verbatim} - 3> (|next| |ncloopParse| - (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0)))) - 4> (|Delay| #0=|next1| - (|ncloopParse| - (|nonnullstream| #0# |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))))) - <4 (|Delay| - (|nonnullstream| #0=|next1| |ncloopParse| - (|nonnullstream| #0# |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))))) - <3 (|next| - (|nonnullstream| #0=|next1| |ncloopParse| - (|nonnullstream| #0# |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))))) -\end{verbatim} +\begin{chunk}{initvars} +(defvar |$HiFiAccess| nil "Is the history function on?") -Finally we call \bfref{intloopProcess} with the step number {\bf stepno}, -whether we are talking to the console {\bf interactive} and the delay -we just constructed {\bf delay} +\end{chunk} -\subsection{Evaluating a Delay -- intloopProcess} +\defdollar{HistList} +Thie \verb|$HistList| variable is set by initHistList to an initial +value of NIL elements. The last element of the list is smashed to +point to the first element to make the list circular. +This is a circular list of length \verb|$HistListLen|. +This is remembered in the current frame. -At this point we have created a large delay. Now we begin to evaluate it. +\begin{chunk}{initvars} +(defvar |$HistList| nil "A circular list of history elements") -\begin{verbatim} - 3> (|intloopProcess| 1 T - (|nonnullstream| #0=|next1| |ncloopParse| - (|nonnullstream| #0# |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))))) -\end{verbatim} +\end{chunk} -\bfref{intloopProcess} calls \bfref{StreamNull} which walks the -delay applying the second value, which is a function, to the rest -of the delay. Thus, all of the functions we packaged into the -delay will be evaluated. +\defdollar{HistListLen} +The \verb|$HistListLen| variable is set by initHistList to 20. +This is the length of a circular list maintained in the variable +\verb|$HistList|. +This is remembered in the current frame. -The result of each function call, e.g the result of calling \bfref{next1} -will be a pair, which we call a ParsePair \index{ParsePair}. -The car of the ParsePair is rplaca'd into the delay and -the cdr of the ParsePair is rplacd'd into the delay. -So the delay is gradually reduced by each function call. +\begin{chunk}{initvars} +(defvar |$HistListLen| 0 "The length of the circular history list") -\begin{verbatim} - 4> (|StreamNull| - (|nonnullstream| #0=|next1| |ncloopParse| - (|nonnullstream| #0# |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))))) -\end{verbatim} +\end{chunk} -Here we see the \bfref{next1} function being called from the delay. -It immediately calls \bfref{StreamNull} to process the rest of the delay. +\defdollar{HistListAct} +The \verb|$HistListAct| variable is set by initHistList to 0. +This variable holds the actual number of elements in the history list. +This is the number of ``undoable'' steps. +This is remembered in the current frame. -\begin{verbatim} - 5> (|next1| |ncloopParse| - (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0)))) - 6> (|StreamNull| - (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0)))) -\end{verbatim} - -\bfref{StreamNull}, now working on the inner portion of the delay, -finds the function \bfref{next1} and calls it, which results in an -immediate inner call to \bfref{StreamNull}. +\begin{chunk}{initvars} +(defvar |$HistLIstAct| 0 "The number of un-doable steps") -\begin{verbatim} - 7> (|next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))) - 8> (|StreamNull| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))) -\end{verbatim} +\end{chunk} -Descending even further, the \bfref{StreamNull} finds \bfref{incZip1}, -which finds the function \bfref{incRenumberLine} and two delays. -\begin{verbatim} - 9> (|incZip1| - |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0)) -\end{verbatim} -\bfref{incZip1} invokes \bfref{StreamNull} on the first delay, which -invokes \bfref{incLude1} on the rest of the delay. -\begin{verbatim} - 10> (|StreamNull| - (|nonnullstream| |incLude1| 0 ("1") 0 - ("strings") (1))) -\end{verbatim} -\bfref{incLude1} unpacks the argument list and invokes \bfref{StreamNull} -on the second argument \verb|("1")| which is not the expected symbol -{\bf nonnullstream} so \bfref{StreamNull} immediately returns NIL. -\begin{verbatim} - 11> (|incLude1| 0 ("1") 0 ("strings") (1)) - 12> (|StreamNull| ("1")) - <12 (|StreamNull| NIL) -\end{verbatim} -Next, \bfref{incLude1} calls \bfref{incClassify} to which calls -\bfref{incCommand?} which checks for a leading ``)''. Since there -isn't one \bfref{incClassify} immediately returns a list of NIL, 0, -and the empty string. -\begin{verbatim} - 12> (|incClassify| "1") - 13> (|incCommand?| "1") - <13 (|incCommand?| NIL) - <12 (|incClassify| (NIL 0 "")) +\defdollar{internalHistoryTable} +The \verb|$internalHistoryTable| variable is set at load time by a call to +initvars to a value of NIL. +It is part of the history mechanism. +This is remembered in the current frame. - 12> (|Skipping?| 1) - 13> (|KeepPart?| 1) - <13 (|KeepPart?| T) - <12 (|Skipping?| NIL) +\begin{chunk}{initvars} +(defvar |$internalHistoryTable| nil) - 12> (|xlOK| 0 "1" 1 "strings") - 13> (|xlOK1| 0 "1" "1" 1 "strings") - 14> (INCLINE1 0 "1" "1" -1 1 "strings") - 15> (|lnCreate| 0 "1" -1 1 "strings") - <15 (|lnCreate| (0 "1" -1 1 "strings")) - <14 (INCLINE1 (((0 "1" -1 1 "strings") . 1) . "1")) - <13 (|xlOK1| ((((0 "1" -1 1 "strings") . 1) . "1") - (NIL |none|))) - <12 (|xlOK| ((((0 "1" -1 1 "strings") . 1) . "1") - (NIL |none|))) +\end{chunk} - 12> (|incLude| 0 NIL 1 ("strings") (1)) - 13> (|Delay| |incLude1| (0 NIL 1 ("strings") (1))) - <13 (|Delay| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1))) - <12 (|incLude| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1))) +\defdollar{HistRecord} +The \verb|$HistRecord| variable is set by initHistList to NIL. +\verb|$HistRecord| collects the input line, all variable bindings +and the output of a step, before it is written to the file named by +the function histFileName. - <11 (|incLude1| - (((((0 "1" -1 1 "strings") . 1) . "1") (NIL |none|)) - |nonnullstream| |incLude1| 0 NIL 1 ("strings") (1))) - <10 (|StreamNull| NIL) -\end{verbatim} +\begin{chunk}{initvars} +(defvar |$HistRecord| nil) -\begin{verbatim} - 10> (|StreamNull| (|nonnullstream| |incIgen1| 0)) - 11> (|incIgen1| 0) - 12> (|incIgen| 1) - 13> (|Delay| |incIgen1| (1)) - <13 (|Delay| (|nonnullstream| |incIgen1| 1)) - <12 (|incIgen| (|nonnullstream| |incIgen1| 1)) - <11 (|incIgen1| (1 |nonnullstream| |incIgen1| 1)) - <10 (|StreamNull| NIL) - 10> (|incRenumberLine| - ((((0 "1" -1 1 "strings") . 1) . "1") (NIL |none|)) 1) - 11> (|incRenumberItem| - (((0 "1" -1 1 "strings") . 1) . "1") 1) - 12> (|lnSetGlobalNum| (0 "1" -1 1 "strings") 1) - <12 (|lnSetGlobalNum| 1) - <11 (|incRenumberItem| (((0 "1" 1 1 "strings") . 1) . "1")) - 11> (|incHandleMessage| - ((((0 "1" 1 1 "strings") . 1) . "1") (NIL |none|))) - <11 (|incHandleMessage| 0) - <10 (|incRenumberLine| - (((0 "1" 1 1 "strings") . 1) . "1")) -\end{verbatim} +\end{chunk} -\begin{verbatim} - 10> (|incZip| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1)) - 11> (|Delay| |incZip1| - (|incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - <11 (|Delay| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - <10 (|incZip| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) -\end{verbatim} +\defdollar{historyFileType} +The \verb|$historyFileType| is set at load time by a call to +initvars to a value of ``axh''. It appears that this +is intended to be used as a filetype extension. +It is part of the history mechanism. It is used in makeHistFileName +as part of the history file name. -\begin{verbatim} - <9 (|incZip1| - ((((0 "1" 1 1 "strings") . 1) . "1") - |nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - <8 (|StreamNull| NIL) -\end{verbatim} +\begin{chunk}{initvars} +(defvar |$historyFileType| nil) -\begin{verbatim} - 8> (|lineoftoks| - ((((0 "1" 1 1 "strings") . 1) . "1") - |nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - 9> (|nextline| - ((((0 "1" 1 1 "strings") . 1) . "1") - |nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - 10> (|npNull| - ((((0 "1" 1 1 "strings") . 1) . "1") - |nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - 11> (|StreamNull| - ((((0 "1" 1 1 "strings") . 1) . "1") - |nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - <11 (|StreamNull| NIL) - <10 (|npNull| NIL) - 10> (STRPOSL " " "1" 0 T) - <10 (STRPOSL 0) - <9 (|nextline| T) - 9> (|scanIgnoreLine| "1" 0) - <9 (|scanIgnoreLine| 0) - 9> (|incPrefix?| "command" 1 "1") - <9 (|incPrefix?| NIL) - 9> (|scanToken|) - 10> (|startsComment?|) - <10 (|startsComment?| NIL) - 10> (|startsNegComment?|) - <10 (|startsNegComment?| NIL) - 10> (|punctuation?| 49) - <10 (|punctuation?| NIL) - 10> (|digit?| #\1) - 11> (DIGITP #\1) - <11 (DIGITP 1) - <10 (|digit?| 1) - 10> (|scanNumber|) - 11> (|spleI| |digit?|) - 12> (|spleI1| |digit?| NIL) - 13> (|digit?| #\1) - 14> (DIGITP #\1) - <14 (DIGITP 1) - <13 (|digit?| 1) - <12 (|spleI1| "1") - <11 (|spleI| "1") - 11> (|lfinteger| "1") - <11 (|lfinteger| (|integer| "1")) - <10 (|scanNumber| (|integer| "1")) - 10> (|lnExtraBlanks| (0 "1" 1 1 "strings")) - <10 (|lnExtraBlanks| 0) - 10> (|constoken| - "1" (0 "1" 1 1 "strings") (|integer| "1") 0) - 11> (|ncPutQ| - (|integer| . "1") |posn| ((0 "1" 1 1 "strings") . 0)) - 12> (|ncAlist| (|integer| . "1")) - <12 (|ncAlist| NIL) - 12> (|ncAlist| (|integer| . "1")) - <12 (|ncAlist| NIL) - 12> (|ncTag| (|integer| . "1")) - <12 (|ncTag| |integer|) - <11 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <10 (|constoken| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . - "1")) - 10> (|dqUnit| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . - "1")) - <10 (|dqUnit| - (#0=(((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . - "1")) . #0#)) - <9 (|scanToken| - (#0=(((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . - "1")) . #0#)) - 9> (|dqAppend| NIL - (#0=(((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . - "1")) . #0#)) - <9 (|dqAppend| - (#0=(((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . - "1")) . #0#)) - <8 (|lineoftoks| - ((((#0=( - ((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) . "1")) - . #0#) - (((#1# . 1) . "1") . - #2=(|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) - . #2#)) -\end{verbatim} +\end{chunk} -\begin{verbatim} - 8> (|next| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - 9> (|Delay| |next1| - (|lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1)))) - <9 (|Delay| - (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1)))) - <8 (|next| - (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1)))) -\end{verbatim} +\chapter{The undo mechanism} -\begin{verbatim} - 8> (|incAppend| - (((#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) . "1")) . #0#) - (((#1# . 1) . "1") . - #2=(|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) - (|nonnullstream| |next1| |lineoftoks| #2#)) - 9> (|Delay| |incAppend1| - ((((#1=(( - (|integer| (|posn| #2=(0 "1" 1 1 "strings") . 0)) . - "1")) . #1#) - (((#2# . 1) . "1") . - #3=(|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) - (|nonnullstream| |next1| |lineoftoks| #3#))) - <9 (|Delay| - (|nonnullstream| |incAppend1| - (((#1= - (((|integer| (|posn| #2=(0 "1" 1 1 "strings") . 0)) - . "1")) - . #1#) - (((#2# . 1) . "1") . - #3=(|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) - (|nonnullstream| |next1| |lineoftoks| #3#))) - <8 (|incAppend| - (|nonnullstream| |incAppend1| - (((#1=(((|integer| (|posn| #2=(0 "1" 1 1 "strings") . 0)) . "1")) . #1#) - (((#2# . 1) . "1") . - #3=(|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) - (|nonnullstream| |next1| |lineoftoks| #3#))) -\end{verbatim} +\chapter{Exposure groups} -\begin{verbatim} - <7 (|next1| - (|nonnullstream| |incAppend1| - (((#1=(((|integer| (|posn| #2=(0 "1" 1 1 "strings") . 0)) - . "1")) - . #1#) (((#2# . 1) . "1") . - #3=(|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) - (|nonnullstream| |next1| |lineoftoks| #3#))) - 7> (|incAppend1| - (((#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) . - "1")) - . #0#) (((#1# . 1) . "1") . - #2=(|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) - (|nonnullstream| |next1| |lineoftoks| #2#)) -\end{verbatim} +\section{Functions to manipulate exposure} -\begin{verbatim} - 8> (|StreamNull| - (((#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - . #0#) (((#1# . 1) . "1") - |nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) - <8 (|StreamNull| NIL) -\end{verbatim} +\Defun{setExposeAddGroup}{Expose a group} +Note that \verb|$localExposureData| is a vector of lists. +It consists of [exposed groups,exposed constructors,hidden constructors] -\begin{verbatim} - 8> (|incAppend| NIL - (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1)))) - 9> (|Delay| |incAppend1| - (NIL - (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) - <9 (|Delay| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) - <8 (|incAppend| (|nonnullstream| |incAppend1| NIL - (|nonnullstream| |next1| |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))))) -\end{verbatim} +\calls{setExposeAddGroup}{object2String} +\calls{setExposeAddGroup}{qcar} +\calls{setExposeAddGroup}{setelt} +\calls{setExposeAddGroup}{displayExposedGroups} +\calls{setExposeAddGroup}{sayMSG} +\calls{setExposeAddGroup}{displayExposedConstructors} +\calls{setExposeAddGroup}{displayHiddenConstructors} +\calls{setExposeAddGroup}{clearClams} +\calls{setExposeAddGroup}{getalist} +\calls{setExposeAddGroup}{sayKeyedMsg} +\calls{setExposeAddGroup}{member} +\calls{setExposeAddGroup}{msort} +\calls{setExposeAddGroup}{centerAndHighlight} +\calls{setExposeAddGroup}{specialChar} +\calls{setExposeAddGroup}{namestring} +\calls{setExposeAddGroup}{pathname} +\calls{setExposeAddGroup}{sayAsManyPerLineAsPossible} +\usesdollar{setExposeAddGroup}{globalExposureGroupAlist} +\usesdollar{setExposeAddGroup}{localExposureData} +\usesdollar{setExposeAddGroup}{interpreterFrameName} +\usesdollar{setExposeAddGroup}{linelength} +\begin{chunk}{defun setExposeAddGroup} +(defun |setExposeAddGroup| (arg) + "Expose a group" + (declare (special |$globalExposureGroupAlist| |$localExposureData| + |$interpreterFrameName| $linelength)) + (if (null arg) + (progn + (|centerAndHighlight| + '|The group Option| $linelength (|specialChar| '|hbar|)) + (|displayExposedGroups|) + (|sayMSG| " ") + (|sayAsManyPerLineAsPossible| + (mapcar #'(lambda (x) (|object2String| (first x))) + |$globalExposureGroupAlist|))) + (dolist (x arg) + (when (consp x) (setq x (qcar x))) + (cond + ((eq x '|all|) + (setelt |$localExposureData| 0 + (mapcar #'first |$globalExposureGroupAlist|)) + (setelt |$localExposureData| 1 nil) + (setelt |$localExposureData| 2 nil) + (|displayExposedGroups|) + (|sayMSG| " ") + (|displayExposedConstructors|) + (|sayMSG| " ") + (|displayHiddenConstructors|) + (|clearClams|)) + ((null (getalist |$globalExposureGroupAlist| x)) + (|sayKeyedMsg| 's2iz0049h (cons x nil))) + ((|member| x (elt |$localExposureData| 0)) + (|sayKeyedMsg| 's2iz0049i (list x |$interpreterFrameName|))) + (t + (setelt |$localExposureData| 0 + (msort (cons x (elt |$localExposureData| 0)))) + (|sayKeyedMsg| 's2iz0049r (list x |$interpreterFrameName|)) + (|clearClams|)))))) -\begin{verbatim} - <7 (|incAppend1| - (((#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) . #0#) (((#1# . 1) . "1") - . #2=(|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1)))) - |nonnullstream| |incAppend1| NIL - (|nonnullstream| |next1| |lineoftoks| #2#))) - <6 (|StreamNull| NIL) -\end{verbatim} +\end{chunk} -\begin{verbatim} - 6> (|ncloopParse| - (((#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) . #0#) (((#1# . 1) . "1") - . #2=(|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1)))) - |nonnullstream| |incAppend1| NIL - (|nonnullstream| |next1| |lineoftoks| #2#))) - 7> (|ncloopDQlines| - (#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) . #0#) (((#1# . 1) . "1") - |nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - 8> (|StreamNull| - ((((0 "1" 1 1 "strings") . 1) . "1") - |nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - <8 (|StreamNull| NIL) - 8> (|tokPosn| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 9> (|ncAlist| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - <9 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <8 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 8> (|poGlobalLinePosn| ((0 "1" 1 1 "strings") . 0)) - 9> (|poGetLineObject| ((0 "1" 1 1 "strings") . 0)) - <9 (|poGetLineObject| (0 "1" 1 1 "strings")) - 9> (|lnGlobalNum| (0 "1" 1 1 "strings")) - <9 (|lnGlobalNum| 1) - <8 (|poGlobalLinePosn| 1) - 8> (|poGlobalLinePosn| ((0 "1" 1 1 "strings") . 1)) - 9> (|poGetLineObject| ((0 "1" 1 1 "strings") . 1)) - <9 (|poGetLineObject| (0 "1" 1 1 "strings")) - 9> (|lnGlobalNum| (0 "1" 1 1 "strings")) - <9 (|lnGlobalNum| 1) - <8 (|poGlobalLinePosn| 1) - 8> (|streamChop| 1 - ((((0 "1" 1 1 "strings") . 1) . "1") - |nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - 9> (|StreamNull| - ((((0 "1" 1 1 "strings") . 1) . "1") - |nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - <9 (|StreamNull| NIL) - 9> (|streamChop| 0 - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - 10> (|StreamNull| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1))) - 11> (|incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) - (|nonnullstream| |incIgen1| 1)) - 12> (|StreamNull| - (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1))) - 13> (|incLude1| 0 NIL 1 ("strings") (1)) - 14> (|StreamNull| NIL) - <14 (|StreamNull| T) - 14> (|Top?| 1) - <14 (|Top?| T) - <13 (|incLude1| (|nullstream|)) - <12 (|StreamNull| T) - <11 (|incZip1| (|nullstream|)) - <10 (|StreamNull| T) - <9 (|streamChop| (NIL NIL)) - 9> (|ncloopPrefix?| ")command" "1") - <9 (|ncloopPrefix?| NIL) - <8 (|streamChop| (((((0 "1" 1 1 "strings") . 1) . "1")) NIL)) - <7 (|ncloopDQlines| (((((0 "1" 1 1 "strings") . 1) . "1")) NIL)) - 7> (|dqToList| - (#0=(( - (|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) . #0#)) - <7 (|dqToList| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) - 7> (|npParse| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) - 8> (|npFirstTok|) - 9> (|tokPart| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - <9 (|tokPart| "1") - <8 (|npFirstTok| "1") - 8> (|npItem|) - 9> (|npQualDef|) - 10> (|npComma|) - 11> (|npTuple| |npQualifiedDefinition|) - 12> (|npListofFun| - |npQualifiedDefinition| - |npCommaBackSet| - |pfTupleListOf|) - 13> (|npQualifiedDefinition|) - 14> (|npQualified| |npDefinitionOrStatement|) - 15> (|npDefinitionOrStatement|) - 16> (|npBackTrack| |npGives| DEF |npDef|) - 17> (|npState|) - <17 (|npState| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 17> (|npGives|) - 18> (|npBackTrack| |npExit| GIVES |npLambda|) - 19> (|npState|) - <19 (|npState| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 19> (|npExit|) - 20> (|npBackTrack| |npAssign| EXIT |npPileExit|) - 21> (|npState|) - <21 (|npState| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 21> (|npAssign|) - 22> (|npBackTrack| |npMDEF| BECOMES |npAssignment|) - 23> (|npState|) - <23 (|npState| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 23> (|npMDEF|) - 24> (|npBackTrack| |npStatement| MDEF |npMDEFinition|) - 25> (|npState|) - <25 (|npState| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 25> (|npStatement|) - 26> (|npExpress|) - 27> (|npExpress1|) - 28> (|npConditionalStatement|) - 29> (|npConditional| |npQualifiedDefinition|) - 30> (|npEqKey| IF) - <30 (|npEqKey| NIL) - <29 (|npConditional| NIL) - <28 (|npConditionalStatement| NIL) - 28> (|npADD|) - 29> (|npType|) - 30> (|npMatch|) - 31> (|npLeftAssoc| (IS ISNT) |npSuch|) - 32> (|npSuch|) - 33> (|npLeftAssoc| (BAR) |npLogical|) - 34> (|npLogical|) - 35> (|npLeftAssoc| (OR) |npDisjand|) - 36> (|npDisjand|) - 37> (|npLeftAssoc| (AND) |npDiscrim|) - 38> (|npDiscrim|) - 39> (|npLeftAssoc| (CASE HAS) |npQuiver|) - 40> (|npQuiver|) - 41> (|npRightAssoc| (ARROW LARROW) |npRelation|) - 42> (|npState|) - <42 (|npState| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 42> (|npRelation|) - 43> (|npLeftAssoc| - (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE) - |npSynthetic|) - 44> (|npSynthetic|) - 45> (|npBy|) - 46> (|npLeftAssoc| (BY) |npInterval|) - 47> (|npInterval|) - 48> (|npArith|) - 49> (|npLeftAssoc| (MOD) |npSum|) - 50> (|npSum|) - 51> (|npLeftAssoc| (PLUS MINUS) |npTerm|) - 52> (|npTerm|) - 53> (|npInfGeneric| (MINUS PLUS)) - 54> (|npDDInfKey| (MINUS PLUS)) - 55> (|npInfKey| (MINUS PLUS)) - <55 (|npInfKey| NIL) - 55> (|npState|) - <55 (|npState| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 55> (|npEqKey| |'|) - <55 (|npEqKey| NIL) - 55> (|npRestore| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 56> (|npFirstTok|) - 57> (|tokPart| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <57 (|tokPart| "1") - <56 (|npFirstTok| "1") - <55 (|npRestore| T) - 55> (|npEqKey| BACKQUOTE) - <55 (|npEqKey| NIL) - 55> (|npRestore| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 56> (|npFirstTok|) - 57> (|tokPart| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <57 (|tokPart| "1") - <56 (|npFirstTok| "1") - <55 (|npRestore| T) - <54 (|npDDInfKey| NIL) - <53 (|npInfGeneric| NIL) - 53> (|npRemainder|) - 54> (|npLeftAssoc| (REM QUO) |npProduct|) - 55> (|npProduct|) - 56> (|npLeftAssoc| - (TIMES SLASH BACKSLASH SLASHSLASH BACKSLASHBACKSLASH - SLASHBACKSLASH BACKSLASHSLASH) - |npPower|) - 57> (|npPower|) - 58> (|npRightAssoc| (POWER CARAT) |npColon|) - 59> (|npState|) - <59 (|npState| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 59> (|npColon|) - 60> (|npTypified|) - 61> (|npApplication|) - 62> (|npDotted| |npPrimary|) - 63> (|npPrimary|) - 64> (|npPrimary1|) - 65> (|npEncAp| |npAtom1|) - 66> (|npAtom1|) - 67> (|npPDefinition|) - 68> (|npParenthesized| |npDefinitionlist|) - 69> (|npParenthesize| |(| |)| |npDefinitionlist|) - 70> (|npEqKey| |(|) - <70 (|npEqKey| NIL) - <69 (|npParenthesize| NIL) - 69> (|npParenthesize| |(\|| |\|)| |npDefinitionlist|) - 70> (|npEqKey| |(\||) - <70 (|npEqKey| NIL) - <69 (|npParenthesize| NIL) - <68 (|npParenthesized| NIL) - <67 (|npPDefinition| NIL) - 67> (|npName|) - 68> (|npId|) - <68 (|npId| NIL) - 68> (|npSymbolVariable|) - 69> (|npState|) - <69 (|npState| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 69> (|npEqKey| BACKQUOTE) - <69 (|npEqKey| NIL) - 69> (|npRestore| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 70> (|npFirstTok|) - 71> (|tokPart| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <71 (|tokPart| "1") - <70 (|npFirstTok| "1") - <69 (|npRestore| T) - <68 (|npSymbolVariable| NIL) - <67 (|npName| NIL) - 67> (|npConstTok|) - 68> (|tokType| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 69> (|ncTag| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <69 (|ncTag| |integer|) - <68 (|tokType| |integer|) - 68> (|npPush| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <68 (|npPush| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 68> (|npNext|) - 69> (|npFirstTok|) - 70> (|tokPosn| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 71> (|ncAlist| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <71 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <70 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 70> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 71> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 72> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <72 (|poNoPosition?| NIL) - <71 (|pfNoPosition?| NIL) - 71> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 72> (|ncAlist| (ERROR . NOMORE)) - <72 (|ncAlist| NIL) - 72> (|ncAlist| (ERROR . NOMORE)) - <72 (|ncAlist| NIL) - 72> (|ncTag| (ERROR . NOMORE)) - <72 (|ncTag| ERROR) - <71 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <70 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) - . NOMORE)) - 70> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <70 (|tokPart| NOMORE) - <69 (|npFirstTok| NOMORE) - <68 (|npNext| NOMORE) - <67 (|npConstTok| NOMORE) - 67> (|npFromdom|) - 68> (|npEqKey| $) - <68 (|npEqKey| NIL) - <67 (|npFromdom| T) - <66 (|npAtom1| T) - 66> (|npAnyNo| |npEncl|) - 67> (|npEncl|) - 68> (|npBDefinition|) - 69> (|npPDefinition|) - 70> (|npParenthesized| |npDefinitionlist|) - 71> (|npParenthesize| |(| |)| |npDefinitionlist|) - 72> (|npEqKey| |(|) - <72 (|npEqKey| NIL) - <71 (|npParenthesize| NIL) - 71> (|npParenthesize| |(\|| |\|)| |npDefinitionlist|) - 72> (|npEqKey| |(\||) - <72 (|npEqKey| NIL) - <71 (|npParenthesize| NIL) - <70 (|npParenthesized| NIL) - <69 (|npPDefinition| NIL) - 69> (|npBracketed| |npDefinitionlist|) - 70> (|npParened| |npDefinitionlist|) - 71> (|npEnclosed| |(| |)| |pfParen| |npDefinitionlist|) - 72> (|npEqKey| |(|) - <72 (|npEqKey| NIL) - <71 (|npEnclosed| NIL) - 71> (|npEnclosed| |(\|| |\|)| |pfParen| |npDefinitionlist|) - 72> (|npEqKey| |(\||) - <72 (|npEqKey| NIL) - <71 (|npEnclosed| NIL) - <70 (|npParened| NIL) - 70> (|npBracked| |npDefinitionlist|) - 71> (|npEnclosed| [ ] |pfBracket| |npDefinitionlist|) - 72> (|npEqKey| [) - <72 (|npEqKey| NIL) - <71 (|npEnclosed| NIL) - 71> (|npEnclosed| |[\|| |\|]| - |pfBracketBar| |npDefinitionlist|) - 72> (|npEqKey| |[\||) - <72 (|npEqKey| NIL) - <71 (|npEnclosed| NIL) - <70 (|npBracked| NIL) - 70> (|npBraced| |npDefinitionlist|) - 71> (|npEnclosed| { } |pfBrace| |npDefinitionlist|) - 72> (|npEqKey| {) - <72 (|npEqKey| NIL) - <71 (|npEnclosed| NIL) - 71> (|npEnclosed| |{\|| |\|}| - |pfBraceBar| |npDefinitionlist|) - 72> (|npEqKey| |{\||) - <72 (|npEqKey| NIL) - <71 (|npEnclosed| NIL) - <70 (|npBraced| NIL) - 70> (|npAngleBared| |npDefinitionlist|) - 71> (|npEnclosed| |<\|| |\|>| |pfHide| |npDefinitionlist|) - 72> (|npEqKey| |<\||) - <72 (|npEqKey| NIL) - <71 (|npEnclosed| NIL) - <70 (|npAngleBared| NIL) - <69 (|npBracketed| NIL) - <68 (|npBDefinition| NIL) - <67 (|npEncl| NIL) - <66 (|npAnyNo| T) - 66> (|npFromdom|) - 67> (|npEqKey| $) - <67 (|npEqKey| NIL) - <66 (|npFromdom| T) - <65 (|npEncAp| T) - <64 (|npPrimary1| T) - <63 (|npPrimary| T) - 63> (|npAnyNo| |npSelector|) - 64> (|npSelector|) - 65> (|npEqKey| DOT) - <65 (|npEqKey| NIL) - <64 (|npSelector| NIL) - <63 (|npAnyNo| T) - <62 (|npDotted| T) - 62> (|npApplication2|) - 63> (|npDotted| |npPrimary1|) - 64> (|npPrimary1|) - 65> (|npEncAp| |npAtom1|) - 66> (|npAtom1|) - 67> (|npPDefinition|) - 68> (|npParenthesized| |npDefinitionlist|) - 69> (|npParenthesize| |(| |)| |npDefinitionlist|) - 70> (|npEqKey| |(|) - <70 (|npEqKey| NIL) - <69 (|npParenthesize| NIL) - 69> (|npParenthesize| |(\|| |\|)| |npDefinitionlist|) - 70> (|npEqKey| |(\||) - <70 (|npEqKey| NIL) - <69 (|npParenthesize| NIL) - <68 (|npParenthesized| NIL) - <67 (|npPDefinition| NIL) - 67> (|npName|) - 68> (|npId|) - <68 (|npId| NIL) - 68> (|npSymbolVariable|) - 69> (|npState|) - <69 (|npState| - (NIL ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 69> (|npEqKey| BACKQUOTE) - <69 (|npEqKey| NIL) - 69> (|npRestore| - (NIL ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 70> (|npFirstTok|) - 71> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 72> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <72 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <71 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 71> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 72> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 73> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <73 (|poNoPosition?| NIL) - <72 (|pfNoPosition?| NIL) - 72> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 73> (|ncAlist| (ERROR . NOMORE)) - <73 (|ncAlist| NIL) - 73> (|ncAlist| (ERROR . NOMORE)) - <73 (|ncAlist| NIL) - 73> (|ncTag| (ERROR . NOMORE)) - <73 (|ncTag| ERROR) - <72 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <71 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 71> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <71 (|tokPart| NOMORE) - <70 (|npFirstTok| NOMORE) - <69 (|npRestore| T) - <68 (|npSymbolVariable| NIL) - <67 (|npName| NIL) - 67> (|npConstTok|) - 68> (|tokType| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 69> (|ncTag| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <69 (|ncTag| ERROR) - <68 (|tokType| ERROR) - 68> (|npEqPeek| |'|) - <68 (|npEqPeek| NIL) - <67 (|npConstTok| NIL) - 67> (|npDollar|) - 68> (|npEqPeek| $) - <68 (|npEqPeek| NIL) - <67 (|npDollar| NIL) - 67> (|npBDefinition|) - 68> (|npPDefinition|) - 69> (|npParenthesized| |npDefinitionlist|) - 70> (|npParenthesize| |(| |)| |npDefinitionlist|) - 71> (|npEqKey| |(|) - <71 (|npEqKey| NIL) - <70 (|npParenthesize| NIL) - 70> (|npParenthesize| |(\|| |\|)| |npDefinitionlist|) - 71> (|npEqKey| |(\||) - <71 (|npEqKey| NIL) - <70 (|npParenthesize| NIL) - <69 (|npParenthesized| NIL) - <68 (|npPDefinition| NIL) - 68> (|npBracketed| |npDefinitionlist|) - 69> (|npParened| |npDefinitionlist|) - 70> (|npEnclosed| |(| |)| |pfParen| |npDefinitionlist|) - 71> (|npEqKey| |(|) - <71 (|npEqKey| NIL) - <70 (|npEnclosed| NIL) - 70> (|npEnclosed| |(\|| |\|)| |pfParen| |npDefinitionlist|) - 71> (|npEqKey| |(\||) - <71 (|npEqKey| NIL) - <70 (|npEnclosed| NIL) - <69 (|npParened| NIL) - 69> (|npBracked| |npDefinitionlist|) - 70> (|npEnclosed| [ ] |pfBracket| |npDefinitionlist|) - 71> (|npEqKey| [) - <71 (|npEqKey| NIL) - <70 (|npEnclosed| NIL) - 70> (|npEnclosed| |[\|| |\|]| - |pfBracketBar| |npDefinitionlist|) - 71> (|npEqKey| |[\||) - <71 (|npEqKey| NIL) - <70 (|npEnclosed| NIL) - <69 (|npBracked| NIL) - 69> (|npBraced| |npDefinitionlist|) - 70> (|npEnclosed| { } |pfBrace| |npDefinitionlist|) - 71> (|npEqKey| {) - <71 (|npEqKey| NIL) - <70 (|npEnclosed| NIL) - 70> (|npEnclosed| |{\|| |\|}| - |pfBraceBar| |npDefinitionlist|) - 71> (|npEqKey| |{\||) - <71 (|npEqKey| NIL) - <70 (|npEnclosed| NIL) - <69 (|npBraced| NIL) - 69> (|npAngleBared| |npDefinitionlist|) - 70> (|npEnclosed| |<\|| |\|>| |pfHide| |npDefinitionlist|) - 71> (|npEqKey| |<\||) - <71 (|npEqKey| NIL) - <70 (|npEnclosed| NIL) - <69 (|npAngleBared| NIL) - <68 (|npBracketed| NIL) - <67 (|npBDefinition| NIL) - <66 (|npAtom1| NIL) - <65 (|npEncAp| NIL) - 65> (|npLet|) - 66> (|npLetQualified| |npDefinitionOrStatement|) - 67> (|npEqKey| LET) - <67 (|npEqKey| NIL) - <66 (|npLetQualified| NIL) - <65 (|npLet| NIL) - 65> (|npFix|) - 66> (|npEqKey| FIX) - <66 (|npEqKey| NIL) - <65 (|npFix| NIL) - 65> (|npMacro|) - 66> (|npEqKey| MACRO) - <66 (|npEqKey| NIL) - <65 (|npMacro| NIL) - 65> (|npBPileDefinition|) - 66> (|npPileBracketed| |npPileDefinitionlist|) - 67> (|npEqKey| SETTAB) - <67 (|npEqKey| NIL) - <66 (|npPileBracketed| NIL) - <65 (|npBPileDefinition| NIL) - 65> (|npDefn|) - 66> (|npEqKey| DEFN) - <66 (|npEqKey| NIL) - <65 (|npDefn| NIL) - 65> (|npRule|) - 66> (|npEqKey| RULE) - <66 (|npEqKey| NIL) - <65 (|npRule| NIL) - <64 (|npPrimary1| NIL) - <63 (|npDotted| NIL) - <62 (|npApplication2| NIL) - <61 (|npApplication| T) - 61> (|npAnyNo| |npTypeStyle|) - 62> (|npTypeStyle|) - 63> (|npCoerceTo|) - 64> (|npTypedForm| COERCE |pfCoerceto|) - 65> (|npEqKey| COERCE) - <65 (|npEqKey| NIL) - <64 (|npTypedForm| NIL) - <63 (|npCoerceTo| NIL) - 63> (|npRestrict|) - 64> (|npTypedForm| AT |pfRestrict|) - 65> (|npEqKey| AT) - <65 (|npEqKey| NIL) - <64 (|npTypedForm| NIL) - <63 (|npRestrict| NIL) - 63> (|npPretend|) - 64> (|npTypedForm| PRETEND |pfPretend|) - 65> (|npEqKey| PRETEND) - <65 (|npEqKey| NIL) - <64 (|npTypedForm| NIL) - <63 (|npPretend| NIL) - 63> (|npColonQuery|) - 64> (|npTypedForm| ATAT |pfRetractTo|) - 65> (|npEqKey| ATAT) - <65 (|npEqKey| NIL) - <64 (|npTypedForm| NIL) - <63 (|npColonQuery| NIL) - <62 (|npTypeStyle| NIL) - <61 (|npAnyNo| T) - <60 (|npTypified| T) - 60> (|npAnyNo| |npTagged|) - 61> (|npTagged|) - 62> (|npTypedForm1| COLON |pfTagged|) - 63> (|npEqKey| COLON) - <63 (|npEqKey| NIL) - <62 (|npTypedForm1| NIL) - <61 (|npTagged| NIL) - <60 (|npAnyNo| T) - <59 (|npColon| T) - 59> (|npInfGeneric| (POWER CARAT)) - 60> (|npDDInfKey| (POWER CARAT)) - 61> (|npInfKey| (POWER CARAT)) - <61 (|npInfKey| NIL) - 61> (|npState|) - <61 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 61> (|npEqKey| |'|) - <61 (|npEqKey| NIL) - 61> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 62> (|npFirstTok|) - 63> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 64> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <64 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <63 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 63> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 64> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 65> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <65 (|poNoPosition?| NIL) - <64 (|pfNoPosition?| NIL) - 64> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 65> (|ncAlist| (ERROR . NOMORE)) - <65 (|ncAlist| NIL) - 65> (|ncAlist| (ERROR . NOMORE)) - <65 (|ncAlist| NIL) - 65> (|ncTag| (ERROR . NOMORE)) - <65 (|ncTag| ERROR) - <64 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <63 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 63> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <63 (|tokPart| NOMORE) - <62 (|npFirstTok| NOMORE) - <61 (|npRestore| T) - 61> (|npEqKey| BACKQUOTE) - <61 (|npEqKey| NIL) - 61> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 62> (|npFirstTok|) - 63> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 64> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <64 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <63 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 63> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 64> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 65> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <65 (|poNoPosition?| NIL) - <64 (|pfNoPosition?| NIL) - 64> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 65> (|ncAlist| (ERROR . NOMORE)) - <65 (|ncAlist| NIL) - 65> (|ncAlist| (ERROR . NOMORE)) - <65 (|ncAlist| NIL) - 65> (|ncTag| (ERROR . NOMORE)) - <65 (|ncTag| ERROR) - <64 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <63 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 63> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <63 (|tokPart| NOMORE) - <62 (|npFirstTok| NOMORE) - <61 (|npRestore| T) - <60 (|npDDInfKey| NIL) - <59 (|npInfGeneric| NIL) - <58 (|npRightAssoc| T) - <57 (|npPower| T) - 57> (|npInfGeneric| - (TIMES SLASH BACKSLASH SLASHSLASH BACKSLASHBACKSLASH - SLASHBACKSLASH BACKSLASHSLASH)) - 58> (|npDDInfKey| - (TIMES SLASH BACKSLASH SLASHSLASH BACKSLASHBACKSLASH - SLASHBACKSLASH BACKSLASHSLASH)) - 59> (|npInfKey| - (TIMES SLASH BACKSLASH SLASHSLASH BACKSLASHBACKSLASH - SLASHBACKSLASH BACKSLASHSLASH)) - <59 (|npInfKey| NIL) - 59> (|npState|) - <59 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 59> (|npEqKey| |'|) - <59 (|npEqKey| NIL) - 59> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 60> (|npFirstTok|) - 61> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 62> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <62 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <61 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 61> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 62> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 63> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <63 (|poNoPosition?| NIL) - <62 (|pfNoPosition?| NIL) - 62> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 63> (|ncAlist| (ERROR . NOMORE)) - <63 (|ncAlist| NIL) - 63> (|ncAlist| (ERROR . NOMORE)) - <63 (|ncAlist| NIL) - 63> (|ncTag| (ERROR . NOMORE)) - <63 (|ncTag| ERROR) - <62 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <61 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 61> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <61 (|tokPart| NOMORE) - <60 (|npFirstTok| NOMORE) - <59 (|npRestore| T) - 59> (|npEqKey| BACKQUOTE) - <59 (|npEqKey| NIL) - 59> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 60> (|npFirstTok|) - 61> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 62> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <62 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <61 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 61> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 62> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 63> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <63 (|poNoPosition?| NIL) - <62 (|pfNoPosition?| NIL) - 62> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 63> (|ncAlist| (ERROR . NOMORE)) - <63 (|ncAlist| NIL) - 63> (|ncAlist| (ERROR . NOMORE)) - <63 (|ncAlist| NIL) - 63> (|ncTag| (ERROR . NOMORE)) - <63 (|ncTag| ERROR) - <62 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <61 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 61> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <61 (|tokPart| NOMORE) - <60 (|npFirstTok| NOMORE) - <59 (|npRestore| T) - <58 (|npDDInfKey| NIL) - <57 (|npInfGeneric| NIL) - <56 (|npLeftAssoc| T) - <55 (|npProduct| T) - 55> (|npInfGeneric| (REM QUO)) - 56> (|npDDInfKey| (REM QUO)) - 57> (|npInfKey| (REM QUO)) - <57 (|npInfKey| NIL) - 57> (|npState|) - <57 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 57> (|npEqKey| |'|) - <57 (|npEqKey| NIL) - 57> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 58> (|npFirstTok|) - 59> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 60> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <60 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <59 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 59> (|tokConstruct| ERROR NOMORE ( - (0 "1" 1 1 "strings") . 0)) - 60> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 61> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <61 (|poNoPosition?| NIL) - <60 (|pfNoPosition?| NIL) - 60> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 61> (|ncAlist| (ERROR . NOMORE)) - <61 (|ncAlist| NIL) - 61> (|ncAlist| (ERROR . NOMORE)) - <61 (|ncAlist| NIL) - 61> (|ncTag| (ERROR . NOMORE)) - <61 (|ncTag| ERROR) - <60 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <59 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 59> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <59 (|tokPart| NOMORE) - <58 (|npFirstTok| NOMORE) - <57 (|npRestore| T) - 57> (|npEqKey| BACKQUOTE) - <57 (|npEqKey| NIL) - 57> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 58> (|npFirstTok|) - 59> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 60> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <60 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <59 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 59> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 60> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 61> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <61 (|poNoPosition?| NIL) - <60 (|pfNoPosition?| NIL) - 60> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 61> (|ncAlist| (ERROR . NOMORE)) - <61 (|ncAlist| NIL) - 61> (|ncAlist| (ERROR . NOMORE)) - <61 (|ncAlist| NIL) - 61> (|ncTag| (ERROR . NOMORE)) - <61 (|ncTag| ERROR) - <60 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <59 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 59> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <59 (|tokPart| NOMORE) - <58 (|npFirstTok| NOMORE) - <57 (|npRestore| T) - <56 (|npDDInfKey| NIL) - <55 (|npInfGeneric| NIL) - <54 (|npLeftAssoc| T) - <53 (|npRemainder| T) - <52 (|npTerm| T) - 52> (|npInfGeneric| (PLUS MINUS)) - 53> (|npDDInfKey| (PLUS MINUS)) - 54> (|npInfKey| (PLUS MINUS)) - <54 (|npInfKey| NIL) - 54> (|npState|) - <54 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 54> (|npEqKey| |'|) - <54 (|npEqKey| NIL) - 54> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 55> (|npFirstTok|) - 56> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 57> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <57 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <56 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 56> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 57> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 58> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <58 (|poNoPosition?| NIL) - <57 (|pfNoPosition?| NIL) - 57> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 58> (|ncAlist| (ERROR . NOMORE)) - <58 (|ncAlist| NIL) - 58> (|ncAlist| (ERROR . NOMORE)) - <58 (|ncAlist| NIL) - 58> (|ncTag| (ERROR . NOMORE)) - <58 (|ncTag| ERROR) - <57 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <56 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 56> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <56 (|tokPart| NOMORE) - <55 (|npFirstTok| NOMORE) - <54 (|npRestore| T) - 54> (|npEqKey| BACKQUOTE) - <54 (|npEqKey| NIL) - 54> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 55> (|npFirstTok|) - 56> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 57> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <57 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <56 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 56> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 57> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 58> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <58 (|poNoPosition?| NIL) - <57 (|pfNoPosition?| NIL) - 57> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 58> (|ncAlist| (ERROR . NOMORE)) - <58 (|ncAlist| NIL) - 58> (|ncAlist| (ERROR . NOMORE)) - <58 (|ncAlist| NIL) - 58> (|ncTag| (ERROR . NOMORE)) - <58 (|ncTag| ERROR) - <57 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <56 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 56> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <56 (|tokPart| NOMORE) - <55 (|npFirstTok| NOMORE) - <54 (|npRestore| T) - <53 (|npDDInfKey| NIL) - <52 (|npInfGeneric| NIL) - <51 (|npLeftAssoc| T) - <50 (|npSum| T) - 50> (|npInfGeneric| (MOD)) - 51> (|npDDInfKey| (MOD)) - 52> (|npInfKey| (MOD)) - <52 (|npInfKey| NIL) - 52> (|npState|) - <52 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 52> (|npEqKey| |'|) - <52 (|npEqKey| NIL) - 52> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 53> (|npFirstTok|) - 54> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 55> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <55 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <54 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 54> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 55> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 56> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <56 (|poNoPosition?| NIL) - <55 (|pfNoPosition?| NIL) - 55> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 56> (|ncAlist| (ERROR . NOMORE)) - <56 (|ncAlist| NIL) - 56> (|ncAlist| (ERROR . NOMORE)) - <56 (|ncAlist| NIL) - 56> (|ncTag| (ERROR . NOMORE)) - <56 (|ncTag| ERROR) - <55 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <54 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 54> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <54 (|tokPart| NOMORE) - <53 (|npFirstTok| NOMORE) - <52 (|npRestore| T) - 52> (|npEqKey| BACKQUOTE) - <52 (|npEqKey| NIL) - 52> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 53> (|npFirstTok|) - 54> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 55> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <55 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <54 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 54> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 55> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 56> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <56 (|poNoPosition?| NIL) - <55 (|pfNoPosition?| NIL) - 55> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 56> (|ncAlist| (ERROR . NOMORE)) - <56 (|ncAlist| NIL) - 56> (|ncAlist| (ERROR . NOMORE)) - <56 (|ncAlist| NIL) - 56> (|ncTag| (ERROR . NOMORE)) - <56 (|ncTag| ERROR) - <55 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <54 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 54> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <54 (|tokPart| NOMORE) - <53 (|npFirstTok| NOMORE) - <52 (|npRestore| T) - <51 (|npDDInfKey| NIL) - <50 (|npInfGeneric| NIL) - <49 (|npLeftAssoc| T) - <48 (|npArith| T) - 48> (|npSegment|) - 49> (|npEqPeek| SEG) - <49 (|npEqPeek| NIL) - <48 (|npSegment| NIL) - <47 (|npInterval| T) - 47> (|npInfGeneric| (BY)) - 48> (|npDDInfKey| (BY)) - 49> (|npInfKey| (BY)) - <49 (|npInfKey| NIL) - 49> (|npState|) - <49 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 49> (|npEqKey| |'|) - <49 (|npEqKey| NIL) - 49> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 50> (|npFirstTok|) - 51> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 52> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <52 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <51 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 51> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 52> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 53> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <53 (|poNoPosition?| NIL) - <52 (|pfNoPosition?| NIL) - 52> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 53> (|ncAlist| (ERROR . NOMORE)) - <53 (|ncAlist| NIL) - 53> (|ncAlist| (ERROR . NOMORE)) - <53 (|ncAlist| NIL) - 53> (|ncTag| (ERROR . NOMORE)) - <53 (|ncTag| ERROR) - <52 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <51 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 51> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <51 (|tokPart| NOMORE) - <50 (|npFirstTok| NOMORE) - <49 (|npRestore| T) - 49> (|npEqKey| BACKQUOTE) - <49 (|npEqKey| NIL) - 49> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 50> (|npFirstTok|) - 51> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 52> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <52 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <51 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 51> (|tokConstruct| ERROR NOMORE ((0 "1" 1 1 "strings") . - 0)) - 52> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 53> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <53 (|poNoPosition?| NIL) - <52 (|pfNoPosition?| NIL) - 52> (|ncPutQ| - (ERROR . NOMORE) |posn| ((0 "1" 1 1 "strings") . 0)) - 53> (|ncAlist| (ERROR . NOMORE)) - <53 (|ncAlist| NIL) - 53> (|ncAlist| (ERROR . NOMORE)) - <53 (|ncAlist| NIL) - 53> (|ncTag| (ERROR . NOMORE)) - <53 (|ncTag| ERROR) - <52 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <51 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 51> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <51 (|tokPart| NOMORE) - <50 (|npFirstTok| NOMORE) - <49 (|npRestore| T) - <48 (|npDDInfKey| NIL) - <47 (|npInfGeneric| NIL) - <46 (|npLeftAssoc| T) - <45 (|npBy| T) - 45> (|npAmpersandFrom|) - 46> (|npAmpersand|) - 47> (|npEqKey| AMPERSAND) - <47 (|npEqKey| NIL) - <46 (|npAmpersand| NIL) - <45 (|npAmpersandFrom| NIL) - <44 (|npSynthetic| T) - 44> (|npInfGeneric| - (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE)) - 45> (|npDDInfKey| - (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE)) - 46> (|npInfKey| (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE)) - <46 (|npInfKey| NIL) - 46> (|npState|) - <46 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 46> (|npEqKey| |'|) - <46 (|npEqKey| NIL) - 46> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 47> (|npFirstTok|) - 48> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 49> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <49 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <48 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 48> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 49> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 50> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <50 (|poNoPosition?| NIL) - <49 (|pfNoPosition?| NIL) - 49> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 50> (|ncAlist| (ERROR . NOMORE)) - <50 (|ncAlist| NIL) - 50> (|ncAlist| (ERROR . NOMORE)) - <50 (|ncAlist| NIL) - 50> (|ncTag| (ERROR . NOMORE)) - <50 (|ncTag| ERROR) - <49 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <48 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 48> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <48 (|tokPart| NOMORE) - <47 (|npFirstTok| NOMORE) - <46 (|npRestore| T) - 46> (|npEqKey| BACKQUOTE) - <46 (|npEqKey| NIL) - 46> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 47> (|npFirstTok|) - 48> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 49> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <49 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <48 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 48> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 49> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 50> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <50 (|poNoPosition?| NIL) - <49 (|pfNoPosition?| NIL) - 49> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 50> (|ncAlist| (ERROR . NOMORE)) - <50 (|ncAlist| NIL) - 50> (|ncAlist| (ERROR . NOMORE)) - <50 (|ncAlist| NIL) - 50> (|ncTag| (ERROR . NOMORE)) - <50 (|ncTag| ERROR) - <49 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <48 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 48> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <48 (|tokPart| NOMORE) - <47 (|npFirstTok| NOMORE) - <46 (|npRestore| T) - <45 (|npDDInfKey| NIL) - <44 (|npInfGeneric| NIL) - <43 (|npLeftAssoc| T) - <42 (|npRelation| T) - 42> (|npInfGeneric| (ARROW LARROW)) - 43> (|npDDInfKey| (ARROW LARROW)) - 44> (|npInfKey| (ARROW LARROW)) - <44 (|npInfKey| NIL) - 44> (|npState|) - <44 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 44> (|npEqKey| |'|) - <44 (|npEqKey| NIL) - 44> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 45> (|npFirstTok|) - 46> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 47> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <47 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <46 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 46> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 47> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 48> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <48 (|poNoPosition?| NIL) - <47 (|pfNoPosition?| NIL) - 47> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 48> (|ncAlist| (ERROR . NOMORE)) - <48 (|ncAlist| NIL) - 48> (|ncAlist| (ERROR . NOMORE)) - <48 (|ncAlist| NIL) - 48> (|ncTag| (ERROR . NOMORE)) - <48 (|ncTag| ERROR) - <47 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <46 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 46> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <46 (|tokPart| NOMORE) - <45 (|npFirstTok| NOMORE) - <44 (|npRestore| T) - 44> (|npEqKey| BACKQUOTE) - <44 (|npEqKey| NIL) - 44> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 45> (|npFirstTok|) - 46> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 47> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <47 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <46 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 46> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 47> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 48> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <48 (|poNoPosition?| NIL) - <47 (|pfNoPosition?| NIL) - 47> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 48> (|ncAlist| (ERROR . NOMORE)) - <48 (|ncAlist| NIL) - 48> (|ncAlist| (ERROR . NOMORE)) - <48 (|ncAlist| NIL) - 48> (|ncTag| (ERROR . NOMORE)) - <48 (|ncTag| ERROR) - <47 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <46 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 46> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <46 (|tokPart| NOMORE) - <45 (|npFirstTok| NOMORE) - <44 (|npRestore| T) - <43 (|npDDInfKey| NIL) - <42 (|npInfGeneric| NIL) - <41 (|npRightAssoc| T) - <40 (|npQuiver| T) - 40> (|npInfGeneric| (CASE HAS)) - 41> (|npDDInfKey| (CASE HAS)) - 42> (|npInfKey| (CASE HAS)) - <42 (|npInfKey| NIL) - 42> (|npState|) - <42 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 42> (|npEqKey| |'|) - <42 (|npEqKey| NIL) - 42> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 43> (|npFirstTok|) - 44> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 45> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <45 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <44 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 44> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 45> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 46> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <46 (|poNoPosition?| NIL) - <45 (|pfNoPosition?| NIL) - 45> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 46> (|ncAlist| (ERROR . NOMORE)) - <46 (|ncAlist| NIL) - 46> (|ncAlist| (ERROR . NOMORE)) - <46 (|ncAlist| NIL) - 46> (|ncTag| (ERROR . NOMORE)) - <46 (|ncTag| ERROR) - <45 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <44 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 44> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <44 (|tokPart| NOMORE) - <43 (|npFirstTok| NOMORE) - <42 (|npRestore| T) - 42> (|npEqKey| BACKQUOTE) - <42 (|npEqKey| NIL) - 42> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 43> (|npFirstTok|) - 44> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 45> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <45 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <44 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 44> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 45> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 46> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <46 (|poNoPosition?| NIL) - <45 (|pfNoPosition?| NIL) - 45> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 46> (|ncAlist| (ERROR . NOMORE)) - <46 (|ncAlist| NIL) - 46> (|ncAlist| (ERROR . NOMORE)) - <46 (|ncAlist| NIL) - 46> (|ncTag| (ERROR . NOMORE)) - <46 (|ncTag| ERROR) - <45 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <44 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 44> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <44 (|tokPart| NOMORE) - <43 (|npFirstTok| NOMORE) - <42 (|npRestore| T) - <41 (|npDDInfKey| NIL) - <40 (|npInfGeneric| NIL) - <39 (|npLeftAssoc| T) - <38 (|npDiscrim| T) - 38> (|npInfGeneric| (AND)) - 39> (|npDDInfKey| (AND)) - 40> (|npInfKey| (AND)) - <40 (|npInfKey| NIL) - 40> (|npState|) - <40 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 40> (|npEqKey| |'|) - <40 (|npEqKey| NIL) - 40> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 41> (|npFirstTok|) - 42> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 43> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <43 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <42 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 42> (|tokConstruct| ERROR NOMORE ((0 "1" 1 1 "strings") . 0)) - 43> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 44> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <44 (|poNoPosition?| NIL) - <43 (|pfNoPosition?| NIL) - 43> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 44> (|ncAlist| (ERROR . NOMORE)) - <44 (|ncAlist| NIL) - 44> (|ncAlist| (ERROR . NOMORE)) - <44 (|ncAlist| NIL) - 44> (|ncTag| (ERROR . NOMORE)) - <44 (|ncTag| ERROR) - <43 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <42 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 42> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <42 (|tokPart| NOMORE) - <41 (|npFirstTok| NOMORE) - <40 (|npRestore| T) - 40> (|npEqKey| BACKQUOTE) - <40 (|npEqKey| NIL) - 40> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 41> (|npFirstTok|) - 42> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 43> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <43 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <42 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 42> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 43> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 44> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <44 (|poNoPosition?| NIL) - <43 (|pfNoPosition?| NIL) - 43> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 44> (|ncAlist| (ERROR . NOMORE)) - <44 (|ncAlist| NIL) - 44> (|ncAlist| (ERROR . NOMORE)) - <44 (|ncAlist| NIL) - 44> (|ncTag| (ERROR . NOMORE)) - <44 (|ncTag| ERROR) - <43 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <42 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 42> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <42 (|tokPart| NOMORE) - <41 (|npFirstTok| NOMORE) - <40 (|npRestore| T) - <39 (|npDDInfKey| NIL) - <38 (|npInfGeneric| NIL) - <37 (|npLeftAssoc| T) - <36 (|npDisjand| T) - 36> (|npInfGeneric| (OR)) - 37> (|npDDInfKey| (OR)) - 38> (|npInfKey| (OR)) - <38 (|npInfKey| NIL) - 38> (|npState|) - <38 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 38> (|npEqKey| |'|) - <38 (|npEqKey| NIL) - 38> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 39> (|npFirstTok|) - 40> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 41> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <41 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <40 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 40> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 41> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 42> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <42 (|poNoPosition?| NIL) - <41 (|pfNoPosition?| NIL) - 41> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 42> (|ncAlist| (ERROR . NOMORE)) - <42 (|ncAlist| NIL) - 42> (|ncAlist| (ERROR . NOMORE)) - <42 (|ncAlist| NIL) - 42> (|ncTag| (ERROR . NOMORE)) - <42 (|ncTag| ERROR) - <41 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <40 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 40> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <40 (|tokPart| NOMORE) - <39 (|npFirstTok| NOMORE) - <38 (|npRestore| T) - 38> (|npEqKey| BACKQUOTE) - <38 (|npEqKey| NIL) - 38> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 39> (|npFirstTok|) - 40> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 41> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <41 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <40 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 40> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 41> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 42> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <42 (|poNoPosition?| NIL) - <41 (|pfNoPosition?| NIL) - 41> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 42> (|ncAlist| (ERROR . NOMORE)) - <42 (|ncAlist| NIL) - 42> (|ncAlist| (ERROR . NOMORE)) - <42 (|ncAlist| NIL) - 42> (|ncTag| (ERROR . NOMORE)) - <42 (|ncTag| ERROR) - <41 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <40 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 40> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <40 (|tokPart| NOMORE) - <39 (|npFirstTok| NOMORE) - <38 (|npRestore| T) - <37 (|npDDInfKey| NIL) - <36 (|npInfGeneric| NIL) - <35 (|npLeftAssoc| T) - <34 (|npLogical| T) - 34> (|npInfGeneric| (BAR)) - 35> (|npDDInfKey| (BAR)) - 36> (|npInfKey| (BAR)) - <36 (|npInfKey| NIL) - 36> (|npState|) - <36 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 36> (|npEqKey| |'|) - <36 (|npEqKey| NIL) - 36> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 37> (|npFirstTok|) - 38> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 39> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <39 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <38 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 38> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 39> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 40> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <40 (|poNoPosition?| NIL) - <39 (|pfNoPosition?| NIL) - 39> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 40> (|ncAlist| (ERROR . NOMORE)) - <40 (|ncAlist| NIL) - 40> (|ncAlist| (ERROR . NOMORE)) - <40 (|ncAlist| NIL) - 40> (|ncTag| (ERROR . NOMORE)) - <40 (|ncTag| ERROR) - <39 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <38 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 38> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <38 (|tokPart| NOMORE) - <37 (|npFirstTok| NOMORE) - <36 (|npRestore| T) - 36> (|npEqKey| BACKQUOTE) - <36 (|npEqKey| NIL) - 36> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 37> (|npFirstTok|) - 38> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 39> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <39 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <38 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 38> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 39> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 40> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <40 (|poNoPosition?| NIL) - <39 (|pfNoPosition?| NIL) - 39> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 40> (|ncAlist| (ERROR . NOMORE)) - <40 (|ncAlist| NIL) - 40> (|ncAlist| (ERROR . NOMORE)) - <40 (|ncAlist| NIL) - 40> (|ncTag| (ERROR . NOMORE)) - <40 (|ncTag| ERROR) - <39 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <38 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 38> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <38 (|tokPart| NOMORE) - <37 (|npFirstTok| NOMORE) - <36 (|npRestore| T) - <35 (|npDDInfKey| NIL) - <34 (|npInfGeneric| NIL) - <33 (|npLeftAssoc| T) - <32 (|npSuch| T) - 32> (|npInfGeneric| (IS ISNT)) - 33> (|npDDInfKey| (IS ISNT)) - 34> (|npInfKey| (IS ISNT)) - <34 (|npInfKey| NIL) - 34> (|npState|) - <34 (|npState| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 34> (|npEqKey| |'|) - <34 (|npEqKey| NIL) - 34> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 35> (|npFirstTok|) - 36> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 37> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <37 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <36 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 36> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 37> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 38> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <38 (|poNoPosition?| NIL) - <37 (|pfNoPosition?| NIL) - 37> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 38> (|ncAlist| (ERROR . NOMORE)) - <38 (|ncAlist| NIL) - 38> (|ncAlist| (ERROR . NOMORE)) - <38 (|ncAlist| NIL) - 38> (|ncTag| (ERROR . NOMORE)) - <38 (|ncTag| ERROR) - <37 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <36 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 36> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <36 (|tokPart| NOMORE) - <35 (|npFirstTok| NOMORE) - <34 (|npRestore| T) - 34> (|npEqKey| BACKQUOTE) - <34 (|npEqKey| NIL) - 34> (|npRestore| - (NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 35> (|npFirstTok|) - 36> (|tokPosn| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 37> (|ncAlist| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <37 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) - <36 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) - 36> (|tokConstruct| ERROR NOMORE - ((0 "1" 1 1 "strings") . 0)) - 37> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) - 38> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) - <38 (|poNoPosition?| NIL) - <37 (|pfNoPosition?| NIL) - 37> (|ncPutQ| (ERROR . NOMORE) |posn| - ((0 "1" 1 1 "strings") . 0)) - 38> (|ncAlist| (ERROR . NOMORE)) - <38 (|ncAlist| NIL) - 38> (|ncAlist| (ERROR . NOMORE)) - <38 (|ncAlist| NIL) - 38> (|ncTag| (ERROR . NOMORE)) - <38 (|ncTag| ERROR) - <37 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) - <36 (|tokConstruct| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - 36> (|tokPart| - ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) - <36 (|tokPart| NOMORE) - <35 (|npFirstTok| NOMORE) - <34 (|npRestore| T) - <33 (|npDDInfKey| NIL) - <32 (|npInfGeneric| NIL) - <31 (|npLeftAssoc| T) - <30 (|npMatch| T) - 30> (|npPop1|) - <30 (|npPop1| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 30> (|npWith| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 31> (|npEqKey| WITH) - <31 (|npEqKey| NIL) - <30 (|npWith| NIL) - 30> (|npPush| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <30 (|npPush| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - <29 (|npType| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 29> (|npPop1|) - <29 (|npPop1| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 29> (|npAdd| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 30> (|npEqKey| ADD) - <30 (|npEqKey| NIL) - <29 (|npAdd| NIL) - 29> (|npPush| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <29 (|npPush| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - <28 (|npADD| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - <27 (|npExpress1| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - 27> (|npIterators|) - 28> (|npForIn|) - 29> (|npEqKey| FOR) - <29 (|npEqKey| NIL) - <28 (|npForIn| NIL) - 28> (|npWhile|) - 29> (|npAndOr| WHILE |npLogical| |pfWhile|) - 30> (|npEqKey| WHILE) - <30 (|npEqKey| NIL) - <29 (|npAndOr| NIL) - <28 (|npWhile| NIL) - <27 (|npIterators| NIL) - <26 (|npExpress| T) - <25 (|npStatement| T) - 25> (|npEqPeek| MDEF) - <25 (|npEqPeek| NIL) - <24 (|npBackTrack| T) - <23 (|npMDEF| T) - 23> (|npEqPeek| BECOMES) - <23 (|npEqPeek| NIL) - <22 (|npBackTrack| T) - <21 (|npAssign| T) - 21> (|npEqPeek| EXIT) - <21 (|npEqPeek| NIL) - <20 (|npBackTrack| T) - <19 (|npExit| T) - 19> (|npEqPeek| GIVES) - <19 (|npEqPeek| NIL) - <18 (|npBackTrack| T) - <17 (|npGives| T) - 17> (|npEqPeek| DEF) - <17 (|npEqPeek| NIL) - <16 (|npBackTrack| T) - <15 (|npDefinitionOrStatement| T) - 15> (|npEqKey| WHERE) - <15 (|npEqKey| NIL) - <14 (|npQualified| T) - <13 (|npQualifiedDefinition| T) - 13> (|npCommaBackSet|) - 14> (|npEqKey| COMMA) - <14 (|npEqKey| NIL) - <13 (|npCommaBackSet| NIL) - <12 (|npListofFun| T) - <11 (|npTuple| T) - <10 (|npComma| T) - 10> (|npPop1|) - <10 (|npPop1| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 10> (|npPush| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1"))) - <10 (|npPush| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - <9 (|npQualDef| - ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")))) - 9> (|npEqKey| SEMICOLON) - <9 (|npEqKey| NIL) - 9> (|npPop1|) - <9 (|npPop1| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) - 9> (|pfEnSequence| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) - <9 (|pfEnSequence| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 9> (|npPush| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - <9 (|npPush| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) - <8 (|npItem| - (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) - <7 (|npParse| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - <6 (|ncloopParse| - ((((((#0=(0 "1" 1 1 "strings") . 1) . "1")) - ((|integer| (|posn| #0# . 0)) . "1"))) - |nonnullstream| |incAppend1| NIL - (|nonnullstream| |next1| |lineoftoks| (|nullstream|)))) -\end{verbatim} - -\begin{verbatim} - 6> (|next| |ncloopParse| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| |next1| |lineoftoks| (|nullstream|)))) - 7> (|Delay| #0=|next1| - (|ncloopParse| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) - <7 (|Delay| - (|nonnullstream| #0=|next1| |ncloopParse| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) - <6 (|next| - (|nonnullstream| #0=|next1| |ncloopParse| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) -\end{verbatim} - -\begin{verbatim} - 6> (|incAppend| - (((((#0=(0 "1" 1 1 "strings") . 1) . "1")) - ((|integer| (|posn| #0# . 0)) . "1"))) - (|nonnullstream| #1=|next1| |ncloopParse| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| #1# |lineoftoks| (|nullstream|))))) - 7> (|Delay| #0=|incAppend1| - ((((((#2=(0 "1" 1 1 "strings") . 1) . "1")) - ((|integer| (|posn| #2# . 0)) . "1"))) - (|nonnullstream| #3=|next1| |ncloopParse| - (|nonnullstream| #0# NIL - (|nonnullstream| #3# |lineoftoks| (|nullstream|)))))) - <7 (|Delay| - (|nonnullstream| #0=|incAppend1| - (((((#2=(0 "1" 1 1 "strings") . 1) . "1")) - ((|integer| (|posn| #2# . 0)) . "1"))) - (|nonnullstream| #3=|next1| |ncloopParse| - (|nonnullstream| #0# NIL - (|nonnullstream| #3# |lineoftoks| (|nullstream|)))))) - <6 (|incAppend| - (|nonnullstream| #0=|incAppend1| - (((((#2=(0 "1" 1 1 "strings") . 1) . "1")) - ((|integer| (|posn| #2# . 0)) . "1"))) - (|nonnullstream| #3=|next1| |ncloopParse| - (|nonnullstream| #0# NIL - (|nonnullstream| #3# |lineoftoks| (|nullstream|)))))) - <5 (|next1| - (|nonnullstream| #0=|incAppend1| - (((((#2=(0 "1" 1 1 "strings") . 1) . "1")) - ((|integer| (|posn| #2# . 0)) . "1"))) - (|nonnullstream| #3=|next1| |ncloopParse| - (|nonnullstream| #0# NIL - (|nonnullstream| #3# |lineoftoks| (|nullstream|)))))) -\end{verbatim} - -\begin{verbatim} - 5> (|incAppend1| - (((((#0=(0 "1" 1 1 "strings") . 1) . "1")) - ((|integer| (|posn| #0# . 0)) . "1"))) - (|nonnullstream| #1=|next1| |ncloopParse| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| #1# |lineoftoks| (|nullstream|))))) - 6> (|StreamNull| - (((((#0=(0 "1" 1 1 "strings") . 1) . "1")) - ((|integer| (|posn| #0# . 0)) . "1")))) - <6 (|StreamNull| NIL) - 6> (|incAppend| NIL - (|nonnullstream| #0=|next1| |ncloopParse| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) - 7> (|Delay| #0=|incAppend1| - (NIL - (|nonnullstream| #2=|next1| |ncloopParse| - (|nonnullstream| #0# NIL - (|nonnullstream| #2# |lineoftoks| (|nullstream|)))))) - <7 (|Delay| - (|nonnullstream| #0=|incAppend1| NIL - (|nonnullstream| #2=|next1| |ncloopParse| - (|nonnullstream| #0# NIL - (|nonnullstream| #2# |lineoftoks| (|nullstream|)))))) - <6 (|incAppend| - (|nonnullstream| #0=|incAppend1| NIL - (|nonnullstream| #2=|next1| |ncloopParse| - (|nonnullstream| #0# NIL - (|nonnullstream| #2# |lineoftoks| (|nullstream|)))))) - <5 (|incAppend1| - (((((#0=(0 "1" 1 1 "strings") . 1) . "1")) - ((|integer| (|posn| #0# . 0)) . "1")) - |nonnullstream| #1=|incAppend1| NIL - (|nonnullstream| #3=|next1| |ncloopParse| - (|nonnullstream| #1# NIL - (|nonnullstream| #3# |lineoftoks| (|nullstream|)))))) - <4 (|StreamNull| NIL) -\end{verbatim} - -\begin{verbatim} - 4> (|pfAbSynOp?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1") |command|) - <4 (|pfAbSynOp?| NIL) -\end{verbatim} - -\begin{verbatim} - 4> (|intloopSpadProcess| 1 - (((#0=(0 "1" 1 1 "strings") . 1) . "1")) - ((|integer| (|posn| #0# . 0)) . "1") T) - 5> (|ncPutQ| (|carrier|) |stepNumber| 1) - 6> (|ncAlist| (|carrier|)) - <6 (|ncAlist| NIL) - 6> (|ncAlist| (|carrier|)) - <6 (|ncAlist| NIL) - 6> (|ncTag| (|carrier|)) - <6 (|ncTag| |carrier|) - <5 (|ncPutQ| 1) - 5> (|ncPutQ| ((|carrier| (|stepNumber| . 1))) |messages| NIL) - 6> (|ncAlist| ((|carrier| (|stepNumber| . 1)))) - <6 (|ncAlist| ((|stepNumber| . 1))) - 6> (|ncAlist| ((|carrier| (|stepNumber| . 1)))) - <6 (|ncAlist| ((|stepNumber| . 1))) - 6> (|ncTag| ((|carrier| (|stepNumber| . 1)))) - <6 (|ncTag| |carrier|) - <5 (|ncPutQ| NIL) - 5> (|ncPutQ| - ((|carrier| (|messages|) (|stepNumber| . 1))) - |lines| ((((0 "1" 1 1 "strings") . 1) . "1"))) - 6> (|ncAlist| ((|carrier| (|messages|) (|stepNumber| . 1)))) - <6 (|ncAlist| ((|messages|) (|stepNumber| . 1))) - 6> (|ncAlist| ((|carrier| (|messages|) (|stepNumber| . 1)))) - <6 (|ncAlist| ((|messages|) (|stepNumber| . 1))) - 6> (|ncTag| ((|carrier| (|messages|) (|stepNumber| . 1)))) - <6 (|ncTag| |carrier|) - <5 (|ncPutQ| ((((0 "1" 1 1 "strings") . 1) . "1"))) - 5> (|intloopSpadProcess,interp| - ((|carrier| (|lines| ((#0=(0 "1" 1 1 "strings") . 1) . "1")) - (|messages|) (|stepNumber| . 1))) - ((|integer| (|posn| #0# . 0)) . "1") T) - 6> (|ncConversationPhase| |phParse| - (((|carrier| (|lines| ((#0=(0 "1" 1 1 "strings") . 1) . "1")) - (|messages|) (|stepNumber| . 1))) - ((|integer| (|posn| #0# . 0)) . "1"))) - 7> (|phParse| - ((|carrier| (|lines| ((#0=(0 "1" 1 1 "strings") . 1) . "1")) - (|messages|) (|stepNumber| . 1))) - ((|integer| (|posn| #0# . 0)) . "1")) - 8> (|ncPutQ| - ((|carrier| (|lines| ((#0=(0 "1" 1 1 "strings") . 1) . "1") - ) (|messages|) (|stepNumber| . 1))) - |ptree| ((|integer| (|posn| #0# . 0)) . "1")) - 9> (|ncAlist| - ((|carrier| (|lines| (((0 "1" 1 1 "strings") . 1) . "1")) - (|messages|) (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|lines| (((0 "1" 1 1 "strings") . 1) . "1")) - (|messages|) (|stepNumber| . 1))) - 9> (|ncAlist| - ((|carrier| (|lines| (((0 "1" 1 1 "strings") . 1) . "1")) - (|messages|) (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|lines| (((0 "1" 1 1 "strings") . 1) . "1")) - (|messages|) (|stepNumber| . 1))) - 9> (|ncTag| - ((|carrier| (|lines| (((0 "1" 1 1 "strings") . 1) . "1")) - (|messages|) (|stepNumber| . 1)))) - <9 (|ncTag| |carrier|) - <8 (|ncPutQ| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - <7 (|phParse| OK) - 7> (|ncConversationPhase,wrapup| - ((|carrier| - (|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) - . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <7 (|ncConversationPhase,wrapup| NIL) - <6 (|ncConversationPhase| OK) - 6> (|ncConversationPhase| |phMacro| - (((|carrier| - (|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))))) - 7> (|phMacro| - ((|carrier| - (|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - 8> (|ncEltQ| - ((|carrier| - (|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) |ptree|) - 9> (|ncAlist| - ((|carrier| - (|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) - . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) - . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - <8 (|ncEltQ| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 8> (|ncPutQ| - ((|carrier| - (|ptree| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - |ptreePremacro| #0#) - 9> (|ncAlist| - ((|carrier| - (|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) - . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) - . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - 9> (|ncAlist| - ((|carrier| - (|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) - . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - 9> (|ncTag| - ((|carrier| - (|ptree| - (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) - . "1") - (|lines| ((#0# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncTag| |carrier|) - <8 (|ncPutQ| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 8> (|macroExpanded| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 9> (|macExpand| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 10> (|pfWhere?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 11> (|pfAbSynOp?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1") |Where|) - <11 (|pfAbSynOp?| NIL) - <10 (|pfWhere?| NIL) - 10> (|pfLambda?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 11> (|pfAbSynOp?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1") |Lambda|) - <11 (|pfAbSynOp?| NIL) - <10 (|pfLambda?| NIL) - 10> (|pfMacro?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 11> (|pfAbSynOp?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1") |Macro|) - <11 (|pfAbSynOp?| NIL) - <10 (|pfMacro?| NIL) - 10> (|pfId?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 11> (|pfAbSynOp?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1") |id|) - <11 (|pfAbSynOp?| NIL) - 11> (|pfAbSynOp?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1") |idsy|) - <11 (|pfAbSynOp?| NIL) - <10 (|pfId?| NIL) - 10> (|pfApplication?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 11> (|pfAbSynOp?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1") |Application|) - <11 (|pfAbSynOp?| NIL) - <10 (|pfApplication?| NIL) - 10> (|pfMapParts| |macExpand| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 11> (|pfLeaf?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 12> (|pfAbSynOp| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <12 (|pfAbSynOp| |integer|) - <11 (|pfLeaf?| (|integer| |Document| |error|)) - <10 (|pfMapParts| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <9 (|macExpand| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - <8 (|macroExpanded| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 8> (|ncPutQ| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) |ptree| #0#) - 9> (|ncAlist| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - <8 (|ncPutQ| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - <7 (|phMacro| OK) - 7> (|ncConversationPhase,wrapup| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <7 (|ncConversationPhase,wrapup| NIL) - <6 (|ncConversationPhase| OK) - 6> (|ncConversationPhase| |phIntReportMsgs| - (((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) T)) - 7> (|phIntReportMsgs| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) T) - 8> (|ncEltQ| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) |lines|) - 9> (|ncAlist| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - <8 (|ncEltQ| ((((0 "1" 1 1 "strings") . 1) . "1"))) - 8> (|ncEltQ| - ((|carrier| (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) . - "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - |messages|) - 9> (|ncAlist| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - <8 (|ncEltQ| NIL) - 8> (|ncPutQ| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) |ok?| T) - 9> (|ncAlist| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - 9> (|ncAlist| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - 9> (|ncTag| - ((|carrier| - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncTag| |carrier|) - <8 (|ncPutQ| T) - <7 (|phIntReportMsgs| OK) - 7> (|ncConversationPhase,wrapup| - ((|carrier| - (|ok?| . T) - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <7 (|ncConversationPhase,wrapup| NIL) - <6 (|ncConversationPhase| OK) - 6> (|ncConversationPhase| |phInterpret| - (((|carrier| - (|ok?| . T) - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))))) - 7> (|phInterpret| - ((|carrier| - (|ok?| . T) - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - 8> (|ncEltQ| - ((|carrier| - (|ok?| . T) - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - |ptree|) - 9> (|ncAlist| - ((|carrier| - (|ok?| . T) - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|ok?| . T) - (|ptreePremacro| . - #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - <8 (|ncEltQ| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 8> (|intInterpretPform| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 9> (|pf2Sex| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 10> (|pf2Sex1| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 11> (|pfNothing?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 12> (|pfAbSynOp?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1") |nothing|) - <12 (|pfAbSynOp?| NIL) - <11 (|pfNothing?| NIL) - 11> (|pfSymbol?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 12> (|pfAbSynOp?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1") |symbol|) - <12 (|pfAbSynOp?| NIL) - <11 (|pfSymbol?| NIL) - 11> (|pfLiteral?| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 12> (|pfAbSynOp| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <12 (|pfAbSynOp| |integer|) - <11 (|pfLiteral?| - (|integer| |symbol| |expression| |one| |zero| - |char| |string| |float|)) - 11> (|pfLiteral2Sex| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 12> (|pfLiteralClass| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 13> (|pfAbSynOp| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <13 (|pfAbSynOp| |integer|) - <12 (|pfLiteralClass| |integer|) - 12> (|pfLiteralString| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - 13> (|tokPart| - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <13 (|tokPart| "1") - <12 (|pfLiteralString| "1") - <11 (|pfLiteral2Sex| 1) - <10 (|pf2Sex1| 1) - <9 (|pf2Sex| 1) - 9> (|zeroOneTran| 1) - <9 (|zeroOneTran| 1) - 9> (|processInteractive| 1 - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 10> (PUT |algebra| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |algebra| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |analysis| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |analysis| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |coercion| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |coercion| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |compilation| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |compilation| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |debug| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |debug| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |evaluation| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |evaluation| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |gc| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |gc| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |history| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |history| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |instantiation| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |instantiation| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |load| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |load| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |modemaps| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |modemaps| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |optimization| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |optimization| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |querycoerce| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |querycoerce| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |other| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |other| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |diskread| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |diskread| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |print| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |print| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |resolve| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |resolve| |SpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |interpreter| |ClassTimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |interpreter| |ClassSpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |evaluation| |ClassTimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |evaluation| |ClassSpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |other| |ClassTimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |other| |ClassSpaceTotal| 0) - <10 (PUT 0) - 10> (PUT |reclaim| |ClassTimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |reclaim| |ClassSpaceTotal| 0) - <10 (PUT 0) - 10> (GETL |gc| |TimeTotal|) - <10 (GETL 0.0) - 10> (PUT |gc| |TimeTotal| 0.050000000000000003) - <10 (PUT 0.050000000000000003) - 10> (PUT |gc| |TimeTotal| 0.0) - <10 (PUT 0.0) - 10> (PUT |gc| |SpaceTotal| 0) - <10 (PUT 0) - 10> (|processInteractive1| 1 - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 11> (|recordFrame| |system|) - 12> (|diffAlist| NIL NIL) - <12 (|diffAlist| NIL) - <11 (|recordFrame| NIL) - 11> (GETL |other| |TimeTotal|) - <11 (GETL 0.0) - 11> (GETL |gc| |TimeTotal|) - <11 (GETL 0.0) - 11> (PUT |gc| |TimeTotal| 0.0) - <11 (PUT 0.0) - 11> (PUT |other| |TimeTotal| 0.0) - <11 (PUT 0.0) - 11> (|interpretTopLevel| 1 - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 12> (|interpret| 1 - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 13> (|interpret1| 1 NIL - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) - 14> (|member| 1 (|noBranch| |noMapVal|)) - <14 (|member| NIL) - 14> (|member| 1 (|nil| |true| |false|)) - <14 (|member| NIL) - 14> (|member| |--immediateData--| NIL) - <14 (|member| NIL) - 14> (|isDomainValuedVariable| |--immediateData--|) - <14 (|isDomainValuedVariable| NIL) - 14> (GETDATABASE |--immediateData--| CONSTRUCTOR) - <14 (GETDATABASE NIL) - 14> (GETDATABASE |--immediateData--| ABBREVIATION) - <14 (GETDATABASE NIL) - 14> (|member| |--immediateData--| - (|Record| |Union| |Enumeration|)) - <14 (|member| NIL) - 14> (|getProplist| |--immediateData--| ((NIL))) - 15> (|search| |--immediateData--| ((NIL))) - 16> (|searchCurrentEnv| |--immediateData--| (NIL)) - <16 (|searchCurrentEnv| NIL) - 16> (|searchTailEnv| |--immediateData--| NIL) - <16 (|searchTailEnv| NIL) - <15 (|search| NIL) - 15> (|search| |--immediateData--| - ((((|Category| - (|modemap| (((|Category|) (|Category|)) (T *)))) - (|Join| - (|modemap| - (((|Category|) - (|Category|) - (|Category|) - (|Category|)) - (T *)) - (((|Category|) - (|Category|) - (|List| (|Category|)) - (|Category|)) - (T *)))))))) - 16> (|searchCurrentEnv| |--immediateData--| - (((|Category| - (|modemap| (((|Category|) (|Category|)) (T *)))) - (|Join| - (|modemap| - (((|Category|) - (|Category|) - (|Category|) - (|Category|)) - (T *)) - (((|Category|) - (|Category|) - (|List| (|Category|)) - (|Category|)) - (T *))))))) - <16 (|searchCurrentEnv| NIL) - 16> (|searchTailEnv| |--immediateData--| NIL) - <16 (|searchTailEnv| NIL) - <15 (|search| NIL) - <14 (|getProplist| NIL) - 14> (|member| |--immediateData--| NIL) - <14 (|member| NIL) - 14> (|member| |--immediateData--| NIL) - <14 (|member| NIL) - 14> (|member| |--immediateData--| NIL) - <14 (|member| NIL) - 14> (|member| |--immediateData--| NIL) - <14 (|member| NIL) - 14> (|member| |--immediateData--| NIL) - <14 (|member| NIL) - 14> (|interpret2| - (#0=(|PositiveInteger|) . 1) #0# - ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) - . "1")) - <14 (|interpret2| ((|PositiveInteger|) . 1)) - <13 (|interpret1| ((|PositiveInteger|) . 1)) - <12 (|interpret| ((|PositiveInteger|) . 1)) - <11 (|interpretTopLevel| ((|PositiveInteger|) . 1)) - 11> (GETL |analysis| |TimeTotal|) - <11 (GETL 0.0) - 11> (GETL |gc| |TimeTotal|) - <11 (GETL 0.0) - 11> (PUT |gc| |TimeTotal| 0.0) - <11 (PUT 0.0) - 11> (PUT |analysis| |TimeTotal| 0.0) - <11 (PUT 0.0) - 11> (GETL |other| |TimeTotal|) - <11 (GETL 0.0) - 11> (GETL |gc| |TimeTotal|) - <11 (GETL 0.0) - 11> (PUT |gc| |TimeTotal| 0.0) - <11 (PUT 0.0) - 11> (PUT |other| |TimeTotal| 0.0) - <11 (PUT 0.0) - 11> (|recordAndPrint| 1 (|PositiveInteger|)) - - 12> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (|member| (|PositiveInteger|) - ((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))) - <12 (|member| NIL) - 12> (|member| (|PositiveInteger|) - ((|Category|) (|Mode|) (|Domain|) - (|SubDomain| (|Domain|)))) - <12 (|member| NIL) - 12> (GETL |print| |TimeTotal|) - <12 (GETL 0.0) - 12> (GETL |gc| |TimeTotal|) - <12 (GETL 0.0) - 12> (PUT |gc| |TimeTotal| 0.0) - <12 (PUT 0.0) - 12> (PUT |print| |TimeTotal| 0.0) - <12 (PUT 0.0) - 12> (|isEqualOrSubDomain| (|PositiveInteger|) - (|OutputForm|)) - <12 (|isEqualOrSubDomain| NIL) - 12> (GETDATABASE |OutputForm| ABBREVIATION) - <12 (GETDATABASE OUTFORM) - 12> (HPUT # - (|OutputForm|) (1)) - <12 (HPUT (1)) - 12> (HPUT # - (NIL NIL NIL) (1 . T)) - <12 (HPUT (1 . T)) - 12> (HPUT # - (#0=(|OutputForm|) NIL NIL) (1 . #0#)) - <12 (HPUT (1 |OutputForm|)) - 12> (HPUT # - (|PositiveInteger|) (1)) - <12 (HPUT (1)) - 12> (|member| (|OutputForm|) ((|Integer|) (|OutputForm|))) - <12 (|member| ((|OutputForm|))) - 12> (|member| (|OutputForm|) - ((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))) - <12 (|member| NIL) - 12> (GETDATABASE |OutputForm| ABBREVIATION) - <12 (GETDATABASE OUTFORM) - 12> (GETDATABASE |OutputForm| COSIG) - <12 (GETDATABASE (NIL)) - 12> (HPUT # - (|OutputForm|) (1 . T)) - <12 (HPUT (1 . T)) - 12> (|isPartialMode| (|OutputForm|)) - <12 (|isPartialMode| NIL) - 12> (|member| |coerce| (= + * -)) - <12 (|member| NIL) - 12> (|isPartialMode| (|OutputForm|)) - <12 (|isPartialMode| NIL) - 12> (|member| |PositiveInteger| - (|List| |Vector| |Stream| |FiniteSet| |Array|)) - <12 (|member| NIL) - 12> (|member| |PositiveInteger| - (|Union| |Record| |Mapping| |Enumeration|)) - <12 (|member| NIL) - 12> (GETDATABASE |PositiveInteger| OPERATIONALIST) - <12 (GETDATABASE - ((~= (((|Boolean|) $ $) NIL)) - (|sample| (($) NIL T CONST)) - (|recip| (((|Union| $ "failed") $) NIL)) - (|one?| (((|Boolean|) $) NIL)) - (|min| (($ $ $) NIL)) - (|max| (($ $ $) NIL)) - (|latex| (((|String|) $) NIL)) - (|hash| (((|SingleInteger|) $) NIL)) - (|gcd| (($ $ $) NIL)) - (|coerce| (((|OutputForm|) $) NIL)) - (^ (($ $ (|NonNegativeInteger|)) NIL) - (($ $ (|PositiveInteger|)) NIL)) - (|One| (($) NIL T CONST)) - (>= (((|Boolean|) $ $) NIL)) - (> (((|Boolean|) $ $) NIL)) - (= (((|Boolean|) $ $) NIL)) - (<= (((|Boolean|) $ $) NIL)) - (< (((|Boolean|) $ $) NIL)) - (+ (($ $ $) NIL)) - (** (($ $ (|NonNegativeInteger|)) NIL) - (($ $ (|PositiveInteger|)) NIL)) - (* (($ (|PositiveInteger|) $) NIL) (($ $ $) NIL)))) - 12> (|constructSubst| (|PositiveInteger|)) - <12 (|constructSubst| (($ |PositiveInteger|))) - 12> (|isEqualOrSubDomain| #0=(|PositiveInteger|) #0#) - <12 (|isEqualOrSubDomain| T) - 12> (|isEqualOrSubDomain| (|OutputForm|) (|OutputForm|)) - <12 (|isEqualOrSubDomain| T) - 12> (|member| |OutputForm| (|Union| |Record| |Mapping| |Enumeration|)) - <12 (|member| NIL) - 12> (GETDATABASE |OutputForm| OPERATIONALIST) - <12 (GETDATABASE - ((~= (((|Boolean|) $ $) NIL)) - (|zag| (($ $ $) 120)) - (|width| (((|Integer|) $) 30) (((|Integer|)) 35)) - (|vspace| (($ (|Integer|)) 47)) - (|vconcat| (($ $ $) 48) (($ (|List| $)) 80)) - (|supersub| (($ $ (|List| $)) 78)) - (|superHeight| (((|Integer|) $) 33)) - (|super| (($ $ $) 66)) - (|sum| (($ $) 135) (($ $ $) 136) (($ $ $ $) 137)) - (|subHeight| (((|Integer|) $) 32)) - (|sub| (($ $ $) 65)) - (|string| (($ $) 109)) - (|slash| (($ $ $) 124)) - (|semicolonSeparate| (($ (|List| $)) 55)) - (|scripts| (($ $ (|List| $)) 72)) - (|rspace| (($ (|Integer|) (|Integer|)) 49)) - (|root| (($ $) 121) (($ $ $) 122)) - (|right| (($ $ (|Integer|)) 42) (($ $) 45)) - (|rem| (($ $ $) 93)) - (|rarrow| (($ $ $) 127)) - (|quote| (($ $) 110)) - (|quo| (($ $ $) 94)) - (|prod| (($ $) 138) (($ $ $) 139) (($ $ $ $) 140)) - (|print| (((|Void|) $) 8)) - (|prime| (($ $) 113) (($ $ (|NonNegativeInteger|)) 117)) - (|presuper| (($ $ $) 68)) - (|presub| (($ $ $) 67)) - (|prefix| (($ $ (|List| $)) 104)) - (|postfix| (($ $ $) 108)) - (|pile| (($ (|List| $)) 53)) - (|paren| (($ $) 63) (($ (|List| $)) 64)) - (|overlabel| (($ $ $) 118)) - (|overbar| (($ $) 111)) - (|over| (($ $ $) 123)) - (|outputForm| (($ (|Integer|)) 20) - (($ (|Symbol|)) 22) - (($ (|String|)) 29) - (($ (|DoubleFloat|)) 24)) - (|or| (($ $ $) 97)) - (|not| (($ $) 98)) - (|messagePrint| (((|Void|) (|String|)) 14)) - (|message| (($ (|String|)) 13)) - (|matrix| (($ (|List| (|List| $))) 51)) - (|left| (($ $ (|Integer|)) 41) (($ $) 44)) - (|latex| (((|String|) $) NIL)) - (|label| (($ $ $) 126)) - (|int| (($ $) 141) (($ $ $) 142) (($ $ $ $) 143)) - (|infix?| (((|Boolean|) $) 102)) - (|infix| (($ $ (|List| $)) 106) (($ $ $ $) 107)) - (|hspace| (($ (|Integer|)) 38)) - (|height| (((|Integer|) $) 31) (((|Integer|)) 34)) - (|hconcat| (($ $ $) 39) (($ (|List| $)) 79)) - (|hash| (((|SingleInteger|) $) NIL)) - (|exquo| (($ $ $) 95)) - (|empty| (($) 12)) - (|elt| (($ $ (|List| $)) 103)) - (|dot| (($ $) 112) - (($ $ (|NonNegativeInteger|)) 116)) - (|div| (($ $ $) 92)) - (|differentiate| (($ $ (|NonNegativeInteger|)) 134)) - (|commaSeparate| (($ (|List| $)) 54)) - (|coerce| (((|OutputForm|) $) 18)) - (|center| (($ $ (|Integer|)) 40) (($ $) 43)) - (|bracket| (($ $) 61) (($ (|List| $)) 62)) - (|brace| (($ $) 59) (($ (|List| $)) 60)) - (|box| (($ $) 119)) - (|blankSeparate| (($ (|List| $)) 58)) - (|binomial| (($ $ $) 101)) - (|assign| (($ $ $) 125)) - (|and| (($ $ $) 96)) - (^= (($ $ $) 81)) - (SEGMENT (($ $ $) 99) (($ $) 100)) - (>= (($ $ $) 85)) - (> (($ $ $) 83)) - (= (((|Boolean|) $ $) 15) (($ $ $) 16)) - (<= (($ $ $) 84)) - (< (($ $ $) 82)) - (/ (($ $ $) 90)) - (- (($ $ $) 87) (($ $) 88)) - (+ (($ $ $) 86)) - (** (($ $ $) 91)) - (* (($ $ $) 89)))) - 12> (|constructSubst| (|OutputForm|)) - <12 (|constructSubst| (($ |OutputForm|))) - 12> (|isEqualOrSubDomain| - (|PositiveInteger|) (|OutputForm|)) - <12 (|isEqualOrSubDomain| NIL) - 12> (HPUT # - (|coerce| (|OutputForm|) (#0=(|PositiveInteger|)) - (#0#) NIL) (1 ((#0# #1=(|OutputForm|) #0#) - (#1# $) (NIL)))) - <12 (HPUT (1 ((#0=(|PositiveInteger|) - #1=(|OutputForm|) #0#) (#1# $) (NIL)))) - 12> (HPUT # - (|coerce| #0=(|PositiveInteger|) (|OutputForm|)) - (1 (#0# #1=(|OutputForm|) #0#) (#1# $) (NIL))) - <12 (HPUT (1 (#0=(|PositiveInteger|) - #1=(|OutputForm|) #0#) (#1# $) (NIL))) - 12> (|evalDomain| (|PositiveInteger|)) - 13> (GETL |print| |TimeTotal|) - <13 (GETL 0.0) - 13> (GETL |gc| |TimeTotal|) - <13 (GETL 0.0) - 13> (PUT |gc| |TimeTotal| 0.0) - <13 (PUT 0.0) - 13> (PUT |print| |TimeTotal| 0.0) - <13 (PUT 0.0) - 13> (|mkEvalable| (|PositiveInteger|)) - 14> (CANFUNCALL? |PositiveInteger|) - <14 (CANFUNCALL? T) - 14> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) - <14 (GETDATABASE |domain|) - 14> (GETDATABASE |PositiveInteger| COSIG) - <14 (GETDATABASE (NIL)) - <13 (|mkEvalable| (|PositiveInteger|)) - 13> (GETL |PositiveInteger| LOADED) - <13 (GETL NIL) - 13> (|loadLib| |PositiveInteger|) - 14> (GETL |instantiation| |TimeTotal|) - <14 (GETL 0.0) - 14> (GETL |gc| |TimeTotal|) - <14 (GETL 0.0) - 14> (PUT |gc| |TimeTotal| 0.0) - <14 (PUT 0.0) - 14> (PUT |instantiation| |TimeTotal| 0.0) - <14 (PUT 0.0) - 14> (GETDATABASE |PositiveInteger| OBJECT) - <14 (GETDATABASE - "/home/daly/noise/mnt/ubuntu/algebra/PI.o") - 14> (|pathnameDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/PI.o") - 15> (|pathname| - "/home/daly/noise/mnt/ubuntu/algebra/PI.o") - <15 (|pathname| - #p"/home/daly/noise/mnt/ubuntu/algebra/PI.o") - <14 (|pathnameDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/") - 14> (|isSystemDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/") - <14 (|isSystemDirectory| T) - 14> (|loadLibNoUpdate| |PositiveInteger| |PositiveInteger| - "/home/daly/noise/mnt/ubuntu/algebra/PI.o") - 15> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) - <15 (GETDATABASE |domain|) - 15> (|getProplist| |NonNegativeInteger| - ((((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) - (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 16> (|search| |NonNegativeInteger| - ((((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) - (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 17> (|searchCurrentEnv| |NonNegativeInteger| - (((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) - (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *))))))) - <17 (|searchCurrentEnv| NIL) - 17> (|searchTailEnv| |NonNegativeInteger| NIL) - <17 (|searchTailEnv| NIL) - <16 (|search| NIL) - 16> (|search| |NonNegativeInteger| - ((((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) - (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 17> (|searchCurrentEnv| |NonNegativeInteger| - (((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *))))))) - <17 (|searchCurrentEnv| NIL) - 17> (|searchTailEnv| |NonNegativeInteger| NIL) - <17 (|searchTailEnv| NIL) - <16 (|search| NIL) - <15 (|getProplist| NIL) - 15> (|addBinding| |NonNegativeInteger| - ((|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - ((((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 16> (|getProplist| |NonNegativeInteger| - ((((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 17> (|search| |NonNegativeInteger| - ((((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 18> (|searchCurrentEnv| |NonNegativeInteger| - (((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *))))))) - <18 (|searchCurrentEnv| NIL) - 18> (|searchTailEnv| |NonNegativeInteger| NIL) - <18 (|searchTailEnv| NIL) - <17 (|search| NIL) - 17> (|search| |NonNegativeInteger| - ((((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 18> (|searchCurrentEnv| |NonNegativeInteger| - (((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *))))))) - <18 (|searchCurrentEnv| NIL) - 18> (|searchTailEnv| |NonNegativeInteger| NIL) - <18 (|searchTailEnv| NIL) - <17 (|search| NIL) - <16 (|getProplist| NIL) - 16> (|addBindingInteractive| |NonNegativeInteger| - ((|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - ((((|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - <16 (|addBindingInteractive| - ((((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - <15 (|addBinding| - ((((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 15> (|getProplist| |PositiveInteger| - ((((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 16> (|search| |PositiveInteger| - ((((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 17> (|searchCurrentEnv| |PositiveInteger| - (((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *))))))) - <17 (|searchCurrentEnv| NIL) - 17> (|searchTailEnv| |PositiveInteger| NIL) - <17 (|searchTailEnv| NIL) - <16 (|search| NIL) - 16> (|search| |PositiveInteger| - ((((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 17> (|searchCurrentEnv| |PositiveInteger| - (((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *))))))) - <17 (|searchCurrentEnv| NIL) - 17> (|searchTailEnv| |PositiveInteger| NIL) - <17 (|searchTailEnv| NIL) - <16 (|search| NIL) - <15 (|getProplist| NIL) - 15> (|addBinding| |PositiveInteger| - ((|SuperDomain| |NonNegativeInteger|)) - ((((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 16> (|getProplist| |PositiveInteger| - ((((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 17> (|search| |PositiveInteger| - ((((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 18> (|searchCurrentEnv| |PositiveInteger| - (((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *))))))) - <18 (|searchCurrentEnv| NIL) - 18> (|searchTailEnv| |PositiveInteger| NIL) - <18 (|searchTailEnv| NIL) - <17 (|search| NIL) - 17> (|search| |PositiveInteger| - ((((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 18> (|searchCurrentEnv| |PositiveInteger| - (((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *))))))) - <18 (|searchCurrentEnv| NIL) - 18> (|searchTailEnv| |PositiveInteger| NIL) - <18 (|searchTailEnv| NIL) - <17 (|search| NIL) - <16 (|getProplist| NIL) - 16> (|addBindingInteractive| |PositiveInteger| - ((|SuperDomain| |NonNegativeInteger|)) - ((((|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - <16 (|addBindingInteractive| - ((((|PositiveInteger| - (|SuperDomain| |NonNegativeInteger|)) - (|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - <15 (|addBinding| - ((((|PositiveInteger| - (|SuperDomain| |NonNegativeInteger|)) - (|NonNegativeInteger| - (|SubDomain| - (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) - (|Category| (|modemap| - (((|Category|) (|Category|)) (T *)))) - (|Join| (|modemap| - (((|Category|) (|Category|) (|Category|) - (|Category|)) (T *)) - (((|Category|) (|Category|) (|List| (|Category|)) - (|Category|)) (T *)))))))) - 15> (|makeByteWordVec2| 1 (0 0 0 0 0 0 0)) - <15 (|makeByteWordVec2| #) - 15> (|makeByteWordVec2| 12 (2 5 6 0 0 7 2 0 6 0 0 1 0 0 0 - 1 1 0 9 0 1 1 0 6 0 1 2 0 0 0 0 1 2 0 0 0 0 1 1 0 11 - 0 1 1 0 10 0 1 2 0 0 0 0 1 1 0 12 0 1 2 0 0 0 8 1 2 - 0 0 0 5 1 0 0 0 1 2 0 6 0 0 1 2 0 6 0 0 1 2 0 6 0 0 - 1 2 0 6 0 0 1 2 0 6 0 0 1 2 0 0 0 0 1 2 0 0 0 8 1 2 - 0 0 0 5 1 2 0 0 0 0 1 2 0 0 8 0 1)) - <15 (|makeByteWordVec2| #) - 15> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) - <15 (GETDATABASE |domain|) - 15> (GETL |load| |TimeTotal|) - <15 (GETL 0.0) - 15> (GETL |gc| |TimeTotal|) - <15 (GETL 0.0) - 15> (PUT |gc| |TimeTotal| 0.0) - <15 (PUT 0.0) - 15> (PUT |load| |TimeTotal| 0.0) - <15 (PUT 0.0) - <14 (|loadLibNoUpdate| T) - <13 (|loadLib| T) - 13> (HPUT # |PositiveInteger| - ((NIL 1 . #))) - <13 (HPUT ((NIL 1 . #))) - 13> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) - <13 (GETDATABASE |domain|) - 13> (GETL |PositiveInteger| |infovec|) - <13 (GETL (# - # - (((|commutative| "*") . 0)) - (# - # - # - . #) |lookupComplete|)) - 13> (HPUT # |PositiveInteger| - ((NIL 1 . #))) - <13 (HPUT ((NIL 1 . #))) - 13> (GETL |instantiation| |TimeTotal|) - <13 (GETL 0.0) - 13> (GETL |gc| |TimeTotal|) - <13 (GETL 0.0) - 13> (PUT |gc| |TimeTotal| 0.0) - <13 (PUT 0.0) - 13> (PUT |instantiation| |TimeTotal| 0.0) - <13 (PUT 0.0) - <12 (|evalDomain| #) - 12> (|compiledLookup| |coerce| ((|OutputForm|) $) - #) - 13> (|NRTevalDomain| #) - 14> (|evalDomain| #) - 15> (GETL |print| |TimeTotal|) - <15 (GETL 0.0) - 15> (GETL |gc| |TimeTotal|) - <15 (GETL 0.0) - 15> (PUT |gc| |TimeTotal| 0.0) - <15 (PUT 0.0) - 15> (PUT |print| |TimeTotal| 0.0) - <15 (PUT 0.0) - 15> (|mkEvalable| #) - <15 (|mkEvalable| #) - 15> (GETL |instantiation| |TimeTotal|) - <15 (GETL 0.0) - 15> (GETL |gc| |TimeTotal|) - <15 (GETL 0.0) - 15> (PUT |gc| |TimeTotal| 0.0) - <15 (PUT 0.0) - 15> (PUT |instantiation| |TimeTotal| 0.0) - <15 (PUT 0.0) - <14 (|evalDomain| #) - <13 (|NRTevalDomain| #) - 13> (|basicLookup| |coerce| ((|OutputForm|) $) - # #) - 14> (|oldCompLookup| |coerce| ((|OutputForm|) $) - # #) - 15> (|lookupInDomainVector| |coerce| ((|OutputForm|) $) - # #) - 16> (GETDATABASE |OutputForm| COSIG) - <16 (GETDATABASE (NIL)) - 16> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) - <16 (GETDATABASE |domain|) - 16> (GETL |NonNegativeInteger| LOADED) - <16 (GETL NIL) - 16> (|loadLib| |NonNegativeInteger|) - 17> (GETL |print| |TimeTotal|) - <17 (GETL 0.0) - 17> (GETL |gc| |TimeTotal|) - <17 (GETL 0.0) - 17> (PUT |gc| |TimeTotal| 0.0) - <17 (PUT 0.0) - 17> (PUT |print| |TimeTotal| 0.0) - <17 (PUT 0.0) - 17> (GETDATABASE |NonNegativeInteger| OBJECT) - <17 (GETDATABASE - "/home/daly/noise/mnt/ubuntu/algebra/NNI.o") - 17> (|pathnameDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/NNI.o") - 18> (|pathname| - "/home/daly/noise/mnt/ubuntu/algebra/NNI.o") - <18 (|pathname| - #p"/home/daly/noise/mnt/ubuntu/algebra/NNI.o") - <17 (|pathnameDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/") - 17> (|isSystemDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/") - <17 (|isSystemDirectory| T) - 17> (|loadLibNoUpdate| |NonNegativeInteger| - |NonNegativeInteger| - "/home/daly/noise/mnt/ubuntu/algebra/NNI.o") - 18> (GETDATABASE |NonNegativeInteger| CONSTRUCTORKIND) - <18 (GETDATABASE |domain|) - 18> (|getProplist| |Integer| ((NIL))) - 19> (|search| |Integer| ((NIL))) - 20> (|searchCurrentEnv| |Integer| (NIL)) - <20 (|searchCurrentEnv| NIL) - 20> (|searchTailEnv| |Integer| NIL) - <20 (|searchTailEnv| NIL) - <19 (|search| NIL) - 19> (|search| |Integer| ((NIL))) - 20> (|searchCurrentEnv| |Integer| (NIL)) - <20 (|searchCurrentEnv| NIL) - 20> (|searchTailEnv| |Integer| NIL) - <20 (|searchTailEnv| NIL) - <19 (|search| NIL) - <18 (|getProplist| NIL) - 18> (|addBinding| |Integer| - ((|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))) ((NIL))) - 19> (|getProplist| |Integer| ((NIL))) - 20> (|search| |Integer| ((NIL))) - 21> (|searchCurrentEnv| |Integer| (NIL)) - <21 (|searchCurrentEnv| NIL) - 21> (|searchTailEnv| |Integer| NIL) - <21 (|searchTailEnv| NIL) - <20 (|search| NIL) - 20> (|search| |Integer| ((NIL))) - 21> (|searchCurrentEnv| |Integer| (NIL)) - <21 (|searchCurrentEnv| NIL) - 21> (|searchTailEnv| |Integer| NIL) - <21 (|searchTailEnv| NIL) - <20 (|search| NIL) - <19 (|getProplist| NIL) - 19> (|addBindingInteractive| |Integer| - ((|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))) ((NIL))) - <19 (|addBindingInteractive| - ((((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - <18 (|addBinding| - ((((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - 18> (|getProplist| |NonNegativeInteger| - ((((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - 19> (|search| |NonNegativeInteger| - ((((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - 20> (|searchCurrentEnv| |NonNegativeInteger| - (((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T)))))))) - <20 (|searchCurrentEnv| NIL) - 20> (|searchTailEnv| |NonNegativeInteger| NIL) - <20 (|searchTailEnv| NIL) - <19 (|search| NIL) - 19> (|search| |NonNegativeInteger| - ((((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - 20> (|searchCurrentEnv| |NonNegativeInteger| - (((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T)))))))) - <20 (|searchCurrentEnv| NIL) - 20> (|searchTailEnv| |NonNegativeInteger| NIL) - <20 (|searchTailEnv| NIL) - <19 (|search| NIL) - <18 (|getProplist| NIL) - 18> (|addBinding| |NonNegativeInteger| - ((|SuperDomain| |Integer|)) - ((((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - 19> (|getProplist| |NonNegativeInteger| - ((((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - 20> (|search| |NonNegativeInteger| - ((((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - 21> (|searchCurrentEnv| |NonNegativeInteger| - (((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T)))))))) - <21 (|searchCurrentEnv| NIL) - 21> (|searchTailEnv| |NonNegativeInteger| NIL) - <21 (|searchTailEnv| NIL) - <20 (|search| NIL) - 20> (|search| |NonNegativeInteger| - ((((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - 21> (|searchCurrentEnv| |NonNegativeInteger| - (((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T)))))))) - <21 (|searchCurrentEnv| NIL) - 21> (|searchTailEnv| |NonNegativeInteger| NIL) - <21 (|searchTailEnv| NIL) - <20 (|search| NIL) - <19 (|getProplist| NIL) - 19> (|addBindingInteractive| |NonNegativeInteger| - ((|SuperDomain| |Integer|)) - ((((|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - <19 (|addBindingInteractive| - ((((|NonNegativeInteger| (|SuperDomain| |Integer|)) - (|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - <18 (|addBinding| - ((((|NonNegativeInteger| (|SuperDomain| |Integer|)) - (|Integer| - (|SubDomain| - (|NonNegativeInteger| - COND - ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) - ((QUOTE T) (QUOTE T))))))))) - 18> (|makeByteWordVec2| 1 (0 0 0 0 0 0 0 0 0 0 0 0 0)) - <18 (|makeByteWordVec2| #) - 18> (|makeByteWordVec2| 18 (2 5 6 0 0 7 2 5 0 0 0 10 2 0 6 - 0 0 1 1 0 6 0 1 2 0 0 0 0 8 2 0 11 0 0 12 2 0 0 0 5 - 9 0 0 0 1 2 0 0 0 0 1 1 0 11 0 1 1 0 0 0 1 2 0 0 0 - 0 1 1 0 6 0 1 2 0 0 0 0 1 2 0 0 0 0 1 1 0 17 0 1 1 - 0 16 0 1 2 0 0 0 0 1 2 0 11 0 0 1 2 0 13 0 0 1 1 0 - 18 0 1 2 0 0 0 14 1 2 0 0 0 15 1 0 0 0 1 0 0 0 1 2 - 0 6 0 0 1 2 0 6 0 0 1 2 0 6 0 0 1 2 0 6 0 0 1 2 0 - 6 0 0 1 2 0 0 0 0 1 2 0 0 0 14 1 2 0 0 0 15 1 2 0 - 0 0 0 1 2 0 0 14 0 1 2 0 0 15 0 1)) - <18 (|makeByteWordVec2| #) - 18> (GETDATABASE |NonNegativeInteger| CONSTRUCTORKIND) - <18 (GETDATABASE |domain|) - 18> (GETL |load| |TimeTotal|) - <18 (GETL 0.0) - 18> (GETL |gc| |TimeTotal|) - <18 (GETL 0.0) - 18> (PUT |gc| |TimeTotal| 0.0) - <18 (PUT 0.0) - 18> (PUT |load| |TimeTotal| 0.0) - <18 (PUT 0.0) - <17 (|loadLibNoUpdate| T) - <16 (|loadLib| T) - 16> (HPUT # - |NonNegativeInteger| - ((NIL 1 . #))) - <16 (HPUT ((NIL 1 . #))) - 16> (GETDATABASE |NonNegativeInteger| CONSTRUCTORKIND) - <16 (GETDATABASE |domain|) - 16> (GETL |NonNegativeInteger| |infovec|) - <16 (GETL (# - # - (((|commutative| "*") . 0)) - (# - # - # - . #) - |lookupComplete|)) - 16> (HPUT # - |NonNegativeInteger| - ((NIL 1 . #))) - <16 (HPUT ((NIL 1 . #))) - 16> (|lookupInDomainVector| |coerce| ((|OutputForm|) $) - # #) - 17> (GETDATABASE |NonNegativeInteger| CONSTRUCTORKIND) - <17 (GETDATABASE |domain|) - 17> (PNAME |NonNegativeInteger|) - <17 (PNAME "NonNegativeInteger") - 17> (PNAME |NonNegativeInteger|) - <17 (PNAME "NonNegativeInteger") - 17> (GETDATABASE |OutputForm| COSIG) - <17 (GETDATABASE (NIL)) - 17> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) - <17 (GETDATABASE |domain|) - 17> (GETL |Integer| LOADED) - <17 (GETL NIL) - 17> (|loadLib| |Integer|) - 18> (GETL |print| |TimeTotal|) - <18 (GETL 0.0) - 18> (GETL |gc| |TimeTotal|) - <18 (GETL 0.0) - 18> (PUT |gc| |TimeTotal| 0.0) - <18 (PUT 0.0) - 18> (PUT |print| |TimeTotal| 0.0) - <18 (PUT 0.0) - 18> (GETDATABASE |Integer| OBJECT) - <18 (GETDATABASE - "/home/daly/noise/mnt/ubuntu/algebra/INT.o") - 18> (|pathnameDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/INT.o") - 19> (|pathname| - "/home/daly/noise/mnt/ubuntu/algebra/INT.o") - <19 (|pathname| - #p"/home/daly/noise/mnt/ubuntu/algebra/INT.o") - <18 (|pathnameDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/") - 18> (|isSystemDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/") - <18 (|isSystemDirectory| T) - 18> (|loadLibNoUpdate| |Integer| |Integer| - "/home/daly/noise/mnt/ubuntu/algebra/INT.o") - 19> (GETDATABASE |Integer| CONSTRUCTORKIND) - <19 (GETDATABASE |domain|) - 19> (|makeByteWordVec2| 1 - (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) - <19 (|makeByteWordVec2| #) - 19> (|makeByteWordVec2| 133 - (1 7 6 0 8 3 7 6 0 9 9 10 2 7 6 0 11 12 1 7 6 0 13 0 - 14 0 15 2 7 0 9 14 16 1 7 6 0 17 1 7 6 0 18 1 7 6 0 - 19 1 35 0 11 36 1 44 0 11 45 1 47 0 11 48 1 50 0 11 - 51 1 9 0 11 53 2 93 90 91 92 94 1 97 95 96 98 1 96 - 0 0 99 1 96 2 0 100 1 101 95 96 102 1 96 0 2 103 1 - 0 104 0 105 2 108 95 106 107 109 2 110 95 95 95 111 - 1 101 95 96 112 1 96 21 0 113 1 96 0 0 114 1 116 96 - 115 117 2 0 21 0 0 1 1 0 21 0 25 1 0 87 0 88 1 0 0 - 0 89 1 0 21 0 1 2 0 0 0 0 1 2 0 83 0 0 1 3 0 0 0 0 - 0 42 1 0 0 0 1 1 0 104 0 1 2 0 21 0 0 1 1 0 11 0 1 - 2 0 0 0 0 82 0 0 0 1 1 0 124 0 1 1 0 11 0 1 2 0 0 0 - 0 81 2 0 60 58 61 62 1 0 57 58 59 1 0 83 0 85 1 0 - 120 0 1 1 0 21 0 1 1 0 121 0 1 1 0 0 0 65 0 0 0 64 - 2 0 0 0 0 80 1 0 127 126 1 1 0 21 0 1 3 0 0 0 0 0 1 - 2 0 0 0 0 56 1 0 21 0 1 2 0 0 0 0 1 3 0 122 0 123 - 122 1 1 0 21 0 26 1 0 21 0 75 1 0 83 0 1 1 0 21 0 - 34 2 0 125 126 0 1 3 0 0 0 0 0 43 2 0 0 0 0 77 2 0 - 0 0 0 76 1 0 0 0 1 1 0 0 0 40 2 0 131 0 0 1 1 0 0 - 126 1 2 0 0 0 0 1 1 0 9 0 55 2 0 0 0 0 1 0 0 0 1 1 - 0 0 0 31 1 0 0 0 33 1 0 133 0 1 2 0 118 118 118 119 - 2 0 0 0 0 86 1 0 0 126 1 1 0 0 0 1 1 0 104 0 105 3 - 0 129 0 0 0 1 2 0 130 0 0 1 2 0 83 0 0 84 2 0 125 - 126 0 1 1 0 21 0 1 1 0 73 0 1 2 0 78 0 0 79 1 0 0 0 - 1 2 0 0 0 73 1 1 0 0 0 32 1 0 0 0 30 1 0 9 0 54 1 0 - 47 0 49 1 0 44 0 46 1 0 50 0 52 1 0 123 0 1 1 0 11 - 0 39 1 0 0 11 38 1 0 0 0 1 1 0 0 11 38 1 0 35 0 37 - 0 0 73 1 2 0 21 0 0 1 2 0 0 0 0 1 0 0 0 29 2 0 21 0 - 0 1 3 0 0 0 0 0 41 1 0 0 0 63 2 0 0 0 73 1 2 0 0 0 - 132 1 0 0 0 27 0 0 0 28 3 0 6 7 0 21 24 2 0 9 0 21 - 22 2 0 6 7 0 23 1 0 9 0 20 1 0 0 0 1 2 0 0 0 73 1 2 - 0 21 0 0 1 2 0 21 0 0 1 2 0 21 0 0 66 2 0 21 0 0 1 - 2 0 21 0 0 67 2 0 0 0 0 70 1 0 0 0 68 2 0 0 0 0 69 - 2 0 0 0 73 74 2 0 0 0 132 1 2 0 0 0 0 71 2 0 0 11 0 - 72 2 0 0 73 0 1 2 0 0 132 0 1)) - <19 (|makeByteWordVec2| #) - 19> (GETDATABASE |Integer| CONSTRUCTORKIND) - <19 (GETDATABASE |domain|) - 19> (GETL |load| |TimeTotal|) - <19 (GETL 0.0) - 19> (GETL |gc| |TimeTotal|) - <19 (GETL 0.0) - 19> (PUT |gc| |TimeTotal| 0.0) - <19 (PUT 0.0) - 19> (PUT |load| |TimeTotal| 0.0) - <19 (PUT 0.0) - <18 (|loadLibNoUpdate| T) - <17 (|loadLib| T) - 17> (HPUT # |Integer| - ((NIL 1 . #))) - <17 (HPUT ((NIL 1 . #))) - 17> (GETDATABASE |Integer| CONSTRUCTORKIND) - <17 (GETDATABASE |domain|) - 17> (GETL |Integer| |infovec|) - <17 (GETL (# - # ((|infinite| . 0) - (|noetherian| . 0) (|canonicalsClosed| . 0) - (|canonical| . 0) (|canonicalUnitNormal| . 0) - (|multiplicativeValuation| . 0) - (|noZeroDivisors| . 0) - ((|commutative| "*") . 0) (|rightUnitary| . 0) - (|leftUnitary| . 0) (|unitsKnown| . 0)) - (# - # - # - . #) - |lookupComplete|)) - 17> (HPUT # |Integer| - ((NIL 1 . #))) - <17 (HPUT ((NIL 1 . #))) - 17> (|lookupInDomainVector| |coerce| ((|OutputForm|) $) - # #) - 18> (GETDATABASE |Integer| CONSTRUCTORKIND) - <18 (GETDATABASE |domain|) - 18> (PNAME |Integer|) - <18 (PNAME "Integer") - 18> (PNAME |Integer|) - <18 (PNAME "Integer") - 18> (GETDATABASE |OutputForm| COSIG) - <18 (GETDATABASE (NIL)) - 18> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) - <18 (GETDATABASE |domain|) - <17 (|lookupInDomainVector| - (# - . #)) - <16 (|lookupInDomainVector| - (# - . #)) - <15 (|lookupInDomainVector| - (# - . #)) - <14 (|oldCompLookup| - (# - . #)) - <13 (|basicLookup| - (# - . #)) - <12 (|compiledLookup| - (# - . #)) - -"TPD:INT:coerce(x):OutputForm" -\end{verbatim} - -\begin{verbatim} - 12> (GETDATABASE |Integer| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (GETL |OutputForm| LOADED) - <12 (GETL NIL) - 12> (|loadLib| |OutputForm|) - 13> (GETL |print| |TimeTotal|) - <13 (GETL 0.0) - 13> (GETL |gc| |TimeTotal|) - <13 (GETL 0.0) - 13> (PUT |gc| |TimeTotal| 0.0) - <13 (PUT 0.0) - 13> (PUT |print| |TimeTotal| 0.0) - <13 (PUT 0.0) - 13> (GETDATABASE |OutputForm| OBJECT) - <13 (GETDATABASE - "/home/daly/noise/mnt/ubuntu/algebra/OUTFORM.o") - 13> (|pathnameDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/OUTFORM.o") - 14> (|pathname| - "/home/daly/noise/mnt/ubuntu/algebra/OUTFORM.o") - <14 (|pathname| - #p"/home/daly/noise/mnt/ubuntu/algebra/OUTFORM.o") - <13 (|pathnameDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/") - 13> (|isSystemDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/") - <13 (|isSystemDirectory| T) - 13> (|loadLibNoUpdate| |OutputForm| |OutputForm| - "/home/daly/noise/mnt/ubuntu/algebra/OUTFORM.o") - 14> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <14 (GETDATABASE |domain|) - 14> (|makeByteWordVec2| 1 (0 0 0)) - <14 (|makeByteWordVec2| #) - 14> (|makeByteWordVec2| 144 - (1 10 9 0 11 0 25 0 26 2 10 0 0 25 27 2 10 0 25 0 28 - 2 19 0 0 0 36 2 19 0 0 0 37 2 19 9 0 0 46 1 6 0 0 56 - 2 6 0 0 0 57 1 6 9 0 69 1 6 0 0 70 1 6 2 0 71 1 6 73 - 0 74 1 19 9 0 75 2 76 0 0 0 77 1 76 0 0 105 1 25 0 - 10 114 2 10 0 73 25 115 1 73 9 0 128 2 73 9 0 0 129 - 1 131 10 130 132 1 10 0 0 133 2 0 9 0 0 1 2 0 0 0 0 - 120 0 0 19 35 1 0 19 0 30 1 0 0 19 47 1 0 0 52 80 2 - 0 0 0 0 48 2 0 0 0 52 78 1 0 19 0 33 2 0 0 0 0 66 2 - 0 0 0 0 136 3 0 0 0 0 0 137 1 0 0 0 135 1 0 19 0 32 - 2 0 0 0 0 65 1 0 0 0 109 2 0 0 0 0 124 1 0 0 52 55 - 2 0 0 0 52 72 2 0 0 19 19 49 1 0 0 0 121 2 0 0 0 0 - 122 1 0 0 0 45 2 0 0 0 19 42 2 0 0 0 0 93 2 0 0 0 0 - 127 1 0 0 0 110 2 0 0 0 0 94 3 0 0 0 0 0 140 1 0 0 - 0 138 2 0 0 0 0 139 1 0 7 0 8 2 0 0 0 73 117 1 0 0 - 0 113 2 0 0 0 0 68 2 0 0 0 0 67 2 0 0 0 52 104 2 0 - 0 0 0 108 1 0 0 52 53 1 0 0 52 64 1 0 0 0 63 2 0 0 - 0 0 118 1 0 0 0 111 2 0 0 0 0 123 1 0 0 10 29 1 0 0 - 23 24 1 0 0 21 22 1 0 0 19 20 2 0 0 0 0 97 1 0 0 0 - 98 1 0 7 10 14 1 0 0 10 13 1 0 0 50 51 1 0 0 0 44 2 - 0 0 0 19 41 1 0 10 0 1 2 0 0 0 0 126 3 0 0 0 0 0 - 143 2 0 0 0 0 142 1 0 0 0 141 1 0 9 0 102 2 0 0 0 - 52 106 3 0 0 0 0 0 107 1 0 0 19 38 0 0 19 34 1 0 19 - 0 31 1 0 0 52 79 2 0 0 0 0 39 1 0 144 0 1 2 0 0 0 0 - 95 0 0 0 12 2 0 0 0 52 103 2 0 0 0 73 116 1 0 0 0 - 112 2 0 0 0 0 92 2 0 0 0 73 134 1 0 0 52 54 1 0 17 - 0 18 1 0 0 0 43 2 0 0 0 19 40 1 0 0 0 61 1 0 0 52 - 62 1 0 0 52 60 1 0 0 0 59 1 0 0 0 119 1 0 0 52 58 2 - 0 0 0 0 101 2 0 0 0 0 125 2 0 0 0 0 96 2 0 0 0 0 81 - 1 0 0 0 100 2 0 0 0 0 99 2 0 0 0 0 85 2 0 0 0 0 83 - 2 0 0 0 0 16 2 0 9 0 0 15 2 0 0 0 0 84 2 0 0 0 0 82 - 2 0 0 0 0 90 1 0 0 0 88 2 0 0 0 0 87 2 0 0 0 0 86 2 - 0 0 0 0 91 2 0 0 0 0 89)) - <14 (|makeByteWordVec2| #) - 14> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <14 (GETDATABASE |domain|) - 14> (GETL |load| |TimeTotal|) - <14 (GETL 0.0) - 14> (GETL |gc| |TimeTotal|) - <14 (GETL 0.0) - 14> (PUT |gc| |TimeTotal| 0.0) - <14 (PUT 0.0) - 14> (PUT |load| |TimeTotal| 0.0) - <14 (PUT 0.0) - <13 (|loadLibNoUpdate| T) - <12 (|loadLib| T) - 12> (HPUT # |OutputForm| - ((NIL 1 . #))) - <12 (HPUT ((NIL 1 . #))) - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (GETL |OutputForm| |infovec|) - <12 (GETL (# - # NIL - (# - # - # - . #) - |lookupComplete|)) - 12> (GETL |List| LOADED) - <12 (GETL NIL) - 12> (|loadLib| |List|) - 13> (GETL |print| |TimeTotal|) - <13 (GETL 0.0) - 13> (GETL |gc| |TimeTotal|) - <13 (GETL 0.0) - 13> (PUT |gc| |TimeTotal| 0.0) - <13 (PUT 0.0) - 13> (PUT |print| |TimeTotal| 0.0) - <13 (PUT 0.0) - 13> (GETDATABASE |List| OBJECT) - <13 (GETDATABASE - "/home/daly/noise/mnt/ubuntu/algebra/LIST.o") - 13> (|pathnameDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/LIST.o") - 14> (|pathname| - "/home/daly/noise/mnt/ubuntu/algebra/LIST.o") - <14 (|pathname| - #p"/home/daly/noise/mnt/ubuntu/algebra/LIST.o") - <13 (|pathnameDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/") - 13> (|isSystemDirectory| - "/home/daly/noise/mnt/ubuntu/algebra/") - <13 (|isSystemDirectory| T) - 13> (|loadLibNoUpdate| |List| |List| - "/home/daly/noise/mnt/ubuntu/algebra/LIST.o") - 14> (GETDATABASE |List| CONSTRUCTORKIND) - <14 (GETDATABASE |domain|) - 14> (|makeByteWordVec2| 8 - (0 0 0 0 0 0 0 0 0 0 3 0 0 8 4 0 0 8 1 2 4 5)) - <14 (|makeByteWordVec2| #) - 14> (|makeByteWordVec2| 51 - (1 13 12 0 14 3 13 12 0 15 15 16 1 0 6 0 17 3 6 12 - 13 0 8 18 1 0 0 0 19 1 13 12 0 20 0 21 0 22 2 13 0 - 15 21 23 1 13 12 0 24 1 13 12 0 25 1 13 12 0 26 1 - 0 15 0 27 2 0 15 0 8 28 2 0 12 13 0 29 3 0 12 13 0 - 8 30 2 0 0 0 0 31 1 0 0 0 32 2 0 0 0 0 33 0 0 0 34 - 1 0 8 0 35 2 0 8 6 0 36 2 0 0 0 0 37 2 0 6 0 38 39 - 2 0 0 6 0 40 2 0 0 0 0 41 1 42 0 15 43 1 44 0 42 45 - 1 6 44 0 46 2 47 0 44 0 48 1 44 0 49 50 1 0 44 0 51 - 2 1 0 0 0 33 2 1 0 0 0 37 2 1 0 0 0 41 1 0 0 0 19 1 - 1 0 0 32 1 0 8 0 9 0 0 0 7 2 1 8 6 0 36 1 0 6 0 17 - 1 0 8 0 35 0 0 0 34 2 0 6 0 38 39 1 2 44 0 51 2 0 0 - 6 0 10 2 0 0 6 0 40 2 0 0 0 0 31 2 0 0 0 0 11 3 5 12 - 13 0 8 30 2 5 12 13 0 29 1 5 15 0 27 2 5 15 0 8 28)) - <14 (|makeByteWordVec2| #) - 14> (GETDATABASE |List| CONSTRUCTORKIND) - <14 (GETDATABASE |domain|) - 14> (GETL |load| |TimeTotal|) - <14 (GETL 0.0) - 14> (GETL |gc| |TimeTotal|) - <14 (GETL 0.0) - 14> (PUT |gc| |TimeTotal| 0.0) - <14 (PUT 0.0) - 14> (PUT |load| |TimeTotal| 0.0) - <14 (PUT 0.0) - <13 (|loadLibNoUpdate| T) - <12 (|loadLib| T) - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (GETDATABASE |SetCategory| COSIG) - <12 (GETDATABASE (NIL)) - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (GETDATABASE |SetCategory| COSIG) - <12 (GETDATABASE (NIL)) - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (GETDATABASE |Integer| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (PNAME |Integer|) - <12 (PNAME "Integer") - 12> (PNAME |Integer|) - <12 (PNAME "Integer") - 12> (GETDATABASE |OrderedSet| COSIG) - <12 (GETDATABASE (NIL)) - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (PNAME |OutputForm|) - <12 (PNAME "OutputForm") - 12> (HPUT # |List| - ((((|OutputForm|)) 1 . #))) - <12 (HPUT ((((|OutputForm|)) 1 - . #))) - 12> (GETDATABASE |List| CONSTRUCTORKIND) - <12 (GETDATABASE |domain|) - 12> (GETL |List| |infovec|) - <12 (GETL (# - # - ((|shallowlyMutable| . 0) - (|finiteAggregate| . 0)) - (# - # - # - . #) - |lookupIncomplete|)) - 12> (HPUT # |OutputForm| - ((NIL 1 . #))) - <12 (HPUT ((NIL 1 . #))) - 12> (GETDATABASE |Integer| COSIG) - <12 (GETDATABASE (NIL)) - 12> (|basicLookup| |outputForm| ($ (|Integer|)) - # #) - 13> (|oldCompLookup| |outputForm| ($ (|Integer|)) - # #) - 14> (|lookupInDomainVector| |outputForm| ($ (|Integer|)) - # #) - 15> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <15 (GETDATABASE |domain|) - 15> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <15 (GETDATABASE |domain|) - 15> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <15 (GETDATABASE |domain|) - 15> (GETDATABASE |OutputForm| CONSTRUCTORKIND) - <15 (GETDATABASE |domain|) - 15> (GETDATABASE |Integer| COSIG) - <15 (GETDATABASE (NIL)) - <14 (|lookupInDomainVector| - (# - . #)) - <13 (|oldCompLookup| - (# - . #)) - <12 (|basicLookup| - (# - . #)) - -"TPD:OUTFORM:outputForm n" -\end{verbatim} - -\begin{verbatim} - 12> (GETL |print| |TimeTotal|) - <12 (GETL 0.0) - 12> (GETL |gc| |TimeTotal|) - <12 (GETL 0.0) - 12> (PUT |gc| |TimeTotal| 0.0) - <12 (PUT 0.0) - 12> (PUT |print| |TimeTotal| 0.0) - <12 (PUT 0.0) - 12> (|member| 1 ("failed" "nil" "prime" "sqfr" "irred")) - <12 (|member| NIL) - 12> (|member| EQUATNUM (SLASH OVER)) - <12 (|member| NIL) - 12> (GETL EQUATNUM |Led|) - <12 (GETL (|dummy| |dummy| 10000 0)) - 12> (|member| EQUATNUM (SLASH OVER)) - <12 (|member| NIL) - 12> (GETL EQUATNUM |Led|) - <12 (GETL (|dummy| |dummy| 10000 0)) - 12> (GETL EQUATNUM INFIXOP) - <12 (GETL " ") - 12> (GETL EQUATNUM WIDTH) - <12 (GETL NIL) - 12> (GETL EQUATNUM APP) - <12 (GETL NIL) - 12> (|member| EQUATNUM (SLASH OVER)) - <12 (|member| NIL) - 12> (GETL EQUATNUM |Led|) - <12 (GETL (|dummy| |dummy| 10000 0)) - 12> (|member| EQUATNUM (SLASH OVER)) - <12 (|member| NIL) - 12> (GETL EQUATNUM |Led|) - <12 (GETL (|dummy| |dummy| 10000 0)) - 12> (GETL EQUATNUM INFIXOP) - <12 (GETL " ") - 12> (GETL EQUATNUM SUPERSPAN) - <12 (GETL NIL) - 12> (GETL EQUATNUM SUBSPAN) - <12 (GETL NIL) - (1) 1 -\end{verbatim} - -\begin{verbatim} - 12> (|putHist| % |value| ((|PositiveInteger|) . 1) ((NIL))) - 13> (|recordNewValue| % |value| ((|PositiveInteger|) . 1)) - 14> (GETL |print| |TimeTotal|) - <14 (GETL 0.0) - 14> (GETL |gc| |TimeTotal|) - <14 (GETL 0.0) - 14> (PUT |gc| |TimeTotal| 0.0) - <14 (PUT 0.0) - 14> (PUT |print| |TimeTotal| 0.0) - <14 (PUT 0.0) - 14> (|recordNewValue0| % |value| ((|PositiveInteger|) . 1)) - <14 (|recordNewValue0| - ((% (|value| (|PositiveInteger|) . 1)))) - 14> (GETL |history| |TimeTotal|) - <14 (GETL 0.0) - 14> (GETL |gc| |TimeTotal|) - <14 (GETL 0.0) - 14> (PUT |gc| |TimeTotal| 0.0) - <14 (PUT 0.0) - 14> (PUT |history| |TimeTotal| 0.0) - <14 (PUT 0.0) - <13 (|recordNewValue| |history|) - 13> (|search| % ((NIL))) - 14> (|searchCurrentEnv| % (NIL)) - <14 (|searchCurrentEnv| NIL) - 14> (|searchTailEnv| % NIL) - <14 (|searchTailEnv| NIL) - <13 (|search| NIL) - <12 (|putHist| ((((% (|value| (|PositiveInteger|) . 1)))))) - 12> (|printTypeAndTime| 1 (|PositiveInteger|)) - 13> (|printTypeAndTimeNormal| 1 (|PositiveInteger|)) - 14> (|sayKeyedMsg| S2GL0012 ((|PositiveInteger|))) - 15> (|sayKeyedMsgLocal| S2GL0012 ((|PositiveInteger|))) - 16> (|getKeyedMsg| S2GL0012) - 17> (|fetchKeyedMsg| S2GL0012 NIL) - <17 (|fetchKeyedMsg| " %rjon Type: %1p %rjoff" T) - <16 (|getKeyedMsg| " %rjon Type: %1p %rjoff" T) - 16> (|segmentKeyedMsg| " %rjon Type: %1p %rjoff") - <16 (|segmentKeyedMsg| ("%rjon" "Type:" "%1p" "%rjoff")) - 16> (|member| "%rjon" (|%ceon| "%ceon")) - <16 (|member| NIL) - 16> (|member| "%rjon" (|%rjon| "%rjon")) - <16 (|member| ("%rjon")) - 16> (|member| "Type:" - (|%ceoff| "%ceoff" |%rjoff| "%rjoff")) - <16 (|member| NIL) - 16> (|member| "%1p" (|%ceoff| "%ceoff" |%rjoff| "%rjoff")) - <16 (|member| NIL) - 16> (|member| "%rjoff" - (|%ceoff| "%ceoff" |%rjoff| "%rjoff")) - <16 (|member| ("%rjoff")) - 16> (|member| "%rj" (|%ceon| "%ceon")) - <16 (|member| NIL) - 16> (|member| "%rj" (|%rjon| "%rjon")) - <16 (|member| NIL) - 16> (|member| "Type:" (|%ceon| "%ceon")) - <16 (|member| NIL) - 16> (|member| "Type:" (|%rjon| "%rjon")) - <16 (|member| NIL) - 16> (|member| "%1p" (|%ceon| "%ceon")) - <16 (|member| NIL) - 16> (|member| "%1p" (|%rjon| "%rjon")) - <16 (|member| NIL) - 16> (DIGITP #\r) - <16 (DIGITP NIL) - 16> (DIGITP #\1) - <16 (DIGITP 1) - 16> (GETDATABASE |PositiveInteger| ABBREVIATION) - <16 (GETDATABASE PI) - 16> (|member| "Type:" ("%n" |%n|)) - <16 (|member| NIL) - 16> (|member| "Type:" ("%y" |%y|)) - <16 (|member| NIL) - 16> (|member| "%rj" - (" " | | "%" % |%b| |%d| |%l| |%i| |%u| %U |%n| |%x| - |%ce| |%rj| "%U" "%b" "%d" "%l" "%i" "%u" "%U" "%n" - "%x" "%ce" "%rj" [ |(| "[" "(")) - <16 (|member| ("%rj" [ |(| "[" "(")) - 16> (|member| |PositiveInteger| ("%n" |%n|)) - <16 (|member| NIL) - 16> (|member| |PositiveInteger| ("%y" |%y|)) - <16 (|member| NIL) - 16> (|member| "Type:" - (" " | | "%" % |%b| |%d| |%l| |%i| |%u| %U |%n| |%x| - |%ce| |%rj| "%U" "%b" "%d" "%l" "%i" "%u" "%U" "%n" - "%x" "%ce" "%rj" [ |(| "[" "(")) - <16 (|member| NIL) - 16> (SIZE "Type:") - <16 (SIZE 5) - 16> (|member| |PositiveInteger| - (" " | | "%" % |%b| |%d| |%l| |%i| |%u| %U |%n| |%x| - |%ce| |%rj| "%U" "%b" "%d" "%l" "%i" "%u" "%U" "%n" - "%x" "%ce" "%rj" |.| |,| ! |:| |;| ? ] |)| "." "," - "!" ":" ";" "?" "]" ")")) - <16 (|member| NIL) - 16> (|member| "%rj" (|%ce| "%ce" |%rj| "%rj")) - <16 (|member| ("%rj")) - 16> (|sayMSG| (("%rj" "Type:" " " |PositiveInteger|))) - 17> (SAYBRIGHTLY1 (("%rj" "Type:" " " |PositiveInteger|)) - #) - 18> (BRIGHTPRINT (("%rj" "Type:" " " |PositiveInteger|))) - 19> (|member| "%rj" ("%p" "%s")) - <19 (|member| NIL) - 19> (|member| "Type:" (|%l| "%l")) - <19 (|member| NIL) - 19> (|member| " " (|%l| "%l")) - <19 (|member| NIL) - 19> (|member| |PositiveInteger| (|%l| "%l")) - <19 (|member| NIL) - 19> (|member| "Type:" ("%b" "%d" |%b| |%d|)) - <19 (|member| NIL) - 19> (|member| "Type:" ("%l" |%l|)) - <19 (|member| NIL) - 19> (|member| " " ("%b" "%d" |%b| |%d|)) - <19 (|member| NIL) - 19> (|member| " " ("%l" |%l|)) - <19 (|member| NIL) - 19> (|member| |PositiveInteger| ("%b" "%d" |%b| |%d|)) - <19 (|member| NIL) - 19> (|member| |PositiveInteger| ("%l" |%l|)) - <19 (|member| NIL) - 19> (PNAME |PositiveInteger|) - <19 (PNAME "PositiveInteger") - 19> (|fillerSpaces| 56 " ") - <19 (|fillerSpaces| - " ") - Type: - 19> (PNAME |PositiveInteger|) - <19 (PNAME "PositiveInteger") -PositiveInteger -\end{verbatim} - -\begin{verbatim} - <18 (BRIGHTPRINT NIL) - <17 (SAYBRIGHTLY1 NIL) - <16 (|sayMSG| NIL) - <15 (|sayKeyedMsgLocal| NIL) - <14 (|sayKeyedMsg| NIL) - <13 (|printTypeAndTimeNormal| NIL) - <12 (|printTypeAndTime| NIL) - <11 (|recordAndPrint| |done|) - 11> (|recordFrame| |normal|) - 12> (|diffAlist| - ((% (|value| (|PositiveInteger|) . 1))) NIL) - <12 (|diffAlist| ((% (|value|)))) - <11 (|recordFrame| ((% (|value|)))) - 11> (GETL |print| |TimeTotal|) - <11 (GETL 0.0) - 11> (GETL |gc| |TimeTotal|) - <11 (GETL 0.0) - 11> (PUT |gc| |TimeTotal| 0.0) - <11 (PUT 0.0) - 11> (PUT |print| |TimeTotal| 0.0) - <11 (PUT 0.0) - <10 (|processInteractive1| ((|PositiveInteger|) . 1)) - 10> (|writeHistModesAndValues|) - 11> (|putHist| % |value| - #0=((|PositiveInteger|) . 1) ((((% (|value| . #0#)))))) - 12> (|recordNewValue| % |value| ((|PositiveInteger|) . 1)) - 13> (GETL |other| |TimeTotal|) - <13 (GETL 0.0) - 13> (GETL |gc| |TimeTotal|) - <13 (GETL 0.0) - 13> (PUT |gc| |TimeTotal| 0.0) - <13 (PUT 0.0) - 13> (PUT |other| |TimeTotal| 0.0) - <13 (PUT 0.0) - 13> (|recordNewValue0| % |value| ((|PositiveInteger|) . 1)) - <13 (|recordNewValue0| (|value| (|PositiveInteger|) . 1)) - 13> (GETL |history| |TimeTotal|) - <13 (GETL 0.0) - 13> (GETL |gc| |TimeTotal|) - <13 (GETL 0.0) - 13> (PUT |gc| |TimeTotal| 0.0) - <13 (PUT 0.0) - 13> (PUT |history| |TimeTotal| 0.0) - <13 (PUT 0.0) - <12 (|recordNewValue| |history|) - 12> (|search| % - ((((% (|value| (|PositiveInteger|) . 1)))))) - 13> (|searchCurrentEnv| % - (((% (|value| (|PositiveInteger|) . 1))))) - <13 (|searchCurrentEnv| - ((|value| (|PositiveInteger|) . 1))) - <12 (|search| ((|value| (|PositiveInteger|) . 1))) - <11 (|putHist| ((((% (|value| (|PositiveInteger|) . 1)))))) - <10 (|writeHistModesAndValues| NIL) - 10> (|updateHist|) - 11> (GETL |other| |TimeTotal|) - <11 (GETL 0.0) - 11> (GETL |gc| |TimeTotal|) - <11 (GETL 0.0) - 11> (PUT |gc| |TimeTotal| 0.0) - <11 (PUT 0.0) - 11> (PUT |other| |TimeTotal| 0.0) - <11 (PUT 0.0) - 11> (|updateInCoreHist|) - <11 (|updateInCoreHist| 1) - 11> (|writeHiFi|) - <11 (|writeHiFi| - ((1 (% (|value| (|PositiveInteger|) . 1))))) - 11> (|disableHist|) - <11 (|disableHist| NIL) - 11> (|updateCurrentInterpreterFrame|) - 12> (|createCurrentInterpreterFrame|) - <12 (|createCurrentInterpreterFrame| - (|frame0| - ((((% (|value| . #0=((|PositiveInteger|) . 1)))))) - 2 T - #1=(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL - NIL NIL NIL NIL NIL NIL NIL NIL NIL . #1#) - 20 1 NIL ((1 (% (|value| . #0#)))) - #)) - 12> (|updateFromCurrentInterpreterFrame|) - <12 (|updateFromCurrentInterpreterFrame| NIL) - <11 (|updateCurrentInterpreterFrame| NIL) - 11> (GETL |history| |TimeTotal|) - <11 (GETL 0.0) - 11> (GETL |gc| |TimeTotal|) - <11 (GETL 0.0) - 11> (PUT |gc| |TimeTotal| 0.0) - <11 (PUT 0.0) - 11> (PUT |history| |TimeTotal| 0.0) - <11 (PUT 0.0) - <10 (|updateHist| |history|) - <9 (|processInteractive| ((|PositiveInteger|) . 1)) - <8 (|intInterpretPform| ((|PositiveInteger|) . 1)) - 8> (|ncPutQ| - ((|carrier| (|ok?| . T) - (|ptreePremacro| - . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) |value| - ((|PositiveInteger|) . 1)) - 9> (|ncAlist| - ((|carrier| (|ok?| . T) - (|ptreePremacro| - . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| ((|ok?| . T) - (|ptreePremacro| - . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - 9> (|ncAlist| - ((|carrier| (|ok?| . T) - (|ptreePremacro| - . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncAlist| - ((|ok?| . T) - (|ptreePremacro| - . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - 9> (|ncTag| - ((|carrier| (|ok?| . T) - (|ptreePremacro| - . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <9 (|ncTag| |carrier|) - <8 (|ncPutQ| ((|PositiveInteger|) . 1)) - <7 (|phInterpret| ((|PositiveInteger|) . 1)) - 7> (|ncConversationPhase,wrapup| - ((|carrier| (|value| (|PositiveInteger|) . 1) (|ok?| . T) - (|ptreePremacro| - . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <7 (|ncConversationPhase,wrapup| NIL) - <6 (|ncConversationPhase| ((|PositiveInteger|) . 1)) - 6> (|ncEltQ| - ((|carrier| (|value| (|PositiveInteger|) . 1) (|ok?| . T) - (|ptreePremacro| - . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - |messages|) - 7> (|ncAlist| - ((|carrier| (|value| (|PositiveInteger|) . 1) (|ok?| . T) - (|ptreePremacro| - . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1)))) - <7 (|ncAlist| - ((|value| (|PositiveInteger|) . 1) (|ok?| . T) - (|ptreePremacro| - . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) - . "1")) - (|ptree| . #0#) - (|lines| ((#1# . 1) . "1")) - (|messages|) - (|stepNumber| . 1))) - <6 (|ncEltQ| NIL) - <5 (|intloopSpadProcess,interp| NIL) - <4 (|intloopSpadProcess| 2) -\end{verbatim} -\begin{verbatim} - 4> (|StreamNull| - (|nonnullstream| #0=|incAppend1| NIL - (|nonnullstream| #2=|next1| |ncloopParse| - (|nonnullstream| #0# NIL - (|nonnullstream| #2# |lineoftoks| (|nullstream|)))))) - 5> (|incAppend1| NIL - (|nonnullstream| #0=|next1| |ncloopParse| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) - 6> (|StreamNull| NIL) - <6 (|StreamNull| T) - 6> (|StreamNull| - (|nonnullstream| #0=|next1| |ncloopParse| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) - 7> (|next1| |ncloopParse| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| |next1| |lineoftoks| (|nullstream|)))) - 8> (|StreamNull| - (|nonnullstream| |incAppend1| NIL - (|nonnullstream| |next1| |lineoftoks| (|nullstream|)))) - 9> (|incAppend1| NIL - (|nonnullstream| |next1| |lineoftoks| (|nullstream|))) - 10> (|StreamNull| NIL) - <10 (|StreamNull| T) - 10> (|StreamNull| - (|nonnullstream| |next1| |lineoftoks| (|nullstream|))) - 11> (|next1| |lineoftoks| (|nullstream|)) - 12> (|StreamNull| (|nullstream|)) - <12 (|StreamNull| T) - <11 (|next1| (|nullstream|)) - <10 (|StreamNull| T) - <9 (|incAppend1| (|nullstream|)) - <8 (|StreamNull| T) - <7 (|next1| (|nullstream|)) - <6 (|StreamNull| T) - <5 (|incAppend1| (|nullstream|)) - <4 (|StreamNull| T) - <3 (|intloopProcess| 2) -\end{verbatim} - -\chapter{Axiom Details} -\section{Variables Used} -\section{Data Structures} -\section{Functions} -\defunsec{set-restart-hook}{Set the restart hook} -When a lisp image containing code is reloaded there is a hook to -allow a function to be called. In our case it is the restart -function which is the entry to the Axiom interpreter. -\sig{set-restart-hook}{Void}{'restart} -\begin{chunk}{defun set-restart-hook 0} -(defun set-restart-hook () - "Set the restart hook" - #+KCL (setq system::*top-level-hook* 'restart) - #+Lucid (setq boot::restart-hook 'restart) - 'restart - ) - -\end{chunk} - -\pagehead{restart function}{The restart function} -\pagepic{ps/v5restart.ps}{Restart}{1.00} -The restart function is the real root of the world. It sets up memory -if we are working in a GCL/akcl version of the system. - -The \verb|compiler::*compile-verbose*| flag has been set to nil globally. -We do not want to know about the microsteps of GCL's compile facility. - -The \verb|compiler::*suppress-compiler-warnings*| flag has been set to t. -We do not care that certain generated variables are not used. - -The \verb|compiler::*suppress-compiler-notes*| flag has been set to t. -We do not care that tail recursion occurs. - -It sets the -current package to be the ``BOOT'' package which is the standard -package in which the interpreter runs. - -The \fnref{initroot} function sets global variables that depend on the -AXIOM shell variable. These are needed to find basic files like s2-us.msgs, -which contains the error message text. - -The \fnref{openserver} function tried to set up the socket connection -used for things like hyperdoc. The \verb|$openServerIfTrue| variable -starts true, which implies trying to start a server. - -Axiom has multiple frames that contain independent information about a -computation. There can be several frames at any one time and you can -shift back and forth between the frames. By default, the system starts -in ``frame0'' (try the \verb|)frame names| command). See the Frame -Mechanism chapter (\ref{TheFrameMechanism} page~\pageref{TheFrameMechanism}). - -The \varref{printLoadMsgs} variable controls whether load messages will -be output as library routines are loaded. We disnable this by default. -It can be changed by using \verb|)set message autoload|. - -The \varref{current-directory} variable is set to the current directory. -This is used by the \verb|)cd| function and some of the compile routines. - -The \fnref{statisticsInitialization} function initializes variables -used to collect statistics. Currently, only the garbage collector -information is initialized. - -\calls{restart}{init-memory-config} -\calls{restart}{initroot} -\calls{restart}{openserver} -\calls{restart}{makeInitialModemapFrame} -\calls{restart}{get-current-directory} -\calls{restart}{statisticsInitialization} -\calls{restart}{initHist} -\calls{restart}{initializeInterpreterFrameRing} -\calls{restart}{spadStartUpMsgs} -\calls{restart}{restart0} -\calls{restart}{readSpadProfileIfThere} -\calls{restart}{spad} -\usesdollar{restart}{openServerIfTrue} -\usesdollar{restart}{SpadServerName} -\usesdollar{restart}{SpadServer} -\usesdollar{restart}{IOindex} -\usesdollar{restart}{InteractiveFrame} -\usesdollar{restart}{printLoadMsgs} -\usesdollar{restart}{current-directory} -\usesdollar{restart}{displayStartMsgs} -\usesdollar{restart}{currentLine} -\begin{chunk}{defun restart} -(defun restart () - (declare (special $openServerIfTrue $SpadServerName |$SpadServer| - |$IOindex| |$InteractiveFrame| |$printLoadMsgs| $current-directory - |$displayStartMsgs| |$currentLine|)) -#+:akcl - (init-memory-config :cons 1024 :fixnum 200 :symbol 500 :package 8 - :array 800 :string 1024 :cfun 200 :cpages 6000 :rpages 2000 :hole 4000) -#+:akcl (setq compiler::*compile-verbose* nil) -#+:akcl (setq compiler::*suppress-compiler-warnings* t) -#+:akcl (setq compiler::*suppress-compiler-notes* t) -#+:akcl (setq si::*system-directory* "") - (in-package "BOOT") - (initroot) -#+:akcl - (when (and $openServerIfTrue (zerop (openserver $SpadServerName))) - (setq $openServerIfTrue nil) - (setq |$SpadServer| t)) - (setq |$IOindex| 1) - (setq |$InteractiveFrame| (|makeInitialModemapFrame|)) - (setq |$printLoadMsgs| nil) - (setq $current-directory (get-current-directory)) - (setq *default-pathname-defaults* (pathname $current-directory)) - (|statisticsInitialization|) - (|initHist|) - (|initializeInterpreterFrameRing|) - (when |$displayStartMsgs| (|spadStartUpMsgs|)) - (setq |$currentLine| nil) - (restart0) - (|readSpadProfileIfThere|) - (|spad|)) - -\end{chunk} - -\defvar{localVars} -\begin{chunk}{initvars} -(defvar |$localVars| ()) ;checked by isType - -\end{chunk} - -\defun{restart0}{Non-interactive restarts} -\calls{restart0}{interpopen} -\calls{restart0}{operationopen} -\calls{restart0}{categoryopen} -\calls{restart0}{browseopen} -\begin{chunk}{defun restart0} -(defun restart0 () - (interpopen) ;; open up the interpreter database - (operationopen) ;; all of the operations known to the system - (categoryopen) ;; answer hasCategory question - (browseopen)) - -\end{chunk} - -\defun{spadStartUpMsgs}{The startup banner messages} -\calls{spadStartUpMsgs}{fillerSpaces} -\calls{spadStartUpMsgs}{specialChar} -\calls{spadStartUpMsgs}{sayKeyedMsg} -\calls{spadStartUpMsgs}{sayMSG} -\usesdollar{spadStartUpMsgs}{msgAlist} -\usesdollar{spadStartUpMsgs}{opSysName} -\usesdollar{spadStartUpMsgs}{linelength} -\uses{spadStartUpMsgs}{*yearweek*} -\uses{spadStartUpMsgs}{*build-version*} -\begin{chunk}{defun spadStartUpMsgs} -(defun |spadStartUpMsgs| () - (let (bar) - (declare (special |$msgAlist| |$opSysName| $linelength *yearweek* - *build-version*)) - (when (> $linelength 60) - (setq bar (|fillerSpaces| $linelength (|specialChar| '|hbar|))) - (|sayKeyedMsg| 'S2GL0001 (list *build-version* *yearweek*)) - (|sayMSG| bar) - (|sayKeyedMsg| 'S2GL0018C nil) - (|sayKeyedMsg| 'S2GL0018D nil) - (|sayKeyedMsg| 'S2GL0003B (list |$opSysName|)) - (say " Visit http://axiom-developer.org for more information") - (|sayMSG| bar) - (setq |$msgAlist| nil) - (|sayMSG| '| |)))) - -\end{chunk} - -\defun{fillerSpaces}{Make a vector of filler characters} -\calls{fillerSpaces}{ifcar} -\begin{chunk}{defun fillerSpaces} -(defun |fillerSpaces| (&rest arglist &aux charPart n) - (setq n (car arglist)) - (setq charPart (cdr arglist)) - (if (<= n 0) - "" - (make-string n :initial-element (character (or (ifcar charPart) " "))))) - -\end{chunk} - -\defdollar{PrintCompilerMessageIfTrue} -The \verb|$PrintCompilerMessageIfTrue| variable is set to NIL in spad. -\begin{chunk}{initvars} -(defvar |$PrintCompilerMessageIfTrue| nil) - -\end{chunk} - -\defunsec{spad}{Starts the interpreter but do not read in profiles} -\calls{spad}{setOutputAlgebra} -\calls{spad}{runspad} -\usesdollar{spad}{PrintCompilerMessageIfTrue} -\begin{chunk}{defun spad} -(defun |spad| () - "Starts the interpreter but do not read in profiles" - (let (|$PrintCompilerMessageIfTrue|) - (declare (special |$PrintCompilerMessageIfTrue|)) - (setq |$PrintCompilerMessageIfTrue| nil) - (|setOutputAlgebra| '|%initialize%|) - (|runspad|) - '|EndOfSpad|)) - -\end{chunk} - -\defdollar{quitTag} -\begin{chunk}{initvars} -(defvar |$quitTag| system::*quit-tag*) - -\end{chunk} - -\defun{runspad}{runspad} -\catches{runspad}{quitTag} -\catches{runspad}{coerceFailure} -\catches{runspad}{top-level} -\calls{runspad}{seq} -\calls{runspad}{exit} -\calls{runspad}{resetStackLimits} -\calls{runspad}{ncTopLevel} -\usesdollar{runspad}{quitTag} -\begin{chunk}{defun runspad} -(defun |runspad| () - (prog (mode) - (declare (special |$quitTag|)) - (return - (seq - (progn - (setq mode '|restart|) - (do () - ((null (eq mode '|restart|)) nil) - (seq - (exit - (progn - (|resetStackLimits|) - (catch |$quitTag| - (catch '|coerceFailure| - (setq mode (catch '|top_level| (|ncTopLevel|)))))))))))))) - -\end{chunk} - -\defun{resetStackLimits}{Reset the stack limits} -\calls{resetStackLimits}{reset-stack-limits} -\begin{chunk}{defun resetStackLimits 0} -(defun |resetStackLimits| () - "Reset the stack limits" - (system:reset-stack-limits)) - -\end{chunk} - -\chapter{Handling Terminal Input} -\section{Streams} -\defvar{curinstream} -The curinstream variable is set to the value of the -\verb|*standard-input*| common lisp -variable in ncIntLoop. While not using the -``dollar'' convention this variable is still ``global''. -\begin{chunk}{initvars} -(defvar curinstream (make-synonym-stream '*standard-input*)) - -\end{chunk} - -\defvar{curoutstream} -The curoutstream variable is set to the value of the -\verb|*standard-output*| common lisp variable in ncIntLoop. -While not using the ``dollar'' convention this variable is still ``global''. -\begin{chunk}{initvars} -(defvar curoutstream (make-synonym-stream '*standard-output*)) - -\end{chunk} - -\defvar{errorinstream} -\begin{chunk}{initvars} -(defvar errorinstream (make-synonym-stream '*terminal-io*)) - -\end{chunk} - -\defvar{erroroutstream} -\begin{chunk}{initvars} -(defvar erroroutstream (make-synonym-stream '*terminal-io*)) - -\end{chunk} - -\defvar{*eof*} -\begin{chunk}{initvars} -(defvar *eof* nil) - -\end{chunk} - -\defvar{*whitespace*} -\begin{chunk}{initvars} -(defvar *whitespace* - '(#\Space #\Newline #\Tab #\Page #\Linefeed #\Return #\Backspace) - "A list of characters used by string-trim considered as whitespace") - -\end{chunk} - -There are several different environments used in the interpreter: - -{\bf \verb|$InteractiveFrame|} is the environment where the user -values are stored. Any side effects of evaluation of a top-level -expression are stored in this environment. It is always used as -the starting environment for interpretation. - -{\bf \$e} is the name used for \verb|$InteractiveFrame| while interpreting. - -{\bf \verb|$env|} is local environment used by the interpreter. -Only temporary information (such as types of local variables is -stored in \verb|$env|. It is thrown away after evaluation of each expression. - -\defdollar{InteractiveFrame} -The \verb|$InteractiveFrame| is set in the restart function -to the value of the call to the makeInitialModemapFrame function. -This function simply returns a copy of the variable \verb|$InitialModemapFrame| - -The \verb|$InteractiveFrame| variable contains the state information -related to the current frame, which includes things like the last value, -the value of all of the variables, etc. -\begin{chunk}{initvars} -(defvar |$InteractiveMode| (list (list nil)) "top level environment") - -\end{chunk} - -\defdollar{env} -\begin{chunk}{initvars} -(defvar |$env| nil "checked in isDomainValuedVariable") - -\end{chunk} - -\defdollar{e} -The \verb|$e| variable is set to the value of \verb|$InteractiveFrame| -which is set in restart to the value of the call to the -makeInitialModemapFrame function. This function simply returns a copy -of the variable \verb|$InitialModemapFrame|. - -Prints out the value x which is of type m, and records the changes -in environment \verb|$e| into \verb|$InteractiveFrame| -Thus \verb|$e| is a copy of the variable \verb|$InitialModemapFrame|. - -This variable is used in the undo mechanism. -\begin{chunk}{initvars} -(defvar |$e| nil "the environment?") - -\end{chunk} - -\defdollar{InteractiveMode} -\begin{chunk}{initvars} -(defvar |$InteractiveMode| t) - -\end{chunk} - -\defdollar{boot} -\begin{chunk}{initvars} -(defvar $boot nil) - -\end{chunk} - -\subsection{\$newspad} -The \verb|$newspad| is set to T in ncTopLevel. -\defdollar{newspad} -\begin{chunk}{initvars} -(defvar $newspad nil) - -\end{chunk} - -\defunsec{ncTopLevel}{Top-level read-parse-eval-print loop} -Top-level read-parse-eval-print loop for the interpreter. Uses -the Bill Burge's parser. -\calls{ncTopLevel}{ncIntLoop} -\usesdollar{ncTopLevel}{e} -\usesdollar{ncTopLevel}{spad} -\usesdollar{ncTopLevel}{newspad} -\usesdollar{ncTopLevel}{boot} -\usesdollar{ncTopLevel}{InteractiveMode} -\usesdollar{ncTopLevel}{InteractiveFrame} -\uses{ncTopLevel}{*eof*} -\uses{ncTopLevel}{in-stream} -\begin{chunk}{defun ncTopLevel} -(defun |ncTopLevel| () - "Top-level read-parse-eval-print loop" - (let (|$e| $spad $newspad $boot |$InteractiveMode| *eof* in-stream) - (declare (special |$e| $spad $newspad $boot |$InteractiveMode| *eof* - in-stream |$InteractiveFrame|)) - (setq in-stream curinstream) - (setq *eof* nil) - (setq |$InteractiveMode| t) - (setq $boot nil) - (setq $newspad t) - (setq $spad t) - (setq |$e| |$InteractiveFrame|) - (|ncIntLoop|))) - -\end{chunk} -\defun{ncIntLoop}{ncIntLoop} -\calls{ncIntLoop}{intloop} -\uses{ncIntLoop}{curinstream} -\uses{ncIntLoop}{curoutstream} -\begin{chunk}{defun ncIntLoop} -(defun |ncIntLoop| () - (let ((curinstream *standard-output*) - (curoutstream *standard-input*)) - (declare (special curinstream curoutstream)) - (|intloop|))) - -\end{chunk} - -\defdollar{intTopLevel} -\begin{chunk}{initvars} -(defvar |$intTopLevel| '|top_level|) - -\end{chunk} - -\defdollar{intRestart} -\begin{chunk}{initvars} -(defvar |$intRestart| '|restart|) - -\end{chunk} - -\defun{intloop}{intloop} -Note that the SpadInterpretStream function uses a list of -three strings as an argument. The values in the list seem to have -no use and can eventually be removed. -\catches{intloop}{intTopLevel} -\calls{intloop}{SpadInterpretStream} -\calls{intloop}{resetStackLimits} -\usesdollar{intloop}{intTopLevel} -\usesdollar{intloop}{intRestart} -\begin{chunk}{defun intloop} -(defun |intloop| () - (prog (mode) - (declare (special |$intTopLevel| |$intRestart|)) - (return - (progn - (setq mode |$intRestart|) - ((lambda () - (loop - (cond - ((not (equal mode |$intRestart|)) - (return nil)) - (t - (progn - (|resetStackLimits|) - (setq mode - (catch |$intTopLevel| - (|SpadInterpretStream| 1 - (list 'tim 'daly '?) t))))))))))))) - -\end{chunk} -\defdollar{ncMsgList} -\begin{chunk}{initvars} -(defvar |$ncMsgList| nil) - -\end{chunk} - -\defun{SpadInterpretStream}{SpadInterpretStream} -The SpadInterpretStream function takes three arguments -\begin{list}{} -\item str This is passed as an argument to intloopReadConsole -\item source This is the name of a source file but appears not -to be used. It is set to the list \verb|(tim daly ?)|. -\item \verb|interactive?| If this is false then various messages are -suppressed and input does not use piles. If this is true then the -library loading routines might output messages and piles are expected -on input (as from a file). -\end{list} -System commands are handled by the function in the ``hook'' -variable \verb|$systemCommandFunction| which -has the default function \verb|InterpExecuteSpadSystemCommand|. -Thus, when a system command is entered this function is called. - -The \verb|$promptMsg| variable is set to the constant S2CTP023. This -constant points to a message in src/doc/msgs/s2-us.msgs. This message -does nothing but print the argument value. -\defdollar{promptMsg} -\begin{chunk}{initvars} -(defvar |$promptMsg| 'S2CTP023) - -\end{chunk} - -\defun{cmpnote}{GCL cmpnote function} -GCL keeps noting the fact that the compiler is performing tail-recursion. -Bill Schelter added this as a debugging tool for Axiom and it was never -removed. Patching the lisp code in the GCL build fails as the system -is actually built from the pre-compiled C code. Thus, we can only step -on this message after the fact. The cmpnote function is used nowhere -else in GCL so stepping on the function call seems best. We're unhappy -with this hack and will try to convince the GCL crowd to fix this. -\begin{chunk}{defun cmpnote} -#+:gcl (defun compiler::cmpnote (&rest x) (declare (ignore x))) - -\end{chunk} - -\defdollar{newcompErrorCount} -\begin{chunk}{initvars} -(defvar |$newcompErrorCount| 0) - -\end{chunk} - -\defdollar{nopos} -\begin{chunk}{initvars} -(defvar |$nopos| (list '|noposition|)) - -\end{chunk} -\calls{SpadInterpretStream}{mkprompt} -\calls{SpadInterpretStream}{intloopReadConsole} -\calls{SpadInterpretStream}{intloopInclude} -\usesdollar{SpadInterpretStream}{promptMsg} -\usesdollar{SpadInterpretStream}{systemCommandFunction} -\usesdollar{SpadInterpretStream}{ncMsgList} -\usesdollar{SpadInterpretStream}{erMsgToss} -\usesdollar{SpadInterpretStream}{lastPos} -\usesdollar{SpadInterpretStream}{inclAssertions} -\usesdollar{SpadInterpretStream}{okToExecuteMachineCode} -\usesdollar{SpadInterpretStream}{newcompErrorCount} -\usesdollar{SpadInterpretStream}{libQuiet} -\usesdollar{SpadInterpretStream}{fn} -\usesdollar{SpadInterpretStream}{nopos} -\label{SpadInterpretStream} -\begin{chunk}{defun SpadInterpretStream} -(defun |SpadInterpretStream| (str source interactive?) - (let (|$promptMsg| |$systemCommandFunction| - |$ncMsgList| |$erMsgToss| |$lastPos| |$inclAssertions| - |$okToExecuteMachineCode| |$newcompErrorCount| - |$libQuiet|) - (declare (special |$promptMsg| - |$systemCommandFunction| |$ncMsgList| |$erMsgToss| |$lastPos| - |$inclAssertions| |$okToExecuteMachineCode| |$newcompErrorCount| - |$libQuiet| |$nopos|)) - (setq |$libQuiet| (null interactive?)) - (setq |$newcompErrorCount| 0) - (setq |$okToExecuteMachineCode| t) - (setq |$inclAssertions| (list 'aix '|CommonLisp|)) - (setq |$lastPos| |$nopos|) - (setq |$erMsgToss| nil) - (setq |$ncMsgList| nil) - (setq |$systemCommandFunction| #'|InterpExecuteSpadSystemCommand|) - (setq |$promptMsg| 's2ctp023) - (if interactive? - (progn - (princ (mkprompt)) - (|intloopReadConsole| "" str)) - (|intloopInclude| source 0)))) - -\end{chunk} - -\section{The Read-Eval-Print Loop} -\defun{intloopReadConsole}{intloopReadConsole} -Note that this function relies on the fact that lisp can do tail-recursion. -The function recursively invokes itself. - -The serverReadLine function is a special readline function that handles -communication with the session manager code, which is a separate process -running in parallel. - -We read a line from standard input. -\begin{itemize} -\item If it is a null line then we exit Axiom. -\item If it is a zero length line we prompt and recurse -\item If \$dalymode and open-paren we execute lisp code, prompt and recurse -The \$dalymode will interpret any input that begins with an open-paren -as a lisp expression rather than Axiom input. This is useful for debugging -purposes when most of the input lines will be lisp. Setting \$dalymode -non-nil will certainly break user expectations and is to be used with -caution. -\item If it is ``)fi'' or ``)fin'' we drop into lisp. Use the (restart) - function to return to the interpreter loop. -\item If it starts with ``)'' we process the command, prompt, and recurse -\item If it is a command then we remember the current line, process the - command, prompt, and recurse. -\item If the input has a trailing underscore (Axiom line-continuation) - then we cut off the continuation character and pass the truncated - string to ourselves, prompt, and recurse -\item otherwise we process the input, prompt, and recurse. -\end{itemize} -Notice that all but two paths (a null input or a ``)fi'' or a ``)fin'') -will end up as a recursive call to ourselves. - -\throws{intloopReadConsole}{top-level} -\calls{intloopReadConsole}{serverReadLine} -\calls{intloopReadConsole}{leaveScratchpad} -\calls{intloopReadConsole}{mkprompt} -\calls{intloopReadConsole}{intloopReadConsole} -\calls{intloopReadConsole}{intloopPrefix?} -\calls{intloopReadConsole}{intnplisp} -\calls{intloopReadConsole}{setCurrentLine} -\calls{intloopReadConsole}{ncloopCommand} -\calls{intloopReadConsole}{concat} -\calls{intloopReadConsole}{ncloopEscaped} -\calls{intloopReadConsole}{intloopProcessString} -\usesdollar{intloopReadConsole}{dalymode} -\label{intloopReadConsole} -\sig{intloopReadConsole}{(String Integer)}{Throw} -\begin{chunk}{defun intloopReadConsole} -(defun |intloopReadConsole| (prefix stepNumber) - (declare (special $dalymode)) - (let (newStepNo cmd pfx input) - ; read the next line - (setq input (|serverReadLine| *standard-input*)) - ; if we have lost *standard-input* then exit Axiom - (when (null (stringp input)) (|leaveScratchpad|)) - ; if the input is a zero-length input, recurse - (when (eql (length input) 0) - (princ (mkprompt)) - (|intloopReadConsole| "" stepNumber)) - ; if $dalymode is nonnil anything starting with '(' is a lisp expression - ; evaluate the expression in lisp and recurse - (when (and $dalymode (|intloopPrefix?| "(" input)) - (|intnplisp| input) - (princ (mkprompt)) - (|intloopReadConsole| "" stepNumber)) - ; if the input starts with ")fi" or ")fin" throw into lisp - (setq pfx (|intloopPrefix?| ")fi" input)) - (when (and pfx (or (string= pfx ")fi") (string= pfx ")fin"))) - (throw '|top_level| nil)) - ; if the input starts with ')' it is a command; execute and recurse - (when (and (equal prefix "") (setq cmd (|intloopPrefix?| ")" input))) - (|setCurrentLine| cmd) - (setq newStepNo (|ncloopCommand| cmd stepNumber)) - (princ (mkprompt)) - (|intloopReadConsole| "" newStepNo)) - ; if the last non-blank character on the line is an underscore - ; we use the current accumulated input as a prefix and recurse. - ; this has the effect of concatenating the next line (minus the underscore) - (setq input (concat prefix input)) - (when (|ncloopEscaped| input) - (|intloopReadConsole| (subseq input 0 (- (length input) 1)) stepNumber)) - ; if there are no special cases, process the current line and recurse - (setq newStepNo (|intloopProcessString| input stepNumber)) - (princ (mkprompt)) - (|intloopReadConsole| "" newStepNo))) - -\end{chunk} - -\section{Helper Functions} -\defunsec{getenviron}{Get the value of an evironment variable} -\calls{getenviron}{getenv} -\begin{chunk}{defun getenviron 0} -(defun getenviron (var) - "Get the value of an evironment variable" - #+allegro (sys::getenv (string var)) - #+clisp (ext:getenv (string var)) - #+(or cmu scl) - (cdr - (assoc (string var) ext:*environment-list* :test #'equalp :key #'string)) - #+(or kcl akcl gcl) (si::getenv (string var)) - #+lispworks (lw:environment-variable (string var)) - #+lucid (lcl:environment-variable (string var)) - #+mcl (ccl::getenv var) - #+sbcl (sb-ext:posix-getenv var) - ) - -\end{chunk} - -\defdollar{intCoerceFailure} -\begin{chunk}{initvars} -(defvar |$intCoerceFailure| '|coerceFailure|) - -\end{chunk} - -\defdollar{intSpadReader} -\begin{chunk}{initvars} -(defvar |$intSpadReader| 'SPAD_READER) - -\end{chunk} -\defun{InterpExecuteSpadSystemCommand}{InterpExecuteSpadSystemCommand} -\catches{InterpExecuteSpadSystemCommand}{intCoerceFailure} -\catches{InterpExecuteSpadSystemCommand}{intSpadReader} -\calls{InterpExecuteSpadSystemCommand}{ExecuteInterpSystemCommand} -\usesdollar{InterpExecuteSpadSystemCommand}{intSpadReader} -\usesdollar{InterpExecuteSpadSystemCommand}{intCoerceFailure} -\begin{chunk}{defun InterpExecuteSpadSystemCommand} -(defun |InterpExecuteSpadSystemCommand| (string) - (declare (special |$intSpadReader| |$intCoerceFailure|)) - (catch |$intCoerceFailure| - (catch |$intSpadReader| - (|ExecuteInterpSystemCommand| string)))) - -\end{chunk} - -\defun{ExecuteInterpSystemCommand}{ExecuteInterpSystemCommand} -\calls{ExecuteInterpSystemCommand}{intProcessSynonyms} -\calls{ExecuteInterpSystemCommand}{substring} -\calls{ExecuteInterpSystemCommand}{doSystemCommand} -\usesdollar{ExecuteInterpSystemCommand}{currentLine} -\begin{chunk}{defun ExecuteInterpSystemCommand} -(defun |ExecuteInterpSystemCommand| (string) - (let (|$currentLine|) - (declare (special |$currentLine|)) - (setq string (|intProcessSynonyms| string)) - (setq |$currentLine| string) - (setq string (substring string 1 nil)) - (unless (equal string "") (|doSystemCommand| string)))) - -\end{chunk} - -\defun{substring}{substring} -\begin{chunk}{defun substring 0} -(defun substring (cvec start length) - (if length - (subseq (string cvec) start (+ start length)) - (subseq (string cvec) start))) - -\end{chunk} - -\defun{intProcessSynonyms}{Handle Synonyms} -\calls{intProcessSynonyms}{processSynonyms} -\uses{intProcessSynonyms}{line} -\begin{chunk}{defun intProcessSynonyms} -(defun |intProcessSynonyms| (str) - (let ((line str)) - (declare (special line)) - (|processSynonyms|) - line)) - -\end{chunk} - -\defun{processSynonyms}{Synonym File Reader} -\calls{processSynonyms}{strpos} -\calls{processSynonyms}{substring} -\calls{processSynonyms}{string2id-n} -\calls{processSynonyms}{lassoc} -\calls{processSynonyms}{strconc} -\calls{processSynonyms}{size} -\calls{processSynonyms}{concat} -\calls{processSynonyms}{rplacstr} -\calls{processSynonyms}{processSynonyms} -\usesdollar{processSynonyms}{CommandSynonymAlist} -\uses{processSynonyms}{line} -\begin{chunk}{defun processSynonyms} -(defun |processSynonyms| () - (let (fill p aline synstr syn to opt fun cl chr) - (declare (special |$CommandSynonymAlist| line)) - (setq p (strpos ")" line 0 nil)) - (setq fill "") - (cond - (p - (setq aline (substring line p nil)) - (when (> p 0) (setq fill (substring line 0 p)))) - (t - (setq p 0) - (setq aline line))) - (setq to (strpos " " aline 1 nil)) - (cond (to (setq to (1- to)))) - (setq synstr (substring aline 1 to)) - (setq syn (string2id-n synstr 1)) - (when (setq fun (lassoc syn |$CommandSynonymAlist|)) - (setq to (strpos ")" fun 1 nil)) - (cond - ((and to (not (eql to (1- (size fun))))) - (setq opt (strconc " " (substring fun to nil))) - (setq fun (substring fun 0 (1- to )))) - (t (setq opt " "))) - (when (> (size synstr) (size fun)) - (do ((G167173 (size synstr)) (i (size fun) (1+ i))) - ((> i G167173) nil) - (setq fun (concat fun " ")))) - (setq cl (strconc fill (rplacstr aline 1 (size synstr) fun) opt)) - (setq line cl) - (setq chr (elt line (1+ p))) - (|processSynonyms|)))) - -\end{chunk} - -\defun{init-memory-config}{init-memory-config} -Austin-Kyoto Common Lisp (AKCL), now known as Gnu Common Lisp (GCL) -requires some changes to the default memory setup to run Axiom efficently. -This function performs those setup commands. - -\calls{init-memory-config}{allocate} -\calls{init-memory-config}{allocate-contiguous-pages} -\calls{init-memory-config}{allocate-relocatable-pages} -\calls{init-memory-config}{set-hole-size} -\begin{chunk}{defun init-memory-config 0} -(defun init-memory-config (&key - (cons 500) - (fixnum 200) - (symbol 500) - (package 8) - (array 400) - (string 500) - (cfun 100) - (cpages 3000) - (rpages 1000) - (hole 2000) ) - ;; initialize AKCL memory allocation parameters - #+:AKCL - (progn - (system:allocate 'cons cons) - (system:allocate 'fixnum fixnum) - (system:allocate 'symbol symbol) - (system:allocate 'package package) - (system:allocate 'array array) - (system:allocate 'string string) - (system:allocate 'cfun cfun) - (system:allocate-contiguous-pages cpages) - (system:allocate-relocatable-pages rpages) - (system:set-hole-size hole)) - #-:AKCL - nil) - -\end{chunk} - -\defunsec{initroot}{Set spadroot to be the AXIOM shell variable} -Sets up the system to use the {\bf AXIOM} shell variable if we can -and default to the {\bf \$spadroot} variable (which was the value -of the {\bf AXIOM} shell variable at build time) if we can't. - -\calls{initroot}{reroot} -\calls{initroot}{getenviron} -\usesdollar{initroot}{spadroot} -\begin{chunk}{defun initroot} -(defun initroot (&optional (newroot (getenviron "AXIOM"))) - "Set spadroot to be the AXIOM shell variable" - (declare (special $spadroot)) - (reroot (or newroot $spadroot (error "setenv AXIOM or (setq $spadroot)")))) - -\end{chunk} - -\defunsec{intloopPrefix?}{Does the string start with this prefix?} -If the prefix string is the same as the whole string initial characters ---R(ignoring spaces in the whole string) then we return the whole string -minus any leading spaces. -\label{intloopPrefix?} -\sig{intloopPrefix?}{String}{Union(String,NIL)} -\begin{chunk}{defun intloopPrefix? 0} -(defun |intloopPrefix?| (prefix whole) - "Does the string start with this prefix?" - (let ((newprefix (string-left-trim '(#\space) prefix)) - (newwhole (string-left-trim '(#\space) whole))) - (when (<= (length newprefix) (length newwhole)) - (when (string= newprefix newwhole :end2 (length prefix)) - newwhole)))) - -\end{chunk} - -\defun{intnplisp}{Interpret a line of lisp code} -This is used to hande {\tt )lisp} top level commands -\calls{intnplisp}{nplisp} -\usesdollar{intnplisp}{currentLine} -\label{intnplisp} -\begin{chunk}{defun intnplisp} -(defun |intnplisp| (s) - (declare (special |$currentLine|)) - (setq |$currentLine| s) - (|nplisp| |$currentLine|)) - -\end{chunk} - -\defunsec{get-current-directory}{Get the current directory} -\begin{chunk}{defun get-current-directory 0} -(defun get-current-directory () - "Get the current directory" - (namestring (truename ""))) - -\end{chunk} - -\defunsec{make-absolute-filename}{Prepend the absolute path to a filename} -Prefix a filename with the {\bf AXIOM} shell variable. - -\usesdollar{make-absolute-filename}{spadroot} -\begin{chunk}{defun make-absolute-filename 0} -(defun make-absolute-filename (name) - "Prepend the absolute path to a filename" - (declare (special $spadroot)) - (concatenate 'string $spadroot name)) - -\end{chunk} - -\defunsec{makeInitialModemapFrame}{Make the initial modemap frame} -\calls{makeInitialModemapFrame}{copy} -\usesdollar{makeInitialModemapFrame}{InitialModemapFrame} -\begin{chunk}{defun makeInitialModemapFrame 0} -(defun |makeInitialModemapFrame| () - "Make the initial modemap frame" - (declare (special |$InitialModemapFrame|)) - (copy |$InitialModemapFrame|)) - -\end{chunk} - -\defun{ncloopEscaped}{ncloopEscaped} -The ncloopEscaped function will return true if the last non-blank -character of a line is an underscore, the Axiom line-continuation -character. Otherwise, it returns nil. -\begin{chunk}{defun ncloopEscaped 0} -(defun |ncloopEscaped| (x) - (let ((l (length x))) - (dotimes (i l) - (when (char= (char x (- l i 1)) #\_) (return t)) - (unless (char= (char x (- l i 1)) #\space) (return nil))))) - -\end{chunk} - -\defun{intloopProcessString}{intloopProcessString} -\calls{intloopProcessString}{setCurrentLine} -\calls{intloopProcessString}{intloopProcess} -\calls{intloopProcessString}{next} -\calls{intloopProcessString}{incString} -\label{intloopProcessString} -\sig{intloopProcessString}{(String,StepNo)}{StepNo} -\begin{chunk}{defun intloopProcessString} -(defun |intloopProcessString| (currentline stepno) - (|setCurrentLine| currentline) - (|intloopProcess| stepno t - (|next| #'|ncloopParse| - (|next| #'|lineoftoks| (|incString| currentline))))) - -\end{chunk} - -\defun{ncloopParse}{ncloopParse} -\calls{ncloopParse}{ncloopDQlines} -\calls{ncloopParse}{npParse} -\calls{ncloopParse}{dqToList} -\begin{chunk}{defun ncloopParse} -(defun |ncloopParse| (s) - (let (cudr lines stream dq t1) - (setq t1 (car s)) - (setq dq (car t1)) - (setq stream (cadr t1)) - (setq t1 (|ncloopDQlines| dq stream)) - (setq lines (car t1)) - (setq cudr (cadr t1)) - (cons (list (list lines (|npParse| (|dqToList| dq)))) (cdr s)))) - -\end{chunk} - -\defun{next}{next} -\calls{next}{Delay} -\calls{next}{next1} -\label{next} -\sig{next}{(Function,Delay)}{Delay} -\begin{chunk}{defun next} -(defun |next| (function delay) - (|Delay| #'|next1| (list function delay))) - -\end{chunk} - -\defun{next1}{next1} -\calls{next1}{StreamNull} -\calls{next1}{incAppend} -\calls{next1}{next} -\label{next1} -\sig{next1}{Delay}{ParsePair} -\begin{chunk}{defun next1} -(defun |next1| (&rest delayArg) - (let (h delay function) - (setq function (car delayArg)) - (setq delay (cadr delayArg)) - (cond - ((|StreamNull| delay) |StreamNil|) - (t - (setq h (apply function (list delay))) - (|incAppend| (car h) (|next| function (cdr h))))))) - -\end{chunk} - -\defun{incString}{incString} -The {\bf incString} function gets a string, usually from Axiom's input, -and constructs a set of nested function calls to process the input line. -\calls{incString}{incRenumber} -\calls{incString}{incLude} -\uses{incString}{Top} -\label{incString} -\sig{incString}{String}{Function} -\begin{chunk}{defun incString} -(defun |incString| (s) - (declare (special |Top|)) - (|incRenumber| (|incLude| 0 (list s) 0 (list "strings") (list |Top|)))) - -\end{chunk} - -\defunsec{reclaim}{Call the garbage collector} -Call the garbage collector on various platforms. -\begin{chunk}{defun reclaim 0} -#+abcl -(defun reclaim () "Call the garbage collector" (ext::gc)) -#+:allegro -(defun reclaim () "Call the garbage collector" (excl::gc t)) -#+:CCL -(defun reclaim () "Call the garbage collector" (gc)) -#+clisp -(defun reclaim () - "Call the garbage collector" - (#+lisp=cl ext::gc #-lisp=cl lisp::gc)) -#+(or :cmulisp :cmu) -(defun reclaim () "Call the garbage collector" (ext:gc)) -#+cormanlisp -(defun reclaim () "Call the garbage collector" (cl::gc)) -#+(OR IBCL KCL GCL) -(defun reclaim () "Call the garbage collector" (si::gbc t)) -#+lispworks -(defun reclaim () "Call the garbage collector" (hcl::normal-gc)) -#+Lucid -(defun reclaim () "Call the garbage collector" (lcl::gc)) -#+sbcl -(defun reclaim () "Call the garbage collector" (sb-ext::gc)) - -\end{chunk} - -\defun{reroot}{reroot} -The reroot function is used to reset the important variables used by -the system. In particular, these variables are sensitive to the -{\bf AXIOM} shell variable. That variable is renamed internally to -be {\bf \$spadroot}. The {\bf reroot} function will change the -system to use a new root directory and will have the same effect -as changing the {\bf AXIOM} shell variable and rerunning the system -from scratch. Note that we have changed from the -NAG distribution back to the original form. If you need the NAG -version you can push {\bf :tpd} on the {\bf *features*} variable -before compiling this file. A correct call looks like: -\begin{verbatim} - (in-package "BOOT") - (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} -\usesdollar{reroot}{relative-directory-list} -\usesdollar{reroot}{library-directory-list} -\usesdollar{reroot}{relative-library-directory-list} -\usesdollar{reroot}{defaultMsgDatabaseName} -\usesdollar{reroot}{msgDatabaseName} -\usesdollar{reroot}{current-directory} -\begin{chunk}{defun reroot} -(defun reroot (dir) - (declare (special $spadroot $directory-list $relative-directory-list - $library-directory-list $relative-library-directory-list - |$defaultMsgDatabaseName| |$msgDatabaseName| $current-directory)) - (setq $spadroot dir) - (setq $directory-list - (mapcar #'make-absolute-filename $relative-directory-list)) - (setq $library-directory-list - (mapcar #'make-absolute-filename $relative-library-directory-list)) - (setq |$defaultMsgDatabaseName| - (pathname (make-absolute-filename "/doc/msgs/s2-us.msgs"))) - (setq |$msgDatabaseName| ()) - (setq $current-directory $spadroot)) - -\end{chunk} - -\defdollar{current-directory} -\begin{chunk}{initvars} -(defvar |$currentLine| "" "A list of the input line history") - -\end{chunk} - -\defun{setCurrentLine}{setCurrentLine} -Remember the current line. The cases are: -\begin{itemize} -\item If there is no \$currentLine set it to the input -\item Is the current line a string and the input a string? - Make them into a list -\item Is \$currentLine not a cons cell? Make it one. -\item Is the input a string? Cons it on the end of the list. -\item Otherwise stick it on the end of the list -\end{itemize} -\usesdollar{setCurrentLine}{currentLine} -\label{setCurrentLine} -\sig{setCurrentLine}{String}{List(String)} -\begin{chunk}{defun setCurrentLine 0} -(defun |setCurrentLine| (s) - (declare (special |$currentLine|)) - (cond - ((null |$currentLine|) (setq |$currentLine| s)) - ((and (stringp |$currentLine|) (stringp s)) - (setq |$currentLine| (list |$currentLine| s))) - ((not (consp |$currentLine|)) (setq |$currentLine| (cons |$currentLine| s))) - ((stringp s) (rplacd (last |$currentLine|) (cons s nil))) - (t (rplacd (last |$currentLine|) s))) - |$currentLine|) - -\end{chunk} - -\defunsec{mkprompt}{Show the Axiom prompt} -\calls{mkprompt}{concat} -\calls{mkprompt}{substring} -\calls{mkprompt}{currenttime} -\usesdollar{mkprompt}{inputPromptType} -\usesdollar{mkprompt}{IOindex} -\usesdollar{mkprompt}{interpreterFrameName} -\label{mkprompt} -\sig{mkprompt}{Void}{String} -\begin{chunk}{defun mkprompt} -(defun mkprompt () - "Show the Axiom prompt" - (declare (special |$inputPromptType| |$IOindex| |$interpreterFrameName|)) - (case |$inputPromptType| - (|none| "") - (|plain| "-> ") - (|step| (concat "(" (princ-to-string |$IOindex|) ") -> ")) - (|frame| - (concat (princ-to-string |$interpreterFrameName|) " (" - (princ-to-string |$IOindex|) ") -> ")) - (t (concat (princ-to-string |$interpreterFrameName|) " [" - (substring (currenttime) 8 nil) "] [" - (princ-to-string |$IOindex|) "] -> ")))) - -\end{chunk} - -\defdollar{frameAlist} -\begin{chunk}{initvars} -(defvar |$frameAlist| nil) - -\end{chunk} -\defdollar{frameNumber} -\begin{chunk}{initvars} -(defvar |$frameNumber| 0) - -\end{chunk} -\defdollar{currentFrameNum} -\begin{chunk}{initvars} -(defvar |$currentFrameNum| 0) - -\end{chunk} - -\defdollar{EndServerSession} -\begin{chunk}{initvars} -(defvar |$EndServerSession| nil) - -\end{chunk} - -\defdollar{NeedToSignalSessionManager} -\begin{chunk}{initvars} -(defvar |$NeedToSignalSessionManager| nil) - -\end{chunk} - -\defdollar{sockBufferLength} -\begin{chunk}{initvars} -(defvar |$sockBufferLength| 9217) - -\end{chunk} - -\defunsec{serverReadLine}{READ-LINE in an Axiom server system} -\catches{serverReadLine}{coerceFailure} -\catches{serverReadLine}{top-level} -\catches{serverReadLine}{spad-reader} -\calls{serverReadLine}{read-line} -\calls{serverReadLine}{addNewInterpreterFrame} -\calls{serverReadLine}{sockSendInt} -\calls{serverReadLine}{sockSendString} -\calls{serverReadLine}{mkprompt} -\calls{serverReadLine}{sockGetInt} -\calls{serverReadLine}{lassoc} -\calls{serverReadLine}{changeToNamedInterpreterFrame} -\calls{serverReadLine}{sockGetString} -\calls{serverReadLine}{unescapeStringsInForm} -\calls{serverReadLine}{protectedEVAL} -\calls{serverReadLine}{executeQuietCommand} -\calls{serverReadLine}{parseAndInterpret} -\seebook{serverReadLine}{is-console}{9} -\calls{serverReadLine}{serverSwitch} -\usesdollar{serverReadLine}{KillLispSystem} -\usesdollar{serverReadLine}{NonSmanSession} -\usesdollar{serverReadLine}{SpadCommand} -\usesdollar{serverReadLine}{QuietSpadCommand} -\usesdollar{serverReadLine}{MenuServer} -\usesdollar{serverReadLine}{sockBufferLength} -\usesdollar{serverReadLine}{LispCommand} -\usesdollar{serverReadLine}{EndServerSession} -\usesdollar{serverReadLine}{EndSession} -\usesdollar{serverReadLine}{SwitchFrames} -\usesdollar{serverReadLine}{CreateFrameAnswer} -\usesdollar{serverReadLine}{currentFrameNum} -\usesdollar{serverReadLine}{frameNumber} -\usesdollar{serverReadLine}{frameAlist} -\usesdollar{serverReadLine}{CreateFrame} -\usesdollar{serverReadLine}{CallInterp} -\usesdollar{serverReadLine}{EndOfOutput} -\usesdollar{serverReadLine}{SessionManager} -\usesdollar{serverReadLine}{NeedToSignalSessionManager} -\usesdollar{serverReadLine}{EndServerSession} -\usesdollar{serverReadLine}{SpadServer} -\uses{serverReadLine}{*eof*} -\uses{serverReadLine}{in-stream} -\label{serverReadLine} -\sig{serverReadLine}{Stream}{String} -\begin{chunk}{defun serverReadLine} -(defun |serverReadLine| (stream) - "used in place of READ-LINE in a Axiom server system." - (let (in-stream *eof* l framename currentframe form stringbuf line action) - (declare (special in-stream *eof* |$SpadServer| |$EndServerSession| - |$NeedToSignalSessionManager| |$SessionManager| |$EndOfOutput| - |$CallInterp| |$CreateFrame| |$frameAlist| |$frameNumber| - |$currentFrameNum| |$CreateFrameAnswer| |$SwitchFrames| |$EndSession| - |$EndServerSession| |$LispCommand| |$sockBufferLength| |$MenuServer| - |$QuietSpadCommand| |$SpadCommand| |$NonSmanSession| |$KillLispSystem|)) - (force-output) - (if (or (null |$SpadServer|) (null (is-console stream))) - (|read-line| stream) - (progn - (setq in-stream stream) - (setq *eof* nil) - (setq line - (do () - ((null (and (null |$EndServerSession|) (null *eof*))) nil) - (when |$NeedToSignalSessionManager| - (|sockSendInt| |$SessionManager| |$EndOfOutput|)) - (setq |$NeedToSignalSessionManager| nil) - ; see bookvol8 for the constants that serverSwitch returns - (setq action (|serverSwitch|)) - (cond - ((= action |$CallInterp|) - (setq l (|read-line| stream)) - (setq |$NeedToSignalSessionManager| t) - (return l)) - ((= action |$CreateFrame|) - (setq framename (gentemp "frame")) - (|addNewInterpreterFrame| framename) - (setq |$frameAlist| - (cons (cons |$frameNumber| framename) |$frameAlist|)) - (setq |$currentFrameNum| |$frameNumber|) - (|sockSendInt| |$SessionManager| |$CreateFrameAnswer|) - (|sockSendInt| |$SessionManager| |$frameNumber|) - (setq |$frameNumber| (1+ |$frameNumber|)) - (|sockSendString| |$SessionManager| (mkprompt))) - ((= action |$SwitchFrames|) - (setq |$currentFrameNum| (|sockGetInt| |$SessionManager|)) - (setq currentframe (lassoc |$currentFrameNum| |$frameAlist|)) - (|changeToNamedInterpreterFrame| currentframe)) - ((= action |$EndSession|) - (setq |$EndServerSession| t)) - ((= action |$LispCommand|) - (setq |$NeedToSignalSessionManager| t) - (setq stringbuf (make-string |$sockBufferLength|)) - (|sockGetString| |$MenuServer| stringbuf |$sockBufferLength|) - (setq form (|unescapeStringsInForm| (read-from-string stringbuf))) - (|protectedEVAL| form)) - ((= action |$QuietSpadCommand|) - (setq |$NeedToSignalSessionManager| t) - (|executeQuietCommand|)) - ((= action |$SpadCommand|) - (setq |$NeedToSignalSessionManager| t) - (setq stringbuf (make-string 512)) - (|sockGetString| |$MenuServer| stringbuf 512) - (catch '|coerceFailure| - (catch '|top_level| - (catch 'spad_reader - (|parseAndInterpret| stringbuf)))) - (princ (mkprompt)) - (finish-output)) - ((= action |$NonSmanSession|) (setq |$SpadServer| nil)) - ((= action |$KillLispSystem|) (bye)) - (t nil)))) - (cond - (line line) - (t '||)))))) - -\end{chunk} - -\defun{protectedEVAL}{protectedEVAL} -\calls{protectedEVAL}{resetStackLimits} -\calls{protectedEVAL}{sendHTErrorSignal} -\begin{chunk}{defun protectedEVAL} -(defun |protectedEVAL| (x) - (let (val (error t)) - (unwind-protect - (progn - (setq val (eval x)) - (setq error nil)) - (when error - (|resetStackLimits|) - (|sendHTErrorSignal|))) - (unless error val))) - -\end{chunk} - -\defdollar{QuietCommand} -\begin{chunk}{initvars} -(defvar |$QuietCommand| nil "If true, produce no top level output") - -\end{chunk} - -\defun{executeQuietCommand}{executeQuietCommand} -When \verb|$QuiteCommand| is true Spad will not produce any output from -a top level command - -\catches{executeQuietCommand}{spad-reader} -\catches{executeQuietCommand}{coerceFailure} -\catches{executeQuietCommand}{toplevel} -\catches{executeQuietCommand}{spadreader} -\calls{executeQuietCommand}{make-string} -\calls{executeQuietCommand}{sockGetString} -\calls{executeQuietCommand}{parseAndInterpret} -\usesdollar{executeQuietCommand}{MenuServer} -\usesdollar{executeQuietCommand}{QuietCommand} -\begin{chunk}{defun executeQuietCommand} -(defun |executeQuietCommand| () - (let (|$QuietCommand| stringBuf) - (declare (special |$QuietCommand| |$MenuServer|)) - (setq |$QuietCommand| t) - (setq stringBuf (make-string 512)) - (|sockGetString| |$MenuServer| stringBuf 512) - (catch '|coerceFailure| - (catch '|top_level| - (catch 'spad_reader (|parseAndInterpret| stringBuf)))))) - -\end{chunk} - -\defun{parseAndInterpret}{parseAndInterpret} -\usesdollar{parseAndInterpret}{InteractiveMode} -\usesdollar{parseAndInterpret}{boot} -\usesdollar{parseAndInterpret}{spad} -\usesdollar{parseAndInterpret}{e} -\usesdollar{parseAndInterpret}{InteractiveFrame} -\begin{chunk}{defun parseAndInterpret} -(defun |parseAndInterpret| (str) - (let (|$InteractiveMode| $boot $spad |$e|) - (declare (special |$InteractiveMode| $boot $spad |$e| - |$InteractiveFrame|)) - (setq |$InteractiveMode| t) - (setq $boot nil) - (setq $spad t) - (setq |$e| |$InteractiveFrame|) - (|processInteractive| (|parseFromString| str) nil))) - -\end{chunk} - -\defun{parseFromString}{parseFromString} -\calls{parseFromString}{next} -\calls{parseFromString}{ncloopParse} -\calls{parseFromString}{lineoftoks} -\calls{parseFromString}{incString} -\calls{parseFromString}{StreamNull} -\calls{parseFromString}{pf2Sex} -\calls{parseFromString}{macroExpanded} -\begin{chunk}{defun parseFromString} -(defun |parseFromString| (s) - (setq s (|next| #'|ncloopParse| (|next| #'|lineoftoks| (|incString| s)))) - (unless (|StreamNull| s) (|pf2Sex| (|macroExpanded| (cadar s))))) - -\end{chunk} - -\defdollar{interpOnly} -\begin{chunk}{initvars} -(defvar |$interpOnly| nil) - -\end{chunk} - -\defdollar{minivectorNames} -\begin{chunk}{initvars} -(defvar |$minivectorNames| nil) - -\end{chunk} - -\defdollar{domPvar} -\begin{chunk}{initvars} -(defvar |$domPvar| nil) - -\end{chunk} - -\defdollar{compilingMap} -{\bf \verb|$compilingMap|}: true when compiling a map, used to -detect where to THROW when interpret-only is invoked -\begin{chunk}{initvars} -(defvar |$compilingMap| ()) - -\end{chunk} - -\defdollar{instantRecord} -\begin{chunk}{initvars} -(setq |$instantRecord| (make-hash-table :test #'eq)) - -\end{chunk} - -\defun{processInteractive}{processInteractive} -Parser Output {\tt -->} Interpreter - -Top-level dispatcher for the interpreter. It sets local variables -and then calls processInteractive1 to do most of the work. -This function receives the output from the parser. - -\calls{processInteractive}{initializeTimedNames} -\calls{processInteractive}{qcar} -\calls{processInteractive}{processInteractive1} -\calls{processInteractive}{reportInstantiations} -\calls{processInteractive}{clrhash} -\calls{processInteractive}{writeHistModesAndValues} -\calls{processInteractive}{updateHist} -\usesdollar{processInteractive}{op} -\usesdollar{processInteractive}{Coerce} -\usesdollar{processInteractive}{compErrorMessageStack} -\usesdollar{processInteractive}{freeVars} -\usesdollar{processInteractive}{mapList} -\usesdollar{processInteractive}{compilingMap} -\usesdollar{processInteractive}{compilingLoop} -\usesdollar{processInteractive}{interpOnly} -\usesdollar{processInteractive}{whereCacheList} -\usesdollar{processInteractive}{timeGlobalName} -\usesdollar{processInteractive}{StreamFrame} -\usesdollar{processInteractive}{declaredMode} -\usesdollar{processInteractive}{localVars} -\usesdollar{processInteractive}{analyzingMapList} -\usesdollar{processInteractive}{lastLineInSEQ} -\usesdollar{processInteractive}{instantCoerceCount} -\usesdollar{processInteractive}{instantCanCoerceCount} -\usesdollar{processInteractive}{instantMmCondCount} -\usesdollar{processInteractive}{fortVar} -\usesdollar{processInteractive}{minivector} -\usesdollar{processInteractive}{minivectorCode} -\usesdollar{processInteractive}{minivectorNames} -\usesdollar{processInteractive}{domPvar} -\usesdollar{processInteractive}{inRetract} -\usesdollar{processInteractive}{instantRecord} -\usesdollar{processInteractive}{reportInstantiations} -\usesdollar{processInteractive}{ProcessInteractiveValue} -\usesdollar{processInteractive}{defaultFortVar} -\usesdollar{processInteractive}{interpreterTimedNames} -\usesdollar{processInteractive}{interpreterTimedClasses} -\begin{chunk}{defun processInteractive} -(defun |processInteractive| (form posnForm) - (let (|$op| |$Coerce| |$compErrorMessageStack| |$freeVars| - |$mapList| |$compilingMap| |$compilingLoop| - |$interpOnly| |$whereCacheList| |$timeGlobalName| - |$StreamFrame| |$declaredMode| |$localVars| - |$analyzingMapList| |$lastLineInSEQ| - |$instantCoerceCount| |$instantCanCoerceCount| - |$instantMmCondCount| |$fortVar| |$minivector| - |$minivectorCode| |$minivectorNames| |$domPvar| - |$inRetract| object) - (declare (special |$op| |$Coerce| |$compErrorMessageStack| - |$freeVars| |$mapList| |$compilingMap| - |$compilingLoop| |$interpOnly| |$whereCacheList| - |$timeGlobalName| |$StreamFrame| |$declaredMode| - |$localVars| |$analyzingMapList| |$lastLineInSEQ| - |$instantCoerceCount| |$instantCanCoerceCount| - |$instantMmCondCount| |$fortVar| |$minivector| - |$minivectorCode| |$minivectorNames| |$domPvar| - |$inRetract| |$instantRecord| |$reportInstantiations| - |$ProcessInteractiveValue| |$defaultFortVar| - |$interpreterTimedNames| |$interpreterTimedClasses|)) - (|initializeTimedNames| |$interpreterTimedNames| |$interpreterTimedClasses|) - (if (consp form) ; compute name of operator - (setq |$op| (qcar form)) - (setq |$op| form)) - (setq |$Coerce| nil) - (setq |$compErrorMessageStack| nil) - (setq |$freeVars| nil) - (setq |$mapList| nil) ; list of maps being type analyzed - (setq |$compilingMap| nil) ; true when compiling a map - (setq |$compilingLoop| nil) ; true when compiling a loop body - (setq |$interpOnly| nil) ; true when in interp only mode - (setq |$whereCacheList| nil) ; maps compiled because of where - (setq |$timeGlobalName| '|$compTimeSum|); see incrementTimeSum - (setq |$StreamFrame| nil) ; used in printing streams - (setq |$declaredMode| nil) ; weak type propagation for symbols - (setq |$localVars| nil) ; list of local variables in function - (setq |$analyzingMapList| nil) ; names of maps currently being analyzed - (setq |$lastLineInSEQ| t) ; see evalIF and friends - (setq |$instantCoerceCount| 0) - (setq |$instantCanCoerceCount| 0) - (setq |$instantMmCondCount| 0) - (setq |$defaultFortVar| 'x) ; default FORTRAN variable name - (setq |$fortVar| |$defaultFortVar|) ; variable name for FORTRAN output - (setq |$minivector| nil) - (setq |$minivectorCode| nil) - (setq |$minivectorNames| nil) - (setq |$domPvar| nil) - (setq |$inRetract| nil) - (setq object (|processInteractive1| form posnForm)) - (unless |$ProcessInteractiveValue| - (when |$reportInstantiations| - (|reportInstantiations|) - (clrhash |$instantRecord|)) - (|writeHistModesAndValues|) - (|updateHist|)) - object)) - -\end{chunk} - -\defdollar{ProcessInteractiveValue} -\begin{chunk}{initvars} -(defvar |$ProcessInteractiveValue| nil "If true, no output or record") - -\end{chunk} - -\defdollar{HTCompanionWindowID} -\begin{chunk}{initvars} -(defvar |$HTCompanionWindowID| nil) - -\end{chunk} - -\defun{processInteractive1}{processInteractive1} -This calls the analysis and output printing routines -\calls{processInteractive1}{recordFrame} -\calls{processInteractive1}{startTimingProcess} -\calls{processInteractive1}{interpretTopLevel} -\calls{processInteractive1}{stopTimingProcess} -\calls{processInteractive1}{recordAndPrint} -\calls{processInteractive1}{objValUnwrap} -\calls{processInteractive1}{objMode} -\usesdollar{processInteractive1}{e} -\usesdollar{processInteractive1}{ProcessInteractiveValue} -\usesdollar{processInteractive1}{InteractiveFrame} -\begin{chunk}{defun processInteractive1} -(defun |processInteractive1| (form posnForm) - (let (|$e| object) - (declare (special |$e| |$ProcessInteractiveValue| |$InteractiveFrame|)) - (setq |$e| |$InteractiveFrame|) - (|recordFrame| '|system|) - (|startTimingProcess| '|analysis|) - (setq object (|interpretTopLevel| form posnForm)) - (|stopTimingProcess| '|analysis|) - (|startTimingProcess| '|print|) - (unless |$ProcessInteractiveValue| - (|recordAndPrint| (|objValUnwrap| object) (|objMode| object))) - (|recordFrame| '|normal|) - (|stopTimingProcess| '|print|) - object)) - -\end{chunk} - -\defun{interpretTopLevel}{interpretTopLevel} -\catches{interpretTopLevel}{interpreter} -\calls{interpretTopLevel}{interpret} -\calls{interpretTopLevel}{stopTimingProcess} -\calls{interpretTopLevel}{peekTimedName} -\calls{interpretTopLevel}{interpretTopLevel} -\usesdollar{interpretTopLevel}{timedNameStack} -\begin{chunk}{defun interpretTopLevel} -(defun |interpretTopLevel| (x posnForm) - (let (savedTimerStack c) - (declare (special |$timedNameStack|)) - (setq savedTimerStack (copy |$timedNameStack|)) - (setq c (catch '|interpreter| (|interpret| x posnForm))) - (do () - ((equal savedTimerStack |$timedNameStack|) nil) - (|stopTimingProcess| (|peekTimedName|))) - (if (eq c '|tryAgain|) - (|interpretTopLevel| x posnForm) - c))) - -\end{chunk} - -\defdollar{genValue} -If the \verb|$genValue| variable is true then evaluate generated code, -otherwise leave code unevaluated. If \verb|$genValue| is false then we -are compiling. This variable is only defined and used locally. -\begin{chunk}{initvars} -(defvar |$genValue| nil "evaluate generated code if true") - -\end{chunk} - -\defun{interpret}{Type analyzes and evaluates expression x, returns object} -\calls{interpret}{interpret1} -\usesdollar{interpret}{env} -\usesdollar{interpret}{eval} -\usesdollar{interpret}{genValue} -\begin{chunk}{defun interpret} -(defun |interpret| (&rest arg &aux restargs x) - (let (|$env| |$eval| |$genValue| posnForm) - (declare (special |$env| |$eval| |$genValue|)) - (setq x (car arg)) - (setq restargs (cdr arg)) - (if (consp restargs) - (setq posnForm (car restargs)) - (setq posnForm restargs)) - (setq |$env| (list (list nil))) - (setq |$eval| t) ; generate code -- don't just type analyze - (setq |$genValue| t) ; evaluate all generated code - (|interpret1| x nil posnForm))) - -\end{chunk} - -\defun{interpret1}{Dispatcher for the type analysis routines} -This is the dispatcher for the type analysis routines. It type analyzes and -evaluates the expression x in the rootMode (if non-nil) -which may be \verb|$EmptyMode|. It returns an object if evaluating, and a -modeset otherwise. It creates the attributed tree. - -\calls{interpret1}{mkAtreeWithSrcPos} -\calls{interpret1}{putTarget} -\calls{interpret1}{bottomUp} -\calls{interpret1}{getArgValue} -\calls{interpret1}{mkObj} -\calls{interpret1}{getValue} -\calls{interpret1}{interpret2} -\calls{interpret1}{keyedSystemError} -\usesdollar{interpret1}{genValue} -\usesdollar{interpret1}{eval} -\begin{chunk}{defun interpret1} -(defun |interpret1| (x rootMode posnForm) - (let (node modeSet newRootMode argVal val) - (declare (special |$genValue| |$eval|)) - (setq node (|mkAtreeWithSrcPos| x posnForm)) - (when rootMode (|putTarget| node rootMode)) - (setq modeSet (|bottomUp| node)) - (if (null |$eval|) - modeSet - (progn - (if (null rootMode) - (setq newRootMode (car modeSet)) - (setq newRootMode rootMode)) - (setq argVal (|getArgValue| node newRootMode)) - (cond - ((and argVal (null |$genValue|)) - (mkObj argVal newRootMode)) - ((and argVal (setq val (|getValue| node))) - (|interpret2| val newRootMode posnForm)) - (t - (|keyedSystemError| 'S2IS0053 (list x)))))))) - -\end{chunk} - -\defdollar{ThrowAwayMode} -\begin{chunk}{initvars} -(defvar |$ThrowAwayMode| '|$ThrowAwayMode| "interp constant") - -\end{chunk} - -\defun{interpret2}{interpret2} -This is the late interpretCoerce. I removed the call to -coerceInteractive, so it only does the JENKS cases. - -\calls{interpret2}{objVal} -\calls{interpret2}{objMode} -\calls{interpret2}{member} -\calls{interpret2}{mkObj} -\calls{interpret2}{systemErrorHere} -\calls{interpret2}{coerceInteractive} -\calls{interpret2}{throwKeyedMsgCannotCoerceWithValue} -\usesdollar{interpret2}{EmptyMode} -\usesdollar{interpret2}{ThrowAwayMode} -\begin{chunk}{defun interpret2} -(defun |interpret2| (object m1 posnForm) - (declare (ignore posnForm)) - (let (x m op ans) - (declare (special |$EmptyMode| |$ThrowAwayMode|)) - (cond - ((equal m1 |$ThrowAwayMode|) object) - (t - (setq x (|objVal| object)) - (setq m (|objMode| object)) - (cond - ((equal m |$EmptyMode|) - (cond - ((and (consp x) - (progn (setq op (qcar x)) t) - (|member| op '(map stream))) - (mkObj x m1)) - ((equal m1 |$EmptyMode|) - (mkObj x m)) - (t - (|systemErrorHere| "interpret2")))) - (m1 - (if (setq ans (|coerceInteractive| object m1)) - ans - (|throwKeyedMsgCannotCoerceWithValue| x m m1))) - (t object)))))) - -\end{chunk} - -\defdollar{runTestFlag} -This is referenced by maPrin to stash output by recordAndPrint to not -print type/time -\begin{chunk}{initvars} -(defvar |$runTestFlag| nil) - -\end{chunk} - -\defdollar{mkTestFlag} -This referenced by READLN to stash input by maPrin to stash output -by recordAndPrint to write i/o onto \verb|$testStream| -\begin{chunk}{initvars} -(defvar |$mkTestFlag| nil) - -\end{chunk} - -\defun{recordAndPrint}{Result Output Printing} -Prints out the value x which is of type m, and records the changes -in environment \verb|$e| into \verb|$InteractiveFrame| -\verb|$printAnyIfTrue| is documented in setvart.boot. -It is controlled with the {\tt )se me any} command. - -\calls{recordAndPrint}{output} -\calls{recordAndPrint}{putHist} -\calls{recordAndPrint}{mkObjWrap} -\calls{recordAndPrint}{printTypeAndTime} -\calls{recordAndPrint}{printStorage} -\calls{recordAndPrint}{printStatisticsSummary} -\calls{recordAndPrint}{mkCompanionPage} -\calls{recordAndPrint}{recordAndPrintTest} -\usesdollar{recordAndPrint}{outputMode} -\usesdollar{recordAndPrint}{mkTestOutputType} -\usesdollar{recordAndPrint}{runTestFlag} -\usesdollar{recordAndPrint}{e} -\usesdollar{recordAndPrint}{mkTestFlag} -\usesdollar{recordAndPrint}{HTCompanionWindowID} -\usesdollar{recordAndPrint}{QuietCommand} -\usesdollar{recordAndPrint}{printStatisticsSummaryIfTrue} -\usesdollar{recordAndPrint}{printTypeIfTrue} -\usesdollar{recordAndPrint}{printStorageIfTrue} -\usesdollar{recordAndPrint}{printTimeIfTrue} -\usesdollar{recordAndPrint}{Void} -\usesdollar{recordAndPrint}{algebraOutputStream} -\usesdollar{recordAndPrint}{collectOutput} -\usesdollar{recordAndPrint}{EmptyMode} -\usesdollar{recordAndPrint}{printVoidIfTrue} -\usesdollar{recordAndPrint}{outputMode} -\usesdollar{recordAndPrint}{printAnyIfTrue} -\begin{chunk}{defun recordAndPrint} -(defun |recordAndPrint| (x md) - (let (|$outputMode| xp mdp mode) - (declare (special |$outputMode| |$mkTestOutputType| |$runTestFlag| |$e| - |$mkTestFlag| |$HTCompanionWindowID| |$QuietCommand| - |$printStatisticsSummaryIfTrue| |$printTypeIfTrue| - |$printStorageIfTrue| |$printTimeIfTrue| |$Void| - |$algebraOutputStream| |$collectOutput| |$EmptyMode| - |$printVoidIfTrue| |$outputMode| |$printAnyIfTrue|)) - (cond - ((and (equal md '(|Any|)) |$printAnyIfTrue|) - (setq mdp (car x)) - (setq xp (cdr x))) - (t - (setq mdp md) - (setq xp x))) - (setq |$outputMode| md) - (if (equal md |$EmptyMode|) - (setq mode (|quadSch|)) - (setq mode md)) - (when (or (not (equal md |$Void|)) |$printVoidIfTrue|) - (unless |$collectOutput| (terpri |$algebraOutputStream|)) - (unless |$QuietCommand| (|output| xp mdp))) - (|putHist| '% '|value| (mkObjWrap x md) |$e|) - (when (or |$printTimeIfTrue| |$printTypeIfTrue|) - (|printTypeAndTime| xp mdp)) - (when |$printStorageIfTrue| (|printStorage|)) - (when |$printStatisticsSummaryIfTrue| (|printStatisticsSummary|)) - (when (integerp |$HTCompanionWindowID|) (|mkCompanionPage| md)) - (cond - (|$mkTestFlag| (|recordAndPrintTest| md)) - (|$runTestFlag| - (setq |$mkTestOutputType| md) - '|done|) - (t '|done|)))) - -\end{chunk} - -\defun{printStatisticsSummary}{printStatisticsSummary} -\calls{printStatisticsSummary}{sayKeyedMsg} -\calls{printStatisticsSummary}{statisticsSummary} -\usesdollar{printStatisticsSummary}{collectOutput} -\begin{chunk}{defun printStatisticsSummary} -(defun |printStatisticsSummary| () - (declare (special |$collectOutput|)) - (unless |$collectOutput| - (|sayKeyedMsg| 'S2GL0017 (list (|statisticsSummary|))))) - -\end{chunk} - -\defun{printStorage}{printStorage} -\calls{printStorage}{makeLongSpaceString} -\usesdollar{printStorage}{interpreterTimedClasses} -\usesdollar{printStorage}{collectOutput} -\usesdollar{printStorage}{interpreterTimedNames} -\begin{chunk}{defun printStorage} -(defun |printStorage| () - (declare (special |$interpreterTimedClasses| |$collectOutput| - |$interpreterTimedNames|)) - (unless |$collectOutput| - (|sayKeyedMsg| 'S2GL0016 - (list - (|makeLongSpaceString| - |$interpreterTimedNames| - |$interpreterTimedClasses|))))) - -\end{chunk} - -\defun{printTypeAndTime}{printTypeAndTime} -\calls{printTypeAndTime}{printTypeAndTimeSaturn} -\calls{printTypeAndTime}{printTypeAndTimeNormal} -\usesdollar{printTypeAndTime}{saturn} -\begin{chunk}{defun printTypeAndTime} -(defun |printTypeAndTime| (x m) - (declare (special |$saturn|)) - (if |$saturn| - (|printTypeAndTimeSaturn| x m) - (|printTypeAndTimeNormal| x m))) - -\end{chunk} - -\defun{printTypeAndTimeNormal}{printTypeAndTimeNormal} -\calls{printTypeAndTimeNormal}{retract} -\calls{printTypeAndTimeNormal}{qcar} -\calls{printTypeAndTimeNormal}{retract} -\calls{printTypeAndTimeNormal}{mkObjWrap} -\calls{printTypeAndTimeNormal}{objMode} -\calls{printTypeAndTimeNormal}{sameUnionBranch} -\calls{printTypeAndTimeNormal}{makeLongTimeString} -\calls{printTypeAndTimeNormal}{msgText} -\calls{printTypeAndTimeNormal}{sayKeyedMsg} -\calls{printTypeAndTimeNormal}{justifyMyType} -\usesdollar{printTypeAndTimeNormal}{collectOutput} -\usesdollar{printTypeAndTimeNormal}{printTypeIfTrue} -\usesdollar{printTypeAndTimeNormal}{printTimeIfTrue} -\usesdollar{printTypeAndTimeNormal}{outputLines} -\usesdollar{printTypeAndTimeNormal}{interpreterTimedNames} -\usesdollar{printTypeAndTimeNormal}{interpreterTimedClasses} -\begin{chunk}{defun printTypeAndTimeNormal} -(defun |printTypeAndTimeNormal| (x m) - (let (xp mp timeString result) - (declare (special |$outputLines| |$collectOutput| |$printTypeIfTrue| - |$printTimeIfTrue| |$outputLines| - |$interpreterTimedNames| |$interpreterTimedClasses|)) - (cond - ((and (consp m) (eq (qcar m) '|Union|)) - (setq xp (|retract| (mkObjWrap x m))) - (setq mp (|objMode| xp)) - (setq m - (cons '|Union| - (append - (dolist (arg (qcdr m) (nreverse result)) - (when (|sameUnionBranch| arg mp) (push arg result))) - (list "...")))))) - (when |$printTimeIfTrue| - (setq timeString - (|makeLongTimeString| - |$interpreterTimedNames| - |$interpreterTimedClasses|))) - (cond - ((and |$printTimeIfTrue| |$printTypeIfTrue|) - (if |$collectOutput| - (push (|msgText| 'S2GL0012 (list m)) |$outputLines|) - (|sayKeyedMsg| 'S2GL0014 (list m timeString )))) - (|$printTimeIfTrue| - (unless |$collectOutput| (|sayKeyedMsg| 'S2GL0013 (list timeString)))) - (|$printTypeIfTrue| - (if |$collectOutput| - (push (|justifyMyType| (|msgText| 'S2GL0012 (list m))) |$outputLines|) - (|sayKeyedMsg| 'S2GL0012 (list m))))))) - -\end{chunk} - -\defun{printTypeAndTimeSaturn}{printTypeAndTimeSaturn} -\calls{printTypeAndTimeSaturn}{makeLongTimeString} -\calls{printTypeAndTimeSaturn}{form2StringAsTeX} -\calls{printTypeAndTimeSaturn}{devaluate} -\calls{printTypeAndTimeSaturn}{printAsTeX} -\usesdollar{printTypeAndTimeSaturn}{printTimeIfTrue} -\usesdollar{printTypeAndTimeSaturn}{printTypeIfTrue} -\usesdollar{printTypeAndTimeSaturn}{interpreterTimedClasses} -\usesdollar{printTypeAndTimeSaturn}{interpreterTimedNames} -\begin{chunk}{defun printTypeAndTimeSaturn} -(defun |printTypeAndTimeSaturn| (x m) - (declare (ignore x)) - (let (timeString typeString) - (declare (special |$printTimeIfTrue| |$printTypeIfTrue| - |$interpreterTimedClasses| |$interpreterTimedNames|)) - (if |$printTimeIfTrue| - (setq timeString - (|makeLongTimeString| - |$interpreterTimedNames| - |$interpreterTimedClasses|)) - (setq timeString "")) - (if |$printTypeIfTrue| - (setq typeString (|form2StringAsTeX| (|devaluate| m))) - (setq typeString "")) - (when |$printTypeIfTrue| - (|printAsTeX| "\\axPrintType{") - (if (consp typeString) - (mapc #'|printAsTeX| typeString) - (|printAsTeX| typeString)) - (|printAsTeX| "}")) - (when |$printTimeIfTrue| - (|printAsTeX| "\\axPrintTime{") - (|printAsTeX| timeString) - (|printAsTeX| "}")))) - -\end{chunk} - -\defun{printAsTeX}{printAsTeX} -\usesdollar{printAsTeX}{texOutputStream} -\begin{chunk}{defun printAsTeX 0} -(defun |printAsTeX| (x) - (declare (special |$texOutputStream|)) - (princ x |$texOutputStream|)) - -\end{chunk} - -\defun{sameUnionBranch}{sameUnionBranch} -\begin{verbatim} -sameUnionBranch(uArg, m) == - uArg is [":", ., t] => t = m - uArg = m -\end{verbatim} -\begin{chunk}{defun sameUnionBranch 0} -(defun |sameUnionBranch| (uArg m) - (let (t1 t2 t3) - (cond - ((and (consp uArg) - (eq (qcar uArg) '|:|) - (progn - (setq t1 (qcdr uArg)) - (and (consp t1) - (progn - (setq t2 (qcdr t1)) - (and (consp t2) - (eq (qcdr t2) nil) - (progn (setq t3 (qcar t2)) t)))))) - (equal t3 m)) - (t (equal uArg m))))) - -\end{chunk} - -\defun{msgText}{msgText} -\calls{msgText}{segmentKeyedMsg} -\calls{msgText}{getKeyedMsg} -\calls{msgText}{substituteSegmentedMsg} -\calls{msgText}{flowSegmentedMsg} -\usesdollar{msgText}{linelength} -\usesdollar{msgText}{margin} -\begin{chunk}{defun msgText} -(defun |msgText| (key args) - (let (msg) - (declare (special $linelength $margin)) - (setq msg (|segmentKeyedMsg| (|getKeyedMsg| key))) - (setq msg (|substituteSegmentedMsg| msg args)) - (setq msg (|flowSegmentedMsg| msg $linelength $margin)) - (apply #'concat (mapcar #'princ-to-string (cdar msg))))) - -\end{chunk} - -\defun{justifyMyType}{Right-justify the Type output} -\calls{justifyMyType}{fillerSpaces} -\usesdollar{justifyMyType}{linelength} -\begin{chunk}{defun justifyMyType} -(defun |justifyMyType| (arg) - (let (len) - (declare (special $linelength)) - (setq len (|#| arg)) - (if (> len $linelength) - arg - (concat (|fillerSpaces| (- $linelength len)) arg)))) - -\end{chunk} - -\defun{unescapeStringsInForm}{Destructively fix quotes in strings} -\calls{unescapeStringsInForm}{unescapeStringsInForm} -\usesdollar{unescapeStringsInForm}{funnyBacks} -\usesdollar{unescapeStringsInForm}{funnyQuote} -\begin{chunk}{defun unescapeStringsInForm} -(defun |unescapeStringsInForm| (form) - (let (str) - (declare (special |$funnyBacks| |$funnyQuote|)) - (cond - ((stringp form) - (setq str (nsubstitute #\" |$funnyQuote| form)) - (nsubstitute #\\ |$funnyBacks| str)) - ((consp form) - (|unescapeStringsInForm| (car form)) - (|unescapeStringsInForm| (cdr form)) - form) - (t form)))) - -\end{chunk} - -\defunsec{intloopInclude}{Include a file into the stream} -\calls{intloopInclude}{intloopInclude0} -\begin{chunk}{defun intloopInclude} -(defun |intloopInclude| (name n) - "Include a file into the stream" - (with-open-file (st name) (|intloopInclude0| st name n))) - -\end{chunk} - -\defun{intloopInclude0}{intloopInclude0} -\calls{intloopInclude0}{incStream} -\calls{intloopInclude0}{intloopProcess} -\calls{intloopInclude0}{next} -\calls{intloopInclude0}{intloopEchoParse} -\calls{intloopInclude0}{insertpile} -\calls{intloopInclude0}{lineoftoks} -\usesdollar{intloopInclude0}{lines} -\begin{chunk}{defun intloopInclude0} -(defun |intloopInclude0| (|st| |name| |n|) - (let (|$lines|) - (declare (special |$lines|)) - (setq |$lines| (|incStream| |st| |name|)) - (|intloopProcess| |n| NIL - (|next| #'|intloopEchoParse| - (|next| #'|insertpile| - (|next| #'|lineoftoks| - |$lines|)))))) - -\end{chunk} - -\defun{intloopProcess}{intloopProcess} -An example call looks like: -\begin{verbatim} - 3> (|intloopProcess| 1 T - (|nonnullstream| #0=|next1| |ncloopParse| - (|nonnullstream| #0# |lineoftoks| - (|nonnullstream| |incZip1| |incRenumberLine| - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) - (|nonnullstream| |incIgen1| 0))))) -\end{verbatim} -which was constructed \bfref{intloopProcessString}. This call -says we are processing the first input, in this case ``1''. -It is interactive. The third argument, the delay, contains the -information to drive the rest of the process. -\calls{intloopProcess}{StreamNull} -\calls{intloopProcess}{pfAbSynOp?} -\calls{intloopProcess}{setCurrentLine} -\calls{intloopProcess}{tokPart} -\calls{intloopProcess}{intloopProcess} -\calls{intloopProcess}{intloopSpadProcess} -\callsdollar{intloopProcess}{systemCommandFunction} -\usesdollar{intloopProcess}{systemCommandFunction} -\label{intloopProcess} -\sig{intloopProcess}{(StepNo,Boolean,Delay)}{StepNo} -\begin{chunk}{defun intloopProcess} -(defun |intloopProcess| (stepno interactive delay) - (let (ptree lines t1) - (declare (special |$systemCommandFunction|)) - (cond - ((|StreamNull| delay) stepno) - (t - (setq t1 (car delay)) - (setq lines (car t1)) - (setq ptree (cadr t1)) - (cond - ((|pfAbSynOp?| ptree '|command|) - (when interactive (|setCurrentLine| (|tokPart| ptree))) - (funcall |$systemCommandFunction| (|tokPart| ptree)) - (|intloopProcess| stepno interactive (cdr delay))) - (t - (|intloopProcess| - (|intloopSpadProcess| stepno lines ptree interactive) - interactive (cdr delay)))))))) - -\end{chunk} - -\defun{intloopSpadProcess}{intloopSpadProcess} -\catches{intloopSpadProcess}{flung} -\catches{intloopSpadProcess}{SpadCompileItem} -\catches{intloopSpadProcess}{intCoerceFailure} -\catches{intloopSpadProcess}{intSpadReader} -\calls{intloopSpadProcess}{ncPutQ} -\calls{intloopSpadProcess}{CatchAsCan} -\calls{intloopSpadProcess}{Catch} -\calls{intloopSpadProcess}{intloopSpadProcess,interp} -\usesdollar{intloopSpadProcess}{currentCarrier} -\usesdollar{intloopSpadProcess}{ncMsgList} -\usesdollar{intloopSpadProcess}{intCoerceFailure} -\usesdollar{intloopSpadProcess}{intSpadReader} -\usesdollar{intloopSpadProcess}{prevCarrier} -\usesdollar{intloopSpadProcess}{stepNo} -\usesdollar{intloopSpadProcess}{NeedToSignalSessionManager} -\uses{intloopSpadProcess}{flung} -\begin{chunk}{defun intloopSpadProcess} -(defun |intloopSpadProcess| (stepNo lines ptree interactive?) - (let (|$stepNo| result cc) - (declare (special |$stepNo| |$prevCarrier| |$intSpadReader| |flung| - |$intCoerceFailure| |$ncMsgList| |$currentCarrier| - |$NeedToSignalSessionManager|)) - (setq |$stepNo| stepNo) - (setq |$currentCarrier| (setq cc (list '|carrier|))) - (|ncPutQ| cc '|stepNumber| stepNo) - (|ncPutQ| cc '|messages| |$ncMsgList|) - (|ncPutQ| cc '|lines| lines) - (setq |$ncMsgList| nil) - (setq result - (catch '|SpadCompileItem| - (catch |$intCoerceFailure| - (catch |$intSpadReader| - (|intloopSpadProcess,interp| cc ptree interactive?))))) - (setq |$NeedToSignalSessionManager| t) - (setq |$prevCarrier| |$currentCarrier|) - (cond - ((eq result '|ncEnd|) stepNo) - ((eq result '|ncError|) stepNo) - ((eq result '|ncEndItem|) stepNo) - (t (1+ stepNo))))) - -\end{chunk} - -\defun{intloopSpadProcess,interp}{intloopSpadProcess,interp} -\calls{intloopSpadProcess,interp}{ncConversationPhase} -\calls{intloopSpadProcess,interp}{ncEltQ} -\calls{intloopSpadProcess,interp}{ncError} -\begin{chunk}{defun intloopSpadProcess,interp} -(defun |intloopSpadProcess,interp| (cc ptree interactive?) - (|ncConversationPhase| #'|phParse| (list cc ptree)) - (|ncConversationPhase| #'|phMacro| (list cc)) - (|ncConversationPhase| #'|phIntReportMsgs| (list cc interactive?)) - (|ncConversationPhase| #'|phInterpret| (list cc)) - (unless (eql (length (|ncEltQ| cc '|messages|)) 0) (|ncError|))) - -\end{chunk} - -\defun{phParse}{phParse} -\tpdhere{The pform function has a leading percent sign} -\begin{verbatim} -phParse: carrier[tokens,...] -> carrier[ptree, tokens,...] -\end{verbatim} -\calls{phParse}{ncPutQ} -\begin{chunk}{defun phParse} -(defun |phParse| (carrier ptree) - (|ncPutQ| carrier '|ptree| ptree) - 'ok) - -\end{chunk} - -\defun{phIntReportMsgs}{phIntReportMsgs} -\begin{verbatim} -carrier[lines,messages,..]-> carrier[lines,messages,..] -\end{verbatim} -\calls{phIntReportMsgs}{ncEltQ} -\calls{phIntReportMsgs}{ncPutQ} -\calls{phIntReportMsgs}{processMsgList} -\usesdollar{phIntReportMsgs}{erMsgToss} -\begin{chunk}{defun phIntReportMsgs} -(defun |phIntReportMsgs| (carrier interactive?) - (declare (ignore interactive?)) - (let (nerr msgs lines) - (declare (special |$erMsgToss|)) - (cond - (|$erMsgToss| 'ok) - (t - (setq lines (|ncEltQ| carrier '|lines|)) - (setq msgs (|ncEltQ| carrier '|messages|)) - (setq nerr (length msgs)) - (|ncPutQ| carrier '|ok?| (eql nerr 0)) - (cond - ((eql nerr 0) 'ok) - (t - (|processMsgList| msgs lines) - (|sayKeyedMsg| 'S2CTP010 (list nerr)) - 'ok)))))) - -\end{chunk} - -\defun{phInterpret}{phInterpret} -\calls{phInterpret}{ncEltQ} -\calls{phInterpret}{intInterpretPform} -\calls{phInterpret}{ncPutQ} -\begin{chunk}{defun phInterpret} -(defun |phInterpret| (carrier) - (let (val ptree) - (setq ptree (|ncEltQ| carrier '|ptree|)) - (setq val (|intInterpretPform| ptree)) - (|ncPutQ| carrier '|value| val))) - -\end{chunk} - -\defun{intInterpretPform}{intInterpretPform} -\calls{intInterpretPform}{processInteractive} -\calls{intInterpretPform}{zeroOneTran} -\calls{intInterpretPform}{pf2Sex} -\begin{chunk}{defun intInterpretPform} -(defun |intInterpretPform| (pf) - (|processInteractive| (|zeroOneTran| (|pf2Sex| pf)) pf)) - -\end{chunk} - -\defun{zeroOneTran}{zeroOneTran} -\calls{zeroOneTran}{nsubst} -\begin{chunk}{defun zeroOneTran 0} -(defun |zeroOneTran| (sex) - (nsubst '|$EmptyMode| '? sex)) - -\end{chunk} - -\defun{ncConversationPhase}{ncConversationPhase} -\calls{ncConversationPhase}{ncConversationPhase,wrapup} -\usesdollar{ncConversationPhase}{ncMsgList} -\begin{chunk}{defun ncConversationPhase} -(defun |ncConversationPhase| (fn args) - (let (|$ncMsgList| carrier) - (declare (special |$ncMsgList|)) - (setq carrier (car args)) - (setq |$ncMsgList| nil) - (unwind-protect - (apply fn args) - (|ncConversationPhase,wrapup| carrier)))) - -\end{chunk} - -\defun{ncConversationPhase,wrapup}{ncConversationPhase,wrapup} -\usesdollar{ncConversationPhase,wrapup}{ncMsgList} -\begin{chunk}{defun ncConversationPhase,wrapup} -(defun |ncConversationPhase,wrapup| (carrier) - (declare (special |$ncMsgList|)) - ((lambda (Var5 m) - (loop - (cond - ((or (atom Var5) (progn (setq m (car Var5)) nil)) - (return nil)) - (t - (|ncPutQ| carrier '|messages| (cons m (|ncEltQ| carrier '|messages|))))) - (setq Var5 (cdr Var5)))) - |$ncMsgList| nil)) - -\end{chunk} - -\defun{ncError}{ncError} -\throws{ncError}{SpadCompileItem} -\begin{chunk}{defun ncError 0} -(defun |ncError| () - (throw '|SpadCompileItem| '|ncError|)) - -\end{chunk} - -\defun{intloopEchoParse}{intloopEchoParse} -\calls{intloopEchoParse}{ncloopDQlines} -\calls{intloopEchoParse}{setCurrentLine} -\calls{intloopEchoParse}{mkLineList} -\calls{intloopEchoParse}{ncloopPrintLines} -\calls{intloopEchoParse}{npParse} -\calls{intloopEchoParse}{dqToList} -\usesdollar{intloopEchoParse}{EchoLines} -\usesdollar{intloopEchoParse}{lines} -\begin{chunk}{defun intloopEchoParse} -(defun |intloopEchoParse| (s) - (let (cudr lines stream dq t1) - (declare (special |$EchoLines| |$lines|)) - (setq t1 (car s)) - (setq dq (car t1)) - (setq stream (cadr t1)) - (setq t1 (|ncloopDQlines| dq |$lines|)) - (setq lines (car t1)) - (setq cudr (cadr t1)) - (|setCurrentLine| (|mkLineList| lines)) - (when |$EchoLines| (|ncloopPrintLines| lines)) - (setq |$lines| cudr) - (cons (list (list lines (|npParse| (|dqToList| dq)))) (cdr s)))) - -\end{chunk} - -\defun{ncloopPrintLines}{ncloopPrintLines} -\begin{verbatim} -;ncloopPrintLines lines == -; for line in lines repeat WRITE_-LINE CDR line -; WRITE_-LINE '" " -\end{verbatim} -\begin{chunk}{defun ncloopPrintLines 0} -(defun |ncloopPrintLines| (lines) - ((lambda (Var4 line) - (loop - (cond - ((or (atom Var4) (progn (setq line (car Var4)) nil)) - (return nil)) - (t (write-line (cdr line)))) - (setq Var4 (cdr Var4)))) - lines nil) - (write-line " ")) - -\end{chunk} - -\defun{mkLineList}{mkLineList} -\begin{verbatim} -;mkLineList lines == -; l := [CDR line for line in lines | nonBlank CDR line] -; #l = 1 => CAR l -; l -\end{verbatim} -\begin{chunk}{defun mkLineList} -(defun |mkLineList| (lines) - (let (l) - (setq l - ((lambda (Var2 Var1 line) - (loop - (cond - ((or (atom Var1) (progn (setq line (car Var1)) nil)) - (return (nreverse Var2))) - (t - (and (|nonBlank| (cdr line)) - (setq Var2 (cons (cdr line) Var2))))) - (setq Var1 (cdr Var1)))) - nil lines nil)) - (cond - ((eql (length l) 1) (car l)) - (t l)))) - -\end{chunk} - -\defun{nonBlank}{nonBlank} -\begin{verbatim} -;nonBlank str == -; value := false -; for i in 0..MAXINDEX str repeat -; str.i ^= char " " => -; value := true -; return value -; value -\end{verbatim} -\begin{chunk}{defun nonBlank 0} -(defun |nonBlank| (str) - (let (value) - ((lambda (Var3 i) - (loop - (cond - ((> i Var3) (return nil)) - (t - (cond - ((not (equal (elt str i) #\Space)) - (identity (progn (setq value t) (return value))))))) - (setq i (+ i 1)))) - (maxindex str) 0) - value)) - -\end{chunk} - -\defun{ncloopDQlines}{ncloopDQlines} -\calls{ncloopDQlines}{StreamNull} -\calls{ncloopDQlines}{poGlobalLinePosn} -\calls{ncloopDQlines}{tokPosn} -\calls{ncloopDQlines}{streamChop} -\begin{chunk}{defun ncloopDQlines} -(defun |ncloopDQlines| (dq stream) - (let (b a) - (|StreamNull| stream) - (setq a (|poGlobalLinePosn| (|tokPosn| (cadr dq)))) - (setq b (|poGlobalLinePosn| (caar stream))) - (|streamChop| (+ (- a b) 1) stream))) - -\end{chunk} - -\defun{poGlobalLinePosn}{poGlobalLinePosn} -\calls{poGlobalLinePosn}{lnGlobalNum} -\calls{poGlobalLinePosn}{poGetLineObject} -\calls{poGlobalLinePosn}{ncBug} -\begin{chunk}{defun poGlobalLinePosn} -(defun |poGlobalLinePosn| (posn) - (if posn - (|lnGlobalNum| (|poGetLineObject| posn)) - (|ncBug| "old style pos objects have no global positions" nil))) - -\end{chunk} - -\defun{streamChop}{streamChop} -Note that changing the name ``lyne'' to ``line'' will break the system. -I do not know why. The symptom shows up when there is a file with a large -contiguous comment spanning enough lines to overflow the stack. - -\calls{streamChop}{StreamNull} -\calls{streamChop}{streamChop} -\calls{streamChop}{ncloopPrefix?} -\begin{chunk}{defun streamChop} -(defun |streamChop| (n s) - (let (d c lyne b a tmp1) - (cond - ((|StreamNull| s) (list nil nil)) - ((eql n 0) (list nil s)) - (t - (setq tmp1 (|streamChop| (- n 1) (cdr s))) - (setq a (car tmp1)) - (setq b (cadr tmp1)) - (setq lyne (car s)) - (setq c (|ncloopPrefix?| ")command" (cdr lyne))) - (setq d (cons (car lyne) (cond (c c) (t (cdr lyne))))) - (list (cons d a) b))))) - -\end{chunk} - -\defun{ncloopInclude0}{ncloopInclude0} -\calls{ncloopInclude0}{incStream} -\calls{ncloopInclude0}{ncloopProcess} -\calls{ncloopInclude0}{next} -\calls{ncloopInclude0}{ncloopEchoParse} -\calls{ncloopInclude0}{insertpile} -\calls{ncloopInclude0}{lineoftoks} -\usesdollar{ncloopInclude0}{lines} -\begin{chunk}{defun ncloopInclude0} -(defun |ncloopInclude0| (st name n) - (let (|$lines|) - (declare (special |$lines|)) - (setq |$lines| (|incStream| st name)) - (|ncloopProcess| n nil - (|next| #'|ncloopEchoParse| - (|next| #'|insertpile| - (|next| #'|lineoftoks| - |$lines|)))))) - -\end{chunk} - -\defun{incStream}{incStream} -\calls{incStream}{incRenumber} -\calls{incStream}{incLude} -\calls{incStream}{incRgen} -\uses{incStream}{Top} -\begin{chunk}{defun incStream} -(defun |incStream| (st fn) - (declare (special |Top|)) - (|incRenumber| (|incLude| 0 (|incRgen| st) 0 (list fn) (list |Top|)))) - -\end{chunk} - -\defun{incRenumber}{incRenumber} -\calls{incRenumber}{incZip} -\calls{incRenumber}{incIgen} -\label{incRenumber} -\sig{incRenumber}{Delay}{Delay} -\begin{chunk}{defun incRenumber} -(defun |incRenumber| (ssx) - (|incZip| #'|incRenumberLine| ssx (|incIgen| 0))) - -\end{chunk} - -\defun{incZip}{incZip} -Axiom ``zips'' a function together with two delays into a delay. - -\calls{incZip}{Delay} -\calls{incZip}{incZip1} -\label{incZip} -\sig{incZip}{(Function,Delay,Delay)}{Delay} -\begin{chunk}{defun incZip} -(defun |incZip| (function delay1 delay2) - (|Delay| #'|incZip1| (list function delay1 delay2))) - -\end{chunk} - -\defun{incZip1}{incZip1} -\calls{incZip1}{StreamNull} -\calls{incZip1}{incZip} -\label{incZip1} -\sig{incZip1}{Delay}{ParsePair} -\begin{chunk}{defun incZip1} -(defun |incZip1| (&rest delayArg) - (let (function delay1 delay2) - (setq function (car delayArg)) - (setq delay1 (cadr delayArg)) - (setq delay2 (caddr delayArg)) - (cond - ((|StreamNull| delay1) |StreamNil|) - ((|StreamNull| delay2) |StreamNil|) - (t - (cons - (funcall function (car delay1) (car delay2)) - (|incZip| function (cdr delay1) (cdr delay2))))))) - -\end{chunk} - -\defun{incIgen}{incIgen} -\calls{incIgen}{Delay} -\calls{incIgen}{incIgen1} -\label{incIgen} -\sig{incIgen}{Integer}{Delay} -\begin{chunk}{defun incIgen} -(defun |incIgen| (int) - (|Delay| #'|incIgen1| (list int))) - -\end{chunk} - -\defun{incIgen1}{incIgen1} -\calls{incIgen1}{incIgen} -\begin{chunk}{defun incIgen1} -(defun |incIgen1| (&rest z) - (let (n) - (setq n (car z)) - (setq n (+ n 1)) - (cons n (|incIgen| n)))) - -\end{chunk} - -\defun{incRenumberLine}{incRenumberLine} -\calls{incRenumberLine}{incRenumberItem} -\calls{incRenumberLine}{incHandleMessage} -\label{incRenumberLine} -\begin{chunk}{defun incRenumberLine} -(defun |incRenumberLine| (xl gno) - (let (l) - (setq l (|incRenumberItem| (elt xl 0) gno)) - (|incHandleMessage| xl) - l)) - -\end{chunk} -\defun{incRenumberItem}{incRenumberItem} -\calls{incRenumberItem}{lnSetGlobalNum} -\begin{chunk}{defun incRenumberItem} -(defun |incRenumberItem| (f i) - (let (l) - (setq l (caar f)) - (|lnSetGlobalNum| l i) f)) - -\end{chunk} - -\defun{incHandleMessage}{incHandleMessage} -\calls{incHandleMessage}{ncSoftError} -\calls{incHandleMessage}{ncBug} -\begin{chunk}{defun incHandleMessage 0} -(defun |incHandleMessage| (x) - "Message handling for the source includer" - (let ((msgtype (elt (elt x 1) 1)) - (pos (car (elt x 0))) - (key (car (elt (elt x 1) 0))) - (args (cadr (elt (elt x 1) 0)))) - - (cond - ((eq msgtype '|none|) 0) - ((eq msgtype '|error|) (|ncSoftError| pos key args)) - ((eq msgtype '|warning|) (|ncSoftError| pos key args)) - ((eq msgtype '|say|) (|ncSoftError| pos key args)) - (t (|ncBug| key args))))) - -\end{chunk} - -\defun{incLude}{incLude} -This function takes -\begin{enumerate} -\item {\bf eb} -- in Integer -\item {\bf ss} -- a list of strings -\item {\bf ln} -- an Integer -\item {\bf ufos} -- a list of strings -\item {\bf states} -- a list of integers -\end{enumerate} -and constructs a call to \bfref{Delay}. - -\calls{incLude}{Delay} -\calls{include}{incLude1} -\label{incLude} -\sig{incLude}{(Int,List(String),Int,List(String),List(Int))}{Delay} -\begin{chunk}{defun incLude} -(defun |incLude| (eb ss ln ufos states) - (|Delay| #'|incLude1| (list eb ss ln ufos states))) - -\end{chunk} - -\defmacro{Rest} -\begin{chunk}{defmacro Rest} -(defmacro |Rest| () - "used in incLude1 for parsing; s is not used." - '(|incLude| eb (cdr ss) lno ufos states)) - -\end{chunk} - -\defvar{Top} -\begin{chunk}{initvars} -(defvar |Top| 1 "used in incLude1 for parsing") - -\end{chunk} - -\defvar{IfSkipToEnd} -\begin{chunk}{initvars} -(defvar |IfSkipToEnd| 10 "used in incLude1 for parsing") - -\end{chunk} - -\defvar{IfKeepPart} -\begin{chunk}{initvars} -(defvar |IfKeepPart| 11 "used in incLude1 for parsing") - -\end{chunk} - -\defvar{IfSkipPart} -\begin{chunk}{initvars} -(defvar |IfSkipPart| 12 "used in incLude1 for parsing") - -\end{chunk} - -\defvar{ElseifSkipToEnd} -\begin{chunk}{initvars} -(defvar |ElseifSkipToEnd| 20 "used in incLude1 for parsing") - -\end{chunk} - -\defvar{ElseifKeepPart} -\begin{chunk}{initvars} -(defvar |ElseifKeepPart| 21 "used in incLude1 for parsing") - -\end{chunk} - -\defvar{ElseifSkipPart} -\begin{chunk}{initvars} -(defvar |ElseifSkipPart| 22 "used in incLude1 for parsing") - -\end{chunk} - -\defvar{ElseSkipToEnd} -\begin{chunk}{initvars} -(defvar |ElseSkipToEnd| 30 "used in incLude1 for parsing") - -\end{chunk} - -\defvar{ElseKeepPart} -\begin{chunk}{initvars} -(defvar |ElseKeepPart| 31 "used in incLude1 for parsing") - -\end{chunk} - -\defun{Top?}{Top?} -\calls{Top?}{quotient} -\begin{chunk}{defun Top? 0} -(defun |Top?| (|st|) - "used in incLude1 for parsing" - (eql (quotient |st| 10) 0)) - -\end{chunk} - -\defun{If?}{If?} -\calls{If?}{quotient} -\begin{chunk}{defun If?} -(defun |If?| (|st|) - "used in incLude1 for parsing" - (eql (quotient |st| 10) 1)) - -\end{chunk} - -\defun{Elseif?}{Elseif?} -\calls{Elseif?}{quotient} -\begin{chunk}{defun Elseif?} -(defun |Elseif?| (|st|) - "used in incLude1 for parsing" - (eql (quotient |st| 10) 2)) - -\end{chunk} - -\defun{Else?}{Else?} -\calls{Else?}{quotient} -\begin{chunk}{defun Else?} -(defun |Else?| (|st|) - "used in incLude1 for parsing" - (eql (quotient |st| 10) 3)) - -\end{chunk} - -\defun{SkipEnd?}{SkipEnd?} -\calls{SkipEnd?}{remainder} -\begin{chunk}{defun SkipEnd?} -(defun |SkipEnd?| (|st|) - "used in incLude1 for parsing" - (eql (remainder |st| 10) 0)) - -\end{chunk} - -\defun{KeepPart?}{KeepPart?} -\calls{KeepPart?}{remainder} -\begin{chunk}{defun KeepPart?} -(defun |KeepPart?| (|st|) - "used in incLude1 for parsing" - (eql (remainder |st| 10) 1)) - -\end{chunk} - -\defun{SkipPart?}{SkipPart?} -\calls{SkipPart?}{remainder} -\begin{chunk}{defun SkipPart?} -(defun |SkipPart?| (|st|) - "used in incLude1 for parsing" - (eql (remainder |st| 10) 2)) - -\end{chunk} - -\defun{Skipping?}{Skipping?} -\calls{Skipping?}{KeepPart?} -\begin{chunk}{defun Skipping?} -(defun |Skipping?| (|st|) - "used in incLude1 for parsing" - (null (|KeepPart?| |st|))) - -\end{chunk} - -\defun{incLude1}{incLude1} -\calls{incLude1}{StreamNull} -\calls{incLude1}{Top?} -\calls{incLude1}{xlPrematureEOF} -\calls{incLude1}{Skipping?} -\calls{incLude1}{xlSkip} -\calls{incLude1}{Rest} -\calls{incLude1}{xlOK} -\calls{incLude1}{xlOK1} -\calls{incLude1}{concat} -\calls{incLude1}{incCommandTail} -\calls{incLude1}{xlSay} -\calls{incLude1}{xlNoSuchFile} -\calls{incLude1}{xlCannotRead} -\calls{incLude1}{incActive?} -\calls{incLude1}{xlFileCycle} -\calls{incLude1}{incLude} -\calls{incLude1}{incFileInput} -\calls{incLude1}{incAppend} -\calls{incLude1}{inclFname} -\calls{incLude1}{xlConActive} -\calls{incLude1}{xlConStill} -\calls{incLude1}{incConsoleInput} -\calls{incLude1}{incNConsoles} -\calls{incLude1}{xlConsole} -\calls{incLude1}{xlSkippingFin} -\calls{incLude1}{xlPrematureFin} -\calls{incLude1}{assertCond} -\calls{incLude1}{ifCond} -\calls{incLude1}{If?} -\calls{incLude1}{Elseif?} -\calls{incLude1}{xlIfSyntax} -\calls{incLude1}{SkipEnd?} -\calls{incLude1}{KeepPart?} -\calls{incLude1}{SkipPart?} -\calls{incLude1}{xlIfBug} -\calls{incLude1}{xlCmdBug} -\calls{incLude1}{expand-tabs} -\calls{incLude1}{incClassify} -\begin{chunk}{defun incLude1} -(defun |incLude1| (&rest z) - (let (pred s1 n tail head includee fn1 info str state lno states - ufos ln ss eb) - (setq eb (car z)) - (setq ss (cadr . (z))) - (setq ln (caddr . (z))) - (setq ufos (cadddr . (z))) - (setq states (car (cddddr . (z)))) - (setq lno (+ ln 1)) - (setq state (elt states 0)) - (cond - ((|StreamNull| ss) - (cond - ((null (|Top?| state)) - (cons (|xlPrematureEOF| eb ")--premature end" lno ufos) - |StreamNil|)) - (t |StreamNil|))) - (t - (progn - (setq str (expand-tabs (car ss))) - (setq info (|incClassify| str)) - (cond - ((null (elt info 0)) - (cond - ((|Skipping?| state) - (cons (|xlSkip| eb str lno (elt ufos 0)) (|Rest|))) - (t - (cons (|xlOK| eb str lno (elt ufos 0)) (|Rest|))))) - ((equal (elt info 2) "other") - (cond - ((|Skipping?| state) - (cons (|xlSkip| eb str lno (elt ufos 0)) (|Rest|))) - (t - (cons - (|xlOK1| eb str (concat ")command" str) lno (elt ufos 0)) - (|Rest|))))) - ((equal (elt info 2) "say") - (cond - ((|Skipping?| state) - (cons (|xlSkip| eb str lno (elt ufos 0)) (|Rest|))) - (t - (progn - (setq str (|incCommandTail| str info)) - (cons (|xlSay| eb str lno ufos str) - (cons (|xlOK| eb str lno (ELT ufos 0)) (|Rest|))))))) - ((equal (elt info 2) "include") - (cond - ((|Skipping?| state) - (cons (|xlSkip| eb str lno (elt ufos 0)) (|Rest|))) - (t - (progn - (setq fn1 (|inclFname| str info)) - (cond - ((null fn1) - (cons (|xlNoSuchFile| eb str lno ufos fn1) (|Rest|))) - ((null (probe-file fn1)) - (cons (|xlCannotRead| eb str lno ufos fn1) (|Rest|))) - ((|incActive?| fn1 ufos) - (cons (|xlFileCycle| eb str lno ufos fn1) (|Rest|))) - (t - (progn - (setq includee - (|incLude| (+ eb (elt info 1)) - (|incFileInput| fn1) - 0 - (cons fn1 ufos) - (cons |Top| states))) - (cons (|xlOK| eb str lno (elt ufos 0)) - (|incAppend| includee (|Rest|)))))))))) - ((equal (elt info 2) "console") - (cond - ((|Skipping?| state) - (cons (|xlSkip| eb str lno (elt ufos 0)) (|Rest|))) - (t - (progn - (setq head - (|incLude| (+ eb (elt info 1)) - (|incConsoleInput|) - 0 - (cons "console" ufos) - (cons |Top| states))) - (setq tail (|Rest|)) - (setq n (|incNConsoles| ufos)) - (cond - ((< 0 n) - (setq head - (cons (|xlConActive| eb str lno ufos n) head)) - (setq tail - (cons (|xlConStill| eb str lno ufos n) tail)))) - (setq head (cons (|xlConsole| eb str lno ufos) head)) - (cons (|xlOK| eb str lno (elt ufos 0)) - (|incAppend| head tail)))))) - ((equal (elt info 2) "fin") - (cond - ((|Skipping?| state) - (cons (|xlSkippingFin| eb str lno ufos) (|Rest|))) - ((null (|Top?| state)) - (cons (|xlPrematureFin| eb str lno ufos) |StreamNil|)) - (t - (cons (|xlOK| eb str lno (elt ufos 0)) |StreamNil|)))) - ((equal (elt info 2) "assert") - (cond - ((|Skipping?| state) - (cons (|xlSkippingFin| eb str lno ufos) (|Rest|))) - (t - (progn - (|assertCond| str info) - (cons (|xlOK| eb str lno (elt ufos 0)) - (|incAppend| includee (|Rest|))))))) - ((equal (elt info 2) "if") - (progn - (setq s1 - (cond - ((|Skipping?| state) |IfSkipToEnd|) - (t - (cond - ((|ifCond| str info) |IfKeepPart|) - (t |IfSkipPart|))))) - (cons (|xlOK| eb str lno (elt ufos 0)) - (|incLude| eb (cdr ss) lno ufos (cons s1 states))))) - ((equal (elt info 2) "elseif") - (cond - ((and (null (|If?| state)) (null (|Elseif?| state))) - (cons (|xlIfSyntax| eb str lno ufos info states) - |StreamNil|)) - (t - (cond - ((or (|SkipEnd?| state) - (|KeepPart?| state) - (|SkipPart?| state)) - (setq s1 - (cond - ((|SkipPart?| state) - (setq pred (|ifCond| str info)) - (cond - (pred |ElseifKeepPart|) - (t |ElseifSkipPart|))) - (t |ElseifSkipToEnd|))) - (cons (|xlOK| eb str lno (elt ufos 0)) - (|incLude| eb (cdr ss) lno ufos (cons s1 (cdr states))))) - (t - (cons (|xlIfBug| eb str lno ufos) |StreamNil|)))))) - ((equal (elt info 2) "else") - (cond - ((and (null (|If?| state)) (null (|Elseif?| state))) - (cons (|xlIfSyntax| eb str lno ufos info states) - |StreamNil|)) - (t - (cond - ((or (|SkipEnd?| state) - (|KeepPart?| state) - (|SkipPart?| state)) - (setq s1 - (cond ((|SkipPart?| state) |ElseKeepPart|) (t |ElseSkipToEnd|))) - (cons (|xlOK| eb str lno (elt ufos 0)) - (|incLude| eb (cdr ss) lno ufos (cons s1 (cdr states))))) - (t - (cons (|xlIfBug| eb str lno ufos) |StreamNil|)))))) - ((equal (elt info 2) "endif") - (cond - ((|Top?| state) - (cons (|xlIfSyntax| eb str lno ufos info states) - |StreamNil|)) - (t - (cons (|xlOK| eb str lno (elt ufos 0)) - (|incLude| eb (cdr ss) lno ufos (cdr states)))))) - (t (cons (|xlCmdBug| eb str lno ufos) |StreamNil|)))))))) - -\end{chunk} - -\defun{xlPrematureEOF}{xlPrematureEOF} -\calls{xlPrematureEOF}{xlMsg} -\calls{xlPrematureEOF}{inclmsgPrematureEOF} -\begin{chunk}{defun xlPrematureEOF} -(defun |xlPrematureEOF| (eb str lno ufos) - (|xlMsg| eb str lno (elt ufos 0) - (list (|inclmsgPrematureEOF| (elt ufos 0)) '|error|))) - -\end{chunk} - -\defun{xlMsg}{xlMsg} -\calls{xlMsg}{incLine} -\begin{chunk}{defun xlMsg} -(defun |xlMsg| (extrablanks string localnum fileobj mess) - (let ((globalnum -1)) - (list (incLine extrablanks string globalnum localnum fileobj) mess))) - -\end{chunk} - -\defun{xlOK}{xlOK} -\calls{xlOK}{xlOK1} -\begin{chunk}{defun xlOK} -(defun |xlOK| (extrablanks string localnum fileobj) - (|xlOK1| extrablanks string string localnum fileobj)) - -\end{chunk} - -\defun{xlOK1}{xlOK1} -\calls{xlOK1}{incLine1} -\begin{chunk}{defun xlOK1} -(defun |xlOK1| (extrablanks string string1 localnum fileobj) - (let ((globalnum -1)) - (list (incLine1 extrablanks string string1 globalnum localnum fileobj) - (list nil '|none|)))) - -\end{chunk} - -\defun{incAppend}{incAppend} -\calls{incAppend}{Delay} -\calls{incAppend}{incAppend1} -\begin{chunk}{defun incAppend} -(defun |incAppend| (x y) - (|Delay| #'|incAppend1| (list x y))) - -\end{chunk} - -\defun{incAppend1}{incAppend1} -\calls{incAppend1}{StreamNull} -\calls{incAppend1}{incAppend} -\begin{chunk}{defun incAppend1} -(defun |incAppend1| (&rest z) - (let (y x) - (setq x (car z)) - (setq y (cadr z)) - (cond - ((|StreamNull| x) - (cond ((|StreamNull| y) |StreamNil|) (t y))) - (t - (cons (car x) (|incAppend| (cdr x) y)))))) - -\end{chunk} - -\defun{incLine}{incLine} -\calls{incLine}{incLine1} -\begin{chunk}{defun incLine} -(defun incLine (extrablanks string globalnum localnum fileobj) - (incLine1 extrablanks string string globalnum localnum fileobj)) - -\end{chunk} - -\defun{incLine1}{incLine1} -\calls{incLine1}{lnCreate} -\begin{chunk}{defun incLine1} -(defun incLine1 (extrablanks string string1 globalnum localnum fileobj) - (cons - (cons (|lnCreate| extrablanks string globalnum localnum fileobj) 1) string1)) - -\end{chunk} - -\defun{inclmsgPrematureEOF}{inclmsgPrematureEOF} -\calls{inclmsgPrematureEOF}{theorigin} -\begin{chunk}{defun inclmsgPrematureEOF 0} -(defun |inclmsgPrematureEOF| (ufo) - (list 'S2CI0002 (list (|theorigin| ufo)))) - -\end{chunk} - -\defun{theorigin}{theorigin} -\begin{chunk}{defun theorigin 0} -(defun |theorigin| (x) (list #'|porigin| x)) - -\end{chunk} - -\defun{porigin}{porigin} -\calls{porigin}{pfname} -\begin{chunk}{defun porigin} -(defun |porigin| (x) - (if (stringp x) - x - (|pfname| x))) - -\end{chunk} - -\defun{ifCond}{ifCond} -\calls{ifCond}{MakeSymbol} -\calls{ifCond}{incCommandTail} -\usesdollar{ifCond}{inclAssertions} -\begin{chunk}{defun ifCond} -(defun |ifCond| (s info) - (let (word) - (declare (special |$inclAssertions|)) - (setq word - (|MakeSymbol| (string-trim *whitespace* (|incCommandTail| s info)))) - (member word |$inclAssertions|))) - -\end{chunk} - -\defun{xlSkip}{xlSkip} -\calls{xlSkip}{incLine} -\calls{xlSkip}{concat} -\begin{chunk}{defun xlSkip} -(defun |xlSkip| (extrablanks str localnum fileobj) - (let ((string (concat "-- Omitting:" str)) (globalnum -1)) - (list - (incLine extrablanks string globalnum localnum fileobj) - (list nil '|none|)))) - -\end{chunk} - -\defun{xlSay}{xlSay} -\calls{xlSay}{xlMsg} -\calls{xlSay}{inclmsgSay} -\begin{chunk}{defun xlSay} -(defun |xlSay| (eb str lno ufos x) - (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgSay| x) '|say|))) - -\end{chunk} - -\defun{inclmsgSay}{inclmsgSay} -\calls{inclmsgSay}{theid} -\begin{chunk}{defun inclmsgSay} -(defun |inclmsgSay| (str) - (list 'S2CI0001 (list (|theid| str)))) - -\end{chunk} - -\defun{theid}{theid} -\begin{chunk}{defun theid 0} -(defun |theid| (a) (list #'identity a)) - -\end{chunk} - -\defun{xlNoSuchFile}{xlNoSuchFile} -\calls{xlNoSuchFile}{xlMsg} -\calls{xlNoSuchFile}{inclmsgNoSuchFile} -\begin{chunk}{defun xlNoSuchFile} -(defun |xlNoSuchFile| (eb str lno ufos fn) - (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgNoSuchFile| fn) '|error|))) - -\end{chunk} - -\defun{inclmsgNoSuchFile}{inclmsgNoSuchFile} -\calls{inclmsgNoSuchFile}{thefname} -\begin{chunk}{defun inclmsgNoSuchFile} -(defun |inclmsgNoSuchFile| (fn) - (list 'S2CI0010 (list (|thefname| fn)))) - -\end{chunk} - -\defun{thefname}{thefname} -\calls{thefname}{pfname} -\begin{chunk}{defun thefname 0} -(defun |thefname| (x) (list #'|pfname| x)) - -\end{chunk} - -\defun{pfname}{pfname} -\calls{pfname}{PathnameString} -\begin{chunk}{defun pfname} -(defun |pfname| (x) (|PathnameString| x)) - -\end{chunk} - -\defun{xlCannotRead}{xlCannotRead} -\calls{xlCannotRead}{xlMsg} -\calls{xlCannotRead}{inclmsgCannotRead} -\begin{chunk}{defun xlCannotRead} -(defun |xlCannotRead| (eb str lno ufos fn) - (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgCannotRead| fn) '|error|))) - -\end{chunk} - -\defun{inclmsgCannotRead}{inclmsgCannotRead} -\calls{inclmsgCannotRead}{thefname} -\begin{chunk}{defun inclmsgCannotRead} -(defun |inclmsgCannotRead| (fn) - (list 'S2CI0011 (list (|thefname| fn)))) - -\end{chunk} - -\defun{xlFileCycle}{xlFileCycle} -\calls{xlFileCycle}{xlMsg} -\calls{xlFileCycle}{inclmsgFileCycle} -\begin{chunk}{defun xlFileCycle} -(defun |xlFileCycle| (eb str lno ufos fn) - (|xlMsg| eb str lno (elt ufos 0) - (list (|inclmsgFileCycle| ufos fn) '|error|))) - -\end{chunk} - -\defun{inclmsgFileCycle}{inclmsgFileCycle} -\begin{verbatim} -;inclmsgFileCycle(ufos,fn) == -; flist := [porigin n for n in reverse ufos] -; f1 := porigin fn -; cycle := [:[:[n,'"==>"] for n in flist], f1] -; ['S2CI0004, [%id cycle, %id f1] ] - -\end{verbatim} -\calls{inclmsgFileCycle}{porigin} -\calls{inclmsgFileCycle}{theid} -\begin{chunk}{defun inclmsgFileCycle} -(defun |inclmsgFileCycle| (ufos fn) - (let (cycle f1 flist) - (setq flist - ((lambda (Var8 Var7 n) - (loop - (cond - ((or (atom Var7) (progn (setq n (car Var7)) nil)) - (return (nreverse Var8))) - (t - (setq Var8 (cons (|porigin| n) Var8)))) - (setq Var7 (cdr Var7)))) - nil (reverse ufos) nil)) - (setq f1 (|porigin| fn)) - (setq cycle - (append - ((lambda (Var10 Var9 n) - (loop - (cond - ((or (atom Var9) (progn (setq n (car Var9)) nil)) - (return (nreverse Var10))) - (t - (setq Var10 (append (reverse (list n "==>")) Var10)))) - (setq Var9 (cdr Var9)))) - nil flist nil) - (cons f1 nil))) - (list 'S2CI0004 (list (|theid| cycle) (|theid| f1))))) - -\end{chunk} - -\defun{xlConActive}{xlConActive} -\calls{xlConActive}{xlMsg} -\calls{xlConActive}{inclmsgConActive} -\begin{chunk}{defun xlConActive} -(defun |xlConActive| (eb str lno ufos n) - (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgConActive| n) '|warning|))) - -\end{chunk} - -\defun{inclmsgConActive}{inclmsgConActive} -\calls{inclmsgConActive}{theid} -\begin{chunk}{defun inclmsgConActive} -(defun |inclmsgConActive| (n) - (list 'S2CI0006 (list (|theid| n)))) - -\end{chunk} - -\defun{xlConStill}{xlConStill} -\calls{xlConStill}{xlMsg} -\calls{xlConStill}{inclmsgConStill} -\begin{chunk}{defun xlConStill} -(defun |xlConStill| (eb str lno ufos n) - (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgConStill| n) '|say|))) - -\end{chunk} - -\defun{inclmsgConStill}{inclmsgConStill} -\calls{inclmsgConStill}{theid} -\begin{chunk}{defun inclmsgConStill} -(defun |inclmsgConStill| (n) - (list 'S2CI0007 (list (|theid| n)))) - -\end{chunk} - -\defun{xlConsole}{xlConsole} -\calls{xlConsole}{xlMsg} -\calls{xlConsole}{inclmsgConsole} -\begin{chunk}{defun xlConsole} -(defun |xlConsole| (eb str lno ufos) - (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgConsole|) '|say|))) - -\end{chunk} - -\defun{inclmsgConsole}{inclmsgConsole} -\begin{chunk}{defun inclmsgConsole 0} -(defun |inclmsgConsole| () - (list 'S2CI0005 nil)) - -\end{chunk} - -\defun{xlSkippingFin}{xlSkippingFin} -\calls{xlSkippingFin}{xlMsg} -\calls{xlSkippingFin}{inclmsgFinSkipped} -\begin{chunk}{defun xlSkippingFin} -(defun |xlSkippingFin| (eb str lno ufos) - (|xlMsg| eb str lno (elt ufos 0) - (list (|inclmsgFinSkipped|) '|warning|))) - -\end{chunk} - -\defun{inclmsgFinSkipped}{inclmsgFinSkipped} -\begin{chunk}{defun inclmsgFinSkipped 0} -(defun |inclmsgFinSkipped| () - (list 'S2CI0008 nil)) - -\end{chunk} - -\defun{xlPrematureFin}{xlPrematureFin} -\calls{xlPrematureFin}{xlMsg} -\calls{xlPrematureFin}{inclmsgPrematureFin} -\begin{chunk}{defun xlPrematureFin} -(defun |xlPrematureFin| (eb str lno ufos) - (|xlMsg| eb str lno (elt ufos 0) - (list (|inclmsgPrematureFin| (elt ufos 0)) '|error|))) - -\end{chunk} - -\defun{inclmsgPrematureFin}{inclmsgPrematureFin} -\calls{inclmsgPrematureFin}{theorigin} -\begin{chunk}{defun inclmsgPrematureFin} -(defun |inclmsgPrematureFin| (ufo) - (list 'S2CI0003 (list (|theorigin| ufo)))) - -\end{chunk} - -\defun{assertCond}{assertCond} -\calls{assertCond}{MakeSymbol} -\calls{assertCond}{incCommandTail} -\usesdollar{assertCond}{inclAssertions} -\uses{assertCond}{*whitespace*} -\begin{chunk}{defun assertCond} -(defun |assertCond| (s info) - (let (word) - (declare (special |$inclAssertions| *whitespace*)) - (setq word - (|MakeSymbol| (string-trim *whitespace* (|incCommandTail| s info)))) - (unless (member word |$inclAssertions|) - (setq |$inclAssertions| (cons word |$inclAssertions|))))) - -\end{chunk} - -\defun{xlIfSyntax}{xlIfSyntax} -\calls{xlIfSyntax}{Top?} -\calls{xlIfSyntax}{Else?} -\calls{xlIfSyntax}{xlMsg} -\calls{xlIfSyntax}{inclmsgIfSyntax} -\begin{chunk}{defun xlIfSyntax} -(defun |xlIfSyntax| (eb str lno ufos info sts) - (let (context found st) - (setq st (elt sts 0)) - (setq found (elt info 2)) - (setq context - (cond - ((|Top?| st) '|not in an )if...)endif|) - ((|Else?| st) '|after an )else|) - (t '|but can't figure out where|))) - (|xlMsg| eb str lno (elt ufos 0) - (list (|inclmsgIfSyntax| (elt ufos 0) found context) '|error|)))) - -\end{chunk} - -\defun{inclmsgIfSyntax}{inclmsgIfSyntax} -\calls{inclmsgIfSyntax}{concat} -\calls{inclmsgIfSyntax}{theid} -\calls{inclmsgIfSyntax}{theorigin} -\begin{chunk}{defun inclmsgIfSyntax} -(defun |inclmsgIfSyntax| (ufo found context) - (setq found (concat ")" found)) - (list 'S2CI0009 (list (|theid| found) - (|theid| context) - (|theorigin| ufo)))) - -\end{chunk} - -\defun{xlIfBug}{xlIfBug} -\calls{xlIfBug}{xlMsg} -\calls{xlIfBug}{inclmsgIfBug} -\begin{chunk}{defun xlIfBug} -(defun |xlIfBug| (eb str lno ufos) - (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgIfBug|) '|bug|))) - -\end{chunk} - -\defun{inclmsgIfBug}{inclmsgIfBug} -\begin{chunk}{defun inclmsgIfBug 0} -(defun |inclmsgIfBug| () - (list 'S2CB0002 nil)) - -\end{chunk} - -\defun{xlCmdBug}{xlCmdBug} -\calls{xlCmdBug}{xlMsg} -\calls{xlCmdBug}{inclmsgCmdBug} -\begin{chunk}{defun xlCmdBug} -(defun |xlCmdBug| (eb str lno ufos) - (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgCmdBug|) '|bug|))) - -\end{chunk} - -\defun{inclmsgCmdBug}{inclmsgCmdBug} -\begin{chunk}{defun inclmsgCmdBug 0} -(defun |inclmsgCmdBug| () - (list 'S2CB0003 nil)) - -\end{chunk} - -\defvar{incCommands} -This is a list of commands that can be in an include file -\begin{chunk}{postvars} -(eval-when (eval load) -(setq |incCommands| - (list "say" "include" "console" "fin" "assert" "if" "elseif" "else" "endif"))) - -\end{chunk} - -\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} -a ==> 3 -a ==> 4 -b ==> 7 -( - (|b| |mbody| ((|integer| (|posn| (0 "b ==> 7" 1 1 "strings") . 6)) . "7")) - (|a| |mbody| ((|integer| (|posn| (0 "a ==> 4" 1 1 "strings") . 6)) . "4")) - (|a| |mbody| ((|integer| (|posn| (0 "a ==> 3" 1 1 "strings") . 6)) . "3")) -) -\end{verbatim} -\begin{chunk}{initvars} -(defvar |$pfMacros| nil) - -\end{chunk} - - -\defun{incClassify}{incClassify} -\begin{verbatim} -;incClassify(s) == -; not incCommand? s => [false,0, '""] -; i := 1; n := #s -; while i < n and s.i = char " " repeat i := i + 1 -; i >= n => [true,0,'"other"] -; eb := (i = 1 => 0; i) -; bad:=true -; for p in incCommands while bad repeat -; incPrefix?(p, i, s) => -; bad:=false -; p1 :=p -; if bad then [true,0,'"other"] else [true,eb,p1] -\end{verbatim} -\calls{incClassify}{incCommand?} -\uses{incClassify}{incCommands} -\label{incClassify} -\begin{chunk}{defun incClassify} -(defun |incClassify| (s) - (let (p1 bad eb n i) - (declare (special |incCommands|)) - (if (null (|incCommand?| s)) - (list nil 0 "") - (progn - (setq i 1) - (setq n (length s)) - ((lambda () - (loop - (cond - ((not (and (< i n) (char= (elt s i) #\space))) - (return nil)) - (t (setq i (1+ i))))))) - (cond - ((not (< i n)) (list t 0 "other")) - (t - (if (= i 1) - (setq eb 0) - (setq eb i)) - (setq bad t) - ((lambda (tmp1 p) - (loop - (cond - ((or (atom tmp1) - (progn (setq p (car tmp1)) nil) - (not bad)) - (return nil)) - (t - (cond - ((|incPrefix?| p i s) - (identity - (progn - (setq bad nil) - (setq p1 p))))))) - (setq tmp1 (cdr tmp1)))) - |incCommands| nil) - (if bad - (list t 0 "other") - (list t eb p1)))))))) - -\end{chunk} - -\defun{incCommand?}{incCommand?} -\sig{incCommand?}{String}{Boolean} -\begin{chunk}{defun incCommand? 0} -(defun |incCommand?| (s) - "does this start with a close paren?" - (and (< 0 (length s)) (equal (elt s 0) #\) ))) - -\end{chunk} - -\defun{incPrefix?}{incPrefix?} -\begin{verbatim} -;incPrefix?(prefix, start, whole) == -; #prefix > #whole-start => false -; good:=true -; for i in 0..#prefix-1 for j in start.. while good repeat -; good:= prefix.i = whole.j -; good -\end{verbatim} -\begin{chunk}{defun incPrefix? 0} -(defun |incPrefix?| (prefix start whole) - (let (good) - (cond - ((< (- (length whole) start) (length prefix)) nil) - (t - (setq good t) - ((lambda (Var i j) - (loop - (cond - ((or (> i Var) (not good)) (return nil)) - (t (setq good (equal (elt prefix i) (elt whole j))))) - (setq i (+ i 1)) - (setq j (+ j 1)))) - (- (length prefix) 1) 0 start) - good)))) - -\end{chunk} - -\defun{incCommandTail}{incCommandTail} -\calls{incCommandTail}{incDrop} -\begin{chunk}{defun incCommandTail} -(defun |incCommandTail| (s info) - (let ((start (elt info 1))) - (when (= start 0) (setq start 1)) - (|incDrop| (+ start (length (elt info 2)) 1) s))) - -\end{chunk} - -\defun{incDrop}{incDrop} -\calls{incDrop}{substring} -\begin{chunk}{defun incDrop 0} -(defun |incDrop| (n b) - (if (>= n (length b)) - '|| - (substring b n nil))) - -\end{chunk} - -\defun{inclFname}{inclFname} -\calls{inclFname}{incFileName} -\calls{inclFname}{incCommandTail} -\begin{chunk}{defun inclFname} -(defun |inclFname| (s info) - (|incFileName| (|incCommandTail| s info))) - -\end{chunk} - -\defun{incFileInput}{incFileInput} -\calls{incFileInput}{incRgen} -\calls{incFileInput}{make-instream} -\begin{chunk}{defun incFileInput} -(defun |incFileInput| (fn) - (|incRgen| (make-instream fn))) - -\end{chunk} - -\defun{incConsoleInput}{incConsoleInput} -\calls{incConsoleInput}{incRgen} -\calls{incConsoleInput}{make-instream} -\begin{chunk}{defun incConsoleInput} -(defun |incConsoleInput| () - (|incRgen| (make-instream 0))) - -\end{chunk} - -\defun{incNConsoles}{incNConsoles} -\calls{incNConsoles}{incNConsoles} -\begin{chunk}{defun incNConsoles} -(defun |incNConsoles| (ufos) - (let ((a (member "console" ufos))) - (if a - (+ 1 (|incNConsoles| (cdr a))) - 0))) - -\end{chunk} - -\defun{incActive?}{incActive?} -\begin{chunk}{defun incActive? 0} -(defun |incActive?| (fn ufos) - (member fn ufos)) - -\end{chunk} - -\defun{incRgen}{incRgen} -Note that incRgen1 recursively calls this function. - -\calls{incRgen}{Delay} -\calls{incRgen}{incRgen1} -\begin{chunk}{defun incRgen} -(defun |incRgen| (s) - (|Delay| #'|incRgen1| (list s))) - -\end{chunk} - -\defun{Delay}{Delay} -{\bf Delay} prepends a label {\bf nonnullstream}, returning a list -of the label, the given function name in {\bf function} -and {\bf arguments}. That is, given -\begin{verbatim} - (|Delay| |incLude1| (0 ("1") 0 ("strings") (1))) -\end{verbatim} -construct -\begin{verbatim} - (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) -\end{verbatim} -Note that {\bf nonnullstream} is NOT a function so the inputs -have been changed from a function call to a simple list. -\label{Delay} -\sig{Delay}{(Function,List(Any))}{Delay} -\begin{chunk}{defun Delay 0} -(defun |Delay| (function arguments) - (cons '|nonnullstream| (cons function arguments))) - -\end{chunk} - -\defvar{StreamNil} -\begin{chunk}{initvars} -(defvar |StreamNil| (list '|nullstream|)) - -\end{chunk} - -\begin{chunk}{postvars} -(eval-when (eval load) - (setq |StreamNil| (list '|nullstream|))) - -\end{chunk} - -\defun{incRgen1}{incRgen1} -This function reads a line from the stream and then conses it up -with a recursive call to incRgen. -Note that incRgen recursively wraps this function in a delay list. - -\calls{incRgen1}{incRgen} -\uses{incRgen1}{StreamNil} -\begin{chunk}{defun incRgen1} -(defun |incRgen1| (&rest z) - (let (a s) - (declare (special |StreamNil|)) - (setq s (car z)) - (setq a (read-line s nil nil)) - (if (null a) - (progn - (close s) - |StreamNil|) - (cons a (|incRgen| s))))) - -\end{chunk} - -\chapter{The Token Scanner} - -\defvar{scanKeyWords} -\begin{chunk}{postvars} -(eval-when (eval load) -(defvar |scanKeyWords| - (list - (list "add" 'add) - (list "and" 'and) - (list "break" 'break) - (list "by" 'by) - (list "case" 'case) - (list "default" 'default) - (list "define" 'defn) - (list "do" 'do) - (list "else" 'else) - (list "exit" 'exit) - (list "export" 'export) - (list "for" 'for) - (list "free" 'free) - (list "from" 'from) - (list "has" 'has) - (list "if" 'if) - (list "import" 'import) - (list "in" 'in) - (list "inline" 'inline) - (list "is" 'is) - (list "isnt" 'isnt) - (list "iterate" 'iterate) - (list "local" '|local|) - (list "macro" 'macro) - (list "mod" 'mod) - (list "or" 'or) - (list "pretend" 'pretend) - (list "quo" 'quo) - (list "rem" 'rem) - (list "repeat" 'repeat) - (list "return" 'return) - (list "rule" 'rule) - (list "then" 'then) - (list "where" 'where) - (list "while" 'while) - (list "with" 'with) - (list "|" 'bar) - (list "." 'dot) - (list "::" 'coerce) - (list ":" 'colon) - (list ":-" 'colondash) - (list "@" 'at) - (list "@@" 'atat) - (list "," 'comma) - (list ";" 'semicolon) - (list "**" 'power) - (list "*" 'times) - (list "+" 'plus) - (list "-" 'minus) - (list "<" 'lt) - (list ">" 'gt) - (list "<=" 'le) - (list ">=" 'ge) - (list "=" 'equal) - (list "~=" 'notequal) - (list "~" '~) - (list "^" 'carat) - (list ".." 'seg) - (list "#" '|#|) - (list "&" 'ampersand) - (list "$" '$) - (list "/" 'slash) - (list "\\" 'backslash) - (list "//" 'slashslash) - (list "\\\\" 'backslashbackslash) - (list "/\\" 'slashbackslash) - (list "\\/" 'backslashslash) - (list "=>" 'exit) - (list ":=" 'becomes) - (list "==" 'def) - (list "==>" 'mdef) - (list "->" 'arrow) - (list "<-" 'larrow) - (list "+->" 'gives) - (list "(" '|(|) - (list ")" '|)|) - (list "(|" '|(\||) - (list "|)" '|\|)|) - (list "[" '[) - (list "]" ']) - (list "[_]" '[]) - (list "{" '{) - (list "}" '}) - (list "{_}" '{}) - (list "[|" '|[\||) - (list "|]" '|\|]|) - (list "[|_|]" '|[\|\|]|) - (list "{|" '|{\||) - (list "|}" '|\|}|) - (list "{|_|}" '|{\|\|}|) - (list "<<" 'oangle) - (list ">>" 'cangle) - (list "'" '|'|) - (list "`" 'backquote)))) - -\end{chunk} - -\defvar{infgeneric} -\begin{chunk}{postvars} -(eval-when (eval load) -(prog () - (return - ((lambda (var value) - (loop - (cond - ((or (atom var) (progn (setq value (car var)) nil)) - (return nil)) - (t - (setf (get (car value) 'infgeneric) (cadr value)))) - (setq var (cdr var)))) - (list - (list 'equal '=) - (list 'times '*) - (list 'has '|has|) - (list 'case '|case|) - (list 'rem '|rem|) - (list 'mod '|mod|) - (list 'quo '|quo|) - (list 'slash '/) - (list 'backslash '|\\|) - (list 'slashslash '//) - (list 'backslashbackslash '|\\\\|) - (list 'slashbackslash '|/\\|) - (list 'backslashslash '|\\/|) - (list 'power '**) - (list 'carat '^) - (list 'plus '+) - (list 'minus '-) - (list 'lt '<) - (list 'gt '>) - (list 'oangle '<<) - (list 'cangle '>>) - (list 'le '<=) - (list 'ge '>=) - (list 'notequal '~=) - (list 'by '|by|) - (list 'arrow '->) - (list 'larrow '<-) - (list 'bar '|\||) - (list 'seg '|..|)) - nil)))) - -\end{chunk} - -\defun{lineoftoks}{lineoftoks} -lineoftoks bites off a token-dq from a line-stream -returning the token-dq and the rest of the line-stream -\begin{verbatim} -;lineoftoks(s)== -; $f: local:=nil -; $r:local :=nil -; $ln:local :=nil -; $linepos:local:=nil -; $n:local:=nil -; $sz:local := nil -; $floatok:local:=true -; if not nextline s -; then CONS(nil,nil) -; else -; if null scanIgnoreLine($ln,$n) -- line of spaces or starts ) or > -; then cons(nil,$r) -; else -; toks:=[] -; a:= incPrefix?('"command",1,$ln) -; a => -; $ln:=SUBSTRING($ln,8,nil) -; b:= dqUnit constoken($ln,$linepos,["command",$ln],0) -; cons([ [b,s] ],$r) -; -; while $n<$sz repeat toks:=dqAppend(toks,scanToken()) -; if null toks -; then cons([],$r) -; else cons([ [toks,s] ],$r) -\end{verbatim} -\calls{lineoftoks}{nextline} -\calls{lineoftoks}{scanIgnoreLine} -\calls{lineoftoks}{incPrefix?} -\calls{lineoftoks}{substring} -\calls{lineoftoks}{dqUnit} -\calls{lineoftoks}{constoken} -\usesdollar{lineoftoks}{floatok} -\usesdollar{lineoftoks}{f} -\usesdollar{lineoftoks}{sz} -\usesdollar{lineoftoks}{linepos} -\usesdollar{lineoftoks}{r} -\usesdollar{lineoftoks}{n} -\usesdollar{lineoftoks}{ln} -\label{lineoftoks} -\begin{chunk}{defun lineoftoks} -(defun |lineoftoks| (s) - (let (|$floatok| |$sz| |$n| |$linepos| |$ln| |$r| |$f| |b| |a| |toks|) - (declare (special |$floatok| |$f| |$sz| |$linepos| |$r| |$n| |$ln|)) - (setq |$f| nil) - (setq |$r| nil) - (setq |$ln| nil) - (setq |$linepos| nil) - (setq |$n| nil) - (setq |$sz| nil) - (setq |$floatok| t) - (cond - ((null (|nextline| s)) (cons nil nil)) - ((null (|scanIgnoreLine| |$ln| |$n|)) (cons nil |$r|)) - (t - (setq |toks| nil) - (setq |a| (|incPrefix?| "command" 1 |$ln|)) - (cond - (|a| - (setq |$ln| (substring |$ln| 8 nil)) - (setq |b| - (|dqUnit| (|constoken| |$ln| |$linepos| (list '|command| |$ln|) 0))) - (cons (list (list |b| s)) |$r|)) - (t - ((lambda () - (loop - (cond - ((not (< |$n| |$sz|)) (return nil)) - (t (setq |toks| (|dqAppend| |toks| (|scanToken|)))))))) - (cond - ((null |toks|) (cons nil |$r|)) - (t (cons (list (list |toks| s)) |$r|))))))))) - -\end{chunk} - -\defun{nextline}{nextline} -\calls{nextline}{npNull} -\calls{nextline}{strposl} -\usesdollar{nextline}{sz} -\usesdollar{nextline}{n} -\usesdollar{nextline}{linepos} -\usesdollar{nextline}{ln} -\usesdollar{nextline}{r} -\usesdollar{nextline}{f} -\begin{chunk}{defun nextline} -(defun |nextline| (s) - (declare (special |$sz| |$n| |$linepos| |$ln| |$r| |$f|)) - (cond - ((|npNull| s) nil) - (t - (setq |$f| (car s)) - (setq |$r| (cdr s)) - (setq |$ln| (cdr |$f|)) - (setq |$linepos| (caar |$f|)) - (setq |$n| (strposl " " |$ln| 0 t)) ; spaces at beginning - (setq |$sz| (length |$ln|)) - t))) - -\end{chunk} - -\defun{scanIgnoreLine}{scanIgnoreLine} -\calls{scanIgnoreLine}{incPrefix?} -\begin{chunk}{defun scanIgnoreLine} -(defun |scanIgnoreLine| (ln n) - (cond - ((null n) n) - (t - (cond - ((= (char-code (char ln 0)) (char-code #\))) - (cond - ((|incPrefix?| "command" 1 ln) t) - (t nil))) - (t n))))) - -\end{chunk} - -\defun{constoken}{constoken} -\calls{constoken}{ncPutQ} -\begin{chunk}{defun constoken} -(defun |constoken| (ln lp b n) - (declare (ignore ln)) - (let (a) - (setq a (cons (elt b 0) (elt b 1))) - (|ncPutQ| a '|posn| (cons lp n)) - a)) - -\end{chunk} - -\defun{scanToken}{scanToken} -\calls{scanToken}{startsComment?} -\calls{scanToken}{scanComment} -\calls{scanToken}{startsNegComment?} -\calls{scanToken}{scanNegComment} -\calls{scanToken}{lfid} -\calls{scanToken}{punctuation?} -\calls{scanToken}{scanPunct} -\calls{scanToken}{startsId?} -\calls{scanToken}{scanWord} -\calls{scanToken}{scanSpace} -\calls{scanToken}{scanString} -\calls{scanToken}{scanNumber} -\calls{scanToken}{scanEscape} -\calls{scanToken}{scanError} -\calls{scanToken}{dqUnit} -\calls{scanToken}{constoken} -\calls{scanToken}{lnExtraBlanks} -\usesdollar{scanToken}{linepos} -\usesdollar{scanToken}{n} -\usesdollar{scanToken}{ln} -\begin{chunk}{defun scanToken} -(defun |scanToken| () - (let (b ch n linepos c ln) - (declare (special |$linepos| |$n| |$ln|)) - (setq ln |$ln|) - (setq c (char-code (char |$ln| |$n|))) - (setq linepos |$linepos|) - (setq n |$n|) - (setq ch (elt |$ln| |$n|)) - (setq b - (cond - ((|startsComment?|) (|scanComment|) nil) - ((|startsNegComment?|) (|scanNegComment|) nil) - ((= c (char-code #\?)) - (setq |$n| (+ |$n| 1)) - (|lfid| "?")) - ((|punctuation?| c) (|scanPunct|)) - ((|startsId?| ch) (|scanWord| nil)) - ((= c (char-code #\space)) (|scanSpace|) nil) - ((= c (char-code #\")) (|scanString|)) - ((digitp ch) (|scanNumber|)) - ((= c (char-code #\_)) (|scanEscape|)) - (t (|scanError|)))) - (cond - ((null b) nil) - (t - (|dqUnit| - (|constoken| ln linepos b (+ n (|lnExtraBlanks| linepos)))))))) - -\end{chunk} - -\defun{lfid}{lfid} -To pair badge and badgee -\begin{chunk}{defun lfid 0} -(defun |lfid| (x) - (list '|id| (intern x "BOOT"))) - -\end{chunk} - -\defun{startsComment?}{Is it a ++ comment?} -\usesdollar{startsComment?}{ln} -\usesdollar{startsComment?}{sz} -\usesdollar{startsComment?}{n} -\begin{chunk}{defun startsComment? 0} -(defun |startsComment?| () - (let (www) - (declare (special |$ln| |$sz| |$n|)) - (cond - ((< |$n| |$sz|) - (cond - ((= (char-code (char |$ln| |$n|)) (char-code #\+)) - (setq www (+ |$n| 1)) - (cond - ((not (< www |$sz|)) nil) - (t (= (char-code (char |$ln| www)) (char-code #\+))))) - (t nil))) - (t nil)))) - -\end{chunk} - -\defun{scanComment}{scanComment} -\calls{scanComment}{lfcomment} -\calls{scanComment}{substring} -\usesdollar{scanComment}{ln} -\usesdollar{scanComment}{sz} -\usesdollar{scanComment}{n} -\begin{chunk}{defun scanComment} -(defun |scanComment| () - (let (n) - (declare (special |$ln| |$sz| |$n|)) - (setq n |$n|) - (setq |$n| |$sz|) - (|lfcomment| (substring |$ln| n nil)))) - -\end{chunk} - -\defun{lfcomment}{lfcomment} -\begin{chunk}{defun lfcomment 0} -(defun |lfcomment| (x) - (list '|comment| x)) - -\end{chunk} - -\defun{startsNegComment?}{Is it a -- comment?} -\usesdollar{startsNegComment?}{ln} -\usesdollar{startsNegComment?}{sz} -\usesdollar{startsNegComment?}{n} -\begin{chunk}{defun startsNegComment?} -(defun |startsNegComment?| () - (let (www) - (declare (special |$ln| |$sz| |$n|)) - (cond - ((< |$n| |$sz|) - (cond - ((= (char-code (char |$ln| |$n|)) (char-code #\-)) - (setq www (+ |$n| 1)) - (cond - ((not (< www |$sz|)) nil) - (t (= (char-code (char |$ln| www)) (char-code #\-))))) - (t nil))) - (t nil)))) - -\end{chunk} - -\defun{scanNegComment}{scanNegComment} -\calls{scanNegComment}{lfnegcomment} -\calls{scanNegComment}{substring} -\usesdollar{scanNegComment}{ln} -\usesdollar{scanNegComment}{sz} -\usesdollar{scanNegComment}{n} -\begin{chunk}{defun scanNegComment} -(defun |scanNegComment| () - (let (n) - (declare (special |$ln| |$sz| |$n|)) - (setq n |$n|) - (setq |$n| |$sz|) - (|lfnegcomment| (substring |$ln| n nil)))) - -\end{chunk} - -\defun{lfnegcomment}{lfnegcomment} -\begin{chunk}{defun lfnegcomment 0} -(defun |lfnegcomment| (x) - (list '|negcomment| x)) - -\end{chunk} - -\defun{punctuation?}{punctuation?} -\begin{chunk}{defun punctuation?} -(defun |punctuation?| (c) - (eql (elt |scanPun| c) 1)) - -\end{chunk} - -\defun{scanPunct}{scanPunct} -\calls{scanPunct}{subMatch} -\calls{scanPunct}{scanError} -\calls{scanPunct}{scanKeyTr} -\usesdollar{scanPunct}{n} -\usesdollar{scanPunct}{ln} -\begin{chunk}{defun scanPunct} -(defun |scanPunct| () - (let (a sss) - (declare (special |$n| |$ln|)) - (setq sss (|subMatch| |$ln| |$n|)) - (setq a (length sss)) - (cond - ((eql a 0) (|scanError|)) - (t (setq |$n| (+ |$n| a)) (|scanKeyTr| sss))))) - -\end{chunk} - -\defun{subMatch}{subMatch} -\calls{subMatch}{substringMatch} -\begin{chunk}{defun subMatch} -(defun |subMatch| (a b) - (|substringMatch| a |scanDict| b)) - -\end{chunk} - -\defun{substringMatch}{substringMatch} -\begin{verbatim} -;substringMatch (l,d,i)== -; h:= QENUM(l, i) -; u:=ELT(d,h) -; ll:=SIZE l -; done:=false -; s1:='"" -; for j in 0.. SIZE u - 1 while not done repeat -; s:=ELT(u,j) -; ls:=SIZE s -; done:=if ls+i > ll -; then false -; else -; eql:= true -; for k in 1..ls-1 while eql repeat -; eql:= EQL(QENUM(s,k),QENUM(l,k+i)) -; if eql -; then -; s1:=s -; true -; else false -; s1 -\end{verbatim} -\calls{substringMatch}{size} -\begin{chunk}{defun substringMatch} -(defun |substringMatch| (l dict i) - (let (equl ls s s1 done ll u h) - (setq h (char-code (char l i))) - (setq u (elt dict h)) - (setq ll (size l)) - (setq s1 "") - ((lambda (Var4 j) - (loop - (cond - ((or (> j Var4) done) (return nil)) - (t - (setq s (elt u j)) - (setq ls (size s)) - (setq done - (cond - ((< ll (+ ls i)) nil) - (t - (setq equl t) - ((lambda (Var5 k) - (loop - (cond - ((or (> k Var5) (not equl)) (return nil)) - (t - (setq equl (= (char-code (char s k)) - (char-code (char l (+ k i))))))) - (setq k (+ k 1)))) - (- ls 1) 1) - (cond (equl (setq s1 s) t) (t nil))))))) - (setq j (+ j 1)))) - (- (size u) 1) 0) - s1)) - -\end{chunk} - -\defun{scanKeyTr}{scanKeyTr} -\calls{scanKeyTr}{keyword} -\calls{scanKeyTr}{scanPossFloat} -\calls{scanKeyTr}{lfkey} -\calls{scanKeyTr}{scanCloser?} -\usesdollar{scanKeyTr}{floatok} -\begin{chunk}{defun scanKeyTr} -(defun |scanKeyTr| (w) - (declare (special |$floatok|)) - (cond - ((eq (|keyword| w) 'dot) - (cond - (|$floatok| (|scanPossFloat| w)) - (t (|lfkey| w)))) - (t (setq |$floatok| (null (|scanCloser?| w))) (|lfkey| w)))) - -\end{chunk} - -\defun{keyword}{keyword} -\calls{keyword}{hget} -\begin{chunk}{defun keyword 0} -(defun |keyword| (st) - (hget |scanKeyTable| st)) - -\end{chunk} - -\defun{keyword?}{keyword?} -\calls{keyword?}{hget} -\begin{chunk}{defun keyword? 0} -(defun |keyword?| (st) - (null (null (hget |scanKeyTable| st)))) - -\end{chunk} - -\defun{scanPossFloat}{scanPossFloat} -\calls{scanPossFloat}{lfkey} -\calls{scanPossFloat}{spleI} -\calls{scanPossFloat}{scanExponent} -\usesdollar{scanPossFloat}{ln} -\usesdollar{scanPossFloat}{sz} -\usesdollar{scanPossFloat}{n} -\begin{chunk}{defun scanPossFloat} -(defun |scanPossFloat| (w) - (declare (special |$ln| |$sz| |$n|)) - (cond - ((or (not (< |$n| |$sz|)) (null (digitp (elt |$ln| |$n|)))) - (|lfkey| w)) - (t - (setq w (|spleI| #'digitp)) (|scanExponent| "0" w)))) - -\end{chunk} - -\defun{digit?}{digit?} -\calls{digit?}{digitp} -\begin{chunk}{defun digit?} -(defun |digit?| (x) - (digitp x)) - -\end{chunk} - -\defun{lfkey}{lfkey} -\calls{lfkey}{keyword} -\begin{chunk}{defun lfkey} -(defun |lfkey| (x) - (list '|key| (|keyword| x))) - -\end{chunk} - -\defun{spleI}{spleI} -\calls{spleI}{spleI1} -\begin{chunk}{defun spleI} -(defun |spleI| (dig) - (|spleI1| dig nil)) - -\end{chunk} - -\defun{spleI1}{spleI1} -\calls{spleI1}{substring} -\calls{spleI1}{scanEsc} -\calls{spleI1}{spleI1} -\calls{spleI1}{concat} -\usesdollar{spleI1}{ln} -\usesdollar{spleI1}{sz} -\usesdollar{spleI1}{n} -\begin{chunk}{defun spleI1} -(defun |spleI1| (dig zro) - (let (bb a str l n) - (declare (special |$ln| |$sz| |$n|)) - (setq n |$n|) - (setq l |$sz|) - ; while $n=$sz -; then if nextline($r) -; then -; while null $n repeat nextline($r) -; scanEsc() -; false -; else false -; else -; n1:=STRPOSL('" ",$ln,$n,true) -; if null n1 -; then if nextline($r) -; then -; while null $n repeat nextline($r) -; scanEsc() -; false -; else false -; else -; if $n=n1 -; then true -; else if QENUM($ln,n1)=ESCAPE -; then -; $n:=n1+1 -; scanEsc() -; false -; else -; $n:=n1 -; startsNegComment?() or startsComment?() => -; nextline($r) -; scanEsc() -; false -; false -\end{verbatim} -\calls{scanEsc}{nextline} -\calls{scanEsc}{scanEsc} -\calls{scanEsc}{strposl} -\calls{scanEsc}{startsNegComment?} -\calls{scanEsc}{startsComment?} -\usesdollar{scanEsc}{ln} -\usesdollar{scanEsc}{r} -\usesdollar{scanEsc}{sz} -\usesdollar{scanEsc}{n} -\begin{chunk}{defun scanEsc} -(defun |scanEsc| () - (let (n1) - (declare (special |$ln| |$r| |$sz| |$n|)) - (cond - ((not (< |$n| |$sz|)) - (cond - ((|nextline| |$r|) - ((lambda () - (loop - (cond - (|$n| (return nil)) - (t (|nextline| |$r|)))))) - (|scanEsc|) - nil) - (t nil))) - (t - (setq n1 (strposl " " |$ln| |$n| t)) - (cond - ((null n1) - (cond - ((|nextline| |$r|) - ((lambda () - (loop - (cond - (|$n| (return nil)) - (t (|nextline| |$r|)))))) - (|scanEsc|) - nil) - (t nil))) - ((equal |$n| n1) t) - ((= (char-code (char |$ln| n1)) (char-code #\_)) - (setq |$n| (+ n1 1)) - (|scanEsc|) - nil) - (t (setq |$n| n1) - (cond - ((or (|startsNegComment?|) (|startsComment?|)) - (progn - (|nextline| |$r|) - (|scanEsc|) - nil)) - (t nil)))))))) - -\end{chunk} - -\defvar{scanCloser} -\begin{chunk}{postvars} -(eval-when (eval load) - (defvar |scanCloser| (list '|)| '} '] '|\|)| '|\|}| '|\|]|))) - -\end{chunk} - -\defun{scanCloser?}{scanCloser?} -\calls{scanCloser?}{keyword} -\uses{scanCloser?}{scanCloser} -\begin{chunk}{defun scanCloser? 0} -(defun |scanCloser?| (w) - (declare (special |scanCloser|)) - (member (|keyword| w) |scanCloser|)) - -\end{chunk} - -\defun{scanWord}{scanWord} -\calls{scanWord}{scanW} -\calls{scanWord}{lfid} -\calls{scanWord}{keyword?} -\calls{scanWord}{lfkey} -\usesdollar{scanWord}{floatok} -\begin{chunk}{defun scanWord} -(defun |scanWord| (esp) - (let (w aaa) - (declare (special |$floatok|)) - (setq aaa (|scanW| nil)) - (setq w (elt aaa 1)) - (setq |$floatok| nil) - (cond - ((or esp (elt aaa 0)) - (|lfid| w)) - ((|keyword?| w) - (setq |$floatok| t) - (|lfkey| w)) - (t - (|lfid| w))))) - -\end{chunk} - -\defun{scanExponent}{scanExponent} -\calls{scanExponent}{lffloat} -\calls{scanExponent}{digit?} -\calls{scanExponent}{spleI} -\calls{scanExponent}{concat} -\usesdollar{scanExponent}{ln} -\usesdollar{scanExponent}{sz} -\usesdollar{scanExponent}{n} -\begin{chunk}{defun scanExponent} -(defun |scanExponent| (a w) - (let (c1 e c n) - (declare (special |$ln| |$sz| |$n|)) - (cond - ((not (< |$n| |$sz|)) (|lffloat| a w "0")) - (t - (setq n |$n|) - (setq c (char-code (char |$ln| |$n|))) - (cond - ((or (= c (char-code #\E)) (= c (char-code #\e))) - (setq |$n| (+ |$n| 1)) - (cond - ((not (< |$n| |$sz|)) - (setq |$n| n) - (|lffloat| a w "0")) - ((digitp (elt |$ln| |$n|)) - (setq e (|spleI| #'digitp)) - (|lffloat| a w e)) - (t - (setq c1 (char-code (char |$ln| |$n|))) - (cond - ((or (= c1 (char-code #\+)) (= c1 (char-code #\-))) - (setq |$n| (+ |$n| 1)) - (cond - ((not (< |$n| |$sz|)) - (setq |$n| n) - (|lffloat| a w "0")) - ((digitp (elt |$ln| |$n|)) - (setq e (|spleI| #'digitp)) - (|lffloat| a w - (cond - ((= c1 (char-code #\-)) - (concat "-" e)) - (t e)))) - (t - (setq |$n| n) - (|lffloat| a w "0")))))))) - (t (|lffloat| a w "0"))))))) - -\end{chunk} - -\defun{lffloat}{lffloat} -\calls{lffloat}{concat} -\begin{chunk}{defun lffloat 0} -(defun |lffloat| (a w e) - (list '|float| (concat a "." w "e" e))) - -\end{chunk} - -\defmacro{idChar?} -\begin{chunk}{defmacro idChar? 0} -(defmacro |idChar?| (x) - `(or (alphanumericp ,x) (member ,x '(#\? #\% #\' #\!) :test #'char=))) - -\end{chunk} - -\defun{scanW}{scanW} -\calls{scanW}{posend} -\calls{scanW}{substring} -\calls{scanW}{scanEsc} -\calls{scanW}{scanW} -\calls{scanW}{idChar?} -\calls{scanW}{concat} -\usesdollar{scanW}{ln} -\usesdollar{scanW}{sz} -\usesdollar{scanW}{n} -\begin{chunk}{defun scanW} -(defun |scanW| (b) - (let (bb a str endid l n1) - (declare (special |$ln| |$sz| |$n|)) - (setq n1 |$n|) - (setq |$n| (+ |$n| 1)) - (setq l |$sz|) - (setq endid (|posend| |$ln| |$n|)) - (cond - ((or (equal endid l) - (not (= (char-code (char |$ln| endid)) (char-code #\_)))) - (setq |$n| endid) - (list b (substring |$ln| n1 (- endid n1)))) - (t - (setq str (substring |$ln| n1 (- endid n1))) - (setq |$n| (+ endid 1)) - (setq a (|scanEsc|)) - (setq bb - (cond - (a (|scanW| t)) - ((not (< |$n| |$sz|)) (list b "")) - ((|idChar?| (elt |$ln| |$n|)) (|scanW| b)) - (t (list b "")))) - (list (or (elt bb 0) b) (concat str (elt bb 1))))))) - -\end{chunk} - -\defun{posend}{posend} -\begin{verbatim} -;posend(line,n)== -; while n<#line and idChar? line.n repeat n:=n+1 -; n -\end{verbatim} -NOTE: do not replace ``lyne'' with ``line'' -\begin{chunk}{defun posend} -(defun |posend| (lyne n) - ((lambda () - (loop - (cond - ((not (and (< n (length lyne)) (|idChar?| (elt lyne n)))) - (return nil)) - (t (setq n (+ n 1))))))) - n) - -\end{chunk} - -\defun{scanSpace}{scanSpace} -\calls{scanSpace}{strposl} -\calls{scanSpace}{lfspaces} -\usesdollar{scanSpace}{floatok} -\usesdollar{scanSpace}{ln} -\usesdollar{scanSpace}{n} -\begin{chunk}{defun scanSpace} -(defun |scanSpace| () - (let (n) - (declare (special |$floatok| |$ln| |$n|)) - (setq n |$n|) - (setq |$n| (strposl " " |$ln| |$n| t)) - (when (null |$n|) (setq |$n| (length |$ln|))) - (setq |$floatok| t) - (|lfspaces| (- |$n| n)))) - -\end{chunk} - -\defun{lfspaces}{lfspaces} -\begin{chunk}{defun lfspaces 0} -(defun |lfspaces| (x) - (list '|spaces| x)) - -\end{chunk} - -\defun{scanString}{scanString} -\calls{scanString}{lfstring} -\calls{scanString}{scanS} -\usesdollar{scanString}{floatok} -\usesdollar{scanString}{n} -\begin{chunk}{defun scanString} -(defun |scanString| () - (declare (special |$floatok| |$n|)) - (setq |$n| (+ |$n| 1)) - (setq |$floatok| nil) - (|lfstring| (|scanS|))) - -\end{chunk} - -\defun{lfstring}{lfstring} -\begin{chunk}{defun lfstring 0} -(defun |lfstring| (x) - (if (eql (length x) 1) - (list '|char| x) - (list '|string| x))) - -\end{chunk} - -\defun{scanS}{scanS} -\calls{scanS}{ncSoftError} -\calls{scanS}{lnExtraBlanks} -\calls{scanS}{strpos} -\calls{scanS}{substring} -\calls{scanS}{scanEsc} -\calls{scanS}{concat} -\calls{scanS}{scanTransform} -\calls{scanS}{scanS} -\usesdollar{scanS}{ln} -\usesdollar{scanS}{linepos} -\usesdollar{scanS}{sz} -\usesdollar{scanS}{n} -\begin{chunk}{defun scanS} -(defun |scanS| () - (let (b a str mn escsym strsym n) - (declare (special |$ln| |$linepos| |$sz| |$n|)) - (cond - ((not (< |$n| |$sz|)) - (|ncSoftError| - (cons |$linepos| (+ (|lnExtraBlanks| |$linepos|) |$n|)) 'S2CN0001 nil) "") - (t - (setq n |$n|) - (setq strsym (or (strpos "\"" |$ln| |$n| nil) |$sz|)) - (setq escsym (or (strpos "_" |$ln| |$n| nil) |$sz|)) - (setq mn (min strsym escsym)) - (cond - ((equal mn |$sz|) - (setq |$n| |$sz|) - (|ncSoftError| - (cons |$linepos| (+ (|lnExtraBlanks| |$linepos|) |$n|)) 'S2CN0001 nil) - (substring |$ln| n nil)) - ((equal mn strsym) - (setq |$n| (+ mn 1)) - (substring |$ln| n (- mn n))) - (t - (setq str (substring |$ln| n (- mn n))) - (setq |$n| (+ mn 1)) - (setq a (|scanEsc|)) - (setq b - (cond - (a - (setq str (concat str (|scanTransform| (elt |$ln| |$n|)))) - (setq |$n| (+ |$n| 1)) (|scanS|)) - (t (|scanS|)))) - (concat str b))))))) - -\end{chunk} - -\defun{scanTransform}{scanTransform} -\begin{chunk}{defun scanTransform} -(defun |scanTransform| (x) x) - -\end{chunk} - -\defun{scanNumber}{scanNumber} -\calls{scanNumber}{spleI} -\calls{scanNumber}{lfinteger} -\calls{scanNumber}{spleI1} -\calls{scanNumber}{scanExponent} -\calls{scanNumber}{scanCheckRadix} -\calls{scanNumber}{lfrinteger} -\calls{scanNumber}{concat} -\usesdollar{scanNumber}{floatok} -\usesdollar{scanNumber}{ln} -\usesdollar{scanNumber}{sz} -\usesdollar{scanNumber}{n} -\begin{chunk}{defun scanNumber} -(defun |scanNumber| () - (let (v w n a) - (declare (special |$floatok| |$ln| |$sz| |$n|)) - (setq a (|spleI| #'digitp)) - (cond - ((not (< |$n| |$sz|)) - (|lfinteger| a)) - ((not (= (char-code (char |$ln| |$n|)) (char-code #\r))) - (cond - ((and |$floatok| (= (char-code (char |$ln| |$n|)) (char-code #\.))) - (setq n |$n|) - (setq |$n| (+ |$n| 1)) - (cond - ((and (< |$n| |$sz|) (= (char-code (char |$ln| |$n|)) (char-code #\.))) - (setq |$n| n) - (|lfinteger| a)) - (t - (setq w (|spleI1| #'digitp t)) - (|scanExponent| a w)))) - (t (|lfinteger| a)))) - (t - (setq |$n| (+ |$n| 1)) - (setq w (|spleI1| #'|rdigit?| t)) - (|scanCheckRadix| (parse-integer a) w) - (cond - ((not (< |$n| |$sz|)) - (|lfrinteger| a w)) - ((= (char-code (char |$ln| |$n|)) (char-code #\.)) - (setq n |$n|) - (setq |$n| (+ |$n| 1)) - (cond - ((and (< |$n| |$sz|) (= (char-code (char |$ln| |$n|)) (char-code #\.))) - (setq |$n| n) - (|lfrinteger| a w)) - (t - (setq v (|spleI1| #'|rdigit?| t)) - (|scanCheckRadix| (parse-integer a) v) - (|scanExponent| (concat a "r" w) v)))) - (t (|lfrinteger| a w))))))) - -\end{chunk} - -\defun{rdigit?}{rdigit?} -\calls{rdigit?}{strpos} -\begin{chunk}{defun rdigit? 0} -(defun |rdigit?| (x) - (strpos x "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" 0 nil)) - -\end{chunk} - -\defun{lfinteger}{lfinteger} -\begin{chunk}{defun lfinteger 0} -(defun |lfinteger| (x) - (list '|integer| x)) - -\end{chunk} - -\defun{lfrinteger}{lfrinteger} -\calls{lfrinteger}{concat} -\begin{chunk}{defun lfrinteger 0} -(defun |lfrinteger| (r x) - (list '|integer| (concat r (concat "r" x)))) - -\end{chunk} - -\defun{scanCheckRadix}{scanCheckRadix} -\begin{verbatim} -;scanCheckRadix(r,w)== -; ns:=#w -; done:=false -; for i in 0..ns-1 repeat -; a:=rdigit? w.i -; if null a or a>=r -; then ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n-ns+i), -; "S2CN0002", [w.i]) -\end{verbatim} -\usesdollar{scanCheckRadix}{n} -\usesdollar{scanCheckRadix}{linepos} -\begin{chunk}{defun scanCheckRadix} -(defun |scanCheckRadix| (r w) - (let (a ns) - (declare (special |$n| |$linepos|)) - (setq ns (length w)) - ((lambda (Var1 i) - (loop - (cond - ((> i Var1) (return nil)) - (t - (setq a (|rdigit?| (elt w i))) - (cond - ((or (null a) (not (< a r))) - (|ncSoftError| - (cons |$linepos| (+ (- (+ (|lnExtraBlanks| |$linepos|) |$n|) ns) i)) - 'S2CN0002 (list (elt w i))))))) - (setq i (+ i 1)))) - (- ns 1) 0))) - -\end{chunk} - -\defun{scanEscape}{scanEscape} -\calls{scanEscape}{scanEsc} -\calls{scanEscape}{scanWord} -\usesdollar{scanEscape}{n} -\begin{chunk}{defun scanEscape} -(defun |scanEscape| () - (declare (special |$n|)) - (setq |$n| (+ |$n| 1)) - (when (|scanEsc|) (|scanWord| t))) - -\end{chunk} - -\defun{scanError}{scanError} -\calls{scanError}{ncSoftError} -\calls{scanError}{lnExtraBlanks} -\calls{scanError}{lferror} -\usesdollar{scanError}{ln} -\usesdollar{scanError}{linepos} -\usesdollar{scanError}{n} -\begin{chunk}{defun scanError} -(defun |scanError| () - (let (n) - (declare (special |$ln| |$linepos| |$n|)) - (setq n |$n|) - (setq |$n| (+ |$n| 1)) - (|ncSoftError| - (cons |$linepos| (+ (|lnExtraBlanks| |$linepos|) |$n|)) - 'S2CN0003 (list (elt |$ln| n))) - (|lferror| (elt |$ln| n)))) - -\end{chunk} - -\defun{lferror}{lferror} -\begin{chunk}{defun lferror 0} -(defun |lferror| (x) - (list '|error| x)) - -\end{chunk} - -\defvar{scanKeyTable} -\begin{chunk}{postvars} -(eval-when (eval load) - (defvar |scanKeyTable| (|scanKeyTableCons|))) - -\end{chunk} - -\defun{scanKeyTableCons}{scanKeyTableCons} -This function is used to build the scanKeyTable -\begin{verbatim} -;scanKeyTableCons()== -; KeyTable:=MAKE_-HASHTABLE("CVEC",true) -; for st in scanKeyWords repeat -; HPUT(KeyTable,CAR st,CADR st) -; KeyTable -\end{verbatim} -\begin{chunk}{defun scanKeyTableCons} -(defun |scanKeyTableCons| () - (let (KeyTable) - (setq KeyTable (make-hash-table :test #'equal)) - ((lambda (Var6 st) - (loop - (cond - ((or (atom Var6) (progn (setq st (car Var6)) nil)) - (return nil)) - (t - (hput KeyTable (car st) (cadr st)))) - (setq Var6 (cdr Var6)))) - |scanKeyWords| nil) - KeyTable)) - -\end{chunk} - -\defvar{scanDict} -\begin{chunk}{postvars} -(eval-when (eval load) - (defvar |scanDict| (|scanDictCons|))) - -\end{chunk} - -\defun{scanDictCons}{scanDictCons} -\begin{verbatim} -;scanDictCons()== -; l:= HKEYS scanKeyTable -; d := -; a:=MAKE_-VEC(256) -; b:=MAKE_-VEC(1) -; VEC_-SETELT(b,0,MAKE_-CVEC 0) -; for i in 0..255 repeat VEC_-SETELT(a,i,b) -; a -; for s in l repeat scanInsert(s,d) -; d -\end{verbatim} -\calls{scanDictCons}{hkeys} -\begin{chunk}{defun scanDictCons} -(defun |scanDictCons| () - (let (d b a l) - (setq l (hkeys |scanKeyTable|)) - (setq d - (progn - (setq a (make-array 256)) - (setq b (make-array 1)) - (setf (svref b 0) - (make-array 0 :fill-pointer 0 :element-type 'string-char)) - ((lambda (i) - (loop - (cond - ((> i 255) (return nil)) - (t (setf (svref a i) b))) - (setq i (+ i 1)))) - 0) - a)) - ((lambda (Var7 s) - (loop - (cond - ((or (atom Var7) (progn (setq s (car Var7)) nil)) - (return nil)) - (t (|scanInsert| s d))) - (setq Var7 (cdr Var7)))) - l nil) - d)) - -\end{chunk} - -\defun{scanInsert}{scanInsert} -\begin{verbatim} -;scanInsert(s,d) == -; l := #s -; h := QENUM(s,0) -; u := ELT(d,h) -; n := #u -; k:=0 -; while l <= #(ELT(u,k)) repeat -; k:=k+1 -; v := MAKE_-VEC(n+1) -; for i in 0..k-1 repeat VEC_-SETELT(v,i,ELT(u,i)) -; VEC_-SETELT(v,k,s) -; for i in k..n-1 repeat VEC_-SETELT(v,i+1,ELT(u,i)) -; VEC_-SETELT(d,h,v) -; s -\end{verbatim} -\begin{chunk}{defun scanInsert} -(defun |scanInsert| (s d) - (let (v k n u h l) - (setq l (length s)) - (setq h (char-code (char s 0))) - (setq u (elt d h)) - (setq n (length u)) - (setq k 0) - ((lambda () - (loop - (cond - ((< (length (elt u k)) l) (return nil)) - (t (setq k (+ k 1))))))) - (setq v (make-array (+ n 1))) - ((lambda (Var2 i) - (loop - (cond - ((> i Var2) (return nil)) - (t (setf (svref v i) (elt u i)))) - (setq i (+ i 1)))) - (- k 1) 0) - (setf (svref v k) s) - ((lambda (Var3 i) - (loop - (cond - ((> i Var3) (return nil)) - (t (setf (svref v (+ i 1)) (elt u i)))) - (setq i (+ i 1)))) - (- n 1) k) - (setf (svref d h) v) - s)) - -\end{chunk} - -\defvar{scanPun} -\begin{chunk}{postvars} -(eval-when (eval load) - (defvar |scanPun| (|scanPunCons|))) - -\end{chunk} - -\defun{scanPunCons}{scanPunCons} -\begin{verbatim} -;scanPunCons()== -; listing := HKEYS scanKeyTable -; a:=MAKE_-BVEC 256 -; for i in 0..255 repeat BVEC_-SETELT(a,i,0) -; for k in listing repeat -; if not startsId? k.0 -; then BVEC_-SETELT(a,QENUM(k,0),1) -; a -\end{verbatim} -\calls{scanPunCons}{hkeys} -\begin{chunk}{defun scanPunCons} -(defun |scanPunCons| () - (let (a listing) - (setq listing (hkeys |scanKeyTable|)) - (setq a (make-array (list 256) :element-type 'bit :initial-element 0)) - ((lambda (i) - (loop - (cond - ((> i 255) (return nil)) - (t (setf (sbit a i) 0))) - (setq i (+ i 1)))) - 0) - ((lambda (Var8 k) - (loop - (cond - ((or (atom Var8) (progn (setq k (car Var8)) nil)) - (return nil)) - (t - (cond - ((null (|startsId?| (elt k 0))) - (setf (sbit a (char-code (char k 0))) 1))))) - (setq Var8 (cdr Var8)))) - listing nil) - a)) - -\end{chunk} - -\chapter{Input Stream Parser} - -\defun{npParse}{Input Stream Parser} -\catches{npParse}{trappoint} -\calls{npParse}{npFirstTok} -\calls{npParse}{npItem} -\calls{npParse}{ncSoftError} -\calls{npParse}{tokPosn} -\calls{npParse}{pfWrong} -\calls{npParse}{pfDocument} -\calls{npParse}{pfListOf} -\usesdollar{npParse}{ttok} -\usesdollar{npParse}{stok} -\usesdollar{npParse}{stack} -\usesdollar{npParse}{inputStream} -\begin{chunk}{defun npParse} -(defun |npParse| (stream) - (let (|$ttok| |$stok| |$stack| |$inputStream| found) - (declare (special |$ttok| |$stack| |$inputStream| |$stok|)) - (setq |$inputStream| stream) - (setq |$stack| nil) - (setq |$stok| nil) - (setq |$ttok| nil) - (|npFirstTok|) - (setq found (catch 'trappoint (|npItem|))) - (cond - ((eq found 'trapped) - (|ncSoftError| (|tokPosn| |$stok|) 's2cy0006 nil) - (|pfWrong| (|pfDocument| "top level syntax error") (|pfListOf| nil))) - ((null (null |$inputStream|)) - (|ncSoftError| (|tokPosn| |$stok|) 's2cy0002 nil) - (|pfWrong| - (|pfDocument| (list "input stream not exhausted")) - (|pfListOf| nil))) - ((null |$stack|) - (|ncSoftError| (|tokPosn| |$stok|) 's2cy0009 nil) - (|pfWrong| (|pfDocument| (list "stack empty")) (|pfListOf| nil))) - (t (car |$stack|))))) - -\end{chunk} - -\defun{npItem}{npItem} -\calls{npItem}{npQualDef} -\calls{npItem}{npEqKey} -\calls{npItem}{npItem1} -\calls{npItem}{npPop1} -\calls{npItem}{pfEnSequence} -\calls{npItem}{npPush} -\calls{npItem}{pfNovalue} -\begin{chunk}{defun npItem} -(defun |npItem| () - (let (c b a tmp1) - (when (|npQualDef|) - (if (|npEqKey| 'semicolon) - (progn - (setq tmp1 (|npItem1| (|npPop1|))) - (setq a (car tmp1)) - (setq b (cadr tmp1)) - (setq c (|pfEnSequence| b)) - (if a - (|npPush| c) - (|npPush| (|pfNovalue| c)))) - (|npPush| (|pfEnSequence| (|npPop1|))))))) - -\end{chunk} - -\defun{npItem1}{npItem1} -\calls{npItem1}{npQualDef} -\calls{npItem1}{npEqKey} -\calls{npItem1}{npItem1} -\calls{npItem1}{npPop1} -\begin{chunk}{defun npItem1} -(defun |npItem1| (c) - (let (b a tmp1) - (if (|npQualDef|) - (if (|npEqKey| 'semicolon) - (progn - (setq tmp1 (|npItem1| (|npPop1|))) - (setq a (car tmp1)) - (setq b (cadr tmp1)) - (list a (append c b))) - (list t (append c (|npPop1|)))) - (list nil c)))) - -\end{chunk} - -\defun{npFirstTok}{npFirstTok} -Sets the current leaf (\$stok) to the next leaf in the input stream. -Sets the current token (\$ttok) cdr of the leaf. -A leaf token looks like [head, token, position] -where head is either an id or (id . alist) - -\calls{npFirstTok}{tokConstruct} -\calls{npFirstTok}{tokPosn} -\calls{npFirstTok}{tokPart} -\usesdollar{npFirstTok}{ttok} -\usesdollar{npFirstTok}{stok} -\usesdollar{npFirstTok}{inputStream} -\begin{chunk}{defun npFirstTok} -(defun |npFirstTok| () - (declare (special |$ttok| |$stok| |$inputStream|)) - (if (null |$inputStream|) - (setq |$stok| (|tokConstruct| 'error 'nomore (|tokPosn| |$stok|))) - (setq |$stok| (car |$inputStream|))) - (setq |$ttok| (|tokPart| |$stok|))) - -\end{chunk} - -\defun{npPush}{Push one item onto \$stack} -\usesdollar{npPush}{stack} -\begin{chunk}{defun npPush 0} -(defun |npPush| (x) - (declare (special |$stack|)) - (push x |$stack|)) - -\end{chunk} - -\defun{npPop1}{Pop one item off \$stack} -\usesdollar{npPop1}{stack} -\begin{chunk}{defun npPop1 0} -(defun |npPop1| () - (declare (special |$stack|)) - (pop |$stack|)) - -\end{chunk} - -\defun{npPop2}{Pop the second item off \$stack} -\usesdollar{npPop2}{stack} -\begin{chunk}{defun npPop2 0} -(defun |npPop2| () - (let (a) - (declare (special |$stack|)) - (setq a (cadr |$stack|)) - (rplacd |$stack| (cddr |$stack|)) - a)) - -\end{chunk} - -\defun{npPop3}{Pop the third item off \$stack} -\usesdollar{npPop3}{stack} -\begin{chunk}{defun npPop3 0} -(defun |npPop3| () - (let (a) - (declare (special |$stack|)) - (setq a (caddr |$stack|)) - (rplacd (cdr |$stack|) (cdddr |$stack|)) a)) - -\end{chunk} - -\defun{npQualDef}{npQualDef} -\calls{npQualDef}{npComma} -\calls{npQualDef}{npPush} -\calls{npQualDef}{npPop1} -\begin{chunk}{defun npQualDef} -(defun |npQualDef| () - (and (|npComma|) (|npPush| (list (|npPop1|))))) - -\end{chunk} - -\defun{npEqKey}{Advance over a keyword} -Test for the keyword, if found advance the token stream - -\calls{npEqKey}{npNext} -\usesdollar{npEqKey}{ttok} -\usesdollar{npEqKey}{stok} -\begin{chunk}{defun npEqKey} -(defun |npEqKey| (keyword) - (declare (special |$ttok| |$stok|)) - (and - (eq (caar |$stok|) '|key|) - (eq keyword |$ttok|) - (|npNext|))) - -\end{chunk} - -\defun{npNext}{Advance the input stream} -This advances the input stream. The call to npFirstTok picks off the -next token in the input stream and updates the current leaf (\$stok) -and the current token (\$ttok) - -\calls{npNext}{npFirstTok} -\usesdollar{npNext}{inputStream} -\begin{chunk}{defun npNext} -(defun |npNext| () - (declare (special |$inputStream|)) - (setq |$inputStream| (cdr |$inputStream|)) - (|npFirstTok|)) - -\end{chunk} - -\defun{npComma}{npComma} -\calls{npComma}{npTuple} -\calls{npComma}{npQualifiedDefinition} -\begin{chunk}{defun npComma} -(defun |npComma| () - (|npTuple| #'|npQualifiedDefinition|)) - -\end{chunk} - -\defun{npTuple}{npTuple} -\calls{npTuple}{npListofFun} -\calls{npTuple}{npCommaBackSet} -\calls{npTuple}{pfTupleListOf} -\begin{chunk}{defun npTuple} -(defun |npTuple| (|p|) - (|npListofFun| |p| #'|npCommaBackSet| #'|pfTupleListOf|)) - -\end{chunk} - -\defun{npCommaBackSet}{npCommaBackSet} -\calls{npCommaBackSet}{npEqKey} -\begin{chunk}{defun npCommaBackSet} -(defun |npCommaBackSet| () - (and - (|npEqKey| 'comma) - (or (|npEqKey| 'backset) t))) - -\end{chunk} - -\defun{npQualifiedDefinition}{npQualifiedDefinition} -\calls{npQualifiedDefinition}{npQualified} -\calls{npQualifiedDefinition}{npDefinitionOrStatement} -\begin{chunk}{defun npQualifiedDefinition} -(defun |npQualifiedDefinition| () - (|npQualified| #'|npDefinitionOrStatement|)) - -\end{chunk} - -\defun{npQualified}{npQualified} -\calls{npQualified}{npEqKey} -\calls{npQualified}{npDefinition} -\calls{npQualified}{npTrap} -\calls{npQualified}{npPush} -\calls{npQualified}{pfWhere} -\calls{npQualified}{npPop1} -\calls{npQualified}{npLetQualified} -\begin{chunk}{defun npQualified} -(defun |npQualified| (f) - (if (funcall f) - (progn - (do () ; while ... do - ((not (and (|npEqKey| 'where) (or (|npDefinition|) (|npTrap|))))) - (|npPush| (|pfWhere| (|npPop1|) (|npPop1|)))) - t) - (|npLetQualified| f))) - -\end{chunk} - -\defun{npDefinitionOrStatement}{npDefinitionOrStatement} -\calls{npDefinitionOrStatement}{npBackTrack} -\calls{npDefinitionOrStatement}{npGives} -\calls{npDefinitionOrStatement}{npDef} -\begin{chunk}{defun npDefinitionOrStatement} -(defun |npDefinitionOrStatement| () - (|npBackTrack| #'|npGives| 'def #'|npDef|)) - -\end{chunk} - -\defun{npBackTrack}{npBackTrack} -\calls{npBackTrack}{npState} -\calls{npBackTrack}{npEqPeek} -\calls{npBackTrack}{npRestore} -\calls{npBackTrack}{npTrap} -\begin{chunk}{defun npBackTrack} -(defun |npBackTrack| (p1 p2 p3) - (let (a) - (setq a (|npState|)) - (when (apply p1 nil) - (cond - ((|npEqPeek| p2) - (|npRestore| a) - (or (apply p3 nil) (|npTrap|))) - (t t))))) - -\end{chunk} - -\defun{npGives}{npGives} -\calls{npGives}{npBackTrack} -\calls{npGives}{npExit} -\calls{npGives}{npLambda} -\begin{chunk}{defun npGives} -(defun |npGives| () - (|npBackTrack| #'|npExit| 'gives #'|npLambda|)) - -\end{chunk} - -\defun{npLambda}{npLambda} -\calls{npLambda}{npVariable} -\calls{npLambda}{npLambda} -\calls{npLambda}{npTrap} -\calls{npLambda}{npPush} -\calls{npLambda}{pfLam} -\calls{npLambda}{npPop2} -\calls{npLambda}{npPop1} -\calls{npLambda}{npEqKey} -\calls{npLambda}{npDefinitionOrStatement} -\calls{npLambda}{npType} -\calls{npLambda}{pfReturnTyped} -\begin{chunk}{defun npLambda} -(defun |npLambda| () - (or - (and - (|npVariable|) - (or (|npLambda|) (|npTrap|)) - (|npPush| (|pfLam| (|npPop2|) (|npPop1|)))) - (and - (|npEqKey| 'gives) - (or (|npDefinitionOrStatement|) (|npTrap|))) - (and - (|npEqKey| 'colon) - (or (|npType|) (|npTrap|)) - (|npEqKey| 'gives) - (or (|npDefinitionOrStatement|) (|npTrap|)) - (|npPush| (|pfReturnTyped| (|npPop2|) (|npPop1|)))))) - -\end{chunk} - -\defun{npType}{npType} -\calls{npType}{npMatch} -\calls{npType}{npPop1} -\calls{npType}{npWith} -\calls{npType}{npPush} -\begin{chunk}{defun npType} -(defun |npType| () - (and - (|npMatch|) - (let ((a (|npPop1|))) - (or - (|npWith| a) - (|npPush| a))))) - -\end{chunk} - -\defun{npMatch}{npMatch} -\calls{npMatch}{npLeftAssoc} -\calls{npMatch}{npSuch} -\begin{chunk}{defun npMatch} -(defun |npMatch| () - (|npLeftAssoc| '(is isnt) #'|npSuch|)) - -\end{chunk} - -\defun{npSuch}{npSuch} -\calls{npSuch}{npLeftAssoc} -\calls{npSuch}{npLogical} -\begin{chunk}{defun npSuch} -(defun |npSuch| () - (|npLeftAssoc| '(bar) #'|npLogical|)) - -\end{chunk} - -\defun{npWith}{npWith} -\calls{npWith}{npEqKey} -\calls{npWith}{npState} -\calls{npWith}{npCategoryL} -\calls{npWith}{npTrap} -\calls{npWith}{npEqPeek} -\calls{npWith}{npRestore} -\calls{npWith}{npVariable} -\calls{npWith}{npCompMissing} -\calls{npWith}{npPush} -\calls{npWith}{pfWith} -\calls{npWith}{npPop2} -\calls{npWith}{npPop1} -\calls{npWith}{pfNothing} -\begin{chunk}{defun npWith} -(defun |npWith| (extra) - (let (a) - (and - (|npEqKey| 'with) - (progn - (setq a (|npState|)) - (or (|npCategoryL|) (|npTrap|)) - (if (|npEqPeek| 'in) - (progn - (|npRestore| a) - (and - (or (|npVariable|) (|npTrap|)) - (|npCompMissing| 'in) - (or (|npCategoryL|) (|npTrap|)) - (|npPush| (|pfWith| (|npPop2|) (|npPop1|) extra)))) - (|npPush| (|pfWith| (|pfNothing|) (|npPop1|) extra))))))) - -\end{chunk} - -\defun{npCompMissing}{npCompMissing} -\calls{npCompMissing}{npEqKey} -\calls{npCompMissing}{npMissing} -\begin{chunk}{defun npCompMissing} -(defun |npCompMissing| (s) - (or (|npEqKey| s) (|npMissing| s))) - -\end{chunk} - -\defun{npMissing}{npMissing} -\throws{npMissing}{trappoint} -\calls{npMissing}{ncSoftError} -\calls{npMissing}{tokPosn} -\calls{npMissing}{pname} -\usesdollar{npMissing}{stok} -\begin{chunk}{defun npMissing} -(defun |npMissing| (s) - (declare (special |$stok|)) - (|ncSoftError| (|tokPosn| |$stok|) 'S2CY0007 (list (pname s))) - (throw 'trappoint 'trapped)) - -\end{chunk} - -\defun{npRestore}{npRestore} -\calls{npRestore}{npFirstTok} -\usesdollar{npRestore}{stack} -\usesdollar{npRestore}{inputStream} -\begin{chunk}{defun npRestore} -(defun |npRestore| (x) - (declare (special |$stack| |$inputStream|)) - (setq |$inputStream| (car x)) - (|npFirstTok|) - (setq |$stack| (cdr x)) - t) - -\end{chunk} - -\defun{npEqPeek}{Peek for keyword s, no advance of token stream} -\usesdollar{npEqPeek}{ttok} -\usesdollar{npEqPeek}{stok} -\begin{chunk}{defun npEqPeek 0} -(defun |npEqPeek| (s) - (declare (special |$ttok| |$stok|)) - (and (eq (caar |$stok|) '|key|) (eq s |$ttok|))) - -\end{chunk} - -\defun{npCategoryL}{npCategoryL} -\calls{npCategoryL}{npCategory} -\calls{npCategoryL}{npPush} -\calls{npCategoryL}{pfUnSequence} -\calls{npCategoryL}{npPop1} -\begin{chunk}{defun npCategoryL} -(defun |npCategoryL| () - (and - (|npCategory|) - (|npPush| (|pfUnSequence| (|npPop1|))))) - -\end{chunk} - -\defun{npCategory}{npCategory} -\calls{npCategory}{npPP} -\calls{npCategory}{npSCategory} -\begin{chunk}{defun npCategory} -(defun |npCategory| () - (|npPP| #'|npSCategory|)) - -\end{chunk} - -\defun{npSCategory}{npSCategory} -\calls{npSCategory}{npWConditional} -\calls{npSCategory}{npCategoryL} -\calls{npSCategory}{npPush} -\calls{npSCategory}{npPop1} -\calls{npSCategory}{npDefaultValue} -\calls{npSCategory}{npState} -\calls{npSCategory}{npPrimary} -\calls{npSCategory}{npEqPeek} -\calls{npSCategory}{npRestore} -\calls{npSCategory}{npSignature} -\calls{npSCategory}{npApplication} -\calls{npSCategory}{pfAttribute} -\calls{npSCategory}{npTrap} -\begin{chunk}{defun npSCategory} -(defun |npSCategory| () - (let (a) - (cond - ((|npWConditional| #'|npCategoryL|) (|npPush| (list (|npPop1|)))) - ((|npDefaultValue|) t) - (t - (setq a (|npState|)) - (cond - ((|npPrimary|) - (cond - ((|npEqPeek| 'colon) (|npRestore| a) (|npSignature|)) - (t - (|npRestore| a) - (or - (and (|npApplication|) (|npPush| (list (|pfAttribute| (|npPop1|))))) - (|npTrap|))))) - (t nil)))))) - -\end{chunk} - -\defun{npSignature}{npSignature} -\calls{npSignature}{npSigItemlist} -\calls{npSignature}{npPush} -\calls{npSignature}{pfWDec} -\calls{npSignature}{pfNothing} -\calls{npSignature}{npPop1} -\begin{chunk}{defun npSignature} -(defun |npSignature| () - (and (|npSigItemlist|) (|npPush| (|pfWDec| (|pfNothing|) (|npPop1|))))) - -\end{chunk} - -\defun{npSigItemlist}{npSigItemlist} -\calls{npSigItemlist}{npListing} -\calls{npSigItemlist}{npSigItem} -\calls{npSigItemlist}{npPush} -\calls{npSigItemlist}{pfListOf} -\calls{npSigItemlist}{pfAppend} -\calls{npSigItemlist}{pfParts} -\calls{npSigItemlist}{npPop1} -\begin{chunk}{defun npSigItemlist} -(defun |npSigItemlist| () - (and - (|npListing| #'|npSigItem|) - (|npPush| (|pfListOf| (|pfAppend| (|pfParts| (|npPop1|))))))) - -\end{chunk} - -\defun{npListing}{npListing} -\calls{npListing}{npList} -\calls{npListing}{pfListOf} -\begin{chunk}{defun npListing} -(defun |npListing| (p) - (|npList| p 'comma #'|pfListOf|)) - -\end{chunk} - -\defun{npList}{Always produces a list, fn is applied to it} -\calls{npList}{npEqKey} -\calls{npList}{npTrap} -\calls{npList}{npPush} -\calls{npList}{npPop3} -\calls{npList}{npPop2} -\calls{npList}{npPop1} -\usesdollar{npList}{stack} -\begin{chunk}{defun npList} -(defun |npList| (f str1 fn) - (let (a) - (declare (special |$stack|)) - (cond - ((apply f nil) - (cond - ((and (|npEqKey| str1) - (or (|npEqKey| 'backset) t) - (or (apply f nil) (|npTrap|))) - (setq a |$stack|) - (setq |$stack| nil) - (do () ; while .. do nothing - ((not - (and (|npEqKey| str1) - (or (|npEqKey| 'backset) t) - (or (apply f nil) (|npTrap|)))) - nil)) - (setq |$stack| (cons (nreverse |$stack|) a)) - (|npPush| (funcall fn (cons (|npPop3|) (cons (|npPop2|) (|npPop1|)))))) - (t (|npPush| (funcall fn (list (|npPop1|))))))) - (t (|npPush| (funcall fn nil)))))) - -\end{chunk} - -\defun{npSigItem}{npSigItem} -\calls{npSigItem}{npTypeVariable} -\calls{npSigItem}{npSigDecl} -\calls{npSigItem}{npTrap} -\begin{chunk}{defun npSigItem} -(defun |npSigItem| () - (and (|npTypeVariable|) (or (|npSigDecl|) (|npTrap|)))) - -\end{chunk} - -\defun{npTypeVariable}{npTypeVariable} -\calls{npTypeVariable}{npParenthesized} -\calls{npTypeVariable}{npTypeVariablelist} -\calls{npTypeVariable}{npSignatureDefinee} -\calls{npTypeVariable}{npPush} -\calls{npTypeVariable}{pfListOf} -\calls{npTypeVariable}{npPop1} -\begin{chunk}{defun npTypeVariable} -(defun |npTypeVariable| () - (or - (|npParenthesized| #'|npTypeVariablelist|) - (and (|npSignatureDefinee|) (|npPush| (|pfListOf| (list (|npPop1|))))))) - -\end{chunk} - -\defun{npSignatureDefinee}{npSignatureDefinee} -\calls{npSignatureDefinee}{npName} -\calls{npSignatureDefinee}{npInfixOperator} -\calls{npSignatureDefinee}{npPrefixColon} -\begin{chunk}{defun npSignatureDefinee} -(defun |npSignatureDefinee| () - (or (|npName|) (|npInfixOperator|) (|npPrefixColon|))) - -\end{chunk} - -\defun{npTypeVariablelist}{npTypeVariablelist} -\calls{npTypeVariablelist}{npListing} -\calls{npTypeVariablelist}{npSignatureDefinee} -\begin{chunk}{defun npTypeVariablelist} -(defun |npTypeVariablelist| () - (|npListing| #'|npSignatureDefinee|)) - -\end{chunk} - -\defun{npSigDecl}{npSigDecl} -\calls{npSigDecl}{npEqKey} -\calls{npSigDecl}{npType} -\calls{npSigDecl}{npTrap} -\calls{npSigDecl}{npPush} -\calls{npSigDecl}{pfSpread} -\calls{npSigDecl}{pfParts} -\calls{npSigDecl}{npPop2} -\calls{npSigDecl}{npPop1} -\begin{chunk}{defun npSigDecl} -(defun |npSigDecl| () - (and - (|npEqKey| 'colon) - (or (|npType|) (|npTrap|)) - (|npPush| (|pfSpread| (|pfParts| (|npPop2|)) (|npPop1|))))) - -\end{chunk} - -\defun{npPrimary}{npPrimary} -\calls{npPrimary}{npPrimary1} -\calls{npPrimary}{npPrimary2} -\begin{chunk}{defun npPrimary} -(defun |npPrimary| () - (or (|npPrimary1|) (|npPrimary2|))) - -\end{chunk} - -\defun{npPrimary2}{npPrimary2} -\calls{npPrimary2}{npEncAp} -\calls{npPrimary2}{npAtom2} -\calls{npPrimary2}{npAdd} -\calls{npPrimary2}{pfNothing} -\calls{npPrimary2}{npWith} -\begin{chunk}{defun npPrimary2} -(defun |npPrimary2| () - (or - (|npEncAp| #'|npAtom2|) - (|npAdd| (|pfNothing|)) - (|npWith| (|pfNothing|)))) - -\end{chunk} - -\defun{npADD}{npADD} -\tpdhere{Note that there is also an npAdd function} - -\calls{npADD}{npType} -\calls{npADD}{npPop1} -\calls{npADD}{npAdd} -\calls{npADD}{npPush} -\begin{chunk}{defun npADD} -(defun |npADD| () - (let (a) - (and - (|npType|) - (progn - (setq a (|npPop1|)) - (or - (|npAdd| a) - (|npPush| a)))))) - -\end{chunk} - -\defun{npAdd}{npAdd} -\tpdhere{Note that there is also an npADD function} - -\calls{npAdd}{npEqKey} -\calls{npAdd}{npState} -\calls{npAdd}{npDefinitionOrStatement} -\calls{npAdd}{npTrap} -\calls{npAdd}{npEqPeek} -\calls{npAdd}{npRestore} -\calls{npAdd}{npVariable} -\calls{npAdd}{npCompMissing} -\calls{npAdd}{npDefinitionOrStatement} -\calls{npAdd}{npPush} -\calls{npAdd}{pfAdd} -\calls{npAdd}{npPop2} -\calls{npAdd}{npPop1} -\calls{npAdd}{pfNothing} -\begin{chunk}{defun npAdd} -(defun |npAdd| (extra) - (let (a) - (and - (|npEqKey| 'add) - (progn - (setq a (|npState|)) - (or (|npDefinitionOrStatement|) (|npTrap|)) - (cond - ((|npEqPeek| 'in) - (progn - (|npRestore| a) - (and - (or (|npVariable|) (|npTrap|)) - (|npCompMissing| 'in) - (or (|npDefinitionOrStatement|) (|npTrap|)) - (|npPush| (|pfAdd| (|npPop2|) (|npPop1|) extra))))) - (t - (|npPush| (|pfAdd| (|pfNothing|) (|npPop1|) extra)))))))) - -\end{chunk} - -\defun{npAtom2}{npAtom2} -\calls{npAtom2}{npInfixOperator} -\calls{npAtom2}{npAmpersand} -\calls{npAtom2}{npPrefixColon} -\calls{npAtom2}{npFromdom} -\begin{chunk}{defun npAtom2} -(defun |npAtom2| () - (and - (or (|npInfixOperator|) (|npAmpersand|) (|npPrefixColon|)) - (|npFromdom|))) - -\end{chunk} - -\defun{npInfixOperator}{npInfixOperator} -\calls{npInfixOperator}{npInfixOp} -\calls{npInfixOperator}{npState} -\calls{npInfixOperator}{npEqKey} -\calls{npInfixOperator}{npInfixOp} -\calls{npInfixOperator}{npPush} -\calls{npInfixOperator}{pfSymb} -\calls{npInfixOperator}{npPop1} -\calls{npInfixOperator}{tokPosn} -\calls{npInfixOperator}{npRestore} -\calls{npInfixOperator}{tokConstruct} -\calls{npInfixOperator}{tokPart} -\usesdollar{npInfixOperator}{stok} -\begin{chunk}{defun npInfixOperator} -(defun |npInfixOperator| () - (let (b a) - (declare (special |$stok|)) - (or (|npInfixOp|) - (progn - (setq a (|npState|)) - (setq b |$stok|) - (cond - ((and (|npEqKey| '|'|) (|npInfixOp|)) - (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| b)))) - (t - (|npRestore| a) - (cond - ((and (|npEqKey| 'backquote) (|npInfixOp|)) - (setq a (|npPop1|)) - (|npPush| (|tokConstruct| '|idsy| (|tokPart| a) (|tokPosn| a)))) - (t - (|npRestore| a) - nil)))))))) - -\end{chunk} - -\defun{npInfixOp}{npInfixOp} -\calls{npInfixOp}{npPushId} -\usesdollar{npInfixOp}{ttok} -\usesdollar{npInfixOp}{stok} -\begin{chunk}{defun npInfixOp} -(defun |npInfixOp| () - (declare (special |$ttok| |$stok|)) - (and - (eq (caar |$stok|) '|key|) - (get |$ttok| 'infgeneric) - (|npPushId|))) - -\end{chunk} - -\defun{npPrefixColon}{npPrefixColon} -\calls{npPrefixColon}{npEqPeek} -\calls{npPrefixColon}{npPush} -\calls{npPrefixColon}{tokConstruct} -\calls{npPrefixColon}{tokPosn} -\calls{npPrefixColon}{npNext} -\usesdollar{npPrefixColon}{stok} -\begin{chunk}{defun npPrefixColon} -(defun |npPrefixColon| () - (declare (special |$stok|)) - (and - (|npEqPeek| 'colon) - (progn - (|npPush| (|tokConstruct| '|id| '|:| (|tokPosn| |$stok|))) - (|npNext|)))) - -\end{chunk} - -\defun{npApplication}{npApplication} -\calls{npApplication}{npDotted} -\calls{npApplication}{npPrimary} -\calls{npApplication}{npApplication2} -\calls{npApplication}{npPush} -\calls{npApplication}{pfApplication} -\calls{npApplication}{npPop2} -\calls{npApplication}{npPop1} -\begin{chunk}{defun npApplication} -(defun |npApplication| () - (and - (|npDotted| #'|npPrimary|) - (or - (and - (|npApplication2|) - (|npPush| (|pfApplication| (|npPop2|) (|npPop1|)))) - t))) - -\end{chunk} - -\defun{npDotted}{npDotted} -\begin{chunk}{defun npDotted} -(defun |npDotted| (f) - (and (apply f nil) (|npAnyNo| #'|npSelector|))) - -\end{chunk} - -\defun{npAnyNo}{npAnyNo} -fn must transform the head of the stack -\begin{chunk}{defun npAnyNo 0} -(defun |npAnyNo| (fn) - (do () ((not (apply fn nil)))) ; while apply do... - t) - -\end{chunk} - -\defun{npSelector}{npSelector} -\calls{npSelector}{npEqKey} -\calls{npSelector}{npPrimary} -\calls{npSelector}{npTrap} -\calls{npSelector}{npPush} -\calls{npSelector}{pfApplication} -\calls{npSelector}{npPop2} -\calls{npSelector}{npPop1} -\begin{chunk}{defun npSelector} -(defun |npSelector| () - (and - (|npEqKey| 'dot) - (or (|npPrimary|) (|npTrap|)) - (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))))) - -\end{chunk} - -\defun{npApplication2}{npApplication2} -\calls{npApplication2}{npDotted} -\calls{npApplication2}{npPrimary1} -\calls{npApplication2}{npApplication2} -\calls{npApplication2}{npPush} -\calls{npApplication2}{pfApplication} -\calls{npApplication2}{npPop2} -\calls{npApplication2}{npPop1} -\begin{chunk}{defun npApplication2} -(defun |npApplication2| () - (and - (|npDotted| #'|npPrimary1|) - (or - (and - (|npApplication2|) - (|npPush| (|pfApplication| (|npPop2|) (|npPop1|)))) - t))) - -\end{chunk} - -\defun{npPrimary1}{npPrimary1} -\calls{npPrimary1}{npEncAp} -\calls{npPrimary1}{npAtom1} -\calls{npPrimary1}{npLet} -\calls{npPrimary1}{npFix} -\calls{npPrimary1}{npMacro} -\calls{npPrimary1}{npBPileDefinition} -\calls{npPrimary1}{npDefn} -\calls{npPrimary1}{npRule} -\begin{chunk}{defun npPrimary1} -(defun |npPrimary1| () - (or - (|npEncAp| #'|npAtom1|) - (|npLet|) - (|npFix|) - (|npMacro|) - (|npBPileDefinition|) - (|npDefn|) - (|npRule|))) - -\end{chunk} - -\defun{npMacro}{npMacro} -\calls{npMacro}{npPP} -\calls{npMacro}{npMdef} -\begin{chunk}{defun npMacro} -(defun |npMacro| () - (and - (|npEqKey| 'macro) - (|npPP| #'|npMdef|))) - -\end{chunk} - -\defun{npMdef}{npMdef} -\tpdhere{Beware that this function occurs with uppercase also} - -\calls{npMdef}{npQuiver} -\calls{npMdef}{pfCheckMacroOut} -\calls{npMdef}{npPop1} -\calls{npMdef}{npDefTail} -\calls{npMdef}{npTrap} -\calls{npMdef}{npPop1} -\calls{npMdef}{npPush} -\calls{npMdef}{pfMacro} -\calls{npMdef}{pfPushMacroBody} -\begin{chunk}{defun npMdef} -(defun |npMdef| () - (let (body arg op tmp) - (when (|npQuiver|) ;[op,arg]:= pfCheckMacroOut(npPop1()) - (setq tmp (|pfCheckMacroOut| (|npPop1|))) - (setq op (car tmp)) - (setq arg (cadr tmp)) - (or (|npDefTail|) (|npTrap|)) - (setq body (|npPop1|)) - (if (null arg) - (|npPush| (|pfMacro| op body)) - (|npPush| (|pfMacro| op (|pfPushMacroBody| arg body))))))) - -\end{chunk} - -\defun{npMDEF}{npMDEF} -\tpdhere{Beware that this function occurs with lowercase also} - -\calls{npMDEF}{npBackTrack} -\calls{npMDEF}{npStatement} -\calls{npMDEF}{npMDEFinition} -\begin{chunk}{defun npMDEF} -(defun |npMDEF| () - (|npBackTrack| #'|npStatement| 'mdef #'|npMDEFinition|)) - -\end{chunk} - -\defun{npMDEFinition}{npMDEFinition} -\calls{npMDEFinition}{npPP} -\calls{npMDEFinition}{npMdef} -\begin{chunk}{defun npMDEFinition} -(defun |npMDEFinition| () - (|npPP| #'|npMdef|)) - -\end{chunk} - -\defun{npFix}{npFix} -\calls{npFix}{npEqKey} -\calls{npFix}{npDef} -\calls{npFix}{npPush} -\calls{npFix}{pfFix} -\calls{npFix}{npPop1} -\begin{chunk}{defun npFix} -(defun |npFix| () - (and - (|npEqKey| 'fix) - (|npPP| #'|npDef|) - (|npPush| (|pfFix| (|npPop1|))))) - -\end{chunk} - -\defun{npLet}{npLet} -\calls{npLet}{npLetQualified} -\calls{npLet}{npDefinitionOrStatement} -\begin{chunk}{defun npLet} -(defun |npLet| () - (|npLetQualified| #'|npDefinitionOrStatement|)) - -\end{chunk} - -\defun{npLetQualified}{npLetQualified} -\calls{npLetQualified}{npEqKey} -\calls{npLetQualified}{npDefinition} -\calls{npLetQualified}{npTrap} -\calls{npLetQualified}{npCompMissing} -\calls{npLetQualified}{npPush} -\calls{npLetQualified}{pfWhere} -\calls{npLetQualified}{npPop2} -\calls{npLetQualified}{npPop1} -\begin{chunk}{defun npLetQualified} -(defun |npLetQualified| (f) - (and - (|npEqKey| 'let) - (or (|npDefinition|) (|npTrap|)) - (|npCompMissing| 'in) - (or (funcall f) (|npTrap|)) - (|npPush| (|pfWhere| (|npPop2|) (|npPop1|))))) - -\end{chunk} - -\defun{npDefinition}{npDefinition} -\calls{npDefinition}{npPP} -\calls{npDefinition}{npDefinitionItem} -\calls{npDefinition}{npPush} -\calls{npDefinition}{pfSequenceToList} -\calls{npDefinition}{npPop1} -\begin{chunk}{defun npDefinition} -(defun |npDefinition| () - (and - (|npPP| #'|npDefinitionItem|) - (|npPush| (|pfSequenceToList| (|npPop1|))))) - -\end{chunk} - -\defun{npDefinitionItem}{npDefinitionItem} -\calls{npDefinitionItem}{npTyping} -\calls{npDefinitionItem}{npImport} -\calls{npDefinitionItem}{npState} -\calls{npDefinitionItem}{npStatement} -\calls{npDefinitionItem}{npEqPeek} -\calls{npDefinitionItem}{npRestore} -\calls{npDefinitionItem}{npDef} -\calls{npDefinitionItem}{npMacro} -\calls{npDefinitionItem}{npDefn} -\calls{npDefinitionItem}{npTrap} -\begin{chunk}{defun npDefinitionItem} -(defun |npDefinitionItem| () - (let (a) - (or (|npTyping|) - (|npImport|) - (progn - (setq a (|npState|)) - (cond - ((|npStatement|) - (cond - ((|npEqPeek| 'def) - (|npRestore| a) - (|npDef|)) - (t - (|npRestore| a) - (or (|npMacro|) (|npDefn|))))) - (t (|npTrap|))))))) - -\end{chunk} - -\defun{npTyping}{npTyping} -\calls{npTyping}{npEqKey} -\calls{npTyping}{npDefaultItemlist} -\calls{npTyping}{npTrap} -\calls{npTyping}{npPush} -\calls{npTyping}{pfTyping} -\calls{npTyping}{npPop1} -\begin{chunk}{defun npTyping} -(defun |npTyping| () - (and - (|npEqKey| 'default) - (or (|npDefaultItemlist|) (|npTrap|)) - (|npPush| (|pfTyping| (|npPop1|))))) - -\end{chunk} - -\defun{npDefaultItemlist}{npDefaultItemlist} -\calls{npDefaultItemlist}{npPC} -\calls{npDefaultItemlist}{npSDefaultItem} -\calls{npDefaultItemlist}{npPush} -\calls{npDefaultItemlist}{pfUnSequence} -\calls{npDefaultItemlist}{npPop1} -\begin{chunk}{defun npDefaultItemlist} -(defun |npDefaultItemlist| () - (and - (|npPC| #'|npSDefaultItem|) - (|npPush| (|pfUnSequence| (|npPop1|))))) - -\end{chunk} - -\defun{npSDefaultItem}{npSDefaultItem} -\calls{npSDefaultItem}{npListing} -\calls{npSDefaultItem}{npDefaultItem} -\calls{npSDefaultItem}{npPush} -\calls{npSDefaultItem}{pfAppend} -\calls{npSDefaultItem}{pfParts} -\calls{npSDefaultItem}{npPop1} -\begin{chunk}{defun npSDefaultItem} -(defun |npSDefaultItem| () - (and - (|npListing| #'|npDefaultItem|) - (|npPush| (|pfAppend| (|pfParts| (|npPop1|)))))) - -\end{chunk} - -\defun{npDefaultItem}{npDefaultItem} -\calls{npDefaultItem}{npTypeVariable} -\calls{npDefaultItem}{npDefaultDecl} -\calls{npDefaultItem}{npTrap} -\begin{chunk}{defun npDefaultItem} -(defun |npDefaultItem| () - (and - (|npTypeVariable|) - (or (|npDefaultDecl|) (|npTrap|)))) - -\end{chunk} - -\defun{npDefaultDecl}{npDefaultDecl} -\calls{npDefaultDecl}{npEqKey} -\calls{npDefaultDecl}{npType} -\calls{npDefaultDecl}{npTrap} -\calls{npDefaultDecl}{npPush} -\calls{npDefaultDecl}{pfSpread} -\calls{npDefaultDecl}{pfParts} -\calls{npDefaultDecl}{npPop2} -\calls{npDefaultDecl}{npPop1} -\begin{chunk}{defun npDefaultDecl} -(defun |npDefaultDecl| () - (and - (|npEqKey| 'colon) - (or (|npType|) (|npTrap|)) - (|npPush| (|pfSpread| (|pfParts| (|npPop2|)) (|npPop1|))))) - -\end{chunk} - -\defun{npStatement}{npStatement} -\calls{npStatement}{npExpress} -\calls{npStatement}{npLoop} -\calls{npStatement}{npIterate} -\calls{npStatement}{npReturn} -\calls{npStatement}{npBreak} -\calls{npStatement}{npFree} -\calls{npStatement}{npImport} -\calls{npStatement}{npInline} -\calls{npStatement}{npLocal} -\calls{npStatement}{npExport} -\calls{npStatement}{npTyping} -\calls{npStatement}{npVoid} -\begin{chunk}{defun npStatement} -(defun |npStatement| () - (or - (|npExpress|) - (|npLoop|) - (|npIterate|) - (|npReturn|) - (|npBreak|) - (|npFree|) - (|npImport|) - (|npInline|) - (|npLocal|) - (|npExport|) - (|npTyping|) - (|npVoid|))) - -\end{chunk} - -\defun{npExport}{npExport} -\calls{npExport}{npEqKey} -\calls{npExport}{npLocalItemlist} -\calls{npExport}{npTrap} -\calls{npExport}{npPush} -\calls{npExport}{pfExport} -\calls{npExport}{npPop1} -\begin{chunk}{defun npExport} -(defun |npExport| () - (and - (|npEqKey| 'export) - (or (|npLocalItemlist|) (|npTrap|)) - (|npPush| (|pfExport| (|npPop1|))))) - -\end{chunk} - -\defun{npLocalItemlist}{npLocalItemlist} -\calls{npLocalItemlist}{npPC} -\calls{npLocalItemlist}{npSLocalItem} -\calls{npLocalItemlist}{npPush} -\calls{npLocalItemlist}{pfUnSequence} -\calls{npLocalItemlist}{npPop1} -\begin{chunk}{defun npLocalItemlist} -(defun |npLocalItemlist| () - (and - (|npPC| #'|npSLocalItem|) - (|npPush| (|pfUnSequence| (|npPop1|))))) - -\end{chunk} - -\defun{npSLocalItem}{npSLocalItem} -\calls{npSLocalItem}{npListing} -\calls{npSLocalItem}{npLocalItem} -\calls{npSLocalItem}{npPush} -\calls{npSLocalItem}{pfAppend} -\calls{npSLocalItem}{pfParts} -\calls{npSLocalItem}{npPop1} -\begin{chunk}{defun npSLocalItem} -(defun |npSLocalItem| () - (and - (|npListing| #'|npLocalItem|) - (|npPush| (|pfAppend| (|pfParts| (|npPop1|)))))) - -\end{chunk} - -\defun{npLocalItem}{npLocalItem} -\calls{npLocalItem}{npTypeVariable} -\calls{npLocalItem}{npLocalDecl} -\begin{chunk}{defun npLocalItem} -(defun |npLocalItem| () - (and - (|npTypeVariable|) - (|npLocalDecl|))) - -\end{chunk} - -\defun{npLocalDecl}{npLocalDecl} -\calls{npLocalDecl}{npEqKey} -\calls{npLocalDecl}{npType} -\calls{npLocalDecl}{npTrap} -\calls{npLocalDecl}{npPush} -\calls{npLocalDecl}{pfSpread} -\calls{npLocalDecl}{pfParts} -\calls{npLocalDecl}{npPop2} -\calls{npLocalDecl}{npPop1} -\calls{npLocalDecl}{pfNothing} -\begin{chunk}{defun npLocalDecl} -(defun |npLocalDecl| () - (or - (and - (|npEqKey| 'colon) - (or (|npType|) (|npTrap|)) - (|npPush| (|pfSpread| (|pfParts| (|npPop2|)) (|npPop1|)))) - (|npPush| (|pfSpread| (|pfParts| (|npPop1|)) (|pfNothing|))))) - -\end{chunk} - -\defun{npLocal}{npLocal} -\calls{npLocal}{npEqKey} -\calls{npLocal}{npLocalItemlist} -\calls{npLocal}{npTrap} -\calls{npLocal}{npPush} -\calls{npLocal}{pfLocal} -\calls{npLocal}{npPop1} -\begin{chunk}{defun npLocal} -(defun |npLocal| () - (and - (|npEqKey| '|local|) - (or (|npLocalItemlist|) (|npTrap|)) - (|npPush| (|pfLocal| (|npPop1|))))) - -\end{chunk} - -\defun{npFree}{npFree} -\calls{npFree}{npEqKey} -\calls{npFree}{npLocalItemlist} -\calls{npFree}{npTrap} -\calls{npFree}{npPush} -\calls{npFree}{pfFree} -\calls{npFree}{npPop1} -\begin{chunk}{defun npFree} -(defun |npFree| () - (and - (|npEqKey| 'free) - (or (|npLocalItemlist|) (|npTrap|)) - (|npPush| (|pfFree| (|npPop1|))))) - -\end{chunk} - -\defun{npInline}{npInline} -\calls{npInline}{npAndOr} -\calls{npInline}{npQualTypelist} -\calls{npInline}{pfInline} -\begin{chunk}{defun npInline} -(defun |npInline| () - (|npAndOr| 'inline #'|npQualTypelist| #'|pfInline|)) - -\end{chunk} - -\defun{npIterate}{npIterate} -\calls{npIterate}{npEqKey} -\calls{npIterate}{npPush} -\calls{npIterate}{pfIterate} -\calls{npIterate}{pfNothing} -\begin{chunk}{defun npIterate} -(defun |npIterate| () - (and (|npEqKey| 'iterate) (|npPush| (|pfIterate| (|pfNothing|))))) - -\end{chunk} - -\defun{npBreak}{npBreak} -\calls{npBreak}{npEqKey} -\calls{npBreak}{npPush} -\calls{npBreak}{pfBreak} -\calls{npBreak}{pfNothing} -\begin{chunk}{defun npBreak} -(defun |npBreak| () - (and (|npEqKey| 'break) (|npPush| (|pfBreak| (|pfNothing|))))) - -\end{chunk} - -\defun{npLoop}{npLoop} -\calls{npLoop}{npIterators} -\calls{npLoop}{npCompMissing} -\calls{npLoop}{npAssign} -\calls{npLoop}{npTrap} -\calls{npLoop}{npPush} -\calls{npLoop}{pfLp} -\calls{npLoop}{npPop2} -\calls{npLoop}{npPop1} -\calls{npLoop}{npEqKey} -\calls{npLoop}{pfLoop1} -\begin{chunk}{defun npLoop} -(defun |npLoop| () - (or - (and - (|npIterators|) - (|npCompMissing| 'repeat) - (or (|npAssign|) (|npTrap|)) - (|npPush| (|pfLp| (|npPop2|) (|npPop1|)))) - (and - (|npEqKey| 'repeat) - (or (|npAssign|) (|npTrap|)) - (|npPush| (|pfLoop1| (|npPop1|)))))) - -\end{chunk} - -\defun{npIterators}{npIterators} -\calls{npIterators}{npForIn} -\calls{npIterators}{npZeroOrMore} -\calls{npIterators}{npIterator} -\calls{npIterators}{npPush} -\calls{npIterators}{npPop2} -\calls{npIterators}{npPop1} -\calls{npIterators}{npWhile} -\calls{npIterators}{npIterators} -\begin{chunk}{defun npIterators} -(defun |npIterators| () - (or - (and - (|npForIn|) - (|npZeroOrMore| #'|npIterator|) - (|npPush| (cons (|npPop2|) (|npPop1|)))) - (and - (|npWhile|) - (or - (and (|npIterators|) (|npPush| (cons (|npPop2|) (|npPop1|)))) - (|npPush| (list (|npPop1|))))))) - -\end{chunk} - -\defun{npIterator}{npIterator} -\calls{npIterator}{npForIn} -\calls{npIterator}{npSuchThat} -\calls{npIterator}{npWhile} -\begin{chunk}{defun npIterator} -(defun |npIterator| () - (or - (|npForIn|) - (|npSuchThat|) - (|npWhile|))) - -\end{chunk} - -\defun{npSuchThat}{npSuchThat} -\calls{npSuchThat}{npAndOr} -\calls{npSuchThat}{npLogical} -\calls{npSuchThat}{pfSuchthat} -\begin{chunk}{defun npSuchThat} -(defun |npSuchThat| () - (|npAndOr| 'bar #'|npLogical| #'|pfSuchthat|)) - -\end{chunk} - -\defun{npZeroOrMore}{Apply argument 0 or more times} -\calls{npZeroOrMore}{npPush} -\calls{npZeroOrMore}{npPop2} -\calls{npZeroOrMore}{npPop1} -\usesdollar{npZeroOrMore}{stack} -\begin{chunk}{defun npZeroOrMore} -(defun |npZeroOrMore| (f) - (let (a) - (declare (special |$stack|)) - (cond - ((apply f nil) - (setq a |$stack|) - (setq |$stack| nil) - (do () ((not (apply f nil)))) ; while .. do - (setq |$stack| (cons (nreverse |$stack|) a)) - (|npPush| (cons (|npPop2|) (|npPop1|)))) - (t (progn (|npPush| nil) t))))) - -\end{chunk} - -\defun{npWhile}{npWhile} -\calls{npWhile}{npAndOr} -\calls{npWhile}{npLogical} -\calls{npWhile}{pfWhile} -\begin{chunk}{defun npWhile} -(defun |npWhile| () - (|npAndOr| 'while #'|npLogical| #'|pfWhile|)) - -\end{chunk} - -\defun{npForIn}{npForIn} -\calls{npForIn}{npEqKey} -\calls{npForIn}{npVariable} -\calls{npForIn}{npTrap} -\calls{npForIn}{npCompMissing} -\calls{npForIn}{npBy} -\calls{npForIn}{npPush} -\calls{npForIn}{pfForin} -\calls{npForIn}{npPop2} -\calls{npForIn}{npPop1} -\begin{chunk}{defun npForIn} -(defun |npForIn| () - (and - (|npEqKey| 'for) - (or (|npVariable|) (|npTrap|)) - (|npCompMissing| 'in) - (or (|npBy|) (|npTrap|)) - (|npPush| (|pfForin| (|npPop2|) (|npPop1|))))) - -\end{chunk} - -\defun{npReturn}{npReturn} -\calls{npReturn}{npEqKey} -\calls{npReturn}{npExpress} -\calls{npReturn}{npPush} -\calls{npReturn}{pfNothing} -\calls{npReturn}{npEqKey} -\calls{npReturn}{npName} -\calls{npReturn}{npTrap} -\calls{npReturn}{pfReturn} -\calls{npReturn}{npPop2} -\calls{npReturn}{npPop1} -\calls{npReturn}{pfReturnNoName} -\begin{chunk}{defun npReturn} -(defun |npReturn| () - (and - (|npEqKey| 'return) - (or - (|npExpress|) - (|npPush| (|pfNothing|))) - (or - (and - (|npEqKey| 'from) - (or (|npName|) (|npTrap|)) - (|npPush| (|pfReturn| (|npPop2|) (|npPop1|)))) - (|npPush| (|pfReturnNoName| (|npPop1|)))))) - -\end{chunk} - -\defun{npVoid}{npVoid} -\calls{npVoid}{npAndOr} -\calls{npVoid}{npStatement} -\calls{npVoid}{pfNovalue} -\begin{chunk}{defun npVoid} -(defun |npVoid| () - (|npAndOr| 'do #'|npStatement| #'|pfNovalue|)) - -\end{chunk} - -\defun{npExpress}{npExpress} -\calls{npExpress}{npExpress1} -\calls{npExpress}{npIterators} -\calls{npExpress}{npPush} -\calls{npExpress}{pfCollect} -\calls{npExpress}{npPop2} -\calls{npExpress}{pfListOf} -\calls{npExpress}{npPop1} -\begin{chunk}{defun npExpress} -(defun |npExpress| () - (and - (|npExpress1|) - (or - (and - (|npIterators|) - (|npPush| (|pfCollect| (|npPop2|) (|pfListOf| (|npPop1|))))) - t))) - -\end{chunk} - -\defun{npExpress1}{npExpress1} -\calls{npExpress1}{npConditionalStatement} -\calls{npExpress1}{npADD} -\begin{chunk}{defun npExpress1} -(defun |npExpress1| () - (or (|npConditionalStatement|) (|npADD|))) - -\end{chunk} - -\defun{npConditionalStatement}{npConditionalStatement} -\calls{npConditionalStatement}{npConditional} -\calls{npConditionalStatement}{npQualifiedDefinition} -\begin{chunk}{defun npConditionalStatement} -(defun |npConditionalStatement| () - (|npConditional| #'|npQualifiedDefinition|)) - -\end{chunk} - -\defun{npImport}{npImport} -\calls{npImport}{npAndOr} -\calls{npImport}{npQualTypelist} -\calls{npImport}{pfImport} -\begin{chunk}{defun npImport} -(defun |npImport| () - (|npAndOr| 'import #'|npQualTypelist| #'|pfImport|)) - -\end{chunk} - -\defun{npQualTypelist}{npQualTypelist} -\calls{npQualTypelist}{npPC} -\calls{npQualTypelist}{npSQualTypelist} -\calls{npQualTypelist}{npPush} -\calls{npQualTypelist}{pfUnSequence} -\calls{npQualTypelist}{npPop1} -\begin{chunk}{defun npQualTypelist} -(defun |npQualTypelist| () - (and - (|npPC| #'|npSQualTypelist|) - (|npPush| (|pfUnSequence| (|npPop1|))))) - -\end{chunk} - -\defun{npSQualTypelist}{npSQualTypelist} -\calls{npSQualTypelist}{npListing} -\calls{npSQualTypelist}{npQualType} -\calls{npSQualTypelist}{npPush} -\calls{npSQualTypelist}{pfParts} -\calls{npSQualTypelist}{npPop1} -\begin{chunk}{defun npSQualTypelist} -(defun |npSQualTypelist| () - (and - (|npListing| #'|npQualType|) - (|npPush| (|pfParts| (|npPop1|))))) - -\end{chunk} - -\defun{npQualType}{npQualType} -\calls{npQualType}{npType} -\calls{npQualType}{npPush} -\calls{npQualType}{pfQualType} -\calls{npQualType}{npPop1} -\calls{npQualType}{pfNothing} -\begin{chunk}{defun npQualType} -(defun |npQualType| () - (and - (|npType|) - (|npPush| (|pfQualType| (|npPop1|) (|pfNothing|))))) - -\end{chunk} - -\defun{npAndOr}{npAndOr} -\calls{npAndOr}{npEqKey} -\calls{npAndOr}{npTrap} -\calls{npAndOr}{npPush} -\calls{npAndOr}{npPop1} -\begin{chunk}{defun npAndOr} -(defun |npAndOr| (keyword p f) - (and - (|npEqKey| keyword) - (or (apply p nil) (|npTrap|)) - (|npPush| (funcall f (|npPop1|))))) - -\end{chunk} - -\defun{npEncAp}{npEncAp} -\calls{npEncAp}{npAnyNo} -\calls{npEncAp}{npEncl} -\calls{npEncAp}{npFromdom} -\begin{chunk}{defun npEncAp} -(defun |npEncAp| (f) - (and (apply f nil) (|npAnyNo| #'|npEncl|) (|npFromdom|))) - -\end{chunk} - -\defun{npEncl}{npEncl} -\calls{npEncl}{npBDefinition} -\calls{npEncl}{npPush} -\calls{npEncl}{pfApplication} -\calls{npEncl}{npPop2} -\calls{npEncl}{npPop1} -\begin{chunk}{defun npEncl} -(defun |npEncl| () - (and - (|npBDefinition|) - (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))))) - -\end{chunk} - -\defun{npAtom1}{npAtom1} -\calls{npAtom1}{npPDefinition} -\calls{npAtom1}{npName} -\calls{npAtom1}{npConstTok} -\calls{npAtom1}{npDollar} -\calls{npAtom1}{npBDefinition} -\calls{npAtom1}{npFromdom} -\begin{chunk}{defun npAtom1} -(defun |npAtom1| () - (or - (|npPDefinition|) - (and - (or (|npName|) (|npConstTok|) (|npDollar|) (|npBDefinition|)) - (|npFromdom|)))) - -\end{chunk} - -\defun{npPDefinition}{npPDefinition} -\calls{npPDefinition}{npParenthesized} -\calls{npPDefinition}{npDefinitionlist} -\calls{npPDefinition}{npPush} -\calls{npPDefinition}{pfEnSequence} -\calls{npPDefinition}{npPop1} -\begin{chunk}{defun npPDefinition} -(defun |npPDefinition| () - (and - (|npParenthesized| #'|npDefinitionlist|) - (|npPush| (|pfEnSequence| (|npPop1|))))) - -\end{chunk} - -\defun{npDollar}{npDollar} -\calls{npDollar}{npEqPeek} -\calls{npDollar}{npPush} -\calls{npDollar}{tokConstruct} -\calls{npDollar}{tokPosn} -\calls{npDollar}{npNext} -\usesdollar{npDollar}{stok} -\begin{chunk}{defun npDollar} -(defun |npDollar| () - (declare (special |$stok|)) - (and (|npEqPeek| '$) - (progn - (|npPush| (|tokConstruct| '|id| '$ (|tokPosn| |$stok|))) - (|npNext|)))) - -\end{chunk} - -\defun{npConstTok}{npConstTok} -\calls{npConstTok}{tokType} -\calls{npConstTok}{npPush} -\calls{npConstTok}{npNext} -\calls{npConstTok}{npEqPeek} -\calls{npConstTok}{npState} -\calls{npConstTok}{npPrimary1} -\calls{npConstTok}{pfSymb} -\calls{npConstTok}{npPop1} -\calls{npConstTok}{tokPosn} -\calls{npConstTok}{npRestore} -\usesdollar{npConstTok}{stok} -\begin{chunk}{defun npConstTok} -(defun |npConstTok| () - (let (b a) - (declare (special |$stok|)) - (cond - ((member (|tokType| |$stok|) '(|integer| |string| |char| |float| |command|)) - (|npPush| |$stok|) - (|npNext|)) - ((|npEqPeek| '|'|) - (setq a |$stok|) - (setq b (|npState|)) - (|npNext|) - (cond - ((and (|npPrimary1|) - (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| a)))) - t) - (t (|npRestore| b) nil))) - (t nil)))) - -\end{chunk} - -\defun{npBDefinition}{npBDefinition} -\calls{npBDefinition}{npPDefinition} -\calls{npBDefinition}{npBracketed} -\calls{npBDefinition}{npDefinitionlist} -\begin{chunk}{defun npBDefinition} -(defun |npBDefinition| () - (or - (|npPDefinition|) - (|npBracketed| #'|npDefinitionlist|))) - -\end{chunk} - -\defun{npBracketed}{npBracketed} -\calls{npBracketed}{npParened} -\calls{npBracketed}{npBracked} -\calls{npBracketed}{npBraced} -\calls{npBracketed}{npAngleBared} -\begin{chunk}{defun npBracketed} -(defun |npBracketed| (f) - (or - (|npParened| f) - (|npBracked| f) - (|npBraced| f) - (|npAngleBared| f))) - -\end{chunk} - -\defun{npParened}{npParened} -\calls{npParened}{npEnclosed} -\calls{npParened}{pfParen} -\begin{chunk}{defun npParened} -(defun |npParened| (f) - (or (|npEnclosed| '|(| '|)| #'|pfParen| f) - (|npEnclosed| '|(\|| '|\|)| #'|pfParen| f))) - -\end{chunk} - -\defun{npBracked}{npBracked} -\calls{npBracked}{npEnclosed} -\calls{npBracked}{pfBracket} -\calls{npBracked}{pfBracketBar} -\begin{chunk}{defun npBracked} -(defun |npBracked| (f) - (or (|npEnclosed| '[ '] #'|pfBracket| f) - (|npEnclosed| '|[\|| '|\|]| #'|pfBracketBar| f))) - -\end{chunk} - -\defun{npBraced}{npBraced} -\calls{npBraced}{npEnclosed} -\calls{npBraced}{pfBrace} -\calls{npBraced}{pfBraceBar} -\begin{chunk}{defun npBraced} -(defun |npBraced| (f) - (or (|npEnclosed| '{ '} #'|pfBrace| f) - (|npEnclosed| '|{\|| '|\|}| #'|pfBraceBar| f))) - -\end{chunk} - -\defun{npAngleBared}{npAngleBared} -\calls{npAngleBared}{npEnclosed} -\calls{npAngleBared}{pfHide} -\begin{chunk}{defun npAngleBared} -(defun |npAngleBared| (f) - (|npEnclosed| '|<\|| '|\|>| #'|pfHide| f)) - -\end{chunk} - -\defun{npDefn}{npDefn} -\calls{npDefn}{npEqKey} -\calls{npDefn}{npPP} -\calls{npDefn}{npDef} -\begin{chunk}{defun npDefn} -(defun |npDefn| () - (and - (|npEqKey| 'defn) - (|npPP| #'|npDef|))) - -\end{chunk} - -\defun{npDef}{npDef} -\calls{npDef}{npMatch} -\calls{npDef}{pfCheckItOut} -\calls{npDef}{npPop1} -\calls{npDef}{npDefTail} -\calls{npDef}{npTrap} -\calls{npDef}{npPop1} -\calls{npDef}{npPush} -\calls{npDef}{pfDefinition} -\calls{npDef}{pfPushBody} -\begin{chunk}{defun npDef} -(defun |npDef| () - (let (body rt arg op tmp1) - (when (|npMatch|) - ; [op,arg,rt]:= pfCheckItOut(npPop1()) - (setq tmp1 (|pfCheckItOut| (|npPop1|))) - (setq op (car tmp1)) - (setq arg (cadr tmp1)) - (setq rt (caddr tmp1)) - (or (|npDefTail|) (|npTrap|)) - (setq body (|npPop1|)) - (if (null arg) - (|npPush| (|pfDefinition| op body)) - (|npPush| (|pfDefinition| op (|pfPushBody| rt arg body))))))) - -\end{chunk} - -\defun{npBPileDefinition}{npBPileDefinition} -\calls{npBPileDefinition}{npPileBracketed} -\calls{npBPileDefinition}{npPileDefinitionlist} -\calls{npBPileDefinition}{npPush} -\calls{npBPileDefinition}{pfSequence} -\calls{npBPileDefinition}{pfListOf} -\calls{npBPileDefinition}{npPop1} -\begin{chunk}{defun npBPileDefinition} -(defun |npBPileDefinition| () - (and - (|npPileBracketed| #'|npPileDefinitionlist|) - (|npPush| (|pfSequence| (|pfListOf| (|npPop1|)))))) - -\end{chunk} - -\defun{npPileBracketed}{npPileBracketed} -\calls{npPileBracketed}{npEqKey} -\calls{npPileBracketed}{npPush} -\calls{npPileBracketed}{pfNothing} -\calls{npPileBracketed}{npMissing} -\calls{npPileBracketed}{pfPile} -\calls{npPileBracketed}{npPop1} -\begin{chunk}{defun npPileBracketed} -(defun |npPileBracketed| (f) - (cond - ((|npEqKey| 'settab) - (cond - ((|npEqKey| 'backtab) (|npPush| (|pfNothing|))) ; never happens - ((and (apply f nil) - (or (|npEqKey| 'backtab) (|npMissing| '|backtab|))) - (|npPush| (|pfPile| (|npPop1|)))) - (t nil))) - (t nil))) - -\end{chunk} - -\defun{npPileDefinitionlist}{npPileDefinitionlist} -\calls{npPileDefinitionlist}{npListAndRecover} -\calls{npPileDefinitionlist}{npDefinitionlist} -\calls{npPileDefinitionlist}{npPush} -\calls{npPileDefinitionlist}{pfAppend} -\calls{npPileDefinitionlist}{npPop1} -\begin{chunk}{defun npPileDefinitionlist} -(defun |npPileDefinitionlist| () - (and - (|npListAndRecover| #'|npDefinitionlist|) - (|npPush| (|pfAppend| (|npPop1|))))) - -\end{chunk} - -\defun{npListAndRecover}{npListAndRecover} -\catches{npListAndRecover}{trappoint} -\calls{npListAndRecover}{npRecoverTrap} -\calls{npListAndRecover}{syGeneralErrorHere} -\calls{npListAndRecover}{npEqKey} -\calls{npListAndRecover}{npEqPeek} -\calls{npListAndRecover}{npNext} -\calls{npListAndRecover}{npPop1} -\calls{npListAndRecover}{npPush} -\usesdollar{npListAndRecover}{inputStream} -\usesdollar{npListAndRecover}{stack} -\begin{chunk}{defun npListAndRecover} -(defun |npListAndRecover| (f) - (let (found c done b savestack) - (declare (special |$inputStream| |$stack|)) - (setq savestack |$stack|) - (setq |$stack| nil) - (setq c |$inputStream|) - (do () - (done) - (setq found (catch 'trappoint (apply f nil))) - (cond - ((eq found 'trapped) - (setq |$inputStream| c) - (|npRecoverTrap|)) - ((null found) - (setq |$inputStream| c) - (|syGeneralErrorHere|) (|npRecoverTrap|))) - (cond - ((|npEqKey| 'backset) (setq c |$inputStream|)) - ((|npEqPeek| 'backtab) (setq done t)) - (t - (setq |$inputStream| c) - (|syGeneralErrorHere|) - (|npRecoverTrap|) - (cond - ((|npEqPeek| 'backtab) (setq done t)) - (t - (|npNext|) - (setq c |$inputStream|))))) - (setq b (cons (|npPop1|) b))) - (setq |$stack| savestack) - (|npPush| (nreverse b)))) - -\end{chunk} - -\defun{npRecoverTrap}{npRecoverTrap} -\calls{npRecoverTrap}{npFirstTok} -\calls{npRecoverTrap}{tokPosn} -\calls{npRecoverTrap}{npMoveTo} -\calls{npRecoverTrap}{syIgnoredFromTo} -\calls{npRecoverTrap}{npPush} -\calls{npRecoverTrap}{pfWrong} -\calls{npRecoverTrap}{pfDocument} -\calls{npRecoverTrap}{pfListOf} -\usesdollar{npRecoverTrap}{stok} -\begin{chunk}{defun npRecoverTrap} -(defun |npRecoverTrap| () - (let (pos2 pos1) - (declare (special |$stok|)) - (|npFirstTok|) - (setq pos1 (|tokPosn| |$stok|)) - (|npMoveTo| 0) - (setq pos2 (|tokPosn| |$stok|)) - (|syIgnoredFromTo| pos1 pos2) - (|npPush| - (list (|pfWrong| (|pfDocument| (list "pile syntax error")) - (|pfListOf| nil)))))) - -\end{chunk} - -\defun{npMoveTo}{npMoveTo} -\calls{npMoveTo}{npEqPeek} -\calls{npMoveTo}{npNext} -\calls{npMoveTo}{npMoveTo} -\calls{npMoveTo}{npEqKey} -\usesdollar{npMoveTo}{inputStream} -\begin{chunk}{defun npMoveTo} -(defun |npMoveTo| (|n|) - (declare (special |$inputStream|)) - (cond - ((null |$inputStream|) t) - ((|npEqPeek| 'backtab) - (cond - ((eql |n| 0) t) - (t (|npNext|) (|npMoveTo| (1- |n|))))) - ((|npEqPeek| 'backset) - (cond - ((eql |n| 0) t) - (t (|npNext|) (|npMoveTo| |n|)))) - ((|npEqKey| 'settab) (|npMoveTo| (+ |n| 1))) - (t (|npNext|) (|npMoveTo| |n|)))) - -\end{chunk} - -\defun{syIgnoredFromTo}{syIgnoredFromTo} -\calls{syIgnoredFromTo}{pfGlobalLinePosn} -\calls{syIgnoredFromTo}{ncSoftError} -\calls{syIgnoredFromTo}{FromTo} -\calls{syIgnoredFromTo}{From} -\calls{syIgnoredFromTo}{To} -\begin{chunk}{defun syIgnoredFromTo} -(defun |syIgnoredFromTo| (pos1 pos2) - (cond - ((equal (|pfGlobalLinePosn| pos1) (|pfGlobalLinePosn| pos2)) - (|ncSoftError| (|FromTo| pos1 pos2) 'S2CY0005 nil)) - (t - (|ncSoftError| (|From| pos1) 'S2CY0003 nil) - (|ncSoftError| (|To| pos2) 'S2CY0004 nil)))) - -\end{chunk} - -\defun{syGeneralErrorHere}{syGeneralErrorHere} -\calls{syGeneralErrorHere}{sySpecificErrorHere} -\begin{chunk}{defun syGeneralErrorHere} -(defun |syGeneralErrorHere| () - (|sySpecificErrorHere| 'S2CY0002 nil)) - -\end{chunk} - -\defun{sySpecificErrorHere}{sySpecificErrorHere} -\calls{sySpecificErrorHere}{sySpecificErrorAtToken} -\usesdollar{sySpecificErrorHere}{stok} -\begin{chunk}{defun sySpecificErrorHere} -(defun |sySpecificErrorHere| (key args) - (declare (special |$stok|)) - (|sySpecificErrorAtToken| |$stok| key args)) - -\end{chunk} - -\defun{sySpecificErrorAtToken}{sySpecificErrorAtToken} -\calls{sySpecificErrorAtToken}{ncSoftError} -\calls{sySpecificErrorAtToken}{tokPosn} -\begin{chunk}{defun sySpecificErrorAtToken} -(defun |sySpecificErrorAtToken| (tok key args) - (|ncSoftError| (|tokPosn| tok) key args)) - -\end{chunk} - -\defun{npDefinitionlist}{npDefinitionlist} -\calls{npDefinitionlist}{npSemiListing} -\calls{npDefinitionlist}{npQualDef} -\begin{chunk}{defun npDefinitionlist} -(defun |npDefinitionlist| () - (|npSemiListing| #'|npQualDef|)) - -\end{chunk} - -\defun{npSemiListing}{npSemiListing} -\calls{npSemiListing}{npListofFun} -\calls{npSemiListing}{npSemiBackSet} -\calls{npSemiListing}{pfAppend} -\begin{chunk}{defun npSemiListing} -(defun |npSemiListing| (p) - (|npListofFun| p #'|npSemiBackSet| #'|pfAppend|)) - -\end{chunk} - -\defun{npSemiBackSet}{npSemiBackSet} -\calls{npSemiBackSet}{npEqKey} -\begin{chunk}{defun npSemiBackSet} -(defun |npSemiBackSet| () - (and (|npEqKey| 'semicolon) (or (|npEqKey| 'backset) t))) - -\end{chunk} - -\defun{npRule}{npRule} -\calls{npRule}{npEqKey} -\calls{npRule}{npPP} -\calls{npRule}{npSingleRule} -\begin{chunk}{defun npRule} -(defun |npRule| () - (and - (|npEqKey| 'rule) - (|npPP| #'|npSingleRule|))) - -\end{chunk} - -\defun{npSingleRule}{npSingleRule} -\calls{npSingleRule}{npQuiver} -\calls{npSingleRule}{npDefTail} -\calls{npSingleRule}{npTrap} -\calls{npSingleRule}{npPush} -\calls{npSingleRule}{pfRule} -\calls{npSingleRule}{npPop2} -\calls{npSingleRule}{npPop1} -\begin{chunk}{defun npSingleRule} -(defun |npSingleRule| () - (when (|npQuiver|) - (or (|npDefTail|) (|npTrap|)) - (|npPush| (|pfRule| (|npPop2|) (|npPop1|))))) - -\end{chunk} - -\defun{npDefTail}{npDefTail} -\calls{npDefTail}{npEqKey} -\calls{npDefTail}{npDefinitionOrStatement} -\begin{chunk}{defun npDefTail} -(defun |npDefTail| () - (and - (or (|npEqKey| 'def) (|npEqKey| 'mdef)) - (|npDefinitionOrStatement|))) - -\end{chunk} - -\defun{npDefaultValue}{npDefaultValue} -\calls{npDefaultValue}{npEqKey} -\calls{npDefaultValue}{npDefinitionOrStatement} -\calls{npDefaultValue}{npTrap} -\calls{npDefaultValue}{npPush} -\calls{npDefaultValue}{pfAdd} -\calls{npDefaultValue}{pfNothing} -\calls{npDefaultValue}{npPop1} -\begin{chunk}{defun npDefaultValue} -(defun |npDefaultValue| () - (and - (|npEqKey| 'default) - (or (|npDefinitionOrStatement|) (|npTrap|)) - (|npPush| (list (|pfAdd| (|pfNothing|) (|npPop1|) (|pfNothing|)))))) - -\end{chunk} - -\defun{npWConditional}{npWConditional} -\calls{npWConditional}{npConditional} -\calls{npWConditional}{npPush} -\calls{npWConditional}{pfTweakIf} -\calls{npWConditional}{npPop1} -\begin{chunk}{defun npWConditional} -(defun |npWConditional| (f) - (when (|npConditional| f) (|npPush| (|pfTweakIf| (|npPop1|))))) - -\end{chunk} - -\defun{npConditional}{npConditional} -\calls{npConditional}{npEqKey} -\calls{npConditional}{npLogical} -\calls{npConditional}{npTrap} -\calls{npConditional}{npMissing} -\calls{npConditional}{npElse} -\begin{chunk}{defun npConditional} -(defun |npConditional| (f) - (cond - ((and (|npEqKey| 'IF) - (or (|npLogical|) (|npTrap|)) - (or (|npEqKey| 'backset) t)) - (cond - ((|npEqKey| 'settab) - (cond - ((|npEqKey| 'then) - (and (or (apply f nil) (|npTrap|)) - (|npElse| f) - (|npEqKey| 'backtab))) - (t (|npMissing| '|then|)))) - ((|npEqKey| 'then) - (and (or (apply f nil) (|npTrap|)) (|npElse| f))) - (t (|npMissing| '|then|)))) - (t nil))) - -\end{chunk} - -\defun{npElse}{npElse} -\calls{npElse}{npState} -\calls{npElse}{npBacksetElse} -\calls{npElse}{npTrap} -\calls{npElse}{npPush} -\calls{npElse}{pfIf} -\calls{npElse}{npPop3} -\calls{npElse}{npPop2} -\calls{npElse}{npPop1} -\calls{npElse}{npRestore} -\calls{npElse}{pfIfThenOnly} -\begin{chunk}{defun npElse} -(defun |npElse| (f) - (let (a) - (setq a (|npState|)) - (cond - ((|npBacksetElse|) - (and - (or (apply f nil) (|npTrap|)) - (|npPush| (|pfIf| (|npPop3|) (|npPop2|) (|npPop1|))))) - (t - (|npRestore| a) - (|npPush| (|pfIfThenOnly| (|npPop2|) (|npPop1|))))))) - -\end{chunk} - -\defun{npBacksetElse}{npBacksetElse} -\tpdhere{Well this makes no sense.} - -\calls{npBacksetElse}{npEqKey} -\begin{chunk}{defun npBacksetElse} -(defun |npBacksetElse| () - (if (|npEqKey| 'backset) - (|npEqKey| 'else) - (|npEqKey| 'else))) - -\end{chunk} - -\defun{npLogical}{npLogical} -\calls{npLogical}{npLeftAssoc} -\calls{npLogical}{npDisjand} -\begin{chunk}{defun npLogical} -(defun |npLogical| () - (|npLeftAssoc| '(or) #'|npDisjand|)) - -\end{chunk} - -\defun{npDisjand}{npDisjand} -\calls{npDisjand}{npLeftAssoc} -\calls{npDisjand}{npDiscrim} -\begin{chunk}{defun npDisjand} -(defun |npDisjand| () - (|npLeftAssoc| '(and) #'|npDiscrim|)) - -\end{chunk} - -\defun{npDiscrim}{npDiscrim} -\calls{npDiscrim}{npLeftAssoc} -\calls{npDiscrim}{npQuiver} -\begin{chunk}{defun npDiscrim} -(defun |npDiscrim| () - (|npLeftAssoc| '(case has) #'|npQuiver|)) - -\end{chunk} - -\defun{npQuiver}{npQuiver} -\calls{npQuiver}{npRightAssoc} -\calls{npQuiver}{npRelation} -\begin{chunk}{defun npQuiver} -(defun |npQuiver| () - (|npRightAssoc| '(arrow larrow) #'|npRelation|)) - -\end{chunk} - -\defun{npRelation}{npRelation} -\calls{npRelation}{npLeftAssoc} -\calls{npRelation}{npSynthetic} -\begin{chunk}{defun npRelation} -(defun |npRelation| () - (|npLeftAssoc| '(equal notequal lt le gt ge oangle cangle) #'|npSynthetic|)) - -\end{chunk} - -\defun{npSynthetic}{npSynthetic} -\calls{npSynthetic}{npBy} -\calls{npSynthetic}{npAmpersandFrom} -\calls{npSynthetic}{npPush} -\calls{npSynthetic}{pfApplication} -\calls{npSynthetic}{npPop2} -\calls{npSynthetic}{npPop1} -\calls{npSynthetic}{pfInfApplication} -\begin{chunk}{defun npSynthetic} -(defun |npSynthetic| () - (cond - ((|npBy|) - ((lambda () - (loop - (cond - ((not (and (|npAmpersandFrom|) - (or (|npBy|) - (progn - (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) - nil)))) - (return nil)) - (t - (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) - t) - (t nil))) - -\end{chunk} - -\defun{npBy}{npBy} -\calls{npBy}{npLeftAssoc} -\calls{npBy}{npInterval} -\begin{chunk}{defun npBy} -(defun |npBy| () - (|npLeftAssoc| '(by) #'|npInterval|)) - -\end{chunk} - -\defun{npInterval}{} -\calls{npInterval}{npArith} -\calls{npInterval}{npSegment} -\calls{npInterval}{npEqPeek} -\calls{npInterval}{npPush} -\calls{npInterval}{pfApplication} -\calls{npInterval}{npPop1} -\calls{npInterval}{pfInfApplication} -\calls{npInterval}{npPop2} -\begin{chunk}{defun npInterval} -(defun |npInterval| () - (and - (|npArith|) - (or - (and - (|npSegment|) - (or - (and - (|npEqPeek| 'bar) - (|npPush| (|pfApplication| (|npPop1|) (|npPop1|)))) - (and - (|npArith|) - (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))) - (|npPush| (|pfApplication| (|npPop1|) (|npPop1|))))) - t))) - -\end{chunk} - -\defun{npSegment}{npSegment} -\calls{npSegment}{npEqPeek} -\calls{npSegment}{npPushId} -\calls{npSegment}{npFromdom} -\begin{chunk}{defun npSegment} -(defun |npSegment| () - (and (|npEqPeek| 'seg) (|npPushId|) (|npFromdom|))) - -\end{chunk} - -\defun{npArith}{npArith} -\calls{npArith}{npLeftAssoc} -\calls{npArith}{npSum} -\begin{chunk}{defun npArith} -(defun |npArith| () - (|npLeftAssoc| '(mod) #'|npSum|)) - -\end{chunk} - -\defun{npSum}{npSum} -\calls{npSum}{npLeftAssoc} -\calls{npSum}{npTerm} -\begin{chunk}{defun npSum} -(defun |npSum| () - (|npLeftAssoc| '(plus minus) #'|npTerm|)) - -\end{chunk} - -\defun{npTerm}{npTerm} -\calls{npTerm}{npInfGeneric} -\calls{npTerm}{npRemainder} -\calls{npTerm}{npPush} -\calls{npTerm}{pfApplication} -\calls{npTerm}{npPop2} -\calls{npTerm}{npPop1} -\begin{chunk}{defun npTerm} -(defun |npTerm| () - (or - (and - (|npInfGeneric| '(minus plus)) - (or - (and (|npRemainder|) (|npPush| (|pfApplication| (|npPop2|) (|npPop1|)))) - t)) - (|npRemainder|))) - -\end{chunk} - -\defun{npRemainder}{npRemainder} -\calls{npRemainder}{npLeftAssoc} -\calls{npRemainder}{npProduct} -\begin{chunk}{defun npRemainder} -(defun |npRemainder| () - (|npLeftAssoc| '(rem quo) #'|npProduct|)) - -\end{chunk} - -\defun{npProduct}{npProduct} -\calls{npProduct}{npLeftAssoc} -\calls{npProduct}{npPower} -\begin{chunk}{defun npProduct} -(defun |npProduct| () - (|npLeftAssoc| - '(times slash backslash slashslash backslashbackslash - slashbackslash backslashslash) - #'|npPower|)) - -\end{chunk} - -\defun{npPower}{npPower} -\calls{npPower}{npRightAssoc} -\calls{npPower}{npColon} -\begin{chunk}{defun npPower} -(defun |npPower| () - (|npRightAssoc| '(power carat) #'|npColon|)) - -\end{chunk} - -\defun{npAmpersandFrom}{npAmpersandFrom} -\calls{npAmpersandFrom}{npAmpersand} -\calls{npAmpersandFrom}{npFromdom} -\begin{chunk}{defun npAmpersandFrom} -(defun |npAmpersandFrom| () - (and (|npAmpersand|) (|npFromdom|))) - -\end{chunk} - -\defun{npFromdom}{npFromdom} -\calls{npFromdom}{npEqKey} -\calls{npFromdom}{npApplication} -\calls{npFromdom}{npTrap} -\calls{npFromdom}{npFromdom1} -\calls{npFromdom}{npPop1} -\calls{npFromdom}{npPush} -\calls{npFromdom}{pfFromDom} -\begin{chunk}{defun npFromdom} -(defun |npFromdom| () - (or - (and - (|npEqKey| '$) - (or (|npApplication|) (|npTrap|)) - (|npFromdom1| (|npPop1|)) - (|npPush| (|pfFromDom| (|npPop1|) (|npPop1|)))) - t)) - -\end{chunk} - -\defun{npFromdom1}{npFromdom1} -\calls{npFromdom1}{npEqKey} -\calls{npFromdom1}{npApplication} -\calls{npFromdom1}{npTrap} -\calls{npFromdom1}{npFromdom1} -\calls{npFromdom1}{npPop1} -\calls{npFromdom1}{npPush} -\calls{npFromdom1}{pfFromDom} -\begin{chunk}{defun npFromdom1} -(defun |npFromdom1| (c) - (or - (and - (|npEqKey| '$) - (or (|npApplication|) (|npTrap|)) - (|npFromdom1| (|npPop1|)) - (|npPush| (|pfFromDom| (|npPop1|) c))) - (|npPush| c))) - -\end{chunk} - -\defun{npAmpersand}{npAmpersand} -\calls{npAmpersand}{npEqKey} -\calls{npAmpersand}{npName} -\calls{npAmpersand}{npTrap} -\begin{chunk}{defun npAmpersand} -(defun |npAmpersand| () - (and - (|npEqKey| 'ampersand) - (or (|npName|) (|npTrap|)))) - -\end{chunk} - -\defun{npName}{npName} -\calls{npName}{npId} -\calls{npName}{npSymbolVariable} -\begin{chunk}{defun npName} -(defun |npName| () - (or (|npId|) (|npSymbolVariable|))) - -\end{chunk} - -\defdollar{npTokToNames} -\begin{chunk}{initvars} -(defvar |$npTokToNames| (list '~ '|#| '[] '{} '|[\|\|]| '|{\|\|}|)) - -\end{chunk} - -\defun{npId}{npId} -\calls{npId}{npPush} -\calls{npId}{npNext} -\calls{npId}{tokConstruct} -\calls{npId}{tokPosn} -\usesdollar{npId}{npTokToNames} -\usesdollar{npId}{ttok} -\usesdollar{npId}{stok} -\begin{chunk}{defun npId} -(defun |npId| () - (declare (special |$npTokToNames| |$ttok| |$stok|)) - (cond - ((eq (caar |$stok|) '|id|) - (|npPush| |$stok|) - (|npNext|)) - ((and (eq (caar |$stok|) '|key|) (member |$ttok| |$npTokToNames|)) - (|npPush| (|tokConstruct| '|id| |$ttok| (|tokPosn| |$stok|))) - (|npNext|)) - (t nil))) - -\end{chunk} - -\defun{npSymbolVariable}{npSymbolVariable} -\calls{npSymbolVariable}{npState} -\calls{npSymbolVariable}{npEqKey} -\calls{npSymbolVariable}{npId} -\calls{npSymbolVariable}{npPop1} -\calls{npSymbolVariable}{npPush} -\calls{npSymbolVariable}{tokConstruct} -\calls{npSymbolVariable}{tokPart} -\calls{npSymbolVariable}{tokPosn} -\calls{npSymbolVariable}{npRestore} -\begin{chunk}{defun npSymbolVariable} -(defun |npSymbolVariable| () - (let (a) - (setq a (|npState|)) - (cond - ((and (|npEqKey| 'backquote) (|npId|)) - (setq a (|npPop1|)) - (|npPush| (|tokConstruct| '|idsy| (|tokPart| a) (|tokPosn| a)))) - (t (|npRestore| a) nil)))) - -\end{chunk} - -\defun{npRightAssoc}{npRightAssoc} -\calls{npRightAssoc}{npState} -\calls{npRightAssoc}{npInfGeneric} -\calls{npRightAssoc}{npRightAssoc} -\calls{npRightAssoc}{npPush} -\calls{npRightAssoc}{pfApplication} -\calls{npRightAssoc}{npPop2} -\calls{npRightAssoc}{npPop1} -\calls{npRightAssoc}{pfInfApplication} -\calls{npRightAssoc}{npRestore} -\begin{chunk}{defun npRightAssoc} -(defun |npRightAssoc| (o p) - (let (a) - (setq a (|npState|)) - (cond - ((apply p nil) - ((lambda () - (loop - (cond - ((not - (and - (|npInfGeneric| o) - (or - (|npRightAssoc| o p) - (progn (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) nil)))) - (return nil)) - (t - (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) - t) - (t - (|npRestore| a) - nil)))) - -\end{chunk} - -\defun{npLeftAssoc}{p o p o p o p = (((p o p) o p) o p)} -\begin{verbatim} -p o p o p o p = (((p o p) o p) o p) -p o p o = (p o p) o -;npLeftAssoc(operations,parser)== -; if APPLY(parser,nil) -; then -; while npInfGeneric(operations) -; and (APPLY(parser,nil) or -; (npPush pfApplication(npPop2(),npPop1());false)) -; repeat -; npPush pfInfApplication(npPop2(),npPop2(),npPop1()) -; true -; else false -\end{verbatim} -\calls{npLeftAssoc}{npInfGeneric} -\calls{npLeftAssoc}{npPush} -\calls{npLeftAssoc}{pfApplication} -\calls{npLeftAssoc}{npPop2} -\calls{npLeftAssoc}{npPop1} -\calls{npLeftAssoc}{pfInfApplication} -\begin{chunk}{defun npLeftAssoc} -(defun |npLeftAssoc| (operations parser) - (when (apply parser nil) - ((lambda nil - (loop - (cond - ((not - (and - (|npInfGeneric| operations) - (or - (apply parser nil) - (progn (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) nil)))) - (return nil)) - (t - (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) - t)) - -\end{chunk} - -\defun{npInfGeneric}{npInfGeneric} -\calls{npInfGeneric}{npDDInfKey} -\calls{npInfGeneric}{npEqKey} -\begin{chunk}{defun npInfGeneric} -(defun |npInfGeneric| (s) - (and - (|npDDInfKey| s) - (or (|npEqKey| 'backset) t))) - -\end{chunk} - -\defun{npDDInfKey}{npDDInfKey} -\calls{npDDInfKey}{npInfKey} -\calls{npDDInfKey}{npState} -\calls{npDDInfKey}{npEqKey} -\calls{npDDInfKey}{npPush} -\calls{npDDInfKey}{pfSymb} -\calls{npDDInfKey}{npPop1} -\calls{npDDInfKey}{tokPosn} -\calls{npDDInfKey}{npRestore} -\calls{npDDInfKey}{tokConstruct} -\calls{npDDInfKey}{tokPart} -\usesdollar{npDDInfKey}{stok} -\begin{chunk}{defun npDDInfKey} -(defun |npDDInfKey| (s) - (let (b a) - (declare (special |$stok|)) - (or - (|npInfKey| s) - (progn - (setq a (|npState|)) - (setq b |$stok|) - (cond - ((and (|npEqKey| '|'|) (|npInfKey| s)) - (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| b)))) - (t - (|npRestore| a) - (cond - ((and (|npEqKey| 'backquote) (|npInfKey| s)) - (setq a (|npPop1|)) - (|npPush| (|tokConstruct| '|idsy| (|tokPart| a) (|tokPosn| a)))) - (t - (|npRestore| a) - nil)))))))) - -\end{chunk} - -\defun{npInfKey}{npInfKey} -\calls{npInfKey}{npPushId} -\usesdollar{npInfKey}{stok} -\usesdollar{npInfKey}{ttok} -\begin{chunk}{defun npInfKey} -(defun |npInfKey| (s) - (declare (special |$ttok| |$stok|)) - (and (eq (caar |$stok|) '|key|) (member |$ttok| s) (|npPushId|))) - -\end{chunk} - -\defun{npPushId}{npPushId} -\calls{npPushId}{tokConstruct} -\calls{npPushId}{tokPosn} -\calls{npPushId}{npNext} -\usesdollar{npPushId}{stack} -\usesdollar{npPushId}{stok} -\usesdollar{npPushId}{ttok} -\begin{chunk}{defun npPushId} -(defun |npPushId| () - (let (a) - (declare (special |$stack| |$stok| |$ttok|)) - (setq a (get |$ttok| 'infgeneric)) - (when a (setq |$ttok| a)) - (setq |$stack| - (cons (|tokConstruct| '|id| |$ttok| (|tokPosn| |$stok|)) |$stack|)) - (|npNext|))) - -\end{chunk} - -\defvar{npPParg} -\begin{chunk}{initvars} -(defvar *npPParg* nil "rewrite npPP without flets, using global scoping") - -\end{chunk} - -\defun{npPP}{npPP} -This was rewritten by NAG to remove flet. - -\calls{npPP}{npParened} -\calls{npPP}{npPPf} -\calls{npPP}{npPileBracketed} -\calls{npPP}{npPPg} -\calls{npPP}{npPush} -\calls{npPP}{pfEnSequence} -\calls{npPP}{npPop1} -\uses{npPP}{npPParg} -\begin{chunk}{defun npPP} -(defun |npPP| (f) - (declare (special *npPParg*)) - (setq *npPParg* f) - (or - (|npParened| #'npPPf) - (and (|npPileBracketed| #'npPPg) (|npPush| (|pfEnSequence| (|npPop1|)))) - (funcall f))) - -\end{chunk} - -\defun{npPPff}{npPPff} -\calls{npPPff}{npPop1} -\calls{npPPff}{npPush} -\usesdollar{npPPff}{npPParg} -\begin{chunk}{defun npPPff} -(defun npPPff () - (and (funcall *npPParg*) (|npPush| (list (|npPop1|))))) - -\end{chunk} - -\defun{npPPg}{npPPg} -\calls{npPPg}{npListAndRecover} -\calls{npPPg}{npPPf} -\calls{npPPg}{npPush} -\calls{npPPg}{pfAppend} -\calls{npPPg}{npPop1} -\begin{chunk}{defun npPPg} -(defun npPPg () - (and (|npListAndRecover| #'npPPf)) - (|npPush| (|pfAppend| (|npPop1|)))) - -\end{chunk} - -\defun{npPPf}{npPPf} -\calls{npPPf}{npSemiListing} -\calls{npPPf}{npPPff} -\begin{chunk}{defun npPPf} -(defun npPPf () - (|npSemiListing| #'npPPff)) - -\end{chunk} - -\defun{npEnclosed}{npEnclosed} -\calls{npEnclosed}{npEqKey} -\calls{npEnclosed}{npPush} -\calls{npEnclosed}{pfTuple} -\calls{npEnclosed}{pfListOf} -\calls{npEnclosed}{npMissingMate} -\calls{npEnclosed}{pfEnSequence} -\calls{npEnclosed}{npPop1} -\usesdollar{npEnclosed}{stok} -\begin{chunk}{defun npEnclosed} -(defun |npEnclosed| (open close fn f) - (let (a) - (declare (special |$stok|)) - (setq a |$stok|) - (when (|npEqKey| open) - (cond - ((|npEqKey| close) - (|npPush| (funcall fn a (|pfTuple| (|pfListOf| NIL))))) - ((and (apply f nil) - (or (|npEqKey| close) - (|npMissingMate| close a))) - (|npPush| (funcall fn a (|pfEnSequence| (|npPop1|))))) - ('t nil))))) - -\end{chunk} - -\defun{npState}{npState} -\usesdollar{npState}{stack} -\usesdollar{npState}{inputStream} -\begin{chunk}{defun npState} -(defun |npState| () - (declare (special |$stack| |$inputStream|)) - (cons |$inputStream| |$stack|)) - -\end{chunk} - -\defun{npTrap}{npTrap} -\throws{npTrap}{trappoint} -\calls{npTrap}{tokPosn} -\calls{npTrap}{ncSoftError} -\usesdollar{npTrap}{stok} -\begin{chunk}{defun npTrap} -(defun |npTrap| () - (declare (special |$stok|)) - (|ncSoftError| (|tokPosn| |$stok|) 'S2CY0002 nil) - (throw 'trappoint 'trapped)) - -\end{chunk} - -\defun{npTrapForm}{npTrapForm} -\throws{npTrapForm}{trappoint} -\calls{npTrapForm}{pfSourceStok} -\calls{npTrapForm}{syGeneralErrorHere} -\calls{npTrapForm}{ncSoftError} -\calls{npTrapForm}{tokPosn} -\begin{chunk}{defun npTrapForm} -(defun |npTrapForm| (x) - (let (a) - (setq a (|pfSourceStok| x)) - (cond - ((eq a '|NoToken|) - (|syGeneralErrorHere|) - (throw 'trappoint 'trapped)) - (t - (|ncSoftError| (|tokPosn| a) 'S2CY0002 nil) - (throw 'trappoint 'trapped))))) - -\end{chunk} - -\defun{npVariable}{npVariable} -\calls{npVariable}{npParenthesized} -\calls{npVariable}{npVariablelist} -\calls{npVariable}{npVariableName} -\calls{npVariable}{npPush} -\calls{npVariable}{pfListOf} -\calls{npVariable}{npPop1} -\begin{chunk}{defun npVariable} -(defun |npVariable| () - (or - (|npParenthesized| #'|npVariablelist|) - (and (|npVariableName|) (|npPush| (|pfListOf| (list (|npPop1|))))))) - -\end{chunk} - -\defun{npVariablelist}{npVariablelist} -\calls{npVariablelist}{npListing} -\calls{npVariablelist}{npVariableName} -\begin{chunk}{defun npVariablelist} -(defun |npVariablelist| () - (|npListing| #'|npVariableName|)) - -\end{chunk} - -\defun{npVariableName}{npVariableName} -\calls{npVariableName}{npName} -\calls{npVariableName}{npDecl} -\calls{npVariableName}{npPush} -\calls{npVariableName}{pfTyped} -\calls{npVariableName}{npPop1} -\calls{npVariableName}{pfNothing} -\begin{chunk}{defun npVariableName} -(defun |npVariableName| () - (and - (|npName|) - (or (|npDecl|) (|npPush| (|pfTyped| (|npPop1|) (|pfNothing|)))))) - -\end{chunk} - -\defun{npDecl}{npDecl} -\calls{npDecl}{npEqKey} -\calls{npDecl}{npType} -\calls{npDecl}{npTrap} -\calls{npDecl}{npPush} -\calls{npDecl}{pfTyped} -\calls{npDecl}{npPop2} -\calls{npDecl}{npPop1} -\begin{chunk}{defun npDecl} -(defun |npDecl| () - (and - (|npEqKey| 'colon) - (or (|npType|) (|npTrap|)) - (|npPush| (|pfTyped| (|npPop2|) (|npPop1|))))) - -\end{chunk} - -\defun{npParenthesized}{npParenthesized} -\calls{npParenthesized}{npParenthesize} -\begin{chunk}{defun npParenthesized} -(defun |npParenthesized| (f) - (or (|npParenthesize| '|(| '|)| f) (|npParenthesize| '|(\|| '|\|)| f))) - -\end{chunk} - -\defun{npParenthesize}{npParenthesize} -\calls{npParenthesize}{npEqKey} -\calls{npParenthesize}{npMissingMate} -\calls{npParenthesize}{npPush} -\usesdollar{npParenthesize}{stok} -\begin{chunk}{defun npParenthesize} -(defun |npParenthesize| (open close f) - (let (a) - (declare (special |$stok|)) - (setq a |$stok|) - (cond - ((|npEqKey| open) - (cond - ((and (apply f nil) - (or (|npEqKey| close) - (|npMissingMate| close a))) - t) - ((|npEqKey| close) (|npPush| nil)) - (t (|npMissingMate| close a)))) - (t nil)))) - -\end{chunk} - -\defun{npMissingMate}{npMissingMate} -\calls{npMissingMate}{ncSoftError} -\calls{npMissingMate}{tokPosn} -\calls{npMissingMate}{npMissing} -\begin{chunk}{defun npMissingMate} -(defun |npMissingMate| (close open) - (|ncSoftError| (|tokPosn| open) 'S2CY0008 nil) - (|npMissing| close)) - -\end{chunk} - -\defun{npExit}{npExit} -\calls{npExit}{npBackTrack} -\calls{npExit}{npAssign} -\calls{npExit}{npPileExit} -\begin{chunk}{defun npExit} -(defun |npExit| () - (|npBackTrack| #'|npAssign| 'exit #'|npPileExit|)) - -\end{chunk} - -\defun{npPileExit}{npPileExit} -\calls{npPileExit}{npAssign} -\calls{npPileExit}{npEqKey} -\calls{npPileExit}{npStatement} -\calls{npPileExit}{npPush} -\calls{npPileExit}{pfExit} -\calls{npPileExit}{npPop2} -\calls{npPileExit}{npPop1} -\begin{chunk}{defun npPileExit} -(defun |npPileExit| () - (and - (|npAssign|) - (or (|npEqKey| 'exit) (|npTrap|)) - (or (|npStatement|) (|npTrap|)) - (|npPush| (|pfExit| (|npPop2|) (|npPop1|))))) - -\end{chunk} - -\defun{npAssign}{npAssign} -\calls{npAssign}{npBackTrack} -\calls{npAssign}{npMDEF} -\calls{npAssign}{npAssignment} -\begin{chunk}{defun npAssign} -(defun |npAssign| () - (|npBackTrack| #'|npMDEF| 'becomes #'|npAssignment|)) - -\end{chunk} - -\defun{npAssignment}{npAssignment} -\calls{npAssignment}{npAssignVariable} -\calls{npAssignment}{npEqKey} -\calls{npAssignment}{npTrap} -\calls{npAssignment}{npGives} -\calls{npAssignment}{npPush} -\calls{npAssignment}{pfAssign} -\calls{npAssignment}{npPop2} -\calls{npAssignment}{npPop1} -\begin{chunk}{defun npAssignment} -(defun |npAssignment| () - (and - (|npAssignVariable|) - (or (|npEqKey| 'becomes) (|npTrap|)) - (or (|npGives|) (|npTrap|)) - (|npPush| (|pfAssign| (|npPop2|) (|npPop1|))))) - -\end{chunk} - -\defun{npAssignVariable}{npAssignVariable} -\calls{npAssignVariable}{npColon} -\calls{npAssignVariable}{npPush} -\calls{npAssignVariable}{pfListOf} -\calls{npAssignVariable}{npPop1} -\begin{chunk}{defun npAssignVariable} -(defun |npAssignVariable| () - (and (|npColon|) (|npPush| (|pfListOf| (list (|npPop1|)))))) - -\end{chunk} - -\defun{npColon}{npColon} -\calls{npColon}{npTypified} -\calls{npColon}{npAnyNo} -\calls{npColon}{npTagged} -\begin{chunk}{defun npColon} -(defun |npColon| () - (and (|npTypified|) (|npAnyNo| #'|npTagged|))) - -\end{chunk} - -\defun{npTagged}{npTagged} -\calls{npTagged}{npTypedForm1} -\calls{npTagged}{pfTagged} -\begin{chunk}{defun npTagged} -(defun |npTagged| () - (|npTypedForm1| 'colon #'|pfTagged|)) - -\end{chunk} - -\defun{npTypedForm1}{npTypedForm1} -\calls{npTypedForm1}{npEqKey} -\calls{npTypedForm1}{npType} -\calls{npTypedForm1}{npTrap} -\calls{npTypedForm1}{npPush} -\calls{npTypedForm1}{npPop2} -\calls{npTypedForm1}{npPop1} -\begin{chunk}{defun npTypedForm1} -(defun |npTypedForm1| (sy fn) - (and - (|npEqKey| sy) - (or (|npType|) (|npTrap|)) - (|npPush| (funcall fn (|npPop2|) (|npPop1|))))) - -\end{chunk} - -\defun{npTypified}{npTypified} -\calls{npTypified}{npApplication} -\calls{npTypified}{npAnyNo} -\calls{npTypified}{npTypeStyle} -\begin{chunk}{defun npTypified} -(defun |npTypified| () - (and (|npApplication|) (|npAnyNo| #'|npTypeStyle|))) - -\end{chunk} - -\defun{npTypeStyle}{npTypeStyle} -\calls{npTypeStyle}{npCoerceTo} -\calls{npTypeStyle}{npRestrict} -\calls{npTypeStyle}{npPretend} -\calls{npTypeStyle}{npColonQuery} -\begin{chunk}{defun npTypeStyle} -(defun |npTypeStyle| () - (or (|npCoerceTo|) (|npRestrict|) (|npPretend|) (|npColonQuery|))) - -\end{chunk} - -\defun{npPretend}{npPretend} -\calls{npPretend}{npTypedForm} -\calls{npPretend}{pfPretend} -\begin{chunk}{defun npPretend} -(defun |npPretend| () - (|npTypedForm| 'pretend #'|pfPretend|)) - -\end{chunk} - -\defun{npColonQuery}{npColonQuery} -\calls{npColonQuery}{npTypedForm} -\calls{npColonQuery}{pfRetractTo} -\begin{chunk}{defun npColonQuery} -(defun |npColonQuery| () - (|npTypedForm| 'atat #'|pfRetractTo|)) - -\end{chunk} - -\defun{npCoerceTo}{npCoerceTo} -\calls{npCoerceTo}{npTypedForm} -\calls{npCoerceTo}{pfCoerceto} -\begin{chunk}{defun npCoerceTo} -(defun |npCoerceTo| () - (|npTypedForm| 'coerce #'|pfCoerceto|)) - -\end{chunk} - -\defun{npTypedForm}{npTypedForm} -\calls{npTypedForm}{npEqKey} -\calls{npTypedForm}{npApplication} -\calls{npTypedForm}{npTrap} -\calls{npTypedForm}{npPush} -\calls{npTypedForm}{npPop2} -\calls{npTypedForm}{npPop1} -\begin{chunk}{defun npTypedForm} -(defun |npTypedForm| (sy fn) - (and - (|npEqKey| sy) - (or (|npApplication|) (|npTrap|)) - (|npPush| (funcall fn (|npPop2|) (|npPop1|))))) - -\end{chunk} - -\defun{npRestrict}{npRestrict} -\calls{npRestrict}{npTypedForm} -\calls{npRestrict}{pfRestrict} -\begin{chunk}{defun npRestrict} -(defun |npRestrict| () - (|npTypedForm| 'at #'|pfRestrict|)) - -\end{chunk} - -\defun{npListofFun}{npListofFun} -\calls{npListofFun}{npTrap} -\calls{npListofFun}{npPush} -\calls{npListofFun}{npPop3} -\calls{npListofFun}{npPop2} -\calls{npListofFun}{npPop1} -\usesdollar{npListofFun}{stack} -\begin{chunk}{defun npListofFun} -(defun |npListofFun| (f h g) - (let (a) - (declare (special |$stack|)) - (cond - ((apply f nil) - (cond - ((and (apply h nil) (or (apply f nil) (|npTrap|))) - (setq a |$stack|) - (setq |$stack| nil) - (do () - ((not (and (apply h nil) - (or (apply f nil) (|npTrap|)))))) - (setq |$stack| (cons (nreverse |$stack|) a)) - (|npPush| (funcall g (cons (|npPop3|) (cons (|npPop2|) (|npPop1|)))))) - (t t))) - (t nil)))) - -\end{chunk} - -\section{Functions on interpreter objects} -Interpreter objects used to be called triples because they had the -structure [value, type, environment]. For many years, the environment -was not used, so finally in January, 1990, the structure of objects -was changed to be (type . value). This was chosen because it was the -structure of objects of type Any. Sometimes the values are wrapped -(see the function isWrapped to see what this means physically). -Wrapped values are not actual values belonging to their types. An -unwrapped value must be evaluated to get an actual value. A wrapped -value must be unwrapped before being passed to a library function. -Typically, an unwrapped value in the interpreter consists of LISP -code, e.g., parts of a function that is being constructed. --- RSS 1/14/90 - -These are the new structure functions. - -\begin{center} -\includegraphics{ps/v5mkObj.eps}\\ -{\bf {\Large Object representation}} -\end{center} - -\defmacro{mkObj} -\begin{chunk}{defmacro mkObj} -(defmacro mkObj (val mode) - `(cons ,mode ,val)) - -\end{chunk} - -\begin{center} -\includegraphics{ps/v5mkObjWrap.eps}\\ -{\bf {\Large Object representation}} -\end{center} - -\defmacro{mkObjWrap} -\calls{mkObjWrap}{wrap} -\begin{chunk}{defmacro mkObjWrap} -(defmacro mkObjWrap (val mode) - `(cons ,mode (|wrap| ,val))) - -\end{chunk} - -\defmacro{mkObjCode} -\begin{chunk}{defmacro mkObjCode} -(defmacro mkObjCode (val mode) - `(cons 'cons (cons (mkq ,mode) (cons ,val nil)))) - -\end{chunk} - -\defmacro{objSetVal} -\begin{chunk}{defmacro objSetVal} -(defmacro |objSetVal| (obj val) - `(rplacd ,obj ,val)) - -\end{chunk} - -\defmacro{objSetMode} -\begin{chunk}{defmacro objSetMode} -(defmacro |objSetMode| (obj mode) - `(rplaca ,obj ,mode)) - -\end{chunk} - -\defmacro{objVal} -\begin{chunk}{defmacro objVal} -(defmacro |objVal| (obj) - `(cdr ,obj)) - -\end{chunk} - -\defmacro{objValUnwrap} -\begin{chunk}{defmacro objValUnwrap} -(defmacro |objValUnwrap| (obj) - `(|unwrap| (cdr ,obj))) - -\end{chunk} - -\defmacro{objMode} -\begin{chunk}{defmacro objMode} -(defmacro |objMode| (obj) - `(car ,obj)) - -\end{chunk} - -\defun{objEnv}{objEnv} -\begin{chunk}{defun objEnv 0} -(defun |objEnv| (obj) - (declare (special $NE) (ignore obj)) - $NE) - -\end{chunk} - -\defmacro{objCodeVal} -\begin{chunk}{defmacro objCodeVal} -(defmacro |objCodeVal| (obj) - `(caddr ,obj)) - -\end{chunk} - -\defmacro{objCodeMode} -\begin{chunk}{defmacro objCodeMode} -(defmacro |objCodeMode| (obj) - `(cadr ,obj)) - -\end{chunk} - -\section{Macro handling} -\defun{phMacro}{phMacro} -\tpdhere{The pform function has a leading percent sign} -\begin{verbatim} -carrier[ptree,...] -> carrier[ptree, ptreePremacro,...] -\end{verbatim} -\calls{phMacro}{ncEltQ} -\calls{phMacro}{ncPutQ} -\calls{phMacro}{macroExpanded} -\calls{phMacro}{pform} -\begin{chunk}{defun phMacro} -(defun |phMacro| (carrier) - (let (ptree) - (setq ptree (|ncEltQ| carrier '|ptree|)) - (|ncPutQ| carrier '|ptreePremacro| ptree) - (setq ptree (|macroExpanded| ptree)) - (|ncPutQ| carrier '|ptree| ptree) - 'ok)) - -\end{chunk} - -\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} -\begin{chunk}{defun macroExpanded} -(defun |macroExpanded| (pf) - (let (|$posActive| |$macActive|) - (declare (special |$posActive| |$macActive|)) - (setq |$macActive| nil) - (setq |$posActive| nil) - (|macExpand| pf))) - -\end{chunk} - -\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} -\begin{chunk}{defun 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)))) - -\end{chunk} - -\defun{macApplication}{macApplication} -\calls{macApplication}{pfMapParts} -\calls{macApplication}{macExpand} -\calls{macApplication}{pfApplicationOp} -\calls{macApplication}{pfMLambda?} -\calls{macApplication}{pf0ApplicationArgs} -\calls{macApplication}{mac0MLambdaApply} -\usesdollar{macApplication}{pfMacros} -\begin{chunk}{defun macApplication} -(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|))))) - -\end{chunk} - -\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} -\begin{chunk}{defun mac0MLambdaApply} -(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|))))) - -\end{chunk} - -\defun{mac0ExpandBody}{mac0ExpandBody} -\calls{mac0ExpandBody}{pfSourcePosition} -\calls{mac0ExpandBody}{mac0InfiniteExpansion} -\calls{mac0ExpandBody}{macExpand} -\usesdollar{mac0ExpandBody}{posActive} -\usesdollar{mac0ExpandBody}{macActive} -\begin{chunk}{defun mac0ExpandBody} -(defun |mac0ExpandBody| (body opf |$macActive| |$posActive|) - (declare (special |$macActive| |$posActive|)) - (let (posn pf) - (cond - ((member 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))))) - -\end{chunk} - -\defun{mac0InfiniteExpansion}{mac0InfiniteExpansion} -\tpdhere{The pform function has a leading percent sign. fix this} - -\calls{mac0InfiniteExpansion}{mac0InfiniteExpansion,name} -\calls{mac0InfiniteExpansion}{ncSoftError} -\calls{mac0InfiniteExpansion}{pform} -\begin{chunk}{defun mac0InfiniteExpansion} -(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)) - -\end{chunk} - -\defun{mac0InfiniteExpansion,name}{mac0InfiniteExpansion,name} -\calls{mac0InfiniteExpansion,name}{mac0GetName} -\calls{mac0InfiniteExpansion,name}{pname} -\begin{chunk}{defun mac0InfiniteExpansion,name 0} -(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)))))) - -\end{chunk} - -\defun{mac0GetName}{mac0GetName} -Returns [state, body] or NIL. -Returns [sy, state] or NIL. - -\calls{mac0GetName}{pfMLambdaBody} -\usesdollar{mac0GetName}{pfMacros} -\begin{chunk}{defun mac0GetName} -(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)) - -\end{chunk} - -\defun{macId}{macId} -\calls{macId}{pfIdSymbol} -\calls{macId}{mac0Get} -\calls{macId}{pfCopyWithPos} -\calls{macId}{pfSourcePosition} -\calls{macId}{mac0ExpandBody} -\usesdollar{macId}{posActive} -\usesdollar{macId}{macActive} -\begin{chunk}{defun macId} -(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)))))))) - -\end{chunk} - -\defun{mac0Get}{mac0Get} -\calls{mac0Get}{ifcdr} -\usesdollar{mac0Get}{pfMacros} -\begin{chunk}{defun mac0Get} -(defun |mac0Get| (sy) - (declare (special |$pfMacros|)) - (ifcdr (assoc sy |$pfMacros|))) - -\end{chunk} - -\defun{macWhere}{macWhere} -\calls{macWhere}{macWhere,mac} -\usesdollar{macWhere}{pfMacros} -\begin{chunk}{defun macWhere} -(defun |macWhere| (pf) - (declare (special |$pfMacros|)) - (|macWhere,mac| pf |$pfMacros|)) - -\end{chunk} - -\defun{macWhere,mac}{macWhere,mac} -\calls{macWhere,mac}{pfMapParts} -\calls{macWhere,mac}{macExpand} -\usesdollar{macWhere,mac}{pfMacros} -\begin{chunk}{defun macWhere,mac} -(defun |macWhere,mac| (pf |$pfMacros|) - (declare (special |$pfMacros|)) - (|pfMapParts| #'|macExpand| pf)) - -\end{chunk} - -\defun{macLambda}{macLambda} -\calls{macLambda}{macLambda,mac} -\usesdollar{macLambda}{pfMacros} -\begin{chunk}{defun macLambda} -(defun |macLambda| (pf) - (declare (special |$pfMacros|)) - (|macLambda,mac| pf |$pfMacros|)) - -\end{chunk} - -\defun{macLambda,mac}{macLambda,mac} -\calls{macLambda,mac}{pfMapParts} -\calls{macLambda,mac}{macExpand} -\usesdollar{macLambda,mac}{pfMacros} -\begin{chunk}{defun macLambda,mac} -(defun |macLambda,mac| (pf |$pfMacros|) - (declare (special |$pfMacros|)) - (|pfMapParts| #'|macExpand| pf)) - -\end{chunk} - -\defun{macMacro}{Add appropriate definition the a Macro pform} -This function adds the 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} -\begin{chunk}{defun macMacro} -(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|)))))))) - -\end{chunk} - -\defun{mac0Define}{Add a macro to the global pfMacros list} -\usesdollar{mac0Define}{pfMacros} -\begin{chunk}{defun mac0Define 0} -(defun |mac0Define| (sy state body) - (declare (special |$pfMacros|)) - (setq |$pfMacros| (cons (list sy state body) |$pfMacros|))) - -\end{chunk} - -\defun{macSubstituteOuter}{macSubstituteOuter} -\calls{macSubstituteOuter}{mac0SubstituteOuter} -\calls{macSubstituteOuter}{macLambdaParameterHandling} -\begin{chunk}{defun macSubstituteOuter} -(defun |macSubstituteOuter| (pform) - (|mac0SubstituteOuter| (|macLambdaParameterHandling| nil pform) pform)) - -\end{chunk} - -\defun{mac0SubstituteOuter}{mac0SubstituteOuter} -\calls{mac0SubstituteOuter}{pfId?} -\calls{mac0SubstituteOuter}{macSubstituteId} -\calls{mac0SubstituteOuter}{pfLeaf?} -\calls{mac0SubstituteOuter}{pfLambda?} -\calls{mac0SubstituteOuter}{macLambdaParameterHandling} -\calls{mac0SubstituteOuter}{mac0SubstituteOuter} -\calls{mac0SubstituteOuter}{pfParts} -\begin{chunk}{defun mac0SubstituteOuter} -(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)))) - -\end{chunk} - -\defun{macLambdaParameterHandling}{macLambdaParameterHandling} -\calls{macLambdaParameterHandling}{pfLeaf?} -\calls{macLambdaParameterHandling}{pfLambda?} -\calls{macLambdaParameterHandling}{pfTypedId} -\calls{macLambdaParameterHandling}{pf0LambdaArgs} -\calls{macLambdaParameterHandling}{pfIdSymbol} -\calls{macLambdaParameterHandling}{pfMLambda?} -\calls{macLambdaParameterHandling}{pf0MLambdaArgs} -\calls{macLambdaParameterHandling}{pfLeaf} -\calls{macLambdaParameterHandling}{pfAbSynOp} -\calls{macLambdaParameterHandling}{pfLeafPosition} -\calls{macLambdaParameterHandling}{pfParts} -\calls{macLambdaParameterHandling}{macLambdaParameterHandling} -\begin{chunk}{defun 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 - (let ((pr (assoc par replist :test #'equal))) - (when pr (remove par replist :test #'equal))))) - 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)))))) - -\end{chunk} - -\defun{macSubstituteId}{macSubstituteId} -\calls{macSubstituteId}{pfIdSymbol} -\begin{chunk}{defun macSubstituteId} -(defun |macSubstituteId| (replist pform) - (let (ex) - (setq ex (assoc (|pfIdSymbol| pform) replist :test #'eq)) - (cond - (ex - (rplaca pform (cadr ex)) - (rplacd pform (cddr ex)) - pform) - (t pform)))) - -\end{chunk} - -\chapter{Pftrees} -\section{Abstract Syntax Trees Overview} - -Th functions create and examine abstract syntax trees. -These are called pforms, for short. - -The pform data structure - -\begin{itemize} -\item Leaves: [hd, tok, pos] where pos is optional -\item Trees: [hd, tree, tree, ...] -\item hd is either an id or (id . alist) -\end{itemize} - -The leaves are: - -\begin{tabular}{lcl} - char &:=& ('char expr position) \\ - Document &:=& ('Document expr position) \\ - error &:=& ('error expr position) \\ - expression &:=& ('expression expr position) \\ - float &:=& ('float expr position) \\ - id &:=& ('id expr position)\\ - idsy &:=& ('idsy expr position)\\ - integer &:=& ('integer expr position)\\ - string &:=& ('string expr position)\\ - symbol &:=& ('symbol expr position) -\end{tabular} - -The special nodes: - -\begin{tabular}{lcl} - ListOf &:=& ('listOf items)\\ - Nothing &:=& ('nothing)\\ - SemiColon &:=& ('SemiColon (Body: Expr)) -\end{tabular} - -The expression nodes: - -\begin{tabular}{lcl} - Add &:=& ('Add (Base: [Typed], Addin: Expr))\\ - And &:=& ('And left right)\\ - Application &:=& ('Application (Op: Expr, Arg: Expr))\\ - Assign &:=& ('Assign (LhsItems: [AssLhs], Rhs: Expr))\\ - Attribute &:=& ('Attribute (Expr: Primary))\\ - Break &:=& ('Break (From: ? Id))\\ - Coerceto &:=& ('Coerceto (Expr: Expr, Type: Type))\\ - Collect &:=& ('Collect (Body: Expr, Iterators: [Iterator]))\\ - ComDefinition &:=& ('ComDefinition (Doc: Document, Def: Definition))\\ - DeclPart &&\\ - Definition &:=& ('Definition (LhsItems: [Typed], Rhs: Expr))\\ - DefinitionSequence &:=& (Args: [DeclPart])\\ - Do &:=& ('Do (Body: Expr))\\ - Document &:=& ('Document strings)\\ - DWhere &:=& ('DWhere (Context: [DeclPart], Expr: [DeclPart]))\\ - EnSequence &:=&\\ - Exit &:=& ('Exit (Cond: ? Expr, Expr: ? Expr))\\ - Export &:=& ('Export (Items: [Typed]))\\ - Forin &:=& ('Forin (Lhs: [AssLhs], Whole: Expr))\\ - Free &:=& ('Free (Items: [Typed]))\\ - Fromdom &:=& ('Fromdom (What: Id, Domain: Type))\\ - Hide &:=& ('hide, arg)\\ - If &:=& ('If (Cond: Expr, Then: Expr, Else: ? Expr))\\ - Import &:=& ('Import (Items: [QualType]))\\ - Inline &:=& ('Inline (Items: [QualType]))\\ - Iterate &:=& ('Iterate (From: ? Id))\\ - Lambda &:=& ('Lambda (Args: [Typed], Rets: ReturnedTyped, Body: Expr))\\ - Literal \\ - Local &:=& ('Local (Items: [Typed]))\\ - Loop &:=& ('Loop (Iterators: [Iterator]))\\ - Macro &:=& ('Macro (Lhs: Id, Rhs: ExprorNot))\\ - MLambda &:=& ('MLambda (Args: [Id], Body: Expr))\\ - Not &:=& ('Not arg)\\ - Novalue &:=& ('Novalue (Expr: Expr))\\ - Or &:=& ('Or left right)\\ - Pretend &:=& ('Pretend (Expr: Expr, Type: Type))\\ - QualType &:=& ('QualType (Type: Type, Qual: ? Type))\\ - Restrict &:=& ('Restrict (Expr: Expr, Type: Type))\\ - Retract &:=& ('RetractTo (Expr: Expr, Type: Type))\\ - Return &:=& ('Return (Expr: ? Expr, From: ? Id))\\ - ReturnTyped &:=& ('returntyuped (type body))\\ - Rule &:=& ('Rule (lhsitems, rhsitems))\\ - Sequence &:=& ('Sequence (Args: [Expr]))\\ - Suchthat &:=& ('Suchthat (Cond: Expr))\\ - Symb &:=& if leaf then symbol else expression\\ - Tagged &:=& ('Tagged (Tag: Expr, Expr: Expr))\\ - TLambda &:=&('TLambda (Args: [Typed], \\ - &&\quad{}Rets: ReturnedTyped Type, Body: Expr))\\ - Tuple &:=& ('Tuple (Parts: [Expr]))\\ - Typed &:=& ('Typed (Id: Id, Type: ? Type))\\ - Typing &:=& ('Typing (Items: [Typed]))\\ - Until &:=& ('Until (Cond: Expr)) NOT USED\\ - WDeclare &:=& ('WDeclare (Signature: Typed, Doc: ? Document))\\ - Where &:=& ('Where (Context: [DeclPart], Expr: Expr))\\ - While &:=& ('While (Cond: Expr))\\ - With &:=& ('With (Base: [Typed], Within: [WithPart]))\\ - WIf &:=& ('WIf (Cond: Primary, Then: [WithPart], Else: [WithPart]))\\ - Wrong &:=& ('Wrong (Why: Document, Rubble: [Expr])) -\end{tabular} - -Special cases of expression nodes are: - -\begin{itemize} -\item Application. The Op parameter is one of - \verb/and, or, Y, |, {}, [], {||}, [||]/ -\item DeclPart. The comment is attached to all signatutres in - Typing, Import, Definition, Sequence, DWhere, Macro nodes -\item EnSequence. This is either a Tuple or Sequence depending on the -argument -\item Literal. One of integer symbol expression one zero char string float -of the form ('expression expr position) -\end{itemize} - -\section{Structure handlers} - -\defun{pfGlobalLinePosn}{pfGlobalLinePosn} -\calls{pfGlobalLinePosn}{poGlobalLinePosn} -\begin{chunk}{defun pfGlobalLinePosn} -(defun |pfGlobalLinePosn| (posn) - (|poGlobalLinePosn| posn)) - -\end{chunk} - -\defun{pfCharPosn}{pfCharPosn} -\calls{pfCharPosn}{poCharPosn} -\begin{chunk}{defun pfCharPosn} -(defun |pfCharPosn| (posn) - (|poCharPosn| posn)) - -\end{chunk} - -\defun{pfLinePosn}{pfLinePosn} -\calls{pfLinePosn}{poLinePosn} -\begin{chunk}{defun pfLinePosn} -(defun |pfLinePosn| (posn) - (|poLinePosn| posn)) - -\end{chunk} - -\defun{pfFileName}{pfFileName} -\calls{pfFileName}{poFileName} -\begin{chunk}{defun pfFileName} -(defun |pfFileName| (posn) - (|poFileName| posn)) - -\end{chunk} - -\defun{pfCopyWithPos}{pfCopyWithPos} -\calls{pfCopyWithPos}{pfLeaf?} -\calls{pfCopyWithPos}{pfLeaf} -\calls{pfCopyWithPos}{pfAbSynOp} -\calls{pfCopyWithPos}{tokPart} -\calls{pfCopyWithPos}{pfTree} -\calls{pfCopyWithPos}{pfParts} -\calls{pfCopyWithPos}{pfCopyWithPos} -\begin{chunk}{defun pfCopyWithPos} -(defun |pfCopyWithPos| (pform pos) - (if (|pfLeaf?| pform) - (|pfLeaf| (|pfAbSynOp| pform) (|tokPart| pform) pos) - (|pfTree| (|pfAbSynOp| pform) - (loop for p in (|pfParts| pform) - collect (|pfCopyWithPos| p pos))))) - -\end{chunk} - -\defun{pfMapParts}{pfMapParts} -\calls{pfMapParts}{pfLeaf?} -\calls{pfMapParts}{pfParts} -\calls{pfMapParts}{pfTree} -\calls{pfMapParts}{pfAbSynOp} -\begin{chunk}{defun pfMapParts} -(defun |pfMapParts| (f pform) - (let (parts1 parts0) - (if (|pfLeaf?| pform) - pform - (progn - (setq parts0 (|pfParts| pform)) - (setq parts1 (loop for p in parts0 collect (funcall f p))) - (if (reduce #'(lambda (u v) (and u v)) (mapcar #'eq parts0 parts1)) - pform - (|pfTree| (|pfAbSynOp| pform) parts1)))))) - -\end{chunk} - -\defun{pf0ApplicationArgs}{pf0ApplicationArgs} -\calls{pf0ApplicationArgs}{pf0FlattenSyntacticTuple} -\calls{pf0ApplicationArgs}{pfApplicationArg} -\begin{chunk}{defun pf0ApplicationArgs} -(defun |pf0ApplicationArgs| (pform) - (|pf0FlattenSyntacticTuple| (|pfApplicationArg| pform))) - -\end{chunk} - -\defun{pf0FlattenSyntacticTuple}{pf0FlattenSyntacticTuple} -\calls{pf0FlattenSyntacticTuple}{pfTuple?} -\calls{pf0FlattenSyntacticTuple}{pf0FlattenSyntacticTuple} -\calls{pf0FlattenSyntacticTuple}{pf0TupleParts} -\begin{chunk}{defun pf0FlattenSyntacticTuple} -(defun |pf0FlattenSyntacticTuple| (pform) - (if (null (|pfTuple?| pform)) - (list pform) - ; [:pf0FlattenSyntacticTuple p for p in pf0TupleParts pform] - ((lambda (arg0 arg1 p) - (loop - (cond - ((or (atom arg1) (progn (setq p (car arg1)) nil)) - (return (nreverse arg0))) - (t - (setq arg0 (append (reverse (|pf0FlattenSyntacticTuple| p)) arg0)))) - (setq arg1 (cdr arg1)))) - nil (|pf0TupleParts| pform) nil))) - -\end{chunk} - -\defun{pfSourcePosition}{pfSourcePosition} -\calls{pfSourcePosition}{pfLeaf?} -\calls{pfSourcePosition}{pfLeafPosition} -\calls{pfSourcePosition}{poNoPosition?} -\calls{pfSourcePosition}{pfSourcePosition} -\calls{pfSourcePosition}{pfParts} -\usesdollar{pfSourcePosition}{nopos} -\begin{chunk}{defun pfSourcePosition} -(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)))) - -\end{chunk} - -\defun{pfSequenceToList}{Convert a Sequence node to a list} -\calls{pfSequenceToList}{pfSequence?} -\calls{pfSequenceToList}{pfSequenceArgs} -\calls{pfSequenceToList}{pfListOf} -\begin{chunk}{defun pfSequenceToList} -(defun |pfSequenceToList| (x) - (if (|pfSequence?| x) - (|pfSequenceArgs| x) - (|pfListOf| (list x)))) - -\end{chunk} - -\defun{pfSpread}{pfSpread} -\calls{pfSpread}{pfTyped} -\begin{chunk}{defun pfSpread} -(defun |pfSpread| (arg1 arg2) - (mapcar #'(lambda (i) (|pfTyped| i arg2)) arg1)) - -\end{chunk} - -\defun{pfCheckItOut}{Deconstruct nodes to lists} -\calls{pfCheckItOut}{pfTagged?} -\calls{pfCheckItOut}{pfTaggedExpr} -\calls{pfCheckItOut}{pfNothing} -\calls{pfCheckItOut}{pfTaggedTag} -\calls{pfCheckItOut}{pfId?} -\calls{pfCheckItOut}{pfListOf} -\calls{pfCheckItOut}{pfTyped} -\calls{pfCheckItOut}{pfCollect1?} -\calls{pfCheckItOut}{pfCollectVariable1} -\calls{pfCheckItOut}{pfTuple?} -\calls{pfCheckItOut}{pf0TupleParts} -\calls{pfCheckItOut}{pfTaggedToTyped} -\calls{pfCheckItOut}{pfDefinition?} -\calls{pfCheckItOut}{pfApplication?} -\calls{pfCheckItOut}{pfFlattenApp} -\calls{pfCheckItOut}{pfTaggedToTyped1} -\calls{pfCheckItOut}{pfTransformArg} -\calls{pfCheckItOut}{npTrapForm} -\begin{chunk}{defun pfCheckItOut} -(defun |pfCheckItOut| (x) - (let (args op ls form rt result) - (if (|pfTagged?| x) - (setq rt (|pfTaggedExpr| x)) - (setq rt (|pfNothing|))) - (if (|pfTagged?| x) - (setq form (|pfTaggedTag| x)) - (setq form x)) - (cond - ((|pfId?| form) - (list (|pfListOf| (list (|pfTyped| form rt))) nil rt)) - ((|pfCollect1?| form) - (list (|pfListOf| (list (|pfCollectVariable1| form))) nil rt)) - ((|pfTuple?| form) - (list (|pfListOf| - (dolist (part (|pf0TupleParts| form) (nreverse result)) - (push (|pfTaggedToTyped| part) result))) - nil rt)) - ((|pfDefinition?| form) - (list (|pfListOf| (list (|pfTyped| form (|pfNothing|)))) nil rt)) - ((|pfApplication?| form) - (setq ls (|pfFlattenApp| form)) - (setq op (|pfTaggedToTyped1| (car ls))) - (setq args - (dolist (part (cdr ls) (nreverse result)) - (push (|pfTransformArg| part) result))) - (list (|pfListOf| (list op)) args rt)) - (t (|npTrapForm| form))))) - -\end{chunk} - -\defun{pfCheckMacroOut}{pfCheckMacroOut} -\calls{pfCheckMacroOut}{pfId?} -\calls{pfCheckMacroOut}{pfApplication?} -\calls{pfCheckMacroOut}{pfFlattenApp} -\calls{pfCheckMacroOut}{pfCheckId} -\calls{pfCheckMacroOut}{pfCheckArg} -\calls{pfCheckMacroOut}{npTrapForm} -\begin{chunk}{defun pfCheckMacroOut} -(defun |pfCheckMacroOut| (form) - (let (args op ls) - (cond - ((|pfId?| form) (list form nil)) - ((|pfApplication?| form) - (setq ls (|pfFlattenApp| form)) - (setq op (|pfCheckId| (car ls))) - (setq args (mapcar #'|pfCheckArg| (cdr ls))) - (list op args)) - (t (|npTrapForm| form))))) - -\end{chunk} - -\defun{pfCheckArg}{pfCheckArg} -\calls{pfCheckArg}{pfTuple?} -\calls{pfCheckArg}{pf0TupleParts} -\calls{pfCheckArg}{pfListOf} -\calls{pfCheckArg}{pfCheckId} -\begin{chunk}{defun pfCheckArg} -(defun |pfCheckArg| (args) - (let (argl) - (if (|pfTuple?| args) - (setq argl (|pf0TupleParts| args)) - (setq argl (list args))) - (|pfListOf| (mapcar #'|pfCheckId| argl)))) - -\end{chunk} - -\defun{pfCheckId}{pfCheckId} -\calls{pfCheckId}{pfId?} -\calls{pfCheckId}{npTrapForm} -\begin{chunk}{defun pfCheckId} -(defun |pfCheckId| (form) - (if (null (|pfId?| form)) - (|npTrapForm| form) - form)) - -\end{chunk} - -\defun{pfFlattenApp}{pfFlattenApp} -\calls{pfFlattenApp}{pfApplication?} -\calls{pfFlattenApp}{pfCollect1?} -\calls{pfFlattenApp}{pfFlattenApp} -\calls{pfFlattenApp}{pfApplicationOp} -\calls{pfFlattenApp}{pfApplicationArg} -\begin{chunk}{defun pfFlattenApp} -(defun |pfFlattenApp| (x) - (cond - ((|pfApplication?| x) - (cond - ((|pfCollect1?| x) (LIST x)) - (t - (append (|pfFlattenApp| (|pfApplicationOp| x)) - (|pfFlattenApp| (|pfApplicationArg| x)))))) - (t (list x)))) - -\end{chunk} - -\defun{pfCollect1?}{pfCollect1?} -\calls{pfCollect1?}{pfApplication?} -\calls{pfCollect1?}{pfApplicationOp} -\calls{pfCollect1?}{pfId?} -\calls{pfCollect1?}{pfIdSymbol} -\begin{chunk}{defun pfCollect1?} -(defun |pfCollect1?| (x) - (let (a) - (when (|pfApplication?| x) - (setq a (|pfApplicationOp| x)) - (when (|pfId?| a) (eq (|pfIdSymbol| a) '|\||))))) - -\end{chunk} - -\defun{pfCollectVariable1}{pfCollectVariable1} -\calls{pfCollectVariable1}{pfApplicationArg} -\calls{pfCollectVariable1}{pf0TupleParts} -\calls{pfCollectVariable1}{pfTaggedToTyped} -\calls{pfCollectVariable1}{pfTyped} -\calls{pfCollectVariable1}{pfSuch} -\calls{pfCollectVariable1}{pfTypedId} -\calls{pfCollectVariable1}{pfTypedType} -\begin{chunk}{defun pfCollectVariable1} -(defun |pfCollectVariable1| (x) - (let (id var a) - (setq a (|pfApplicationArg| x)) - (setq var (car (|pf0TupleParts| a))) - (setq id (|pfTaggedToTyped| var)) - (|pfTyped| - (|pfSuch| (|pfTypedId| id) (cadr (|pf0TupleParts| a))) - (|pfTypedType| id)))) - -\end{chunk} - -\defun{pfPushMacroBody}{pfPushMacroBody} -\calls{pfPushMacroBody}{pfMLambda} -\calls{pfPushMacroBody}{pfPushMacroBody} -\begin{chunk}{defun pfPushMacroBody} -(defun |pfPushMacroBody| (args body) - (if (null args) - body - (|pfMLambda| (car args) (|pfPushMacroBody| (cdr args) body)))) - -\end{chunk} - -\defun{pfSourceStok}{pfSourceStok} -\calls{pfSourceStok}{pfLeaf?} -\calls{pfSourceStok}{pfParts} -\calls{pfSourceStok}{pfSourceStok} -\calls{pfSourceStok}{pfFirst} -\begin{chunk}{defun pfSourceStok} -(defun |pfSourceStok| (x) - (cond - ((|pfLeaf?| x) x) - ((null (|pfParts| x)) '|NoToken|) - (t (|pfSourceStok| (|pfFirst| x))))) - -\end{chunk} - -\defun{pfTransformArg}{pfTransformArg} -\calls{pfTransformArg}{pfTuple?} -\calls{pfTransformArg}{pf0TupleParts} -\calls{pfTransformArg}{pfListOf} -\calls{pfTransformArg}{pfTaggedToTyped1} -\begin{chunk}{defun pfTransformArg} -(defun |pfTransformArg| (args) - (let (arglist result) - (if (|pfTuple?| args) - (setq arglist (|pf0TupleParts| args)) - (setq arglist (list args))) - (|pfListOf| - (dolist (|i| arglist (nreverse result)) - (push (|pfTaggedToTyped1| |i|) result))))) - -\end{chunk} - -\defun{pfTaggedToTyped1}{pfTaggedToTyped1} -\calls{pfTaggedToTyped1}{pfCollect1?} -\calls{pfTaggedToTyped1}{pfCollectVariable1} -\calls{pfTaggedToTyped1}{pfDefinition?} -\calls{pfTaggedToTyped1}{pfTyped} -\calls{pfTaggedToTyped1}{pfNothing} -\calls{pfTaggedToTyped1}{pfTaggedToTyped} -\begin{chunk}{defun pfTaggedToTyped1} -(defun |pfTaggedToTyped1| (arg) - (cond - ((|pfCollect1?| arg) (|pfCollectVariable1| arg)) - ((|pfDefinition?| arg) (|pfTyped| arg (|pfNothing|))) - (t (|pfTaggedToTyped| arg)))) - -\end{chunk} - -\defun{pfSuch}{pfSuch} -\calls{pfSuch}{pfInfApplication} -\calls{pfSuch}{pfId} -\begin{chunk}{defun pfSuch} -(defun |pfSuch| (x y) - (|pfInfApplication| (|pfId| '|\||) x y)) - -\end{chunk} - -\section{Special Nodes} - -\defun{pfListOf}{Create a Listof node} -\calls{pfListOf}{pfTree} -\begin{chunk}{defun pfListOf} -(defun |pfListOf| (x) - (|pfTree| '|listOf| x)) - -\end{chunk} - -\defun{pfNothing}{pfNothing} -\calls{pfNothing}{pfTree} -\begin{chunk}{defun pfNothing} -(defun |pfNothing| () - (|pfTree| '|nothing| nil)) - -\end{chunk} - -\defun{pfNothing?}{Is this a Nothing node?} -\calls{pfNothing?}{pfAbSynOp?} -\begin{chunk}{defun pfNothing?} -(defun |pfNothing?| (form) - (|pfAbSynOp?| form '|nothing|)) - -\end{chunk} - -\section{Leaves} - -\defun{pfDocument}{Create a Document node} -\calls{pfDocument}{pfLeaf} -\begin{chunk}{defun pfDocument} -(defun |pfDocument| (strings) - (|pfLeaf| '|Document| strings)) - -\end{chunk} - -\defun{pfId}{Construct an Id node} -\calls{pfId}{pfLeaf} -\begin{chunk}{defun pfId} -(defun |pfId| (expr) - (|pfLeaf| '|id| expr)) - -\end{chunk} - -\defun{pfId?}{Is this an Id node?} -\calls{pfId?}{pfAbSynOp?} -\begin{chunk}{defun pfId?} -(defun |pfId?| (form) - (or (|pfAbSynOp?| form '|id|) (|pfAbSynOp?| form '|idsy|))) - -\end{chunk} - -\defun{pfIdPos}{Construct an Id leaf node} -\calls{pfIdPos}{pfLeaf} -\begin{chunk}{defun pfIdPos} -(defun |pfIdPos| (expr pos) - (|pfLeaf| '|id| expr pos)) - -\end{chunk} - -\defun{pfIdSymbol}{Return the Id part} -\calls{pfIdSymbol}{tokPart} -\begin{chunk}{defun pfIdSymbol} -(defun |pfIdSymbol| (form) - (|tokPart| form)) - -\end{chunk} - -\defun{pfLeaf}{Construct a Leaf node} -\calls{pfLeaf}{tokConstruct} -\calls{pfLeaf}{ifcar} -\calls{pfLeaf}{pfNoPosition} -\begin{chunk}{defun pfLeaf} -(defun |pfLeaf| (x y &rest z) - (|tokConstruct| x y (or (ifcar z) (|pfNoPosition|)))) - -\end{chunk} - -\defun{pfLeaf?}{Is this a leaf node?} -\calls{pfLeaf?}{pfAbSynOp} -\begin{chunk}{defun pfLeaf?} -(defun |pfLeaf?| (form) - (member (|pfAbSynOp| form) - '(|id| |idsy| |symbol| |string| |char| |float| |expression| - |integer| |Document| |error|))) - -\end{chunk} - -\defun{pfLeafPosition}{Return the token position of a leaf node} -\calls{pfLeafPosition}{tokPosn} -\begin{chunk}{defun pfLeafPosition} -(defun |pfLeafPosition| (form) - (|tokPosn| form)) - -\end{chunk} - -\defun{pfLeafToken}{Return the Leaf Token} -\calls{pfLeafToken}{tokPart} -\begin{chunk}{defun pfLeafToken} -(defun |pfLeafToken| (form) - (|tokPart| form)) - -\end{chunk} - -\defun{pfLiteral?}{Is this a Literal node?} -\calls{pfLiteral?}{pfAbSynOp} -\begin{chunk}{defun pfLiteral? 0} -(defun |pfLiteral?| (form) - (member (|pfAbSynOp| form) - '(|integer| |symbol| |expression| |one| |zero| |char| |string| |float|))) - -\end{chunk} - -\defun{pfLiteralClass}{Create a LiteralClass node} -\calls{pfLiteralClass}{pfAbSynOp} -\begin{chunk}{defun pfLiteralClass} -(defun |pfLiteralClass| (form) - (|pfAbSynOp| form)) - -\end{chunk} - -\defun{pfLiteralString}{Return the LiteralString} -\calls{pfLiteralString}{tokPart} -\begin{chunk}{defun pfLiteralString} -(defun |pfLiteralString| (form) - (|tokPart| form)) - -\end{chunk} - -\defun{pfParts}{Return the parts of a tree node} -\begin{chunk}{defun pfParts 0} -(defun |pfParts| (form) - (cdr form)) - -\end{chunk} - -\defun{pfPile}{Return the argument unchanged} -\begin{chunk}{defun pfPile 0} -(defun |pfPile| (part) - part) - -\end{chunk} - -\defun{pfPushBody}{pfPushBody} -\calls{pfPushBody}{pfLambda} -\calls{pfPushBody}{pfNothing} -\calls{pfPushBody}{pfPushBody} -\begin{chunk}{defun pfPushBody} -(defun |pfPushBody| (rt args body) - (cond - ((null args) body) - ((null (cdr args)) (|pfLambda| (car args) rt body)) - (t - (|pfLambda| (car args) (|pfNothing|) - (|pfPushBody| rt (cdr args) body))))) - -\end{chunk} - -\defun{pfSexpr}{An S-expression which people can read.} -\calls{pfSexpr}{pfSexpr,strip} -\begin{chunk}{defun pfSexpr} -(defun |pfSexpr| (pform) - (|pfSexpr,strip| pform)) - -\end{chunk} - -\defun{pfSexpr,strip}{Create a human readable S-expression} -\calls{pfSexpr,strip}{pfId?} -\calls{pfSexpr,strip}{pfIdSymbol} -\calls{pfSexpr,strip}{pfLiteral?} -\calls{pfSexpr,strip}{pfLiteralString} -\calls{pfSexpr,strip}{pfLeaf?} -\calls{pfSexpr,strip}{tokPart} -\calls{pfSexpr,strip}{pfApplication?} -\calls{pfSexpr,strip}{pfApplicationArg} -\calls{pfSexpr,strip}{pfTuple?} -\calls{pfSexpr,strip}{pf0TupleParts} -\calls{pfSexpr,strip}{pfApplicationOp} -\calls{pfSexpr,strip}{pfSexpr,strip} -\calls{pfSexpr,strip}{pfAbSynOp} -\calls{pfSexpr,strip}{pfParts} -\begin{chunk}{defun pfSexpr,strip} -(defun |pfSexpr,strip| (pform) - (let (args a result) - (cond - ((|pfId?| pform) (|pfIdSymbol| pform)) - ((|pfLiteral?| pform) (|pfLiteralString| pform)) - ((|pfLeaf?| pform) (|tokPart| pform)) - ((|pfApplication?| pform) - (setq a (|pfApplicationArg| pform)) - (if (|pfTuple?| a) - (setq args (|pf0TupleParts| a)) - (setq args (list a))) - (dolist (p (cons (|pfApplicationOp| pform) args) (nreverse result)) - (push (|pfSexpr,strip| p) result))) - (t - (cons (|pfAbSynOp| pform) - (dolist (p (|pfParts| pform) (nreverse result)) - (push (|pfSexpr,strip| p) result))))))) - -\end{chunk} - -\defun{pfSymb}{Construct a Symbol or Expression node} -\calls{pfSymb}{pfLeaf?} -\calls{pfSymb}{pfSymbol} -\calls{pfSymb}{tokPart} -\calls{pfSymb}{ifcar} -\calls{pfSymb}{pfExpression} -\calls{pfSymb}{pfSexpr} -\begin{chunk}{defun pfSymb} -(defun |pfSymb| (expr &REST optpos) - (if (|pfLeaf?| expr) - (|pfSymbol| (|tokPart| expr) (ifcar optpos)) - (|pfExpression| (|pfSexpr| expr) (ifcar optpos)))) - -\end{chunk} - -\defun{pfSymbol}{Construct a Symbol leaf node} -\calls{pfSymbol}{pfLeaf} -\calls{pfSymbol}{ifcar} -\begin{chunk}{defun pfSymbol} -(defun |pfSymbol| (expr &rest optpos) - (|pfLeaf| '|symbol| expr (ifcar optpos))) - -\end{chunk} - -\defun{pfSymbol?}{Is this a Symbol node?} -\calls{pfSymbol?}{pfAbSynOp?} -\begin{chunk}{defun pfSymbol?} -(defun |pfSymbol?| (form) - (|pfAbSynOp?| form '|symbol|)) - -\end{chunk} - -\defun{pfSymbolSymbol}{Return the Symbol part} -\calls{pfSymbolSymbol}{tokPart} -\begin{chunk}{defun pfSymbolSymbol} -(defun |pfSymbolSymbol| (form) - (|tokPart| form)) - -\end{chunk} - -\section{Trees} - -\defun{pfTree}{Construct a tree node} -\begin{chunk}{defun pfTree 0} -(defun |pfTree| (x y) - (cons x y)) - -\end{chunk} - -\defun{pfAdd}{Construct an Add node} -\calls{pfAdd}{pfNothing} -\calls{pfAdd}{pfTree} -\begin{chunk}{defun pfAdd} -(defun |pfAdd| (pfbase pfaddin &rest addon) - (let (lhs) - (if addon - (setq lhs addon) - (setq lhs (|pfNothing|))) - (|pfTree| '|Add| (list pfbase pfaddin lhs)))) - -\end{chunk} - -\defun{pfAnd}{Construct an And node} -\calls{pfAnd}{pfTree} -\begin{chunk}{defun pfAnd} -(defun |pfAnd| (pfleft pfright) - (|pfTree| '|And| (list pfleft pfright))) - -\end{chunk} - -\defun{pfAttribute}{pfAttribute} -\calls{pfAttribute}{pfTree} -\begin{chunk}{defun pfAttribute} -(defun |pfAttribute| (pfexpr) - (|pfTree| '|Attribute| (list pfexpr))) - -\end{chunk} - -\defun{pfApplication}{Return an Application node} -\calls{pfApplication}{pfTree} -\begin{chunk}{defun pfApplication} -(defun |pfApplication| (pfop pfarg) - (|pfTree| '|Application| (list pfop pfarg))) - -\end{chunk} - -\defun{pfApplicationArg}{Return the Arg part of an Application node} -\begin{chunk}{defun pfApplicationArg 0} -(defun |pfApplicationArg| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfApplicationOp}{Return the Op part of an Application node} -\begin{chunk}{defun pfApplicationOp 0} -(defun |pfApplicationOp| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfAnd?}{Is this an And node?} -\calls{pfAnd?}{pfAbSynOp?} -\begin{chunk}{defun pfAnd?} -(defun |pfAnd?| (pf) - (|pfAbSynOp?| pf '|And|)) - -\end{chunk} - -\defun{pfAndLeft}{Return the Left part of an And node} -\begin{chunk}{defun pfAndLeft 0} -(defun |pfAndLeft| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfAndRight}{Return the Right part of an And node} -\begin{chunk}{defun pfAndRight 0} -(defun |pfAndRight| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfAppend}{Flatten a list of lists} -\begin{chunk}{defun pfAppend 0} -(defun |pfAppend| (list) - (apply #'append list)) - -\end{chunk} - -\defun{pfApplication?}{Is this an Application node?} -\calls{pfApplication?}{pfAbSynOp?} -\begin{chunk}{defun pfApplication?} -(defun |pfApplication?| (pf) - (|pfAbSynOp?| pf '|Application|)) - -\end{chunk} - -\defun{pfAssign}{Create an Assign node} -\calls{pfAssign}{pfTree} -\begin{chunk}{defun pfAssign} -(defun |pfAssign| (pflhsitems pfrhs) - (|pfTree| '|Assign| (list pflhsitems pfrhs))) - -\end{chunk} - -\defun{pfAssign?}{Is this an Assign node?} -\calls{pfAssign?}{pfAbSynOp?} -\begin{chunk}{defun pfAssign?} -(defun |pfAssign?| (pf) - (|pfAbSynOp?| pf '|Assign|)) - -\end{chunk} - -\defun{pf0AssignLhsItems}{Return the parts of an LhsItem of an Assign node} -\calls{pf0AssignLhsItems}{pfParts} -\calls{pf0AssignLhsItems}{pfAssignLhsItems} -\begin{chunk}{defun pf0AssignLhsItems 0} -(defun |pf0AssignLhsItems| (pf) - (|pfParts| (|pfAssignLhsItems| pf))) - -\end{chunk} - -\defun{pfAssignLhsItems}{Return the LhsItem of an Assign node} -\begin{chunk}{defun pfAssignLhsItems 0} -(defun |pfAssignLhsItems| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfAssignRhs}{Return the RHS of an Assign node} -\begin{chunk}{defun pfAssignRhs 0} -(defun |pfAssignRhs| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfBrace}{Construct an application node for a brace} -\calls{pfBrace}{pfApplication} -\calls{pfBrace}{pfIdPos} -\calls{pfBrace}{tokPosn} -\begin{chunk}{defun pfBrace} -(defun |pfBrace| (a part) - (|pfApplication| (|pfIdPos| '{} (|tokPosn| a)) part)) - -\end{chunk} - -\defun{pfBraceBar}{Construct an Application node for brace-bars} -\calls{pfBraceBar}{pfApplication} -\calls{pfBraceBar}{pfIdPos} -\calls{pfBraceBar}{tokPosn} -\begin{chunk}{defun pfBraceBar} -(defun |pfBraceBar| (a part) - (|pfApplication| (|pfIdPos| '|{\|\|}| (|tokPosn| a)) part)) - -\end{chunk} - -\defun{pfBracket}{Construct an Application node for a bracket} -\calls{pfBracket}{pfApplication} -\calls{pfBracket}{pfIdPos} -\calls{pfBracket}{tokPosn} -\begin{chunk}{defun pfBracket} -(defun |pfBracket| (a part) - (|pfApplication| (|pfIdPos| '[] (|tokPosn| a)) part)) - -\end{chunk} - -\defun{pfBracketBar}{Construct an Application node for bracket-bars} -\calls{pfBracketBar}{pfApplication} -\calls{pfBracketBar}{pfIdPos} -\calls{pfBracketBar}{tokPosn} -\begin{chunk}{defun pfBracketBar} -(defun |pfBracketBar| (a part) - (|pfApplication| (|pfIdPos| '|[\|\|]| (|tokPosn| a)) part)) - -\end{chunk} - -\defun{pfBreak}{Create a Break node} -\calls{pfBreak}{pfTree} -\begin{chunk}{defun pfBreak} -(defun |pfBreak| (pffrom) - (|pfTree| '|Break| (list pffrom))) - -\end{chunk} - -\defun{pfBreak?}{Is this a Break node?} -\calls{pfBreak?}{pfAbSynOp?} -\begin{chunk}{defun pfBreak?} -(defun |pfBreak?| (pf) - (|pfAbSynOp?| pf '|Break|)) - -\end{chunk} - -\defun{pfBreakFrom}{Return the From part of a Break node} -\begin{chunk}{defun pfBreakFrom 0} -(defun |pfBreakFrom| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfCoerceto}{Construct a Coerceto node} -\calls{pfCoerceto}{pfTree} -\begin{chunk}{defun pfCoerceto} -(defun |pfCoerceto| (pfexpr pftype) - (|pfTree| '|Coerceto| (list pfexpr pftype))) - -\end{chunk} - -\defun{pfCoerceto?}{Is this a CoerceTo node?} -\calls{pfCoerceto?}{pfAbSynOp?} -\begin{chunk}{defun pfCoerceto?} -(defun |pfCoerceto?| (pf) - (|pfAbSynOp?| pf '|Coerceto|)) - -\end{chunk} - -\defun{pfCoercetoExpr}{Return the Expression part of a CoerceTo node} -\begin{chunk}{defun pfCoercetoExpr 0} -(defun |pfCoercetoExpr| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfCoercetoType}{Return the Type part of a CoerceTo node} -\begin{chunk}{defun pfCoercetoType 0} -(defun |pfCoercetoType| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfCollectBody}{Return the Body of a Collect node} -\begin{chunk}{defun pfCollectBody 0} -(defun |pfCollectBody| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfCollectIterators}{Return the Iterators of a Collect node} -\begin{chunk}{defun pfCollectIterators 0} -(defun |pfCollectIterators| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfCollect}{Create a Collect node} -\calls{pfCollect}{pfTree} -\begin{chunk}{defun pfCollect} -(defun |pfCollect| (pfbody pfiterators) - (|pfTree| '|Collect| (list pfbody pfiterators))) - -\end{chunk} - -\defun{pfCollect?}{Is this a Collect node?} -\calls{pfCollect?}{pfAbSynOp?} -\begin{chunk}{defun pfCollect?} -(defun |pfCollect?| (pf) - (|pfAbSynOp?| pf '|Collect|)) - -\end{chunk} - -\defun{pfDefinition}{pfDefinition} -\calls{pfDefinition}{pfTree} -\begin{chunk}{defun pfDefinition} -(defun |pfDefinition| (pflhsitems pfrhs) - (|pfTree| '|Definition| (list pflhsitems pfrhs))) - -\end{chunk} - -\defun{pfDefinitionLhsItems}{Return the Lhs of a Definition node} -\begin{chunk}{defun pfDefinitionLhsItems 0} -(defun |pfDefinitionLhsItems| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfDefinitionRhs}{Return the Rhs of a Definition node} -\begin{chunk}{defun pfDefinitionRhs 0} -(defun |pfDefinitionRhs| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfDefinition?}{Is this a Definition node?} -\calls{pfDefinition?}{pfAbSynOp?} -\begin{chunk}{defun pfDefinition?} -(defun |pfDefinition?| (pf) - (|pfAbSynOp?| pf '|Definition|)) - -\end{chunk} - -\defun{pf0DefinitionLhsItems}{Return the parts of a Definition node} -\calls{pf0DefinitionLhsItems}{pfParts} -\calls{pf0DefinitionLhsItems}{pfDefinitionLhsItems} -\begin{chunk}{defun pf0DefinitionLhsItems} -(defun |pf0DefinitionLhsItems| (pf) - (|pfParts| (|pfDefinitionLhsItems| pf))) - -\end{chunk} - -\defun{pfDo}{Create a Do node} -\calls{pfDo}{pfTree} -\begin{chunk}{defun pfDo} -(defun |pfDo| (pfbody) - (|pfTree| '|Do| (list pfbody))) - -\end{chunk} - -\defun{pfDo?}{Is this a Do node?} -\calls{pfDo?}{pfAbSynOp?} -\begin{chunk}{defun pfDo?} -(defun |pfDo?| (pf) - (|pfAbSynOp?| pf '|Do|)) - -\end{chunk} - -\defun{pfDoBody}{Return the Body of a Do node} -\begin{chunk}{defun pfDoBody 0} -(defun |pfDoBody| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfEnSequence}{Construct a Sequence node} -\calls{pfEnSequence}{pfTuple} -\calls{pfEnSequence}{pfListOf} -\calls{pfEnSequence}{pfSequence} -\begin{chunk}{defun pfEnSequence} -(defun |pfEnSequence| (a) - (cond - ((null a) (|pfTuple| (|pfListOf| a))) - ((null (cdr a)) (car a)) - (t (|pfSequence| (|pfListOf| a))))) - -\end{chunk} - -\defun{pfExit}{Construct an Exit node} -\calls{pfExit}{pfTree} -\begin{chunk}{defun pfExit} -(defun |pfExit| (pfcond pfexpr) - (|pfTree| '|Exit| (list pfcond pfexpr))) - -\end{chunk} - -\defun{pfExit?}{Is this an Exit node?} -\calls{pfExit?}{pfAbSynOp?} -\begin{chunk}{defun pfExit?} -(defun |pfExit?| (pf) - (|pfAbSynOp?| pf '|Exit|)) - -\end{chunk} - -\defun{pfExitCond}{Return the Cond part of an Exit} -\begin{chunk}{defun pfExitCond 0} -(defun |pfExitCond| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfExitExpr}{Return the Expression part of an Exit} -\begin{chunk}{defun pfExitExpr 0} -(defun |pfExitExpr| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfExport}{Create an Export node} -\calls{pfExport}{pfTree} -\begin{chunk}{defun pfExport} -(defun |pfExport| (pfitems) - (|pfTree| '|Export| (list pfitems))) - -\end{chunk} - -\defun{pfExpression}{Construct an Expression leaf node} -\calls{pfExpression}{pfLeaf} -\calls{pfExpression}{ifcar} -\begin{chunk}{defun pfExpression} -(defun |pfExpression| (expr &rest optpos) - (|pfLeaf| '|expression| expr (ifcar optpos))) - -\end{chunk} - -\defun{pfFirst}{pfFirst} -\begin{chunk}{defun pfFirst 0} -(defun |pfFirst| (form) - (cadr form)) - -\end{chunk} - -\defun{pfFix}{Create an Application Fix node} -\calls{pfFix}{pfApplication} -\calls{pfFix}{pfId} -\begin{chunk}{defun pfFix} -(defun |pfFix| (pf) - (|pfApplication| (|pfId| 'Y) pf)) - -\end{chunk} - -\defun{pfFree}{Create a Free node} -\calls{pfFree}{pfTree} -\begin{chunk}{defun pfFree} -(defun |pfFree| (pfitems) - (|pfTree| '|Free| (list pfitems))) - -\end{chunk} - -\defun{pfFree?}{Is this a Free node?} -\calls{pfFree?}{pfAbSynOp?} -\begin{chunk}{defun pfFree?} -(defun |pfFree?| (pf) - (|pfAbSynOp?| pf '|Free|)) - -\end{chunk} - -\defun{pf0FreeItems}{Return the parts of the Items of a Free node} -\calls{pf0FreeItems}{pfParts} -\calls{pf0FreeItems}{pfFreeItems} -\begin{chunk}{defun pf0FreeItems} -(defun |pf0FreeItems| (pf) - (|pfParts| (|pfFreeItems| pf))) - -\end{chunk} - -\defun{pfFreeItems}{Return the Items of a Free node} -\begin{chunk}{defun pfFreeItems 0} -(defun |pfFreeItems| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfForin}{Construct a Forin node} -\calls{pfForin}{pfTree} -\begin{chunk}{defun pfForin} -(defun |pfForin| (pflhs pfwhole) - (|pfTree| '|Forin| (list pflhs pfwhole))) - -\end{chunk} - -\defun{pfForin?}{Is this a ForIn node?} -\calls{pfForin?}{pfAbSynOp?} -\begin{chunk}{defun pfForin?} -(defun |pfForin?| (pf) - (|pfAbSynOp?| pf '|Forin|)) - -\end{chunk} - -\defun{pf0ForinLhs}{Return all the parts of the LHS of a ForIn node} -\calls{pf0ForinLhs}{pfParts} -\calls{pf0ForinLhs}{pfForinLhs} -\begin{chunk}{defun pf0ForinLhs} -(defun |pf0ForinLhs| (pf) - (|pfParts| (|pfForinLhs| pf))) - -\end{chunk} - -\defun{pfForinLhs}{Return the LHS part of a ForIn node} -\begin{chunk}{defun pfForinLhs 0} -(defun |pfForinLhs| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfForinWhole}{Return the Whole part of a ForIn node} -\begin{chunk}{defun pfForinWhole 0} -(defun |pfForinWhole| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfFromDom}{pfFromDom} -\calls{pfFromDom}{pfApplication?} -\calls{pfFromDom}{pfApplication} -\calls{pfFromDom}{pfApplicationOp} -\calls{pfFromDom}{pfApplicationArg} -\calls{pfFromDom}{pfFromdom} -\begin{chunk}{defun pfFromDom} -(defun |pfFromDom| (dom expr) - (cond - ((|pfApplication?| expr) - (|pfApplication| - (|pfFromdom| (|pfApplicationOp| expr) dom) - (|pfApplicationArg| expr))) - (t (|pfFromdom| expr dom)))) - -\end{chunk} - -\defun{pfFromdom}{Construct a Fromdom node} -\calls{pfFromdom}{pfTree} -\begin{chunk}{defun pfFromdom} -(defun |pfFromdom| (pfwhat pfdomain) - (|pfTree| '|Fromdom| (list pfwhat pfdomain))) - -\end{chunk} - -\defun{pfFromdom?}{Is this a Fromdom mode?} -\calls{pfFromdom?}{pfAbSynOp?} -\begin{chunk}{defun pfFromdom?} -(defun |pfFromdom?| (pf) - (|pfAbSynOp?| pf '|Fromdom|)) - -\end{chunk} - -\defun{pfFromdomWhat}{Return the What part of a Fromdom node} -\begin{chunk}{defun pfFromdomWhat 0} -(defun |pfFromdomWhat| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfFromdomDomain}{Return the Domain part of a Fromdom node} -\begin{chunk}{defun pfFromdomDomain 0} -(defun |pfFromdomDomain| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfHide}{Construct a Hide node} -\calls{pfHide}{pfTree} -\begin{chunk}{defun pfHide} -(defun |pfHide| (a part) - (declare (ignore a)) - (|pfTree| '|Hide| (list part))) - -\end{chunk} - -\defun{pfIf}{pfIf} -\calls{pfIf}{pfTree} -\begin{chunk}{defun pfIf} -(defun |pfIf| (pfcond pfthen pfelse) - (|pfTree| '|If| (list pfcond pfthen pfelse))) - -\end{chunk} - -\defun{pfIf?}{Is this an If node?} -\calls{pfIf?}{pfAbSynOp?} -\begin{chunk}{defun pfIf?} -(defun |pfIf?| (pf) - (|pfAbSynOp?| pf '|If|)) - -\end{chunk} - -\defun{pfIfCond}{Return the Cond part of an If} -\begin{chunk}{defun pfIfCond 0} -(defun |pfIfCond| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfIfThen}{Return the Then part of an If} -\begin{chunk}{defun pfIfThen 0} -(defun |pfIfThen| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfIfThenOnly}{pfIfThenOnly} -\calls{pfIfThenOnly}{pfIf} -\calls{pfIfThenOnly}{pfNothing} -\begin{chunk}{defun pfIfThenOnly} -(defun |pfIfThenOnly| (pred cararg) - (|pfIf| pred cararg (|pfNothing|))) - -\end{chunk} - -\defun{pfIfElse}{Return the Else part of an If} -\begin{chunk}{defun pfIfElse 0} -(defun |pfIfElse| (pf) - (cadddr pf)) - -\end{chunk} - -\defun{pfImport}{Construct an Import node} -\calls{pfImport}{pfTree} -\begin{chunk}{defun pfImport} -(defun |pfImport| (pfitems) - (|pfTree| '|Import| (list pfitems))) - -\end{chunk} - -\defun{pfIterate}{Construct an Iterate node} -\calls{pfIterate}{pfTree} -\begin{chunk}{defun pfIterate} -(defun |pfIterate| (pffrom) - (|pfTree| '|Iterate| (list pffrom))) - -\end{chunk} - -\defun{pfIterate?}{Is this an Iterate node?} -\calls{pfIterate?}{pfAbSynOp?} -\begin{chunk}{defun pfIterate?} -(defun |pfIterate?| (pf) - (|pfAbSynOp?| pf '|Iterate|)) - -\end{chunk} - -\defun{pfInfApplication}{Handle an infix application} -\calls{pfInfApplication}{pfListOf} -\calls{pfInfApplication}{pfIdSymbol} -\calls{pfInfApplication}{pfAnd} -\calls{pfInfApplication}{pfOr} -\calls{pfInfApplication}{pfApplication} -\calls{pfInfApplication}{pfTuple} -\begin{chunk}{defun pfInfApplication} -(defun |pfInfApplication| (op left right) - (cond - ((eq (|pfIdSymbol| op) '|and|) (|pfAnd| left right)) - ((eq (|pfIdSymbol| op) '|or|) (|pfOr| left right)) - (t (|pfApplication| op (|pfTuple| (|pfListOf| (list left right))))))) - -\end{chunk} - -\defun{pfInline}{Create an Inline node} -\calls{pfInline}{pfTree} -\begin{chunk}{defun pfInline} -(defun |pfInline| (pfitems) - (|pfTree| '|Inline| (list pfitems))) - -\end{chunk} - -\defun{pfLam}{pfLam} -\calls{pfLam}{pfAbSynOp?} -\calls{pfLam}{pfFirst} -\calls{pfLam}{pfNothing} -\calls{pfLam}{pfSecond} -\calls{pfLam}{pfLambda} -\begin{chunk}{defun pfLam} -(defun |pfLam| (variable body) - (let (bdy rets) - (if (|pfAbSynOp?| body '|returntyped|) - (setq rets (|pfFirst| body)) - (setq rets (|pfNothing|))) - (if (|pfAbSynOp?| body '|returntyped|) - (setq bdy (|pfSecond| body)) - (setq bdy body)) - (|pfLambda| variable rets bdy))) - -\end{chunk} - -\defun{pfLambda}{pfLambda} -\calls{pfLambda}{pfTree} -\begin{chunk}{defun pfLambda} -(defun |pfLambda| (pfargs pfrets pfbody) - (|pfTree| '|Lambda| (list pfargs pfrets pfbody))) - -\end{chunk} - -\defun{pfLambdaBody}{Return the Body part of a Lambda node} -\begin{chunk}{defun pfLambdaBody 0} -(defun |pfLambdaBody| (pf) - (cadddr pf)) - -\end{chunk} - -\defun{pfLambdaRets}{Return the Rets part of a Lambda node} -\begin{chunk}{defun pfLambdaRets 0} -(defun |pfLambdaRets| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfLambda?}{Is this a Lambda node?} -\calls{pfLambda?}{pfAbSynOp?} -\begin{chunk}{defun pfLambda?} -(defun |pfLambda?| (pf) - (|pfAbSynOp?| pf '|Lambda|)) - -\end{chunk} - -\defun{pfLambdaArgs}{Return the Args part of a Lambda node} -\begin{chunk}{defun pfLambdaArgs 0} -(defun |pfLambdaArgs| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pf0LambdaArgs}{Return the Args of a Lambda Node} -\calls{pf0LambdaArgs}{pfParts} -\calls{pf0LambdaArgs}{pfLambdaArgs} -\begin{chunk}{defun pf0LambdaArgs} -(defun |pf0LambdaArgs| (pf) - (|pfParts| (|pfLambdaArgs| pf))) - -\end{chunk} - -\defun{pfLocal}{Construct a Local node} -\calls{pfLocal}{pfTree} -\begin{chunk}{defun pfLocal} -(defun |pfLocal| (pfitems) - (|pfTree| '|Local| (list pfitems))) - -\end{chunk} - -\defun{pfLocal?}{Is this a Local node?} -\calls{pfLocal?}{pfAbSynOp?} -\begin{chunk}{defun pfLocal?} -(defun |pfLocal?| (pf) - (|pfAbSynOp?| pf '|Local|)) - -\end{chunk} - -\defun{pf0LocalItems}{Return the parts of Items of a Local node} -\calls{pf0LocalItems}{pfParts} -\calls{pf0LocalItems}{pfLocalItems} -\begin{chunk}{defun pf0LocalItems} -(defun |pf0LocalItems| (pf) - (|pfParts| (|pfLocalItems| pf))) - -\end{chunk} - -\defun{pfLocalItems}{Return the Items of a Local node} -\begin{chunk}{defun pfLocalItems 0} -(defun |pfLocalItems| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfLoop}{Construct a Loop node} -\calls{pfLoop}{pfTree} -\begin{chunk}{defun pfLoop} -(defun |pfLoop| (pfiterators) - (|pfTree| '|Loop| (list pfiterators))) - -\end{chunk} - -\defun{pfLoop1}{pfLoop1} -\calls{pfLoop1}{pfLoop} -\calls{pfLoop1}{pfListOf} -\calls{pfLoop1}{pfDo} -\begin{chunk}{defun pfLoop1} -(defun |pfLoop1| (body) - (|pfLoop| (|pfListOf| (list (|pfDo| body))))) - -\end{chunk} - -\defun{pfLoop?}{Is this a Loop node?} -\calls{pfLoop?}{pfAbSynOp?} -\begin{chunk}{defun pfLoop?} -(defun |pfLoop?| (pf) - (|pfAbSynOp?| pf '|Loop|)) - -\end{chunk} - -\defun{pfLoopIterators}{Return the Iterators of a Loop node} -\begin{chunk}{defun pfLoopIterators 0} -(defun |pfLoopIterators| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pf0LoopIterators}{pf0LoopIterators} -\calls{pf0LoopIterators}{pfParts} -\calls{pf0LoopIterators}{pf0LoopIterators} -\begin{chunk}{defun pf0LoopIterators} -(defun |pf0LoopIterators| (pf) - (|pfParts| (|pfLoopIterators| pf))) - -\end{chunk} - -\defun{pfLp}{pfLp} -\calls{pfLp}{pfLoop} -\calls{pfLp}{pfListOf} -\calls{pfLp}{pfDo} -\begin{chunk}{defun pfLp} -(defun |pfLp| (iterators body) - (|pfLoop| (|pfListOf| (append iterators (list (|pfDo| body)))))) - -\end{chunk} - -\defun{pfMacro}{Create a Macro node} -\calls{pfMacro}{pfTree} -\begin{chunk}{defun pfMacro} -(defun |pfMacro| (pflhs pfrhs) - (|pfTree| '|Macro| (list pflhs pfrhs))) - -\end{chunk} - -\defun{pfMacro?}{Is this a Macro node?} -\calls{pfMacro?}{pfAbSynOp?} -\begin{chunk}{defun pfMacro?} -(defun |pfMacro?| (pf) - (|pfAbSynOp?| pf '|Macro|)) - -\end{chunk} - -\defun{pfMacroLhs}{Return the Lhs of a Macro node} -\begin{chunk}{defun pfMacroLhs 0} -(defun |pfMacroLhs| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfMacroRhs}{Return the Rhs of a Macro node} -\begin{chunk}{defun pfMacroRhs 0} -(defun |pfMacroRhs| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfMLambda}{Construct an MLambda node} -\calls{pfMLambda}{pfTree} -\begin{chunk}{defun pfMLambda} -(defun |pfMLambda| (pfargs pfbody) - (|pfTree| '|MLambda| (list pfargs pfbody))) - -\end{chunk} - -\defun{pfMLambda?}{Is this an MLambda node?} -\calls{pfMLambda?}{pfAbSynOp?} -\begin{chunk}{defun pfMLambda?} -(defun |pfMLambda?| (pf) - (|pfAbSynOp?| pf '|MLambda|)) - -\end{chunk} - -\defun{pfMLambdaArgs}{Return the Args of an MLambda} -\begin{chunk}{defun pfMLambdaArgs 0} -(defun |pfMLambdaArgs| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pf0MLambdaArgs}{Return the parts of an MLambda argument} -\calls{pf0MLambdaArgs}{pfParts} -\begin{chunk}{defun pf0MLambdaArgs} -(defun |pf0MLambdaArgs| (pf) - (|pfParts| (|pfMLambdaArgs| pf))) - -\end{chunk} - -\defun{pfMLambdaBody}{pfMLambdaBody} -\begin{chunk}{defun pfMLambdaBody 0} -(defun |pfMLambdaBody| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfNot?}{Is this a Not node?} -\calls{pfNot?}{pfAbSynOp?} -\begin{chunk}{defun pfNot?} -(defun |pfNot?| (pf) - (|pfAbSynOp?| pf '|Not|)) - -\end{chunk} - -\defun{pfNotArg}{Return the Arg part of a Not node} -\begin{chunk}{defun pfNotArg 0} -(defun |pfNotArg| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfNovalue}{Construct a NoValue node} -\calls{pfNovalue}{pfTree} -\begin{chunk}{defun pfNovalue} -(defun |pfNovalue| (pfexpr) - (|pfTree| '|Novalue| (list pfexpr))) - -\end{chunk} - -\defun{pfNovalue?}{Is this a Novalue node?} -\calls{pfNovalue?}{pfAbSynOp?} -\begin{chunk}{defun pfNovalue?} -(defun |pfNovalue?| (pf) - (|pfAbSynOp?| pf '|Novalue|)) - -\end{chunk} - -\defun{pfNovalueExpr}{Return the Expr part of a Novalue node} -\begin{chunk}{defun pfNovalueExpr 0} -(defun |pfNovalueExpr| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfOr}{Construct an Or node} -\calls{pfOr}{pfTree} -\begin{chunk}{defun pfOr} -(defun |pfOr| (pfleft pfright) - (|pfTree| '|Or| (list pfleft pfright))) - -\end{chunk} - -\defun{pfOr?}{Is this an Or node?} -\calls{pfOr?}{pfAbSynOp?} -\begin{chunk}{defun pfOr?} -(defun |pfOr?| (pf) - (|pfAbSynOp?| pf '|Or|)) - -\end{chunk} - -\defun{pfOrLeft}{Return the Left part of an Or node} -\begin{chunk}{defun pfOrLeft 0} -(defun |pfOrLeft| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfOrRight}{Return the Right part of an Or node} -\begin{chunk}{defun pfOrRight 0} -(defun |pfOrRight| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfParen}{Return the part of a parenthesised expression} -\begin{chunk}{defun pfParen} -(defun |pfParen| (a part) - (declare (ignore a)) - part) - -\end{chunk} - -\defun{pfPretend}{pfPretend} -\calls{pfPretend}{pfTree} -\begin{chunk}{defun pfPretend} -(defun |pfPretend| (pfexpr pftype) - (|pfTree| '|Pretend| (list pfexpr pftype))) - -\end{chunk} - -\defun{pfPretend?}{Is this a Pretend node?} -\calls{pfPretend?}{pfAbSynOp?} -\begin{chunk}{defun pfPretend?} -(defun |pfPretend?| (pf) - (|pfAbSynOp?| pf '|Pretend|)) - -\end{chunk} - -\defun{pfPretendExpr}{Return the Expression part of a Pretend node} -\begin{chunk}{defun pfPretendExpr 0} -(defun |pfPretendExpr| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfPretendType}{Return the Type part of a Pretend node} -\begin{chunk}{defun pfPretendType 0} -(defun |pfPretendType| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfQualType}{Construct a QualType node} -\calls{pfQualType}{pfTree} -\begin{chunk}{defun pfQualType} -(defun |pfQualType| (pftype pfqual) - (|pfTree| '|QualType| (list pftype pfqual))) - -\end{chunk} - -\defun{pfRestrict}{Construct a Restrict node} -\calls{pfRestrict}{pfTree} -\begin{chunk}{defun pfRestrict} -(defun |pfRestrict| (pfexpr pftype) - (|pfTree| '|Restrict| (list pfexpr pftype))) - -\end{chunk} - -\defun{pfRestrict?}{Is this a Restrict node?} -\calls{pfRestrict?}{pfAbSynOp?} -\begin{chunk}{defun pfRestrict?} -(defun |pfRestrict?| (pf) - (|pfAbSynOp?| pf '|Restrict|)) - -\end{chunk} - -\defun{pfRestrictExpr}{Return the Expr part of a Restrict node} -\begin{chunk}{defun pfRestrictExpr 0} -(defun |pfRestrictExpr| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfRestrictType}{Return the Type part of a Restrict node} -\begin{chunk}{defun pfRestrictType 0} -(defun |pfRestrictType| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfRetractTo}{Construct a RetractTo node} -\calls{pfRetractTo}{pfTree} -\begin{chunk}{defun pfRetractTo} -(defun |pfRetractTo| (pfexpr pftype) - (|pfTree| '|RetractTo| (list pfexpr pftype))) - -\end{chunk} - -\defun{pfReturn}{Construct a Return node} -\calls{pfReturn}{pfTree} -\begin{chunk}{defun pfReturn} -(defun |pfReturn| (pfexpr pffrom) - (|pfTree| '|Return| (list pfexpr pffrom))) - -\end{chunk} - -\defun{pfReturn?}{Is this a Return node?} -\calls{pfReturn?}{pfAbSynOp?} -\begin{chunk}{defun pfReturn?} -(defun |pfReturn?| (pf) - (|pfAbSynOp?| pf '|Return|)) - -\end{chunk} - -\defun{pfReturnExpr}{Return the Expr part of a Return node} -\begin{chunk}{defun pfReturnExpr 0} -(defun |pfReturnExpr| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfReturnNoName}{pfReturnNoName} -\calls{pfReturnNoName}{pfReturn} -\calls{pfReturnNoName}{pfNothing} -\begin{chunk}{defun pfReturnNoName} -(defun |pfReturnNoName| (|value|) - (|pfReturn| |value| (|pfNothing|))) - -\end{chunk} - -\defun{pfReturnTyped}{Construct a ReturnTyped node} -\calls{pfReturnTyped}{pfTree} -\begin{chunk}{defun pfReturnTyped} -(defun |pfReturnTyped| (type body) - (|pfTree| '|returntyped| (list type body))) - -\end{chunk} - -\defun{pfRule}{Construct a Rule node} -\calls{pfRule}{pfTree} -\begin{chunk}{defun pfRule} -(defun |pfRule| (pflhsitems pfrhs) - (|pfTree| '|Rule| (list pflhsitems pfrhs))) - -\end{chunk} - -\defun{pfRuleLhsItems}{Return the Lhs of a Rule node} -\begin{chunk}{defun pfRuleLhsItems 0} -(defun |pfRuleLhsItems| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfRuleRhs}{Return the Rhs of a Rule node} -\begin{chunk}{defun pfRuleRhs 0} -(defun |pfRuleRhs| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfRule?}{Is this a Rule node?} -\calls{pfRule?}{pfAbSynOp?} -\begin{chunk}{defun pfRule?} -(defun |pfRule?| (pf) - (|pfAbSynOp?| pf '|Rule|)) - -\end{chunk} - -\defun{pfSecond}{pfSecond} -\begin{chunk}{defun pfSecond 0} -(defun |pfSecond| (form) - (caddr form)) - -\end{chunk} - -\defun{pfSequence}{Construct a Sequence node} -\calls{pfSequence}{pfTree} -\begin{chunk}{defun pfSequence} -(defun |pfSequence| (pfargs) - (|pfTree| '|Sequence| (list pfargs))) - -\end{chunk} - -\defun{pfSequenceArgs}{Return the Args of a Sequence node} -\begin{chunk}{defun pfSequenceArgs 0} -(defun |pfSequenceArgs| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfSequence?}{ Is this a Sequence node?} -\calls{pfSequence?}{pfAbSynOp?} -\begin{chunk}{defun pfSequence?} -(defun |pfSequence?| (pf) - (|pfAbSynOp?| pf '|Sequence|)) - -\end{chunk} - -\defun{pf0SequenceArgs}{Return the parts of the Args of a Sequence node} -\calls{pf0SequenceArgs}{pfParts} -\calls{pf0SequenceArgs}{pfSequenceArgs} -\begin{chunk}{defun pf0SequenceArgs} -(defun |pf0SequenceArgs| (pf) - (|pfParts| (|pfSequenceArgs| pf))) - -\end{chunk} - -\defun{pfSuchthat}{Create a Suchthat node} -\calls{pfSuchthat}{pfTree} -\begin{chunk}{defun pfSuchthat} -(defun |pfSuchthat| (pfcond) - (|pfTree| '|Suchthat| (list pfcond))) - -\end{chunk} - -\defun{pfSuchthat?}{Is this a SuchThat node?} -\calls{pfSuchthat?}{pfAbSynOp?} -\begin{chunk}{defun pfSuchthat?} -(defun |pfSuchthat?| (pf) - (|pfAbSynOp?| pf '|Suchthat|)) - -\end{chunk} - -\defun{pfSuchthatCond}{Return the Cond part of a SuchThat node} -\begin{chunk}{defun pfSuchthatCond 0} -(defun |pfSuchthatCond| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfTagged}{Create a Tagged node} -\calls{pfTagged}{pfTree} -\begin{chunk}{defun pfTagged} -(defun |pfTagged| (pftag pfexpr) - (|pfTree| '|Tagged| (list pftag pfexpr))) - -\end{chunk} - -\defun{pfTagged?}{Is this a Tagged node?} -\calls{pfTagged?}{pfAbSynOp?} -\begin{chunk}{defun pfTagged?} -(defun |pfTagged?| (pf) - (|pfAbSynOp?| pf '|Tagged|)) - -\end{chunk} - -\defun{pfTaggedExpr}{Return the Expression portion of a Tagged node} -\begin{chunk}{defun pfTaggedExpr 0} -(defun |pfTaggedExpr| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfTaggedTag}{Return the Tag of a Tagged node} -\begin{chunk}{defun pfTaggedTag 0} -(defun |pfTaggedTag| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfTaggedToTyped}{pfTaggedToTyped} -\calls{pfTaggedToTyped}{pfTagged?} -\calls{pfTaggedToTyped}{pfTaggedExpr} -\calls{pfTaggedToTyped}{pfNothing} -\calls{pfTaggedToTyped}{pfTaggedTag} -\calls{pfTaggedToTyped}{pfId?} -\calls{pfTaggedToTyped}{pfId} -\calls{pfTaggedToTyped}{pfTyped} -\calls{pfTaggedToTyped}{pfSuch} -\calls{pfTaggedToTyped}{pfInfApplication} -\begin{chunk}{defun pfTaggedToTyped} -(defun |pfTaggedToTyped| (arg) - (let (a form rt) - (if (|pfTagged?| arg) - (setq rt (|pfTaggedExpr| arg)) - (setq rt (|pfNothing|))) - (if (|pfTagged?| arg) - (setq form (|pfTaggedTag| arg)) - (setq form arg)) - (cond - ((null (|pfId?| form)) - (setq a (|pfId| (gensym))) - (|pfTyped| (|pfSuch| a (|pfInfApplication| (|pfId| '=) a form)) rt)) - (t (|pfTyped| form rt))))) - -\end{chunk} - -\defun{pfTweakIf}{pfTweakIf} -\calls{pfTweakIf}{pfIfElse} -\calls{pfTweakIf}{pfNothing?} -\calls{pfTweakIf}{pfListOf} -\calls{pfTweakIf}{pfTree} -\calls{pfTweakIf}{pfIfCond} -\calls{pfTweakIf}{pfIfThen} -\begin{chunk}{defun pfTweakIf} -(defun |pfTweakIf| (form) - (let (b a) - (setq a (|pfIfElse| form)) - (setq b (if (|pfNothing?| a) (|pfListOf| NIL) a)) - (|pfTree| '|WIf| (list (|pfIfCond| form) (|pfIfThen| form) b)))) - -\end{chunk} - -\defun{pfTyped}{Construct a Typed node} -\calls{pfTyped}{pfTree} -\begin{chunk}{defun pfTyped} -(defun |pfTyped| (pfid pftype) - (|pfTree| '|Typed| (list pfid pftype))) - -\end{chunk} - -\defun{pfTyped?}{Is this a Typed node?} -\calls{pfTyped?}{pfAbSynOp?} -\begin{chunk}{defun pfTyped?} -(defun |pfTyped?| (pf) - (|pfAbSynOp?| pf '|Typed|)) - -\end{chunk} - -\defun{pfTypedType}{Return the Type of a Typed node} -\begin{chunk}{defun pfTypedType 0} -(defun |pfTypedType| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfTypedId}{Return the Id of a Typed node} -\begin{chunk}{defun pfTypedId 0} -(defun |pfTypedId| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfTyping}{Construct a Typing node} -\calls{pfTyping}{pfTree} -\begin{chunk}{defun pfTyping} -(defun |pfTyping| (pfitems) - (|pfTree| '|Typing| (list pfitems))) - -\end{chunk} - -\defun{pfTuple}{Return a Tuple node} -\calls{pfTuple}{pfTree} -\begin{chunk}{defun pfTuple} -(defun |pfTuple| (pfparts) - (|pfTree| '|Tuple| (list pfparts))) - -\end{chunk} - -\defun{pfTupleListOf}{Return a Tuple from a List} -\calls{pfTupleListOf}{pfTuple} -\calls{pfTupleListOf}{pfListOf} -\begin{chunk}{defun pfTupleListOf} -(defun |pfTupleListOf| (pfparts) - (|pfTuple| (|pfListOf| pfparts))) - -\end{chunk} - -\defun{pfTuple?}{Is this a Tuple node?} -\calls{pfTuple?}{pfAbSynOp?} -\begin{chunk}{defun pfTuple?} -(defun |pfTuple?| (pf) - (|pfAbSynOp?| pf '|Tuple|)) - -\end{chunk} - -\defun{pfTupleParts}{Return the Parts of a Tuple node} -\begin{chunk}{defun pfTupleParts 0} -(defun |pfTupleParts| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pf0TupleParts}{Return the parts of a Tuple} -\calls{pf0TupleParts}{pfParts} -\calls{pf0TupleParts}{pfTupleParts} -\begin{chunk}{defun pf0TupleParts} -(defun |pf0TupleParts| (pf) - (|pfParts| (|pfTupleParts| pf))) - -\end{chunk} - -\defun{pfUnSequence}{Return a list from a Sequence node} -\calls{pfUnSequence}{pfSequence?} -\calls{pfUnSequence}{pfAppend} -\calls{pfUnSequence}{pf0SequenceArgs} -\calls{pfUnSequence}{pfListOf} -\begin{chunk}{defun pfUnSequence} -(defun |pfUnSequence| (x) - (if (|pfSequence?| x) - (|pfListOf| (|pfAppend| (|pf0SequenceArgs| x))) - (|pfListOf| x))) - -\end{chunk} - -\defun{pfWDec}{The comment is attached to all signatutres} -\calls{pfWDec}{pfWDeclare} -\calls{pfWDec}{pfParts} -\begin{chunk}{defun pfWDec} -(defun |pfWDec| (doc name) - (mapcar #'(lambda (i) (|pfWDeclare| i doc)) (|pfParts| name))) - -\end{chunk} - -\defun{pfWDeclare}{Construct a WDeclare node} -\calls{pfWDeclare}{pfTree} -\begin{chunk}{defun pfWDeclare} -(defun |pfWDeclare| (pfsignature pfdoc) - (|pfTree| '|WDeclare| (list pfsignature pfdoc))) - -\end{chunk} - -\defun{pfWhere}{Construct a Where node} -\calls{pfWhere}{pfTree} -\begin{chunk}{defun pfWhere} -(defun |pfWhere| (pfcontext pfexpr) - (|pfTree| '|Where| (list pfcontext pfexpr))) - -\end{chunk} - -\defun{pfWhere?}{Is this a Where node?} -\calls{pfWhere?}{pfAbSynOp?} -\begin{chunk}{defun pfWhere?} -(defun |pfWhere?| (pf) - (|pfAbSynOp?| pf '|Where|)) - -\end{chunk} - -\defun{pf0WhereContext}{Return the parts of the Context of a Where node} -\calls{pf0WhereContext}{pfParts} -\calls{pf0WhereContext}{pfWhereContext} -\begin{chunk}{defun pf0WhereContext} -(defun |pf0WhereContext| (pf) - (|pfParts| (|pfWhereContext| pf))) - -\end{chunk} - -\defun{pfWhereContext}{Return the Context of a Where node} -\begin{chunk}{defun pfWhereContext 0} -(defun |pfWhereContext| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfWhereExpr}{Return the Expr part of a Where node} -\begin{chunk}{defun pfWhereExpr 0} -(defun |pfWhereExpr| (pf) - (caddr pf)) - -\end{chunk} - -\defun{pfWhile}{Construct a While node} -\calls{pfWhile}{pfTree} -\begin{chunk}{defun pfWhile} -(defun |pfWhile| (pfcond) - (|pfTree| '|While| (list pfcond))) - -\end{chunk} - -\defun{pfWhile?}{Is this a While node?} -\calls{pfWhile?}{pfAbSynOp?} -\begin{chunk}{defun pfWhile?} -(defun |pfWhile?| (pf) - (|pfAbSynOp?| pf '|While|)) - -\end{chunk} - -\defun{pfWhileCond}{Return the Cond part of a While node} -\begin{chunk}{defun pfWhileCond 0} -(defun |pfWhileCond| (pf) - (cadr pf)) - -\end{chunk} - -\defun{pfWith}{Construct a With node} -\calls{pfWith}{pfTree} -\begin{chunk}{defun pfWith} -(defun |pfWith| (pfbase pfwithin pfwithon) - (|pfTree| '|With| (list pfbase pfwithin pfwithon))) - -\end{chunk} - -\defun{pfWrong}{Create a Wrong node} -\calls{pfWrong}{pfTree} -\begin{chunk}{defun pfWrong} -(defun |pfWrong| (pfwhy pfrubble) - (|pfTree| '|Wrong| (list pfwhy pfrubble))) - -\end{chunk} - -\defun{pfWrong?}{Is this a Wrong node?} -\calls{pfWrong?}{pfAbSynOp?} -\begin{chunk}{defun pfWrong?} -(defun |pfWrong?| (pf) - (|pfAbSynOp?| pf '|Wrong|)) - -\end{chunk} - -\chapter{Pftree to s-expression translation} -Pftree to s-expression translation. Used to interface the new parser -technology to the interpreter. The input is a parseTree and the -output is an old-parser-style s-expression. - -\defun{pf2Sex}{Pftree to s-expression translation} -\calls{pf2Sex}{pf2Sex1} -\usesdollar{pf2Sex}{insideSEQ} -\usesdollar{pf2Sex}{insideApplication} -\usesdollar{pf2Sex}{insideRule} -\usesdollar{pf2Sex}{QuietCommand} -\begin{chunk}{defun pf2Sex} -(defun |pf2Sex| (pf) - (let (|$insideSEQ| |$insideApplication| |$insideRule|) - (declare (special |$insideSEQ| |$insideApplication| |$insideRule| - |$QuietCommand|)) - (setq |$QuietCommand| nil) - (setq |$insideRule| nil) - (setq |$insideApplication| nil) - (setq |$insideSEQ| nil) - (|pf2Sex1| pf))) - -\end{chunk} - -\defun{pf2Sex1}{Pftree to s-expression translation inner function} -\calls{pf2Sex1}{pfNothing?} -\calls{pf2Sex1}{pfSymbol?} -\calls{pf2Sex1}{pfSymbolSymbol} -\calls{pf2Sex1}{pfLiteral?} -\calls{pf2Sex1}{pfLiteral2Sex} -\calls{pf2Sex1}{pfIdSymbol} -\calls{pf2Sex1}{pfApplication?} -\calls{pf2Sex1}{pfApplication2Sex} -\calls{pf2Sex1}{pfTuple?} -\calls{pf2Sex1}{pf2Sex1} -\calls{pf2Sex1}{pf0TupleParts} -\calls{pf2Sex1}{pfIf?} -\calls{pf2Sex1}{pfIfCond} -\calls{pf2Sex1}{pfIfThen} -\calls{pf2Sex1}{pfIfElse} -\calls{pf2Sex1}{pfTagged?} -\calls{pf2Sex1}{pfTaggedTag} -\calls{pf2Sex1}{pfTaggedExpr} -\calls{pf2Sex1}{pfCoerceto?} -\calls{pf2Sex1}{pfCoercetoExpr} -\calls{pf2Sex1}{pfCoercetoType} -\calls{pf2Sex1}{pfPretend?} -\calls{pf2Sex1}{pfPretendExpr} -\calls{pf2Sex1}{pfPretendType} -\calls{pf2Sex1}{pfFromdom?} -\calls{pf2Sex1}{opTran} -\calls{pf2Sex1}{pfFromdomWhat} -\calls{pf2Sex1}{pfFromdomDomain} -\calls{pf2Sex1}{pfSequence?} -\calls{pf2Sex1}{pfSequence2Sex} -\calls{pf2Sex1}{pfExit?} -\calls{pf2Sex1}{pfExitCond} -\calls{pf2Sex1}{pfExitExpr} -\calls{pf2Sex1}{pfLoop?} -\calls{pf2Sex1}{loopIters2Sex} -\calls{pf2Sex1}{pf0LoopIterators} -\calls{pf2Sex1}{pfCollect?} -\calls{pf2Sex1}{pfCollect2Sex} -\calls{pf2Sex1}{pfForin?} -\calls{pf2Sex1}{pf0ForinLhs} -\calls{pf2Sex1}{pfForinWhole} -\calls{pf2Sex1}{pfWhile?} -\calls{pf2Sex1}{pfWhileCond} -\calls{pf2Sex1}{pfSuchthat?} -\calls{pf2Sex1}{keyedSystemError} -\calls{pf2Sex1}{pfSuchthatCond} -\calls{pf2Sex1}{pfDo?} -\calls{pf2Sex1}{pfDoBody} -\calls{pf2Sex1}{pfTyped?} -\calls{pf2Sex1}{pfTypedType} -\calls{pf2Sex1}{pfTypedId} -\calls{pf2Sex1}{pfAssign?} -\calls{pf2Sex1}{pf0AssignLhsItems} -\calls{pf2Sex1}{pfAssignRhs} -\calls{pf2Sex1}{pfDefinition?} -\calls{pf2Sex1}{pfDefinition2Sex} -\calls{pf2Sex1}{pfLambda?} -\calls{pf2Sex1}{pfLambda2Sex} -\calls{pf2Sex1}{pfMLambda?} -\calls{pf2Sex1}{pfRestrict?} -\calls{pf2Sex1}{pfRestrictExpr} -\calls{pf2Sex1}{pfRestrictType} -\calls{pf2Sex1}{pfFree?} -\calls{pf2Sex1}{pf0FreeItems} -\calls{pf2Sex1}{pfLocal?} -\calls{pf2Sex1}{pf0LocalItems} -\calls{pf2Sex1}{pfWrong?} -\calls{pf2Sex1}{spadThrow} -\calls{pf2Sex1}{pfAnd?} -\calls{pf2Sex1}{pfAndLeft} -\calls{pf2Sex1}{pfAndRight} -\calls{pf2Sex1}{pfOr?} -\calls{pf2Sex1}{pfOrLeft} -\calls{pf2Sex1}{pfOrRight} -\calls{pf2Sex1}{pfNot?} -\calls{pf2Sex1}{pfNotArg} -\calls{pf2Sex1}{pfNovalue?} -\calls{pf2Sex1}{pfNovalueExpr} -\calls{pf2Sex1}{pfRule?} -\calls{pf2Sex1}{pfRule2Sex} -\calls{pf2Sex1}{pfBreak?} -\calls{pf2Sex1}{pfBreakFrom} -\calls{pf2Sex1}{pfMacro?} -\calls{pf2Sex1}{pfReturn?} -\calls{pf2Sex1}{pfReturnExpr} -\calls{pf2Sex1}{pfIterate?} -\calls{pf2Sex1}{pfWhere?} -\calls{pf2Sex1}{pf0WhereContext} -\calls{pf2Sex1}{pfWhereExpr} -\calls{pf2Sex1}{pfAbSynOp} -\calls{pf2Sex1}{tokPart} -\usesdollar{pf2Sex1}{insideSEQ} -\usesdollar{pf2Sex1}{insideRule} -\usesdollar{pf2Sex1}{QuietCommand} -\begin{chunk}{defun pf2Sex1} -(defun |pf2Sex1| (pf) - (let (args idList type op tagPart tag s) - (declare (special |$insideSEQ| |$insideRule| |$QuietCommand|)) - (cond - ((|pfNothing?| pf) '|noBranch|) - ((|pfSymbol?| pf) - (if (eq |$insideRule| '|left|) - (progn - (setq s (|pfSymbolSymbol| pf)) - (list '|constant| (list 'quote s))) - (list 'quote (|pfSymbolSymbol| pf)))) - ((|pfLiteral?| pf) (|pfLiteral2Sex| pf)) - ((|pfId?| pf) - (if |$insideRule| - (progn - (setq s (|pfIdSymbol| pf)) - (if (member s '(|%pi| |%e| |%i|)) - s - (list 'quote s))) - (|pfIdSymbol| pf))) - ((|pfApplication?| pf) (|pfApplication2Sex| pf)) - ((|pfTuple?| pf) (cons '|Tuple| (mapcar #'|pf2Sex1| (|pf0TupleParts| pf)))) - ((|pfIf?| pf) - (list 'if (|pf2Sex1| (|pfIfCond| pf)) - (|pf2Sex1| (|pfIfThen| pf)) - (|pf2Sex1| (|pfIfElse| pf)))) - ((|pfTagged?| pf) - (setq tag (|pfTaggedTag| pf)) - (setq tagPart - (if (|pfTuple?| tag) - (cons '|Tuple| (mapcar #'|pf2Sex1| (|pf0TupleParts| tag))) - (|pf2Sex1| tag))) - (list '|:| tagPart (|pf2Sex1| (|pfTaggedExpr| pf)))) - ((|pfCoerceto?| pf) - (list '|::| (|pf2Sex1| (|pfCoercetoExpr| pf)) - (|pf2Sex1| (|pfCoercetoType| pf)))) - ((|pfPretend?| pf) - (list '|pretend| (|pf2Sex1| (|pfPretendExpr| pf)) - (|pf2Sex1| (|pfPretendType| pf)))) - ((|pfFromdom?| pf) - (setq op (|opTran| (|pf2Sex1| (|pfFromdomWhat| pf)))) - (when (eq op '|braceFromCurly|) (setq op 'seq)) - (list '|$elt| (|pf2Sex1| (|pfFromdomDomain| pf)) op)) - ((|pfSequence?| pf) (|pfSequence2Sex| pf)) - ((|pfExit?| pf) - (if |$insideSEQ| - (list '|exit| (|pf2Sex1| (|pfExitCond| pf)) - (|pf2Sex1| (|pfExitExpr| pf))) - (list 'if (|pf2Sex1| (|pfExitCond| pf)) - (|pf2Sex1| (|pfExitExpr| pf)) '|noBranch|))) - ((|pfLoop?| pf) (cons 'repeat (|loopIters2Sex| (|pf0LoopIterators| pf)))) - ((|pfCollect?| pf) (|pfCollect2Sex| pf)) - ((|pfForin?| pf) - (cons 'in - (append (mapcar #'|pf2Sex1| (|pf0ForinLhs| pf)) - (list (|pf2Sex1| (|pfForinWhole| pf)))))) - ((|pfWhile?| pf) (list 'while (|pf2Sex1| (|pfWhileCond| pf)))) - ((|pfSuchthat?| pf) - (if (eq |$insideRule| '|left|) - (|keyedSystemError| "S2GE0017" (list "pf2Sex1: pfSuchThat")) - (list '|\|| (|pf2Sex1| (|pfSuchthatCond| pf))))) - ((|pfDo?| pf) (|pf2Sex1| (|pfDoBody| pf))) - ((|pfTyped?| pf) - (setq type (|pfTypedType| pf)) - (if (|pfNothing?| type) - (|pf2Sex1| (|pfTypedId| pf)) - (list '|:| (|pf2Sex1| (|pfTypedId| pf)) (|pf2Sex1| (|pfTypedType| pf))))) - ((|pfAssign?| pf) - (setq idList (mapcar #'|pf2Sex1| (|pf0AssignLhsItems| pf))) - (if (not (eql (length idList) 1)) - (setq idList (cons '|Tuple| idList)) - (setq idList (car idList))) - (list 'let idList (|pf2Sex1| (|pfAssignRhs| pf)))) - ((|pfDefinition?| pf) (|pfDefinition2Sex| pf)) - ((|pfLambda?| pf) (|pfLambda2Sex| pf)) - ((|pfMLambda?| pf) '|/throwAway|) - ((|pfRestrict?| pf) - (list '@ (|pf2Sex1| (|pfRestrictExpr| pf)) - (|pf2Sex1| (|pfRestrictType| pf)))) - ((|pfFree?| pf) (cons '|free| (mapcar #'|pf2Sex1| (|pf0FreeItems| pf)))) - ((|pfLocal?| pf) (cons '|local| (mapcar #'|pf2Sex1| (|pf0LocalItems| pf)))) - ((|pfWrong?| pf) (|spadThrow|)) - ((|pfAnd?| pf) - (list '|and| (|pf2Sex1| (|pfAndLeft| pf)) - (|pf2Sex1| (|pfAndRight| pf)))) - ((|pfOr?| pf) - (list '|or| (|pf2Sex1| (|pfOrLeft| pf)) - (|pf2Sex1| (|pfOrRight| pf)))) - ((|pfNot?| pf) (list '|not| (|pf2Sex1| (|pfNotArg| pf)))) - ((|pfNovalue?| pf) - (setq |$QuietCommand| t) - (list 'seq (|pf2Sex1| (|pfNovalueExpr| pf)))) - ((|pfRule?| pf) (|pfRule2Sex| pf)) - ((|pfBreak?| pf) (list '|break| (|pfBreakFrom| pf))) - ((|pfMacro?| pf) '|/throwAway|) - ((|pfReturn?| pf) (list '|return| (|pf2Sex1| (|pfReturnExpr| pf)))) - ((|pfIterate?| pf) (list '|iterate|)) - ((|pfWhere?| pf) - (setq args (mapcar #'|pf2Sex1| (|pf0WhereContext| pf))) - (if (eql (length args) 1) - (cons '|where| (cons (|pf2Sex1| (|pfWhereExpr| pf)) args)) - (list '|where| (|pf2Sex1| (|pfWhereExpr| pf)) (cons 'seq args)))) -; -- under strange circumstances/piling, system commands can wind -; -- up in expressions. This just passes it through as a string for -; -- the user to figure out what happened. - ((eq (|pfAbSynOp| pf) '|command|) (|tokPart| pf)) - (t (|keyedSystemError| "S2GE0017" (list "pf2Sex1")))))) - -\end{chunk} - -\defun{pfLiteral2Sex}{Convert a Literal to an S-expression} -\calls{pfLiteral2Sex}{pfLiteralClass} -\calls{pfLiteral2Sex}{pfLiteralString} -\calls{pfLiteral2Sex}{float2Sex} -\calls{pfLiteral2Sex}{pfSymbolSymbol} -\calls{pfLiteral2Sex}{pfLeafToken} -\calls{pfLiteral2Sex}{keyedSystemError} -\usesdollar{pfLiteral2Sex}{insideRule} -\begin{chunk}{defun pfLiteral2Sex} -(defun |pfLiteral2Sex| (pf) - (let (s type) - (declare (special |$insideRule|)) - (setq type (|pfLiteralClass| pf)) - (cond - ((eq type '|integer|) (read-from-string (|pfLiteralString| pf))) - ((or (eq type '|string|) (eq type '|char|)) - (|pfLiteralString| pf)) - ((eq type '|float|) (|float2Sex| (|pfLiteralString| pf))) - ((eq type '|symbol|) - (if |$insideRule| - (progn - (setq s (|pfSymbolSymbol| pf)) - (list 'quote s)) - (|pfSymbolSymbol| pf))) - ((eq type '|expression|) (list 'quote (|pfLeafToken| pf))) - (t - (|keyedSystemError| 'S2GE0017 (list "pfLiteral2Sex: unexpected form")))))) - -\end{chunk} - -\defun{float2Sex}{Convert a float to an S-expression} -\usesdollar{float2Sex}{useBFasDefault} -\begin{chunk}{defun float2Sex} -(defun |float2Sex| (num) - (let (exp frac bfForm fracPartString intPart dotIndex expPart mantPart eIndex) - (declare (special |$useBFasDefault|)) - (setq eIndex (search "e" num)) - (if eIndex - (setq mantPart (subseq num 0 eIndex)) - (setq mantPart num)) - (if eIndex - (setq expPart (read-from-string (subseq num (+ eIndex 1)))) - (setq expPart 0)) - (setq dotIndex (search "." mantPart)) - (if dotIndex - (setq intPart (read-from-string (subseq mantPart 0 dotIndex))) - (setq intPart (read-from-string mantPart))) - (if dotIndex - (setq fracPartString (subseq mantPart (+ dotIndex 1))) - (setq fracPartString 0)) - (setq bfForm - (make-float intPart (read-from-string fracPartString) - (length fracPartString) expPart)) - (if |$useBFasDefault| - (progn - (setq frac (cadr bfForm)) - (setq exp (cddr bfForm)) - (list (list '|$elt| (list '|Float|) '|float|) frac exp 10)) - bfForm))) - -\end{chunk} - -\defun{pfApplication2Sex}{Change an Application node to an S-expression} -\calls{pfApplication2Sex}{pfOp2Sex} -\calls{pfApplication2Sex}{pfApplicationOp} -\calls{pfApplication2Sex}{opTran} -\calls{pfApplication2Sex}{pf0TupleParts} -\calls{pfApplication2Sex}{pfApplicationArg} -\calls{pfApplication2Sex}{pfTuple?} -\calls{pfApplication2Sex}{pf2Sex1} -\calls{pfApplication2Sex}{pf2Sex} -\calls{pfApplication2Sex}{pfSuchThat2Sex} -\calls{pfApplication2Sex}{hasOptArgs?} -\usesdollar{pfApplication2Sex}{insideApplication} -\usesdollar{pfApplication2Sex}{insideRule} -\begin{chunk}{defun pfApplication2Sex} -(defun |pfApplication2Sex| (pf) - (let (|$insideApplication| x val realOp tmp1 qt argSex typeList args op) - (declare (special |$insideApplication| |$insideRule|)) - (setq |$insideApplication| t) - (setq op (|pfOp2Sex| (|pfApplicationOp| pf))) - (setq op (|opTran| op)) - (cond - ((eq op '->) - (setq args (|pf0TupleParts| (|pfApplicationArg| pf))) - (if (|pfTuple?| (car args)) - (setq typeList (mapcar #'|pf2Sex1| (|pf0TupleParts| (car args)))) - (setq typeList (list (|pf2Sex1| (car args))))) - (setq args (cons (|pf2Sex1| (cadr args)) typeList)) - (cons '|Mapping| args)) - ((and (eq op '|:|) (eq |$insideRule| '|left|)) - (list '|multiple| (|pf2Sex| (|pfApplicationArg| pf)))) - ((and (eq op '?) (eq |$insideRule| '|left|)) - (list '|optional| (|pf2Sex| (|pfApplicationArg| pf)))) - (t - (setq args (|pfApplicationArg| pf)) - (cond - ((|pfTuple?| args) - (if (and (eq op '|\||) (eq |$insideRule| '|left|)) - (|pfSuchThat2Sex| args) - (progn - (setq argSex (cdr (|pf2Sex1| args))) - (cond - ((eq op '>) (list '< (cadr argSex) (car argSex))) - ((eq op '>=) (list '|not| (list '< (car argSex) (cadr argSex)))) - ((eq op '<=) (list '|not| (list '< (cadr argSex) (car argSex)))) - ((eq op 'and) (list '|and| (car argSex) (cadr argSex))) - ((eq op 'or) (list '|or| (car argSex) (cadr argSex))) - ((eq op '|Iterate|) (list '|iterate|)) - ((eq op '|by|) (cons 'by argSex)) - ((eq op '|braceFromCurly|) - (if (and (consp argSex) (eq (car argSex) 'seq)) - argSex - (cons 'seq argSex))) - ((and (consp op) - (progn - (setq qt (car op)) - (setq tmp1 (cdr op)) - (and (consp tmp1) - (eq (cdr tmp1) nil) - (progn - (setq realOp (car tmp1)) - t))) - (eq qt 'quote)) - (cons '|applyQuote| (cons op argSex))) - ((setq val (|hasOptArgs?| argSex)) (cons op val)) - (t (cons op argSex)))))) - ((and (consp op) - (progn - (setq qt (car op)) - (setq tmp1 (cdr op)) - (and (consp tmp1) - (eq (cdr tmp1) NIL) - (progn - (setq realOp (car tmp1)) - t))) - (eq qt 'quote)) - (list '|applyQuote| op (|pf2Sex1| args))) - ((eq op '|braceFromCurly|) - (setq x (|pf2Sex1| args)) - (if (and (consp x) (eq (car x) 'seq)) - x - (list 'seq x))) - ((eq op '|by|) (list 'by (|pf2Sex1| args))) - (t (list op (|pf2Sex1| args)))))))) - -\end{chunk} - -\defun{pfSuchThat2Sex}{Convert a SuchThat node to an S-expression} -\calls{pfSuchThat2Sex}{pf0TupleParts} -\calls{pfSuchThat2Sex}{pf2Sex1} -\calls{pfSuchThat2Sex}{pf2Sex} -\usesdollar{pfSuchThat2Sex}{predicateList} -\begin{chunk}{defun pfSuchThat2Sex} -(defun |pfSuchThat2Sex| (args) - (let (rhsSex lhsSex argList name) - (declare (special |$predicateList|)) - (setq name (gentemp)) - (setq argList (|pf0TupleParts| args)) - (setq lhsSex (|pf2Sex1| (car argList))) - (setq rhsSex (|pf2Sex| (cadr argList))) - (setq |$predicateList| - (cons (cons name (cons lhsSex rhsSex)) |$predicateList|)) - name)) - -\end{chunk} - -\defun{pfOp2Sex}{pfOp2Sex} -\calls{pfOp2Sex}{pf2Sex1} -\calls{pfOp2Sex}{pmDontQuote?} -\calls{pfOp2Sex}{pfSymbol?} -\usesdollar{pfOp2Sex}{quotedOpList} -\usesdollar{pfOp2Sex}{insideRule} -\begin{chunk}{defun pfOp2Sex} -(defun |pfOp2Sex| (pf) - (let (realOp tmp1 op alreadyQuoted) - (declare (special |$quotedOpList| |$insideRule|)) - (setq alreadyQuoted (|pfSymbol?| pf)) - (setq op (|pf2Sex1| pf)) - (cond - ((and (consp op) - (eq (car op) 'quote) - (progn - (setq tmp1 (cdr op)) - (and (consp tmp1) - (eq (cdr tmp1) nil) - (progn - (setq realOp (car tmp1)) t)))) - (cond - ((eq |$insideRule| '|left|) realOp) - ((eq |$insideRule| '|right|) - (cond - ((|pmDontQuote?| realOp) realOp) - (t - (setq |$quotedOpList| (cons op |$quotedOpList|)) - op))) - ((eq realOp '|\||) realOp) - ((eq realOp '|:|) realOp) - ((eq realOp '?) realOp) - (t op))) - (t op)))) - -\end{chunk} - -\defun{pmDontQuote?}{pmDontQuote?} -\begin{chunk}{defun pmDontQuote? 0} -(defun |pmDontQuote?| (sy) - (member sy - '(+ - * ** ^ / |log| |exp| |pi| |sqrt| |ei| |li| |erf| |ci| - |si| |dilog| |sin| |cos| |tan| |cot| |sec| |csc| |asin| - |acos| |atan| |acot| |asec| |acsc| |sinh| |cosh| |tanh| - |coth| |sech| |csch| |asinh| |acosh| |atanh| |acoth| - |asech| |acsc|))) - -\end{chunk} - -\defun{hasOptArgs?}{hasOptArgs?} -\begin{chunk}{defun hasOptArgs? 0} -(defun |hasOptArgs?| (argSex) - (let (rhs lhs opt nonOpt tmp1 tmp2) - (dolist (arg argSex) - (cond - ((and (consp arg) - (eq (car arg) 'optarg) - (progn - (setq tmp1 (cdr arg)) - (and (consp tmp1) - (progn - (setq lhs (car tmp1)) - (setq tmp2 (cdr tmp1)) - (and (consp tmp2) - (eq (cdr tmp2) nil) - (progn - (setq rhs (car tmp2)) - t)))))) - (setq opt (cons (list lhs rhs) opt))) - (t (setq nonOpt (cons arg nonOpt))))) - (when opt - (nconc (nreverse nonOpt) (list (cons '|construct| (nreverse opt))))))) - -\end{chunk} - -\defun{pfSequence2Sex}{Convert a Sequence node to an S-expression} -\calls{pfSequence2Sex}{pf2Sex1} -\calls{pfSequence2Sex}{pf0SequenceArgs} -\usesdollar{pfSequence2Sex}{insideSEQ} -\begin{chunk}{defun pfSequence2Sex} -(defun |pfSequence2Sex| (pf) - (let (|$insideSEQ| tmp1 ruleList seq) - (declare (special |$insideSEQ|)) - (setq |$insideSEQ| t) - (setq seq (|pfSequence2Sex0| (mapcar #'|pf2Sex1| (|pf0SequenceArgs| pf)))) - (cond - ((and (consp seq) - (eq (car seq) 'seq) - (progn (setq ruleList (cdr seq)) 't) - (consp ruleList) - (progn - (setq tmp1 (car ruleList)) - (and (consp tmp1) (eq (car tmp1) '|rule|)))) - (list '|ruleset| (cons '|construct| ruleList))) - (t seq)))) - -\end{chunk} - -\defun{pfSequence2Sex0}{pfSequence2Sex0} -\tpdhere{rewrite this using (dolist (item seqList)...)} -\begin{verbatim} -;pfSequence2Sex0 seqList == -; null seqList => "noBranch" -; seqTranList := [] -; while seqList ^= nil repeat -; item := first seqList -; item is ["exit", cond, value] => -; item := ["IF", cond, value, pfSequence2Sex0 rest seqList] -; seqTranList := [item, :seqTranList] -; seqList := nil -; seqTranList := [item ,:seqTranList] -; seqList := rest seqList -; #seqTranList = 1 => first seqTranList -; ["SEQ", :nreverse seqTranList] -\end{verbatim} -\calls{pfSequence2Sex0}{pfSequence2Sex0} -\begin{chunk}{defun pfSequence2Sex0} -(defun |pfSequence2Sex0| (seqList) - (let (value tmp2 cond tmp1 item seqTranList) - (if (null seqList) - '|noBranch| - (progn - ((lambda () - (loop - (if (not seqList) - (return nil) - (progn - (setq item (car seqList)) - (cond - ((and (consp item) - (eq (car item) '|exit|) - (progn - (setq tmp1 (cdr item)) - (and (consp tmp1) - (progn - (setq cond (car tmp1)) - (setq tmp2 (cdr tmp1)) - (and (consp tmp2) - (eq (cdr tmp2) nil) - (progn - (setq value (car tmp2)) - t)))))) - (setq item - (list 'if cond value (|pfSequence2Sex0| (cdr seqList)))) - (setq seqTranList (cons item seqTranList)) - (setq seqList nil)) - (t - (progn - (setq seqTranList (cons item seqTranList)) - (setq seqList (cdr seqList)))))))))) - (if (eql (length seqTranList) 1) - (car seqTranList) - (cons 'seq (nreverse seqTranList))))))) - -\end{chunk} - -\defun{loopIters2Sex}{Convert a loop node to an S-expression} -\tpdhere{rewrite using dsetq} -\begin{verbatim} -;loopIters2Sex iterList == -; result := nil -; for iter in iterList repeat -; sex := pf2Sex1 iter -; sex is ['IN, var, ['SEGMENT, i, ["BY", incr]]] => -; result := [ ['STEP, var, i, incr], :result] -; sex is ['IN, var, ["BY", ['SEGMENT, i, j], incr]] => -; result := [ ['STEP, var, i, incr, j], :result] -; sex is ['IN, var, ['SEGMENT, i, j]] => -; result := [ ['STEP, var, i, 1, j], :result] -; result := [sex, :result] -; nreverse result -\end{verbatim} -\calls{loopIters2Sex}{pf2Sex1} -\begin{chunk}{defun loopIters2Sex} -(defun |loopIters2Sex| (iterList) - (let (j incr i var sex result tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 tmp7 tmp8) - (dolist (iter iterList (nreverse result)) - (setq sex (|pf2Sex1| iter)) - (cond - ((and (consp sex) - (eq (car sex) 'in) - (progn - (setq tmp1 (cdr sex)) - (and (consp tmp1) - (progn - (setq var (car tmp1)) - (setq tmp2 (cdr tmp1)) - (and (consp tmp2) - (eq (cdr tmp2) nil) - (progn - (setq tmp3 (car tmp2)) - (and (consp tmp3) - (eq (car tmp3) 'segment) - (progn - (setq tmp4 (cdr tmp3)) - (and (consp tmp4) - (progn - (setq i (car tmp4)) - (setq tmp5 (cdr tmp4)) - (and (consp tmp5) - (eq (cdr tmp5) nil) - (progn - (setq tmp6 (car tmp5)) - (and (consp tmp6) - (eq (car tmp6) 'by) - (progn - (setq tmp7 (cdr tmp6)) - (and (consp tmp7) - (eq (cdr tmp7) nil) - (progn - (setq incr (car tmp7)) - t)))))))))))))))) - (setq result (cons (list 'step var i incr) result))) - ((and (consp sex) - (eq (car sex) 'in) - (progn - (setq tmp1 (cdr sex)) - (and (consp tmp1) - (progn - (setq var (car tmp1)) - (setq tmp2 (cdr tmp1)) - (and (consp tmp2) - (eq (cdr tmp2) nil) - (progn - (setq tmp3 (car tmp2)) - (and (consp tmp3) - (eq (car tmp3) 'by) - (progn - (setq tmp4 (cdr tmp3)) - (and (consp tmp4) - (progn - (setq tmp5 (car tmp4)) - (and (consp tmp5) - (eq (car tmp5) 'segment) - (progn - (setq tmp6 (cdr tmp5)) - (and (consp tmp6) - (progn - (setq i (car tmp6)) - (setq tmp7 (cdr tmp6)) - (and (consp tmp7) - (eq (cdr tmp7) nil) - (progn - (setq j (car tmp7)) - t))))))) - (progn - (setq tmp8 (cdr tmp4)) - (and (consp tmp8) - (eq (cdr tmp8) nil) - (progn - (setq incr (car tmp8)) - t)))))))))))) - (setq result (cons (list 'step var i incr j) result))) - ((and (consp sex) - (eq (car sex) 'in) - (progn - (setq tmp1 (cdr sex)) - (and (consp tmp1) - (progn - (setq var (car tmp1)) - (setq tmp2 (cdr tmp1)) - (and (consp tmp2) - (eq (cdr tmp2) nil) - (progn - (setq tmp3 (car tmp2)) - (and (consp tmp3) - (eq (car tmp3) 'segment) - (progn - (setq tmp4 (cdr tmp3)) - (and (consp tmp4) - (progn - (setq i (car tmp4)) - (setq tmp5 (cdr tmp4)) - (and (consp tmp5) - (eq (cdr tmp5) nil) - (progn - (setq j (car tmp5)) - t)))))))))))) - (setq result (cons (list 'step var i 1 j) result))) - (t (setq result (cons sex result))))))) - -\end{chunk} - -\defun{pfCollect2Sex}{Change a Collect node to an S-expression} -\calls{pfCollect2Sex}{loopIters2Sex} -\calls{pfCollect2Sex}{pfParts} -\calls{pfCollect2Sex}{pfCollectIterators} -\calls{pfCollect2Sex}{pf2Sex1} -\calls{pfCollect2Sex}{pfCollectBody} -\begin{chunk}{defun pfCollect2Sex} -(defun |pfCollect2Sex| (pf) - (let (var cond sex tmp1 tmp2 tmp3 tmp4) - (setq sex - (cons 'collect - (append (|loopIters2Sex| (|pfParts| (|pfCollectIterators| pf))) - (list (|pf2Sex1| (|pfCollectBody| pf)))))) - (cond - ((and (consp sex) - (eq (car sex) 'collect) - (progn - (setq tmp1 (cdr sex)) - (and (consp tmp1) - (progn - (setq tmp2 (car tmp1)) - (and (consp tmp2) - (eq (car tmp2) '|\||) - (progn - (setq tmp3 (cdr tmp2)) - (and (consp tmp3) - (eq (cdr tmp3) nil) - (progn - (setq cond (car tmp3)) - t))))) - (progn - (setq tmp4 (cdr tmp1)) - (and (consp tmp4) - (eq (cdr tmp4) nil) - (progn (setq var (car tmp4)) t))))) - (symbolp var)) - (list '|\|| var cond)) - (t sex)))) - -\end{chunk} - -\defun{pfDefinition2Sex}{Convert a Definition node to an S-expression} -\calls{pfDefinition2Sex}{pf2Sex1} -\calls{pfDefinition2Sex}{pf0DefinitionLhsItems} -\calls{pfDefinition2Sex}{pfDefinitionRhs} -\calls{pfDefinition2Sex}{systemError} -\calls{pfDefinition2Sex}{pfLambdaTran} -\usesdollar{pfDefinition2Sex}{insideApplication} -\begin{chunk}{defun pfDefinition2Sex} -(defun |pfDefinition2Sex| (pf) - (let (body argList tmp1 rhs id idList) - (declare (special |$insideApplication|)) - (if |$insideApplication| - (list 'optarg - (|pf2Sex1| (car (|pf0DefinitionLhsItems| pf))) - (|pf2Sex1| (|pfDefinitionRhs| pf))) - (progn - (setq idList (mapcar #'|pf2Sex1| (|pf0DefinitionLhsItems| pf))) - (if (not (eql (length idList) 1)) - (|systemError| - "lhs of definition must be a single item in the interpreter") - (progn - (setq id (car idList)) - (setq rhs (|pfDefinitionRhs| pf)) - (setq tmp1 (|pfLambdaTran| rhs)) - (setq argList (car tmp1)) - (setq body (cdr tmp1)) - (cons 'def - (cons - (if (eq argList '|id|) - id - (cons id argList)) - body)))))))) - -\end{chunk} - -\defun{pfLambdaTran}{Convert a Lambda node to an S-expression} -\calls{pfLambdaTran}{pfLambda?} -\calls{pfLambdaTran}{pf0LambdaArgs} -\calls{pfLambdaTran}{pfTyped?} -\calls{pfLambdaTran}{pfCollectArgTran} -\calls{pfLambdaTran}{pfTypedId} -\calls{pfLambdaTran}{pfNothing?} -\calls{pfLambdaTran}{pfTypedType} -\calls{pfLambdaTran}{pf2Sex1} -\calls{pfLambdaTran}{systemError} -\calls{pfLambdaTran}{pfLambdaRets} -\calls{pfLambdaTran}{pfLambdaBody} -\begin{chunk}{defun pfLambdaTran} -(defun |pfLambdaTran| (pf) - (let (retType argList argTypeList) - (cond - ((|pfLambda?| pf) - (dolist (arg (|pf0LambdaArgs| pf)) - (if (|pfTyped?| arg) - (progn - (setq argList - (cons (|pfCollectArgTran| (|pfTypedId| arg)) argList)) - (if (|pfNothing?| (|pfTypedType| arg)) - (setq argTypeList (cons nil argTypeList)) - (setq argTypeList - (cons (|pf2Sex1| (|pfTypedType| arg)) argTypeList)))) - (|systemError| "definition args should be typed"))) - (setq argList (nreverse argList)) - (unless (|pfNothing?| (|pfLambdaRets| pf)) - (setq retType (|pf2Sex1| (|pfLambdaRets| pf)))) - (setq argTypeList (cons retType (nreverse argTypeList))) - (cons argList - (list argTypeList - (mapcar #'(lambda (x) (declare (ignore x)) nil) argTypeList) - (|pf2Sex1| (|pfLambdaBody| pf))))) - (t (cons '|id| (list '(nil) '(nil) (|pf2Sex1| pf))))))) - -\end{chunk} - -\defun{pfCollectArgTran}{pfCollectArgTran} -\calls{pfCollectArgTran}{pfCollect?} -\calls{pfCollectArgTran}{pf2sex1} -\calls{pfCollectArgTran}{pfParts} -\calls{pfCollectArgTran}{pfCollectIterators} -\calls{pfCollectArgTran}{pfCollectBody} -\begin{chunk}{defun pfCollectArgTran} -(defun |pfCollectArgTran| (pf) - (let (cond tmp2 tmp1 id conds) - (cond - ((|pfCollect?| pf) - (setq conds (mapcar #'|pf2sex1| (|pfParts| (|pfCollectIterators| pf)))) - (setq id (|pf2Sex1| (|pfCollectBody| pf))) - (cond - ((and (consp conds) ; conds is [ ["|", cond] ] - (eq (cdr conds) nil) - (progn - (setq tmp1 (car conds)) - (and (consp tmp1) - (eq (car tmp1) '|\||) - (progn - (setq tmp2 (cdr tmp1)) - (and (consp tmp2) - (eq (cdr tmp2) nil) - (progn - (setq cond (car tmp2)) - t)))))) - (list '|\|| id cond)) - (t (cons id conds)))) - (t (|pf2Sex1| pf))))) - -\end{chunk} - -\defun{pfLambda2Sex}{Convert a Lambda node to an S-expression} -\calls{pfLambda2Sex}{pfLambdaTran} -\begin{chunk}{defun pfLambda2Sex} -(defun |pfLambda2Sex| (pf) - (let (body argList tmp1) - (setq tmp1 (|pfLambdaTran| pf)) - (setq argList (car tmp1)) - (setq body (cdr tmp1)) - (cons 'adef (cons argList body)))) - -\end{chunk} - -\defun{pfRule2Sex}{Convert a Rule node to an S-expression} -\calls{pfRule2Sex}{pfLhsRule2Sex} -\calls{pfRule2Sex}{pfRuleLhsItems} -\calls{pfRule2Sex}{pfRhsRule2Sex} -\calls{pfRule2Sex}{pfRuleRhs} -\calls{pfRule2Sex}{ruleLhsTran} -\calls{pfRule2Sex}{rulePredicateTran} -\usesdollar{pfRule2Sex}{multiVarPredicateList} -\usesdollar{pfRule2Sex}{predicateList} -\usesdollar{pfRule2Sex}{quotedOpList} -\begin{chunk}{defun pfRule2Sex} -(defun |pfRule2Sex| (pf) - (let (|$multiVarPredicateList| |$predicateList| |$quotedOpList| rhs lhs) - (declare (special |$multiVarPredicateList| |$predicateList| |$quotedOpList|)) - (setq |$quotedOpList| nil) - (setq |$predicateList| nil) - (setq |$multiVarPredicateList| nil) - (setq lhs (|pfLhsRule2Sex| (|pfRuleLhsItems| pf))) - (setq rhs (|pfRhsRule2Sex| (|pfRuleRhs| pf))) - (setq lhs (|ruleLhsTran| lhs)) - (|rulePredicateTran| - (if |$quotedOpList| - (list '|rule| lhs rhs (cons '|construct| |$quotedOpList|)) - (list '|rule| lhs rhs))))) - -\end{chunk} - -\defun{pfLhsRule2Sex}{Convert the Lhs of a Rule to an S-expression} -\calls{pfLhsRule2Sex}{pf2Sex1} -\usesdollar{pfLhsRule2Sex}{insideRule} -\begin{chunk}{defun pfLhsRule2Sex} -(defun |pfLhsRule2Sex| (lhs) - (let (|$insideRule|) - (declare (special |$insideRule|)) - (setq |$insideRule| '|left|) - (|pf2Sex1| lhs))) - -\end{chunk} - -\defun{pfRhsRule2Sex}{Convert the Rhs of a Rule to an S-expression} -\calls{pfRhsRule2Sex}{pf2Sex1} -\usesdollar{pfRhsRule2Sex}{insideRule} -\begin{chunk}{defun pfRhsRule2Sex} -(defun |pfRhsRule2Sex| (rhs) - (let (|$insideRule|) - (declare (special |$insideRule|)) - (setq |$insideRule| '|right|) - (|pf2Sex1| rhs))) - -\end{chunk} - -\defun{rulePredicateTran}{Convert a Rule predicate to an S-expression} -\begin{verbatim} -;rulePredicateTran rule == -; null $multiVarPredicateList => rule -; varList := patternVarsOf [rhs for [.,.,:rhs] in $multiVarPredicateList] -; predBody := -; CDR $multiVarPredicateList => -; ['AND, :[:pvarPredTran(rhs, varList) for [.,.,:rhs] in -; $multiVarPredicateList]] -; [ [.,.,:rhs],:.] := $multiVarPredicateList -; pvarPredTran(rhs, varList) -; ['suchThat, rule, -; ['construct, :[ ["QUOTE", var] for var in varList]], -; ['ADEF, '(predicateVariable), -; '((Boolean) (List (Expression (Integer)))), '(() ()), -; predBody]] -\end{verbatim} -\calls{rulePredicateTran}{patternVarsOf} -\calls{rulePredicateTran}{pvarPredTran} -\usesdollar{rulePredicateTran}{multiVarPredicateList} -\begin{chunk}{defun rulePredicateTran} -(defun |rulePredicateTran| (rule) - (let (predBody varList rhs tmp1 result) - (declare (special |$multiVarPredicateList|)) - (if (null |$multiVarPredicateList|) - rule - (progn - (setq varList - (|patternVarsOf| - ((lambda (t1 t2 t3) - (loop - (cond - ((or (atom t2) - (progn - (setq t3 (car t2)) - nil)) - (return (nreverse t1))) - (t - (and (consp t3) - (progn - (setq tmp1 (cdr t3)) - (and (consp tmp1) - (progn - (setq rhs (cdr tmp1)) - t))) - (setq t1 (cons rhs t1))))) - (setq t2 (cdr t2)))) - nil |$multiVarPredicateList| nil))) - (setq predBody - (cond - ((cdr |$multiVarPredicateList|) - (cons 'and - ((lambda (t4 t5 t6) - (loop - (cond - ((or (atom t5) - (progn - (setq t6 (car t5)) - nil)) - (return (nreverse t4))) - (t - (and (consp t6) - (progn - (setq tmp1 (cdr t6)) - (and (consp tmp1) - (progn - (setq rhs (cdr tmp1)) - t))) - (setq t4 - (append (reverse (|pvarPredTran| rhs varList)) - t4))))) - (setq t5 (cdr t5)))) - nil |$multiVarPredicateList| nil))) - (t - (progn - (setq rhs (cddar |$multiVarPredicateList|)) - (|pvarPredTran| rhs varList))))) - (dolist (var varList) (push (list 'quote var) result)) - (list '|suchThat| rule - (cons '|construct| (nreverse result)) - (list 'adef '(|predicateVariable|) - '((|Boolean|) - (|List| (|Expression| (|Integer|)))) - '(nil nil) predBody)))))) - -\end{chunk} - -\defun{patternVarsOf}{patternVarsOf} -\calls{patternVarsOf}{patternVarsOf1} -\begin{chunk}{defun patternVarsOf} -(defun |patternVarsOf| (expr) - (|patternVarsOf1| expr nil)) - -\end{chunk} - -\defun{patternVarsOf1}{patternVarsOf1} -\calls{patternVarsOf1}{patternVarsOf1} -\begin{chunk}{defun patternVarsOf1} -(defun |patternVarsOf1| (expr varList) - (let (argl op) - (cond - ((null expr) varList) - ((atom expr) - (cond - ((null (symbolp expr)) varList) - ((member expr varList) varList) - (t (cons expr varList)))) - ((and (consp expr) - (progn - (setq op (car expr)) - (setq argl (cdr expr)) - t)) - (progn - (dolist (arg argl) - (setq varList (|patternVarsOf1| arg varList))) - varList)) - (t varList)))) - -\end{chunk} - -\defun{pvarPredTran}{pvarPredTran} -\begin{chunk}{defun pvarPredTran} -(defun |pvarPredTran| (rhs varList) - (let ((i 0)) - (dolist (var varList rhs) - (setq rhs (nsubst (list '|elt| '|predicateVariable| (incf i)) var rhs))))) - -\end{chunk} - -\defun{ruleLhsTran}{Convert the Lhs of a Rule node to an S-expression} -\calls{ruleLhsTran}{patternVarsOf} -\calls{ruleLhsTran}{nsubst} -\usesdollar{ruleLhsTran}{predicateList} -\usesdollar{ruleLhsTran}{multiVarPredicateList} -\begin{chunk}{defun ruleLhsTran} -(defun |ruleLhsTran| (ruleLhs) - (let (predicate var vars predRhs predLhs name) - (declare (special |$predicateList| |$multiVarPredicateList|)) - (dolist (pred |$predicateList|) - (setq name (car pred)) - (setq predLhs (cadr pred)) - (setq predRhs (cddr pred)) - (setq vars (|patternVarsOf| predRhs)) - (cond - ((cdr vars) - (setq ruleLhs (nsubst predLhs name ruleLhs)) - (setq |$multiVarPredicateList| (cons pred |$multiVarPredicateList|))) - (t - (setq var (cadr predLhs)) - (setq predicate - (list '|suchThat| predLhs (list 'adef (list var) - '((|Boolean|) (|Expression| (|Integer|))) '(nil nil) predRhs))) - (setq ruleLhs (nsubst predicate name ruleLhs))))) - ruleLhs)) - -\end{chunk} - -\defun{opTran}{Translate ops into internal symbols} -\begin{chunk}{defun opTran 0} -(defun |opTran| (op) - (cond - ((equal op '|..|) 'segment) - ((eq op '[]) '|construct|) - ((eq op '{}) '|braceFromCurly|) - ((eq op 'is) '|is|) - (t op))) - -\end{chunk} - -\chapter{Keyed Message Handling} -Throughout the interpreter there are messages printed using a symbol -for a database lookup. This was done to enable translation of these -messages languages other than English. - -Axiom messages are read from a flat file database and returned -as one long string. They are preceded in the database by a key and -this is how they are referenced from code. For example, one key is -S2IL0001 which means: -\begin{verbatim} - S2 Scratchpad II designation - I from the interpreter - L originally from LISPLIB BOOT - 0001 a sequence number -\end{verbatim} - -Each message may contain formatting codes and and parameter codes. -The formatting codes are: -\begin{verbatim} - %b turn on bright printing - %ceoff turn off centering - %ceon turn on centering - %d turn off bright printing - %f user defined printing - %i start indentation of 3 more spaces - %l start a new line - %m math-print an expression - %rjoff turn off right justification (actually ragged left) - %rjon turn on right justification (actually ragged left) - %s pretty-print as an S-expression - %u unindent 3 spaces - %x# insert # spaces -\end{verbatim} - -The parameter codes look like \%1, \%2b, \%3p, \%4m, \%5bp, \%6s where the -digit is the parameter number and the letters following indicate -additional formatting. You can indicate as many additional formatting -qualifiers as you like, to the degree they make sense. -\begin{itemize} -\item The ``p'' code means to call prefix2String on the parameter, -a standard way of printing abbreviated types. -\item The ``P'' operator maps prefix2String over its arguments. -\item The ``o'' operation formats the argument as an operation name. -\item The ``b'' means to print that parameter in a bold (bright) font. -\item The ``c'' means to center that parameter on a new line. -\item The ``r'' means to right justify (ragged left) the argument. -\item The ``f'' means that the parameter is a list [fn, :args] -and that ``fn'' is to be called on ``args'' to get the text. -\end{itemize} - -Look in the file with the name defined in \verb|$defaultMsgDatabaseName| -above for examples. - -\defdollar{cacheMessages} -This is used for debugging -\begin{chunk}{initvars} -(defvar |$cacheMessages| t) - -\end{chunk} - -\defdollar{msgAlist} -\begin{chunk}{initvars} -(defvar |$msgAlist| nil) - -\end{chunk} - -\defdollar{testingErrorPrefix} -\begin{chunk}{initvars} -(defvar |$testingErrorPrefix| "Daly Bug") - -\end{chunk} - -\defdollar{texFormatting} -\begin{chunk}{initvars} -(defvar |$texFormatting| nil) - -\end{chunk} - -\defvar{*msghash*} -\begin{chunk}{initvars} -(defvar *msghash* nil "hash table keyed by msg number") - -\end{chunk} - -\defdollar{msgdbPrims} -\begin{chunk}{initvars} -(defvar |$msgdbPrims| - '(|%b| |%d| |%l| |%i| |%u| %U |%n| |%x| |%ce| |%rj| "%U" "%b" "%d" - "%l" "%i" "%u" "%U" "%n" "%x" "%ce" "%rj")) - -\end{chunk} - -\defdollar{msgdbPunct} -\begin{chunk}{initvars} -(defvar |$msgdbPunct| - '(|.| |,| ! |:| |;| ? ] |)| "." "," "!" ":" ";" "?" "]" ")")) - -\end{chunk} - -\defdollar{msgdbNoBlanksBeforeGroup} -\begin{chunk}{initvars} -(defvar |$msgdbNoBlanksBeforeGroup| - `(" " | | "%" % ,@|$msgdbPrims| ,@|$msgdbPunct|)) - -\end{chunk} - -\defdollar{msgdbNoBlanksAfterGroup} -\begin{chunk}{initvars} -(defvar |$msgdbNoBlanksAfterGroup| - `(" " | | "%" % ,@|$msgdbPrims| [ |(| "[" "(")) - -\end{chunk} - -\defun{fetchKeyedMsg}{Fetch a message from the message database} -If the {\tt *msghash*} hash table is empty we call {\tt cacheKeyedMsg} -to fill the table, otherwise we do a key lookup in the hash table. -\calls{fetchKeyedMsg}{object2Identifier} -\calls{fetchKeyedMsg}{cacheKeyedMsg} -\usesdollar{fetchKeyedMsg}{defaultMsgDatabaseName} -\uses{fetchKeyedMsg}{*msghash*} -\begin{chunk}{defun fetchKeyedMsg} -(defun |fetchKeyedMsg| (key ignore) - (declare (ignore ignore) (special *msghash* |$defaultMsgDatabaseName|)) - (setq key (|object2Identifier| key)) - (unless *msghash* - (setq *msghash* (make-hash-table)) - (cacheKeyedMsg |$defaultMsgDatabaseName|)) - (gethash key *msghash*)) - -\end{chunk} - -\defun{cacheKeyedMsg}{Cache messages read from message database} -\catches{cacheKeyedMsg}{done} -\throws{cacheKeyedMsg}{done} -\uses{cacheKeyedMsg}{*msghash*} -\begin{chunk}{defun cacheKeyedMsg} -(defun cacheKeyedMsg (file) - (let ((line "") (msg "") key) - (declare (special *msghash*)) - (with-open-file (in file) - (catch 'done - (loop - (setq line (read-line in nil nil)) - (cond - ((null line) - (when key (setf (gethash key *msghash*) msg)) - (throw 'done nil)) - ((= (length line) 0)) - ((char= (schar line 0) #\S) - (when key (setf (gethash key *msghash*) msg)) - (setq key (intern line "BOOT")) - (setq msg "")) - ('else - (setq msg (concatenate 'string msg line))))))))) - -\end{chunk} - -\defun{getKeyedMsg}{getKeyedMsg} -\calls{getKeyedMsg}{fetchKeyedMsg} -\begin{chunk}{defun getKeyedMsg} -(defun |getKeyedMsg| (key) (|fetchKeyedMsg| key nil)) - -\end{chunk} - -\defun{sayKeyedMsg}{Say a message using a keyed lookup} -\calls{sayKeyedMsg}{sayKeyedMsgLocal} -\usesdollar{sayKeyedMsg}{texFormatting} -\begin{chunk}{defun sayKeyedMsg} -(defun |sayKeyedMsg| (key args) - (let (|$texFormatting|) - (declare (special |$texFormatting|)) - (setq |$texFormatting| nil) - (|sayKeyedMsgLocal| key args))) - -\end{chunk} - -\defun{sayKeyedMsgLocal}{Handle msg formatting and print to file} -\calls{sayKeyedMsgLocal}{segmentKeyedMsg} -\calls{sayKeyedMsgLocal}{getKeyedMsg} -\calls{sayKeyedMsgLocal}{substituteSegmentedMsg} -\calls{sayKeyedMsgLocal}{flowSegmentedMsg} -\calls{sayKeyedMsgLocal}{sayMSG2File} -\calls{sayKeyedMsgLocal}{sayMSG} -\usesdollar{sayKeyedMsgLocal}{printMsgsToFile} -\usesdollar{sayKeyedMsgLocal}{linelength} -\usesdollar{sayKeyedMsgLocal}{margin} -\usesdollar{sayKeyedMsgLocal}{displayMsgNumber} -\begin{chunk}{defun sayKeyedMsgLocal} -(defun |sayKeyedMsgLocal| (key args) - (let (msg msgp) - (declare (special |$printMsgsToFile| $linelength $margin |$displayMsgNumber|)) - (setq msg (|segmentKeyedMsg| (|getKeyedMsg| key))) - (setq msg (|substituteSegmentedMsg| msg args)) - (when |$displayMsgNumber| (setq msg `("%b" ,key |:| "%d" . ,msg))) - (setq msgp (|flowSegmentedMsg| msg $linelength $margin)) - (when |$printMsgsToFile| (|sayMSG2File| msgp)) - (|sayMSG| msgp))) - -\end{chunk} - -\defun{segmentKeyedMsg}{Break a message into words} -\calls{segmentKeyedMsg}{string2Words} -\begin{chunk}{defun segmentKeyedMsg} -(defun |segmentKeyedMsg| (msg) (|string2Words| msg)) - -\end{chunk} - -\defun{sayMSG2File}{Write a msg into spadmsg.listing file} -\calls{sayMSG2File}{makePathname} -\calls{sayMSG2File}{defiostream} -\calls{sayMSG2File}{sayBrightly1} -\calls{sayMSG2File}{shut} -\begin{chunk}{defun sayMSG2File} -(defun |sayMSG2File| (msg) - (let (file str) - (setq file (|makePathname| '|spadmsg| '|listing| 'a)) - (setq str (defiostream `((mode . output) (file . ,file)) 255 0)) - (sayBrightly1 msg str) - (shut str))) - -\end{chunk} - -\defun{sayMSG}{sayMSG} -\calls{saymsg}{saybrightly1} -\usesdollar{sayMSG}{algebraOutputStream} -\begin{chunk}{defun sayMSG} -(defun |sayMSG| (x) - (declare (special |$algebraOutputStream|)) - (when x (sayBrightly1 x |$algebraOutputStream|))) - -\end{chunk} - -\chapter{Stream Utilities} -The input stream is parsed into a large s-expression by repeated calls -to Delay. Delay takes a function f and an argument x and returns a list -consisting of \verb|("nonnullstream" f x)|. Eventually multiple calls are made -and a large list structure is created that consists of -\verb|("nonnullstream" f x ("nonnullstream" f1 x1 ("nonnullstream" f2 x2...| - -This delay structure is given to StreamNull which walks along the -list looking at the head. If the head is ``nonnullstream'' then the -function is applied to the argument. - -So, in effect, the input is ``zipped up'' into a Delay data structure -which is then evaluated by calling StreamNull. This "zippered stream" -parser was a research project at IBM and Axiom was the testbed (which -explains the strange parsing technique). - -\defun{npNull}{npNull} -\calls{npNull}{StreamNull} -\begin{chunk}{defun npNull} -(defun |npNull| (x) (|StreamNull| x)) - -\end{chunk} - -\defun{StreamNull}{StreamNull} -\calls{StreamNull}{eqcar} -\label{StreamNull} -\sig{StreamNull}{Delay}{Union(T,NIL)} -\begin{chunk}{defun StreamNull 0} -(defun |StreamNull| (delay) - (let (parsepair) - (cond - ((or (null delay) (eqcar delay '|nullstream|)) t) - (t - ((lambda nil - (loop - (cond - ((not (eqcar delay '|nonnullstream|)) (return nil)) - (t - (setq parsepair (apply (cadr delay) (cddr delay))) - (rplaca delay (car parsepair)) - (rplacd delay (cdr parsepair))))))) - (eqcar delay '|nullstream|))))) - -\end{chunk} - -\chapter{Code Piles} -The insertpiles function converts a line-list to a line-forest where -a line is a token-dequeue and has a column which is an integer. -An A-forest is an A-tree-list -An A-tree has a root which is an A, and subtrees which is an A-forest. - -A forest with more than one tree corresponds to a Scratchpad pile -structure (t1;t2;t3;...;tn), and a tree corresponds to a pile item. -The ( ; and ) tokens are inserted into a >1-forest, otherwise -the root of the first tree is concatenated with its forest. -column t is the number of spaces before the first non-space in line t - -\defun{insertpile}{insertpile} -\calls{insertpile}{npNull} -\calls{insertpile}{pilePlusComment} -\calls{insertpile}{pilePlusComments} -\calls{insertpile}{pileTree} -\calls{insertpile}{pileCforest} -\begin{chunk}{defun insertpile} -(defun |insertpile| (s) - (let (stream a t1 h1 t2 h tmp1) - (cond - ((|npNull| s) (list nil 0 nil s)) - (t - (setq tmp1 (list (car s) (cdr s))) - (setq h (car tmp1)) - (setq t2 (cadr tmp1)) - (cond - ((|pilePlusComment| h) - (setq tmp1 (|pilePlusComments| s)) - (setq h1 (car tmp1)) - (setq t1 (cadr tmp1)) - (setq a (|pileTree| (- 1) t1)) - (cons (list (|pileCforest| - (append h1 (cons (elt a 2) nil)))) - (elt a 3))) - (t - (setq stream (cadar s)) - (setq a (|pileTree| -1 s)) - (cons (list (list (elt a 2) stream)) (elt a 3)))))))) - -\end{chunk} - -\defun{pilePlusComment}{pilePlusComment} -\calls{pilePlusComment}{tokType} -\calls{pilePlusComments}{npNull} -\calls{pilePlusComments}{pilePlusComment} -\calls{pilePlusComments}{pilePlusComments} -\begin{chunk}{defun pilePlusComment} -(defun |pilePlusComment| (arg) - (eq (|tokType| (caar arg)) '|comment|)) - -\end{chunk} -\defun{pilePlusComments}{pilePlusComments} -\begin{chunk}{defun pilePlusComments} -(defun |pilePlusComments| (s) - (let (t1 h1 t2 h tmp1) - (cond - ((|npNull| s) (list nil s)) - (t - (setq tmp1 (list (car s) (cdr s))) - (setq h (car tmp1)) - (setq t2 (cadr tmp1)) - (cond - ((|pilePlusComment| h) - (setq tmp1 (|pilePlusComments| t2)) - (setq h1 (car tmp1)) - (setq t1 (cadr tmp1)) - (list (cons h h1) t1)) - (t - (list nil s))))))) - -\end{chunk} - -\defun{pileTree}{pileTree} -\calls{pileTree}{npNull} -\calls{pileTree}{pileColumn} -\calls{pileTree}{pileForests} -\begin{chunk}{defun pileTree} -(defun |pileTree| (n s) - (let (hh t1 h tmp1) - (cond - ((|npNull| s) (list nil n nil s)) - (t - (setq tmp1 (list (car s) (cdr s))) - (setq h (car tmp1)) - (setq t1 (cadr tmp1)) - (setq hh (|pileColumn| (car h))) - (cond - ((< n hh) (|pileForests| (car h) hh t1)) - (t (list nil n nil s))))))) - -\end{chunk} - -\defun{pileColumn}{pileColumn} -\calls{pileColumn}{tokPosn} -\begin{chunk}{defun pileColumn} -(defun |pileColumn| (arg) - (cdr (|tokPosn| (caar arg)))) - -\end{chunk} - -\defun{pileForests}{pileForests} -\calls{pileForests}{pileForest} -\calls{pileForests}{npNull} -\calls{pileForests}{pileForests} -\calls{pileForests}{pileCtree} -\begin{chunk}{defun pileForests} -(defun |pileForests| (h n s) - (let (t1 h1 tmp1) - (setq tmp1 (|pileForest| n s)) - (setq h1 (car tmp1)) - (setq t1 (cadr tmp1)) - (cond - ((|npNull| h1) (list t n h s)) - (t (|pileForests| (|pileCtree| h h1) n t1))))) - -\end{chunk} - -\defun{pileForest}{pileForest} -\calls{pileForest}{pileTree} -\calls{pileForest}{pileForest1} -\begin{chunk}{defun pileForest} -(defun |pileForest| (n s) - (let (t1 h1 t2 h hh b tmp) - (setq tmp (|pileTree| n s)) - (setq b (car tmp)) - (setq hh (cadr tmp)) - (setq h (caddr tmp)) - (setq t2 (cadddr tmp)) - (cond - (b - (setq tmp (|pileForest1| hh t2)) - (setq h1 (car tmp)) - (setq t1 (cadr tmp)) - (list (cons h h1) t1)) - (t - (list nil s))))) - -\end{chunk} - -\defun{pileForest1}{pileForest1} -\calls{pileForest1}{eqpileTree} -\calls{pileForest1}{pileForest1} -\begin{chunk}{defun pileForest1} -(defun |pileForest1| (n s) - (let (t1 h1 t2 h n1 b tmp) - (setq tmp (|eqpileTree| n s)) - (setq b (car tmp)) - (setq n1 (cadr tmp)) - (setq h (caddr tmp)) - (setq t2 (cadddr tmp)) - (cond - (b - (setq tmp (|pileForest1| n t2)) - (setq h1 (car tmp)) - (setq t1 (cadr tmp)) - (list (cons h h1) t1)) - (t (list nil s))))) - -\end{chunk} - -\defun{eqpileTree}{eqpileTree} -\calls{eqpileTree}{npNull} -\calls{eqpileTree}{pileColumn} -\calls{eqpileTree}{pileForests} -\begin{chunk}{defun eqpileTree} -(defun |eqpileTree| (n s) - (let (hh t1 h tmp) - (cond - ((|npNull| s) (list nil n nil s)) - (t - (setq tmp (list (car s) (cdr s))) - (setq h (car tmp)) - (setq t1 (cadr tmp)) - (setq hh (|pileColumn| (car h))) - (cond - ((equal hh n) (|pileForests| (car h) hh t1)) - (t (list nil n nil s))))))) - -\end{chunk} - -\defun{pileCtree}{pileCtree} -\calls{pileCtree}{dqAppend} -\calls{pileCtree}{pileCforest} -\begin{chunk}{defun pileCtree} -(defun |pileCtree| (x y) - (|dqAppend| x (|pileCforest| y))) - -\end{chunk} - -\defun{pileCforest}{pileCforest} -Only enpiles forests with $>=2$ trees - -\calls{pileCforest}{tokPart} -\calls{pileCforest}{enPile} -\calls{pileCforest}{separatePiles} -\begin{chunk}{defun pileCforest} -(defun |pileCforest| (x) - (let (f) - (cond - ((null x) nil) - ((null (cdr x)) (setq f (car x)) - (cond - ((eq (|tokPart| (caar f)) 'if) (|enPile| f)) - (t f))) - (t (|enPile| (|separatePiles| x)))))) - -\end{chunk} - -\defun{enPile}{enPile} -\calls{enPile}{dqConcat} -\calls{enPile}{dqUnit} -\calls{enPile}{tokConstruct} -\calls{enPile}{firstTokPosn} -\calls{enPile}{lastTokPosn} -\begin{chunk}{defun enPile} -(defun |enPile| (x) - (|dqConcat| - (list - (|dqUnit| (|tokConstruct| '|key| 'settab (|firstTokPosn| x))) - x - (|dqUnit| (|tokConstruct| '|key| 'backtab (|lastTokPosn| x)))))) - -\end{chunk} - -\defun{firstTokPosn}{firstTokPosn} -\calls{firstTokPosn}{tokPosn} -\begin{chunk}{defun firstTokPosn} -(defun |firstTokPosn| (arg) (|tokPosn| (caar arg))) - -\end{chunk} - -\defun{lastTokPosn}{lastTokPosn} -\calls{lastTokPosn}{tokPosn} -\begin{chunk}{defun lastTokPosn} -(defun |lastTokPosn| (arg) (|tokPosn| (cadr arg))) - -\end{chunk} - -\defun{separatePiles}{separatePiles} -\calls{separatePiles}{dqUnit} -\calls{separatePiles}{tokConstruct} -\calls{separatePiles}{lastTokPosn} -\calls{separatePiles}{dqConcat} -\calls{separatePiles}{separatePiles} -\begin{chunk}{defun separatePiles} -(defun |separatePiles| (x) - (let (semicolon a) - (cond - ((null x) nil) - ((null (cdr x)) (car x)) - (t - (setq a (car x)) - (setq semicolon - (|dqUnit| (|tokConstruct| '|key| 'backset (|lastTokPosn| a)))) - (|dqConcat| (list a semicolon (|separatePiles| (cdr x)))))))) - -\end{chunk} - -\chapter{Dequeue Functions} -The dqUnit makes a unit dq i.e. a dq with one item, from the item -\defun{dqUnit}{dqUnit} -\begin{chunk}{defun dqUnit 0} -(defun |dqUnit| (s) - (let (a) - (setq a (list s)) - (cons a a))) - -\end{chunk} - -\defun{dqConcat}{dqConcat} -The dqConcat function concatenates a list of dq's, destroying all but the last - -\calls{dqConcat}{dqAppend} -\calls{dqConcat}{dqConcat} -\begin{chunk}{defun dqConcat} -(defun |dqConcat| (ld) - (cond - ((null ld) nil) - ((null (cdr ld)) (car ld)) - (t (|dqAppend| (car ld) (|dqConcat| (cdr ld)))))) - -\end{chunk} - -\defun{dqAppend}{dqAppend} -The dqAppend function appends 2 dq's, destroying the first -\begin{chunk}{defun dqAppend 0} -(defun |dqAppend| (x y) - (cond - ((null x) y) - ((null y) x) - (t - (rplacd (cdr x) (car y)) - (rplacd x (cdr y)) x))) - -\end{chunk} - -\defun{dqToList}{dqToList} -\begin{chunk}{defun dqToList 0} -(defun |dqToList| (s) - (when s (car s))) - -\end{chunk} - -\chapter{Message Handling} - -\section{The Line Object} - -\defun{lnCreate}{Line object creation} -This is called in only one place, the incLine1 function. -\begin{chunk}{defun lnCreate 0} -(defun |lnCreate| (extraBlanks string globalNum &rest optFileStuff) - (let ((localNum (first optFileStuff)) - (filename (second optFileStuff))) - (unless localNum (setq localNum 0)) - (list extraBlanks string globalNum localNum filename))) - -\end{chunk} - -\defun{lnExtraBlanks}{Line element 0; Extra blanks} -\begin{chunk}{defun lnExtraBlanks 0} -(defun |lnExtraBlanks| (lineObject) (elt lineObject 0)) - -\end{chunk} - -\defun{lnString}{Line element 1; String} -\begin{chunk}{defun lnString 0} -(defun |lnString| (lineObject) (elt lineObject 1)) - -\end{chunk} - -\defun{lnGlobalNum}{Line element 2; Globlal number} -\begin{chunk}{defun lnGlobalNum 0} -(defun |lnGlobalNum| (lineObject) (elt lineObject 2)) - -\end{chunk} - -\defun{lnSetGlobalNum}{Line element 2; Set Global number} -\begin{chunk}{defun lnSetGlobalNum 0} -(defun |lnSetGlobalNum| (lineObject num) - (setf (elt lineObject 2) num)) - -\end{chunk} - -\defun{lnLocalNum}{Line elemnt 3; Local number} -\begin{chunk}{defun lnLocalNum 0} -(defun |lnLocalNum| (lineObject) (elt lineObject 3)) - -\end{chunk} - -\defun{lnPlaceOfOrigin}{Line element 4; Place of origin} -\begin{chunk}{defun lnPlaceOfOrigin 0} -(defun |lnPlaceOfOrigin| (lineObject) (elt lineObject 4)) - -\end{chunk} - -\defun{lnImmediate?}{Line element 4: Is it a filename?} -\calls{lnImmediate?}{lnFileName?} -\begin{chunk}{defun lnImmediate? 0} -(defun |lnImmediate?| (lineObject) (null (|lnFileName?| lineObject))) - -\end{chunk} - -\defun{lnFileName?}{Line element 4: Is it a filename?} -\begin{chunk}{defun lnFileName? 0} -(defun |lnFileName?| (lineObject) - (let (filename) - (when (consp (setq filename (elt lineObject 4))) filename))) - -\end{chunk} - -\defun{lnFileName}{Line element 4; Get filename} -\calls{lnFileName}{lnFileName?} -\calls{lnFileName}{ncBug} -\begin{chunk}{defun lnFileName} -(defun |lnFileName| (lineObject) - (let (fN) - (if (setq fN (|lnFileName?| lineObject)) - fN - (|ncBug| "there is no file name in %1" (list lineObject))))) - -\end{chunk} - - -\section{Messages} - -\defun{msgCreate}{msgCreate} -\begin{verbatim} -msgObject - tag -- catagory of msg - -- attributes as a-list - 'imPr => dont save for list processing - toWhere, screen or file - 'norep => only display once in list - pos -- position with possible FROM/TO tag - key -- key for message database - argL -- arguments to be placed in the msg test - prefix -- things like "Error: " - text -- the actual text -\end{verbatim} -\calls{msgCreate}{setMsgForcedAttrList} -\calls{msgCreate}{putDatabaseStuff} -\calls{msgCreate}{initImPr} -\calls{msgCreate}{initToWhere} -\begin{chunk}{defun msgCreate} -(defun |msgCreate| (tag posWTag key argL optPre &rest optAttr) - (let (msg) - (when (consp key) (setq tag '|old|)) - (setq msg (list tag posWTag key argL optPre nil)) - (when (car optAttr) (|setMsgForcedAttrList| msg (car optAttr))) - (|putDatabaseStuff| msg) - (|initImPr| msg) - (|initToWhere| msg) - msg)) - -\end{chunk} - -\defmacro{getMsgPosTagOb} -\begin{chunk}{defmacro getMsgPosTagOb 0} -(defmacro |getMsgPosTagOb| (msg) - `(elt ,msg 1)) - -\end{chunk} - -\defmacro{getMsgKey} -\begin{chunk}{defmacro getMsgKey 0} -(defmacro |getMsgKey| (msg) - `(elt ,msg 2)) - -\end{chunk} - -\defmacro{getMsgArgL} -\begin{chunk}{defmacro getMsgArgL 0} -(defmacro |getMsgArgL| (msg) - `(elt ,msg 3)) - -\end{chunk} - -\defmacro{getMsgPrefix} -\begin{chunk}{defmacro getMsgPrefix 0} -(defmacro |getMsgPrefix| (msg) - `(elt ,msg 4)) - -\end{chunk} - -\defmacro{setMsgPrefix} -\begin{chunk}{defmacro setMsgPrefix 0} -(defmacro |setMsgPrefix| (msg val) - `(setf (elt ,msg 4) ,val)) - -\end{chunk} - -\defmacro{getMsgText} -\begin{chunk}{defmacro getMsgText 0} -(defmacro |getMsgText| (msg) - `(elt ,msg 5)) - -\end{chunk} - -\defmacro{setMsgText} -\begin{chunk}{defmacro setMsgText 0} -(defmacro |setMsgText| (msg val) - `(setf (elt ,msg 5) ,val)) - -\end{chunk} - -\defmacro{getMsgPrefix?} -\begin{chunk}{defmacro getMsgPrefix? 0} -(defmacro |getMsgPrefix?| (msg) - `(let ((pre (|getMsgPrefix| ,msg))) - (unless (eq pre '|noPre|) pre))) - -\end{chunk} - -\defmacro{getMsgTag} -The valid message tags are: -line, old, error, warn, bug, unimple, remark, stat, say, debug - -\calls{getMsgTag}{ncTag} -\begin{chunk}{defmacro getMsgTag 0} -(defmacro |getMsgTag| (msg) - `(|ncTag| ,msg)) - -\end{chunk} - -\defmacro{getMsgTag?} -\calls{getMsgTag?}{ifcar} -\calls{getMsgTag?}{getMsgTag} -\begin{chunk}{defmacro getMsgTag? 0} -(defmacro |getMsgTag?| (msg) - `(ifcar (member (|getMsgTag| ,msg) - (list '|line| '|old| '|error| '|warn| '|bug| - '|unimple| '|remark| '|stat| '|say| '|debug|)))) - -\end{chunk} - -\defmacro{line?} -\calls{line?}{getMsgTag} -\begin{chunk}{defmacro line?} -(defmacro |line?| (msg) - `(eq (|getMsgTag| ,msg) '|line|)) - -\end{chunk} - -\defmacro{leader?} -\calls{leader?}{getMsgTag} -\begin{chunk}{defmacro leader?} -(defmacro |leader?| (msg) - `(eq (|getMsgTag| ,msg) '|leader|)) - -\end{chunk} - -\defmacro{toScreen?} -\calls{toScreen?}{getMsgToWhere} -\begin{chunk}{defmacro toScreen?} -(defmacro |toScreen?| (msg) - `(not (eq (|getMsgToWhere| ,msg) '|fileOnly|))) - -\end{chunk} - -\defun{ncSoftError}{ncSoftError} -Messages for the USERS of the compiler. -The program being compiled has a minor error. -Give a message and continue processing. - -\calls{ncSoftError}{desiredMsg} -\calls{ncSoftError}{processKeyedError} -\calls{ncSoftError}{msgCreate} -\usesdollar{ncSoftError}{newcompErrorCount} -\begin{chunk}{defun ncSoftError} -(defun |ncSoftError| (pos erMsgKey erArgL &rest optAttr) - (declare (special |$newcompErrorCount|)) - (setq |$newcompErrorCount| (+ |$newcompErrorCount| 1)) - (when (|desiredMsg| erMsgKey) - (|processKeyedError| - (|msgCreate| '|error| pos erMsgKey erArgL - "Error" optAttr)))) - -\end{chunk} - -\defun{ncHardError}{ncHardError} -The program being compiled is seriously incorrect. -Give message and throw to a recovery point. - -\calls{ncHardError}{desiredMsg} -\calls{ncHardError}{processKeyedError} -\calls{ncHardError}{msgCreate} -\calls{ncHardError}{ncError} -\usesdollar{ncHardError}{newcompErrorCount} -\begin{chunk}{defun ncHardError} -(defun |ncHardError| (pos erMsgKey erArgL &rest optAttr) - (let (erMsg) - (declare (special |$newcompErrorCount|)) - (setq |$newcompErrorCount| (+ |$newcompErrorCount| 1)) - (if (|desiredMsg| erMsgKey) - (setq erMsg - (|processKeyedError| - (|msgCreate| '|error| pos erMsgKey erArgL "Error" optAttr))) - (|ncError|)))) - -\end{chunk} - -\defun{desiredMsg}{desiredMsg} -\begin{chunk}{defun desiredMsg 0} -(defun |desiredMsg| (erMsgKey &rest optCatFlag) - (declare (ignore erMsgKey)) - (cond - ((null (null optCatFlag)) (car optCatFlag)) - (t t))) - -\end{chunk} - -\defun{processKeyedError}{processKeyedError} -\calls{processKeyedError}{getMsgTag?} -\calls{processKeyedError}{getMsgKey} -\calls{processKeyedError}{getMsgPrefix?} -\calls{processKeyedError}{sayBrightly} -\calls{processKeyedError}{CallerName} -\calls{processKeyedError}{msgImPr?} -\calls{processKeyedError}{msgOutputter} -\usesdollar{processKeyedError}{ncMsgList} -\begin{chunk}{defun processKeyedError} -(defun |processKeyedError| (msg) - (prog (pre erMsg) - (declare (special |$ncMsgList|)) - (cond - ((eq (|getMsgTag?| msg) '|old|) - (setq erMsg (|getMsgKey| msg)) - (cond - ((setq pre (|getMsgPrefix?| msg)) - (setq erMsg (cons '|%b| (cons pre (cons '|%d| erMsg)))))) - (|sayBrightly| (cons "old msg from " (cons (|CallerName| 4) erMsg)))) - ((|msgImPr?| msg) (|msgOutputter| msg)) - (t (setq |$ncMsgList| (cons msg |$ncMsgList|)))))) - -\end{chunk} - -\defun{msgOutputter}{msgOutputter} -\calls{msgOutputter}{getStFromMsg} -\calls{msgOutputter}{leader?} -\calls{msgOutputter}{line?} -\calls{msgOutputter}{toScreen?} -\calls{msgOutputter}{flowSegmentedMsg} -\calls{msgOutputter}{sayBrightly} -\calls{msgOutputter}{toFile?} -\calls{msgOutputter}{alreadyOpened?} -\usesdollar{msgOutputter}{linelength} -\begin{chunk}{defun msgOutputter} -(defun |msgOutputter| (msg) - (let (alreadyOpened shouldFlow st) - (declare (special $linelength)) - (setq st (|getStFromMsg| msg)) - (setq shouldFlow (null (or (|leader?| msg) (|line?| msg)))) - (when (|toScreen?| msg) - (when shouldFlow (setq st (|flowSegmentedMsg| st $linelength 0))) - (|sayBrightly| st)) - (when (|toFile?| msg) - (when shouldFlow (setq st (|flowSegmentedMsg| st (- $linelength 6) 0))) - (setq alreadyOpened (|alreadyOpened?| msg))))) - -\end{chunk} - -\defun{listOutputter}{listOutputter} -\calls{listOutputter}{msgOutputter} -\begin{chunk}{defun listOutputter} -(defun |listOutputter| (outputList) - (dolist (msg outputList) - (|msgOutputter| msg))) - -\end{chunk} - -\defun{getStFromMsg}{getStFromMsg} -\calls{getStFromMsg}{getPreStL} -\calls{getStFromMsg}{getMsgPrefix?} -\calls{getStFromMsg}{getMsgTag} -\calls{getStFromMsg}{getMsgText} -\calls{getStFromMsg}{getPosStL} -\calls{getStFromMsg}{getMsgKey?} -\calls{getStFromMsg}{pname} -\calls{getStFromMsg}{getMsgLitSym} -\calls{getStFromMsg}{tabbing} -\begin{chunk}{defun getStFromMsg} -(defun |getStFromMsg| (msg) - (let (st posStL preStL) - (setq preStL (|getPreStL| (|getMsgPrefix?| msg))) - (cond - ((eq (|getMsgTag| msg) '|line|) - (cons "" - (cons "%x1" (append preStL (cons (|getMsgText| msg) nil))))) - (t - (setq posStL (|getPosStL| msg)) - (setq st - (cons posStL - (cons (|getMsgLitSym| msg) - (cons "" - (append preStL - (cons (|tabbing| msg) - (|getMsgText| msg))))))))))) - -\end{chunk} - -\defdollar{preLength} -\begin{chunk}{initvars} -(defvar |$preLength| 11) - -\end{chunk} - -\defun{getPreStL}{getPreStL} -\calls{getPreStL}{size} -\usesdollar{getPreStL}{preLength} -\begin{chunk}{defun getPreStL 0} -(defun |getPreStL| (optPre) - (let (spses extraPlaces) - (declare (special |$preLength|)) - (cond - ((null optPre) (list " ")) - (t - (setq spses - (cond - ((< 0 (setq extraPlaces (- (- |$preLength| (size optPre)) 3))) - (make-string extraPlaces)) - (t ""))) - (list '|%b| optPre spses ":" '|%d|))))) - -\end{chunk} - -\defun{getPosStL}{getPosStL} -\calls{getPosStL}{showMsgPos?} -\calls{getPosStL}{getMsgPos} -\calls{getPosStL}{msgImPr?} -\calls{getPosStL}{decideHowMuch} -\calls{getPosStL}{listDecideHowMuch} -\calls{getPosStL}{ppos} -\calls{getPosStL}{remLine} -\calls{getPosStL}{remFile} -\usesdollar{getPosStL}{lastPos} -\begin{chunk}{defun getPosStL} -(defun |getPosStL| (msg) - (let (printedOrigin printedLineNum printedFileName fullPrintedPos howMuch - msgPos) - (declare (special |$lastPos|)) - (cond - ((null (|showMsgPos?| msg)) "") - (t - (setq msgPos (|getMsgPos| msg)) - (setq howMuch - (if (|msgImPr?| msg) - (|decideHowMuch| msgPos |$lastPos|) - (|listDecideHowMuch| msgPos |$lastPos|))) - (setq |$lastPos| msgPos) - (setq fullPrintedPos (|ppos| msgPos)) - (setq printedFileName - (cons "%x2" (cons "[" (append (|remLine| fullPrintedPos) (cons "]" nil))))) - (setq printedLineNum - (cons "%x2" (cons "[" (append (|remFile| fullPrintedPos) (cons "]" nil))))) - (setq printedOrigin - (cons "%x2" (cons "[" (append fullPrintedPos (cons "]" nil))))) - (cond - ((eq howMuch 'org) - (cons "" (append printedOrigin (cons '|%l| nil)))) - ((eq howMuch 'line) - (cons "" (append printedLineNum (cons '|%l| nil)))) - ((eq howMuch 'file) - (cons "" (append printedFileName (cons '|%l| nil)))) - ((eq howMuch 'all) - (cons "" - (append printedFileName - (cons '|%l| - (cons "" - (append printedLineNum - (cons '|%l| nil))))))) - (t "")))))) - -\end{chunk} - -\defun{ppos}{ppos} -\calls{ppos}{pfNoPosition?} -\calls{ppos}{pfImmediate?} -\calls{ppos}{pfCharPosn} -\calls{ppos}{pfLinePosn} -\calls{ppos}{porigin} -\calls{ppos}{pfFileName} -\begin{chunk}{defun ppos} -(defun |ppos| (p) - (let (org lpos cpos) - (cond - ((|pfNoPosition?| p) (list "no position")) - ((|pfImmediate?| p) (list "console")) - (t - (setq cpos (|pfCharPosn| p)) - (setq lpos (|pfLinePosn| p)) - (setq org (|porigin| (|pfFileName| p))) - (list org " " "line" " " lpos))))) - -\end{chunk} - -\defun{remFile}{remFile} -\calls{remFile}{ifcdr} -\calls{remLine}{ifcar} -\begin{chunk}{defun remFile} -(defun |remFile| (positionList) (ifcdr (ifcdr positionList))) - -\end{chunk} - -\defun{showMsgPos?}{showMsgPos?} -\calls{showMsgPos?}{msgImPr?} -\calls{showMsgPos?}{leader?} -\usesdollar{showMsgPos?}{erMsgToss} -\begin{chunk}{defun showMsgPos? 0} -(defun |showMsgPos?| (msg) - (declare (special |$erMsgToss|)) - (or |$erMsgToss| (and (null (|msgImPr?| msg)) (null (|leader?| msg))))) - -\end{chunk} - -\defdollar{imPrGuys} -\begin{chunk}{initvars} -(defvar |$imPrGuys| (list '|imPr|)) - -\end{chunk} - -\defun{msgImPr?}{msgImPr?} -\calls{msgImPr?}{getMsgCatAttr} -\begin{chunk}{defun msgImPr?} -(defun |msgImPr?| (msg) - (eq (|getMsgCatAttr| msg '|$imPrGuys|) '|imPr|)) - -\end{chunk} - -\defun{getMsgCatAttr}{getMsgCatAttr} -\calls{getMsgCatAttr}{ifcdr} -\calls{getMsgCatAttr}{qassq} -\calls{getMsgCatAttr}{ncAlist} -\begin{chunk}{defun getMsgCatAttr} -(defun |getMsgCatAttr| (msg cat) - (ifcdr (qassq cat (|ncAlist| msg)))) - -\end{chunk} - -\defun{getMsgPos}{getMsgPos} -\calls{getMsgPos}{getMsgFTTag?} -\calls{getMsgPos}{getMsgPosTagOb} -\begin{chunk}{defun getMsgPos} -(defun |getMsgPos| (msg) - (if (|getMsgFTTag?| msg) - (cadr (|getMsgPosTagOb| msg)) - (|getMsgPosTagOb| msg))) - -\end{chunk} - -\defun{getMsgFTTag?}{getMsgFTTag?} -\calls{getMsgFTTag?}{ifcar} -\calls{getMsgFTTag?}{getMsgPosTagOb} -\begin{chunk}{defun getMsgFTTag?} -(defun |getMsgFTTag?| (msg) - (ifcar (member (ifcar (|getMsgPosTagOb| msg)) (list 'from 'to 'fromto)))) - -\end{chunk} - -\defun{decideHowMuch}{decideHowMuch} -When printing a msg, we wish not to show pos information that was -shown for a previous msg with identical pos info. -org prints out the word noposition or console -\calls{decideHowMuch}{poNopos?} -\calls{decideHowMuch}{poPosImmediate?} -\calls{decideHowMuch}{poFileName} -\calls{decideHowMuch}{poLinePosn} -\begin{chunk}{defun decideHowMuch} -(defun |decideHowMuch| (pos oldPos) - (cond - ((or (and (|poNopos?| pos) (|poNopos?| oldPos)) - (and (|poPosImmediate?| pos) (|poPosImmediate?| oldPos))) - 'none) - ((or (|poNopos?| pos) (|poPosImmediate?| pos)) 'org) - ((or (|poNopos?| oldPos) (|poPosImmediate?| oldPos)) 'all) - ((not (equal (|poFileName| oldPos) (|poFileName| pos))) 'all) - ((not (equal (|poLinePosn| oldPos) (|poLinePosn| pos))) 'line) - (t 'none))) - -\end{chunk} - -\defun{poNopos?}{poNopos?} -\begin{chunk}{defun poNopos? 0} -(defun |poNopos?| (posn) - (equal posn (list '|noposition|))) - -\end{chunk} - -\defun{poPosImmediate?}{poPosImmediate?} -\calls{poPosImmediate?}{poNopos?} -\calls{poPosImmediate?}{lnImmediate?} -\calls{poPosImmediate?}{poGetLineObject} -\begin{chunk}{defun poPosImmediate?} -(defun |poPosImmediate?| (txp) - (unless (|poNopos?| txp) (|lnImmediate?| (|poGetLineObject| txp)))) - -\end{chunk} - -\defun{poFileName}{poFileName} -\calls{poFileName}{lnFileName} -\calls{poFileName}{poGetLineObject} -\begin{chunk}{defun poFileName} -(defun |poFileName| (posn) - (if posn - (|lnFileName| (|poGetLineObject| posn)) - (caar posn))) - -\end{chunk} - -\defun{poGetLineObject}{poGetLineObject} -\begin{chunk}{defun poGetLineObject 0} -(defun |poGetLineObject| (posn) - (car posn)) - -\end{chunk} - -\defun{poLinePosn}{poLinePosn} -\calls{poLinePosn}{lnLocalNum} -\calls{poLinePosn}{poGetLineObject} -\begin{chunk}{defun poLinePosn} -(defun |poLinePosn| (posn) - (if posn - (|lnLocalNum| (|poGetLineObject| posn)) - (cdar posn))) - -\end{chunk} - -\defun{listDecideHowMuch}{listDecideHowMuch} -\calls{listDecideHowMuch}{poNopos?} -\calls{listDecideHowMuch}{poPosImmediate?} -\calls{listDecideHowMuch}{poGlobalLinePosn} -\begin{chunk}{defun listDecideHowMuch} -(defun |listDecideHowMuch| (pos oldPos) - (cond - ((or (and (|poNopos?| pos) (|poNopos?| oldPos)) - (and (|poPosImmediate?| pos) (|poPosImmediate?| oldPos))) - 'none) - ((|poNopos?| pos) 'org) - ((|poNopos?| oldPos) 'none) - ((< (|poGlobalLinePosn| pos) (|poGlobalLinePosn| oldPos)) - (if (|poPosImmediate?| pos) 'org 'line)) - (t 'none))) - -\end{chunk} - -\defun{remLine}{remLine} -\begin{chunk}{defun remLine 0} -(defun |remLine| (positionList) (list (ifcar positionList))) - -\end{chunk} - -\defun{getMsgKey?}{getMsgKey?} -\calls{getMsgKey?}{identp} -\begin{chunk}{defun getMsgKey? 0} -(defun |getMsgKey?| (msg) - (let ((val (|getMsgKey| msg))) - (when (identp val) val))) - -\end{chunk} - -\defun{getMsgLitSym}{getMsgLitSym} -\calls{getMsgLitSym}{getMsgKey?} -\begin{chunk}{defun getMsgLitSym} -(defun |getMsgLitSym| (msg) - (if (|getMsgKey?| msg) " " "*")) - -\end{chunk} - -\defun{tabbing}{tabbing} -\calls{tabbing}{getMsgPrefix?} -\usesdollar{tabbing}{preLength} -\begin{chunk}{defun tabbing} -(defun |tabbing| (msg) - (let (chPos) - (declare (special |$preLength|)) - (setq chPos 2) - (when (|getMsgPrefix?| msg) (setq chPos (- (+ chPos |$preLength|) 1))) - (cons '|%t| chPos))) - -\end{chunk} - -\defdollar{toWhereGuys} -\begin{chunk}{initvars} -(defvar |$toWhereGuys| (list '|fileOnly| '|screenOnly|)) - -\end{chunk} - -\defun{getMsgToWhere}{getMsgToWhere} -\calls{getMsgToWhere}{getMsgCatAttr} -\begin{chunk}{defun getMsgToWhere} -(defun |getMsgToWhere| (msg) (|getMsgCatAttr| msg '|$toWhereGuys|)) - -\end{chunk} - -\defun{toFile?}{toFile?} -\calls{toFile?}{getMsgToWhere} -\usesdollar{toFile?}{fn} -\begin{chunk}{defun toFile?} -(defun |toFile?| (msg) - (and (not (eq (|getMsgToWhere| msg) '|screenOnly|)))) - -\end{chunk} - -\defun{alreadyOpened?}{alreadyOpened?} -\calls{alreadyOpened?}{msgImPr?} -\begin{chunk}{defun alreadyOpened?} -(defun |alreadyOpened?| (msg) (null (|msgImPr?| msg))) - -\end{chunk} - -\defun{setMsgForcedAttrList}{setMsgForcedAttrList} -\calls{setMsgForcedAttrList}{setMsgForcedAttr} -\calls{setMsgForcedAttrList}{whichCat} -\begin{chunk}{defun setMsgForcedAttrList} -(defun |setMsgForcedAttrList| (msg attrlist) - (dolist (attr attrlist) - (|setMsgForcedAttr| msg (|whichCat| attr) attr))) - -\end{chunk} - -\defun{setMsgForcedAttr}{setMsgForcedAttr} -\calls{setMsgForcedAttr}{setMsgCatlessAttr} -\calls{setMsgForcedAttr}{ncPutQ} -\begin{chunk}{defun setMsgForcedAttr} -(defun |setMsgForcedAttr| (msg cat attr) - (if (eq cat '|catless|) - (|setMsgCatlessAttr| msg attr) - (|ncPutQ| msg cat attr))) - -\end{chunk} - -\defdollar{attrCats} -\begin{chunk}{initvars} -(defvar |$attrCats| (list '|$imPrGuys| '|$toWhereGuys| '|$repGuys|)) - -\end{chunk} - -\defun{whichCat}{whichCat} -\calls{whichCat}{ListMember?} -\usesdollar{whichCat}{attrCats} -\begin{chunk}{defun whichCat} -(defun |whichCat| (attr) - (let ((found '|catless|) done) - (declare (special |$attrCats|)) - (loop for cat in |$attrCats| do - (when (|ListMember?| attr (eval cat)) - (setq found cat) - (setq done t)) - until done) - found)) - -\end{chunk} - -\defun{setMsgCatlessAttr}{setMsgCatlessAttr} -\tpdhere{Changed from |catless| to '|catless|} - -\calls{setMsgCatlessAttr}{ncPutQ} -\calls{setMsgCatlessAttr}{ifcdr} -\calls{setMsgCatlessAttr}{qassq} -\calls{setMsgCatlessAttr}{ncAlist} -\begin{chunk}{defun setMsgCatlessAttr} -(defun |setMsgCatlessAttr| (msg attr) - (|ncPutQ| msg catless (cons attr (ifcdr (qassq catless (|ncAlist| msg)))))) - -\end{chunk} - -\defun{putDatabaseStuff}{putDatabaseStuff} -\tpdhere{The variable al is undefined} -\calls{putDatabaseStuff}{getMsgInfoFromKey} -\calls{putDatabaseStuff}{setMsgUnforcedAttrList} -\calls{putDatabaseStuff}{setMsgText} -\begin{chunk}{defun putDatabaseStuff} -(defun |putDatabaseStuff| (msg) - (let (attributes text tmp) - (setq tmp (|getMsgInfoFromKey| msg)) - (setq text (car tmp)) - (setq attributes (cadr tmp)) - (when attributes (|setMsgUnforcedAttrList| msg attributes)) - (|setMsgText| msg text))) - -\end{chunk} - -\defun{getMsgInfoFromKey}{getMsgInfoFromKey} -\calls{getMsgInfoFromKey}{getMsgKey?} -\calls{getMsgInfoFromKey}{getErFromDbL} -\calls{getMsgInfoFromKey}{getMsgKey} -\calls{getMsgInfoFromKey}{segmentKeyedMsg} -\calls{getMsgInfoFromKey}{removeAttributes} -\calls{getMsgInfoFromKey}{substituteSegmentedMsg} -\calls{getMsgInfoFromKey}{getMsgArgL} -\usesdollar{getMsgInfoFromKey}{msgDatabaseName} -\begin{chunk}{defun getMsgInfoFromKey} -(defun |getMsgInfoFromKey| (msg) - (let (|$msgDatabaseName| attributes tmp msgText msgKey) - (declare (special |$msgDatabaseName|)) - (setq |$msgDatabaseName| nil) - (setq msgText - (cond - ((setq msgKey (|getMsgKey?| msg)) - (|fetchKeyedMsg| msgKey nil)) - (t (|getMsgKey| msg)))) - (setq msgText (|segmentKeyedMsg| msgText)) - (setq tmp (|removeAttributes| msgText)) - (setq msgText (car tmp)) - (setq attributes (cadr tmp)) - (setq msgText (|substituteSegmentedMsg| msgText (|getMsgArgL| msg))) - (list msgText attributes))) - -\end{chunk} - -\defun{setMsgUnforcedAttrList}{setMsgUnforcedAttrList} -\calls{setMsgUnforcedAttrList}{setMsgUnforcedAttr} -\calls{setMsgUnforcedAttrList}{whichCat} -\begin{chunk}{defun setMsgUnforcedAttrList} -(defun |setMsgUnforcedAttrList| (msg attrlist) - (dolist (attr attrlist) - (|setMsgUnforcedAttr| msg (|whichCat| attr) attr))) - -\end{chunk} - -\defun{setMsgUnforcedAttr}{setMsgUnforcedAttr} -\calls{setMsgUnforcedAttr}{setMsgCatlessAttr} -\calls{setMsgUnforcedAttr}{qassq} -\calls{setMsgUnforcedAttr}{ncAlist} -\calls{setMsgUnforcedAttr}{ncPutQ} -\begin{chunk}{defun setMsgUnforcedAttr} -(defun |setMsgUnforcedAttr| (msg cat attr) - (cond - ((eq cat '|catless|) (|setMsgCatlessAttr| msg attr)) - ((null (qassq cat (|ncAlist| msg))) (|ncPutQ| msg cat attr)))) - -\end{chunk} - -\defdollar{imPrTagGuys} -\begin{chunk}{initvars} -(defvar |$imPrTagGuys| (list '|unimple| '|bug| '|debug| '|say| '|warn|)) - -\end{chunk} - -\defun{initImPr}{initImPr} -\calls{initImPr}{getMsgTag} -\calls{initImPr}{setMsgUnforcedAttr} -\usesdollar{initImPr}{imPrTagGuys} -\usesdollar{initImPr}{erMsgToss} -\begin{chunk}{defun initImPr} -(defun |initImPr| (msg) - (declare (special |$imPrTagGuys| |$erMsgToss|)) - (when (or |$erMsgToss| (member (|getMsgTag| msg) |$imPrTagGuys|)) - (|setMsgUnforcedAttr| msg '|$imPrGuys| '|imPr|))) - -\end{chunk} - -\defun{initToWhere}{initToWhere} -\calls{initToWhere}{getMsgCatAttr} -\calls{initToWhere}{setMsgUnforcedAttr} -\begin{chunk}{defun initToWhere} -(defun |initToWhere| (msg) - (if (member '|trace| (|getMsgCatAttr| msg '|catless|)) - (|setMsgUnforcedAttr| msg '|$toWhereGuys| '|screenOnly|))) - -\end{chunk} - -\defun{ncBug}{Report a bug in the compiler} -Bug in the compiler: something which shouldn't have happened did. - -\calls{ncBug}{processKeyedError} -\calls{ncBug}{msgCreate} -\calls{ncBug}{enable-backtrace} -\calls{ncBug}{ncAbort} -\usesdollar{ncBug}{nopos} -\usesdollar{ncBug}{newcompErrorCount} -\begin{chunk}{defun ncBug} -(defun |ncBug| (erMsgKey erArgL &rest optAttr) - (let (erMsg) - (declare (special |$nopos| |$newcompErrorCount|)) - (setq |$newcompErrorCount| (+ |$newcompErrorCount| 1)) - (setq erMsg - (|processKeyedError| - (|msgCreate| '|bug| |$nopos| erMsgKey erArgL "Bug!" optAttr))) - (break) - (|ncAbort|))) - -\end{chunk} - -\defun{processMsgList}{processMsgList} -\calls{processMsgList}{erMsgSort} -\calls{processMsgList}{makeMsgFromLine} -\calls{processMsgList}{poGlobalLinePosn} -\calls{processMsgList}{getMsgPos} -\calls{processMsgList}{queueUpErrors} -\calls{processMsgList}{listOutputter} -\usesdollar{processMsgList}{noRepList} -\usesdollar{processMsgList}{outputList} -\begin{chunk}{defun processMsgList} -(defun |processMsgList| (erMsgList lineList) - (let (|$noRepList| |$outputList| st globalNumOfLine msgLine) - (declare (special |$noRepList| |$outputList|)) - (setq |$outputList| nil) - (setq |$noRepList| nil) - (setq erMsgList (|erMsgSort| erMsgList)) - (dolist (line lineList) - (setq msgLine (|makeMsgFromLine| line)) - (setq |$outputList| (cons msgLine |$outputList|)) - (setq globalNumOfLine (|poGlobalLinePosn| (|getMsgPos| msgLine))) - (setq erMsgList (|queueUpErrors| globalNumOfLine erMsgList))) - (setq |$outputList| (append erMsgList |$outputList|)) - (setq st "---------SOURCE-TEXT-&-ERRORS------------------------") - (|listOutputter| (reverse |$outputList|)))) - -\end{chunk} - -\defun{erMsgSort}{erMsgSort} -\calls{erMsgSort}{erMsgSep} -\calls{erMsgSort}{listSort} -\begin{chunk}{defun erMsgSort} -(defun |erMsgSort| (erMsgList) - (let (msgWOPos msgWPos tmp) - (setq tmp (|erMsgSep| erMsgList)) - (setq msgWPos (car tmp)) - (setq msgWOPos (cadr tmp)) - (setq msgWPos (|listSort| #'|erMsgCompare| msgWPos)) - (setq msgWOPos (reverse msgWOPos)) - (append msgWPos msgWOPos))) - -\end{chunk} - -\defun{erMsgCompare}{erMsgCompare} -\calls{erMsgCompare}{compareposns} -\calls{erMsgCompare}{getMsgPos} -\begin{chunk}{defun erMsgCompare} -(defun |erMsgCompare| (ob1 ob2) - (|compareposns| (|getMsgPos| ob2) (|getMsgPos| ob1))) - -\end{chunk} - -\defun{compareposns}{compareposns} -\calls{compareposns}{poGlobalLinePosn} -\calls{compareposns}{poCharPosn} -\begin{chunk}{defun compareposns} -(defun |compareposns| (a b) - (let (c d) - (setq c (|poGlobalLinePosn| a)) - (setq d (|poGlobalLinePosn| b)) - (if (equal c d) - (not (< (|poCharPosn| a) (|poCharPosn| b))) - (not (< c d))))) - -\end{chunk} - -\defun{erMsgSep}{erMsgSep} -\calls{erMsgSep}{poNopos?} -\calls{erMsgSep}{getMsgPos} -\begin{chunk}{defun erMsgSep} -(defun |erMsgSep| (erMsgList) - (let (msgWOPos msgWPos) - (dolist (msg erMsgList) - (if (|poNopos?| (|getMsgPos| msg)) - (setq msgWOPos (cons msg msgWOPos)) - (setq msgWPos (cons msg msgWPos)))) - (list msgWPos msgWOPos))) - -\end{chunk} - -\defun{makeMsgFromLine}{makeMsgFromLine} -\calls{makeMsgFromLine}{getLinePos} -\calls{makeMsgFromLine}{getLineText} -\calls{makeMsgFromLine}{poGlobalLinePosn} -\calls{makeMsgFromLine}{poLinePosn} -\calls{makeMsgFromLine}{strconc} -\calls{makeMsgFromLine}{rep} -\calls{makeMsgFromLine}{char} -\calls{makeMsgFromLine}{size} -\usesdollar{makeMsgFromLine}{preLength} -\begin{chunk}{defun makeMsgFromLine} -(defun |makeMsgFromLine| (line) - (let (localNumOfLine stNum globalNumOfLine textOfLine posOfLine) - (declare (special |$preLength|)) - (setq posOfLine (|getLinePos| line)) - (setq textOfLine (|getLineText| line)) - (setq globalNumOfLine (|poGlobalLinePosn| posOfLine)) - (setq stNum (princ-to-string (|poLinePosn| posOfLine))) - (setq localNumOfLine - (strconc (|rep| #\space (- |$preLength| 7 (size stNum))) stNum)) - (list '|line| posOfLine nil nil (strconc "Line" localNumOfLine) textOfLine))) - -\end{chunk} - -\defun{rep}{rep} -\tpdhere{This function should be replaced by fillerspaces} -\begin{chunk}{defun rep 0} -(defun |rep| (c n) - (if (< 0 n) - (make-string n :initial-element (character c)) - "")) - -\end{chunk} - -\defun{getLinePos}{getLinePos} -\begin{chunk}{defun getLinePos 0} -(defun |getLinePos| (line) (car line)) - -\end{chunk} - -\defun{getLineText}{getLineText} -\begin{chunk}{defun getLineText 0} -(defun |getLineText| (line) (cdr line)) - -\end{chunk} - -\defun{queueUpErrors}{queueUpErrors} -\begin{verbatim} -;queueUpErrors(globalNumOfLine,msgList)== -; thisPosMsgs := [] -; notThisLineMsgs := [] -; for msg in msgList _ -; while thisPosIsLess(getMsgPos msg,globalNumOfLine) repeat -; --these are msgs that refer to positions from earlier compilations -; if not redundant (msg,notThisPosMsgs) then -; notThisPosMsgs := [msg,:notThisPosMsgs] -; msgList := rest msgList -; for msg in msgList _ -; while thisPosIsEqual(getMsgPos msg,globalNumOfLine) repeat -; if not redundant (msg,thisPosMsgs) then -; thisPosMsgs := [msg,:thisPosMsgs] -; msgList := rest msgList -; if thisPosMsgs then -; thisPosMsgs := processChPosesForOneLine thisPosMsgs -; $outputList := NCONC(thisPosMsgs,$outputList) -; if notThisPosMsgs then -; $outputList := NCONC(notThisPosMsgs,$outputList) -; msgList -\end{verbatim} -\calls{queueUpErrors}{processChPosesForOneLine} -\usesdollar{queueUpErrors}{outputList} -\begin{chunk}{defun queueUpErrors} -(DEFUN |queueUpErrors| (|globalNumOfLine| |msgList|) - (PROG (|notThisPosMsgs| |notThisLineMsgs| |thisPosMsgs|) - (DECLARE (SPECIAL |$outputList|)) - (RETURN - (PROGN - (SETQ |thisPosMsgs| NIL) - (SETQ |notThisLineMsgs| NIL) - ((LAMBDA (|bfVar#7| |msg|) - (LOOP - (COND - ((OR (ATOM |bfVar#7|) - (PROGN (SETQ |msg| (CAR |bfVar#7|)) NIL) - (NOT (|thisPosIsLess| (|getMsgPos| |msg|) - |globalNumOfLine|))) - (RETURN NIL)) - ('T - (PROGN - (COND - ((NULL (|redundant| |msg| |notThisPosMsgs|)) - (SETQ |notThisPosMsgs| - (CONS |msg| |notThisPosMsgs|)))) - (SETQ |msgList| (CDR |msgList|))))) - (SETQ |bfVar#7| (CDR |bfVar#7|)))) - |msgList| NIL) - ((LAMBDA (|bfVar#8| |msg|) - (LOOP - (COND - ((OR (ATOM |bfVar#8|) - (PROGN (SETQ |msg| (CAR |bfVar#8|)) NIL) - (NOT (|thisPosIsEqual| (|getMsgPos| |msg|) - |globalNumOfLine|))) - (RETURN NIL)) - ('T - (PROGN - (COND - ((NULL (|redundant| |msg| |thisPosMsgs|)) - (SETQ |thisPosMsgs| (CONS |msg| |thisPosMsgs|)))) - (SETQ |msgList| (CDR |msgList|))))) - (SETQ |bfVar#8| (CDR |bfVar#8|)))) - |msgList| NIL) - (COND - (|thisPosMsgs| - (SETQ |thisPosMsgs| - (|processChPosesForOneLine| |thisPosMsgs|)) - (SETQ |$outputList| (NCONC |thisPosMsgs| |$outputList|)))) - (COND - (|notThisPosMsgs| - (SETQ |$outputList| - (NCONC |notThisPosMsgs| |$outputList|)))) - |msgList|)))) - -\end{chunk} - -\defun{thisPosIsLess}{thisPosIsLess} -\calls{thisPosIsLess}{poNopos?} -\calls{thisPosIsLess}{poGlobalLinePosn} -\begin{chunk}{defun thisPosIsLess} -(defun |thisPosIsLess| (pos num) - (unless (|poNopos?| pos) (< (|poGlobalLinePosn| pos) num))) - -\end{chunk} - -\defun{thisPosIsEqual}{thisPosIsEqual} -\calls{thisPosIsEqual}{poNopos?} -\calls{thisPosIsEqual}{poGlobalLinePosn} -\begin{chunk}{defun thisPosIsEqual} -(defun |thisPosIsEqual| (pos num) - (unless (|poNopos?| pos) (equal (|poGlobalLinePosn| pos) num))) - -\end{chunk} - -\defun{redundant}{redundant} -\begin{verbatim} -redundant(msg,thisPosMsgs) == - found := NIL - if msgNoRep? msg then - for item in $noRepList repeat - sameMsg?(msg,item) => return (found := true) - $noRepList := [msg,$noRepList] - found or MEMBER(msg,thisPosMsgs) -\end{verbatim} -\calls{redundant}{msgNoRep?} -\calls{redundant}{sameMsg?} -\usesdollar{redundant}{noRepList} -\begin{chunk}{defun redundant} -(defun |redundant| (msg thisPosMsgs) - (prog (found) - (declare (special |$noRepList|)) - (return - (progn - (cond - ((|msgNoRep?| msg) - ((lambda (Var9 item) - (loop - (cond - ((or (atom Var9) (progn (setq item (car Var9)) nil)) - (return nil)) - (t - (cond - ((|sameMsg?| msg item) (return (setq found t)))))) - (setq Var9 (cdr Var9)))) - |$noRepList| nil) - (setq |$noRepList| (list msg |$noRepList|)))) - (or found (member msg thisPosMsgs)))))) - -\end{chunk} - -\defdollar{repGuys} -\begin{chunk}{initvars} -(defvar |$repGuys| (list '|noRep| '|rep|)) - -\end{chunk} - -\defun{msgNoRep?}{msgNoRep?} -\calls{msgNoRep?}{getMsgCatAttr} -\begin{chunk}{defun msgNoRep?} -(defun |msgNoRep?| (msg) (eq (|getMsgCatAttr| msg '|$repGuys|) '|noRep|)) - -\end{chunk} - -\defun{sameMsg?}{sameMsg?} -\calls{sameMsg?}{getMsgKey} -\calls{sameMsg?}{getMsgArgL} -\begin{chunk}{defun sameMsg?} -(defun |sameMsg?| (msg1 msg2) - (and (equal (|getMsgKey| msg1) (|getMsgKey| msg2)) - (equal (|getMsgArgL| msg1) (|getMsgArgL| msg2)))) - -\end{chunk} - -\defun{processChPosesForOneLine}{processChPosesForOneLine} -\calls{processChPosesForOneLine}{posPointers} -\calls{processChPosesForOneLine}{getMsgFTTag?} -\calls{processChPosesForOneLine}{putFTText} -\calls{processChPosesForOneLine}{poCharPosn} -\calls{processChPosesForOneLine}{getMsgPos} -\calls{processChPosesForOneLine}{getMsgPrefix} -\calls{processChPosesForOneLine}{setMsgPrefix} -\calls{processChPosesForOneLine}{strconc} -\calls{processChPosesForOneLine}{size} -\calls{processChPosesForOneLine}{makeLeaderMsg} -\usesdollar{processChPosesForOneLine}{preLength} -\begin{chunk}{defun processChPosesForOneLine} -(defun |processChPosesForOneLine| (msgList) - (let (leaderMsg oldPre posLetter chPosList) - (declare (special |$preLength|)) - (setq chPosList (|posPointers| msgList)) - (dolist (msg msgList) - (when (|getMsgFTTag?| msg) (|putFTText| msg chPosList)) - (setq posLetter (cdr (assoc (|poCharPosn| (|getMsgPos| msg)) chPosList))) - (setq oldPre (|getMsgPrefix| msg)) - (|setMsgPrefix| msg - (strconc oldPre - (make-string (- |$preLength| 4 (size oldPre))) posLetter))) - (setq leaderMsg (|makeLeaderMsg| chPosList)) - (nconc msgList (list leaderMsg)))) - -\end{chunk} - -\defun{poCharPosn}{poCharPosn} -\begin{chunk}{defun poCharPosn 0} -(defun |poCharPosn| (posn) - (cdr posn)) - -\end{chunk} - -\defun{makeLeaderMsg}{makeLeaderMsg} -\begin{verbatim} -makeLeaderMsg chPosList == - st := MAKE_-FULL_-CVEC ($preLength- 3) - oldPos := -1 - for [posNum,:posLetter] in reverse chPosList repeat - st := STRCONC(st, _ - rep(char ".", (posNum - oldPos - 1)),posLetter) - oldPos := posNum - ['leader,$nopos,'nokey,NIL,NIL,[st] ] -\end{verbatim} -\usesdollar{makeLeaderMsg}{nopos} -\usesdollar{makeLeaderMsg}{preLength} -\begin{chunk}{defun makeLeaderMsg} -(defun |makeLeaderMsg| (chPosList) - (let (posLetter posNum oldPos st) - (declare (special |$nopos| |$preLength|)) - (setq st (make-string (- |$preLength| 3))) - (setq oldPos -1) - ((lambda (Var15 Var14) - (loop - (cond - ((or (atom Var15) (progn (setq Var14 (car Var15)) nil)) - (return nil)) - (t - (and (consp Var14) - (progn - (setq posNum (car Var14)) - (setq posLetter (cdr Var14)) - t) - (progn - (setq st - (strconc st (|rep| #\. (- posNum oldPos 1)) posLetter)) - (setq oldPos posNum))))) - (setq Var15 (cdr Var15)))) - (reverse chPosList) nil) - (list '|leader| |$nopos| '|nokey| nil nil (list st)))) - -\end{chunk} - -\defun{posPointers}{posPointers} -\tpdhere{getMsgFTTag is nonsense} - -\calls{posPointers}{poCharPosn} -\calls{posPointers}{getMsgPos} -\calls{posPointers}{ifcar} -\calls{posPointers}{getMsgPos2} -\calls{posPointers}{insertPos} -\uses{posPointers}{getMsgFTTag} -\begin{chunk}{defun posPointers} -(defun |posPointers| (msgList) - (let (posLetterList pos ftPosList posList increment pointers) - (declare (special |getMsgFTTag|)) - (setq pointers "ABCDEFGHIJKLMONPQRS") - (setq increment 0) - (dolist (msg msgList) - (setq pos (|poCharPosn| (|getMsgPos| msg))) - (unless (equal pos (ifcar posList)) - (setq posList (cons pos posList))) - ; this should probably read TPDHERE - ; (when (eq (|getMsgPosTagOb| msg) 'fromto)) - (when (eq |getMsgFTTag| 'fromto) - (setq ftPosList (cons (|poCharPosn| (|getMsgPos2| msg)) ftPosList)))) - (dolist (toPos ftPosList) - (setq posList (|insertPos| toPos posList))) - (dolist (pos posList) - (setq posLetterList - (cons (cons pos (elt pointers increment)) posLetterList)) - (setq increment (+ increment 1))) - posLetterList)) - -\end{chunk} - -\defun{getMsgPos2}{getMsgPos2} -\calls{getMsgPos2}{getMsgFTTag?} -\calls{getMsgPos2}{getMsgPosTagOb} -\calls{getMsgPos2}{ncBug} -\begin{chunk}{defun getMsgPos2} -(defun |getMsgPos2| (msg) - (if (|getMsgFTTag?| msg) - (caddr (|getMsgPosTagOb| msg)) - (|ncBug| "not a from to" nil))) - -\end{chunk} - -\defun{insertPos}{insertPos} -This function inserts a position in the proper place of a position list. -This is used for the 2nd pos of a fromto -\calls{insertPos}{done} -\begin{chunk}{defun insertPos 0} -(defun |insertPos| (newPos posList) - (let (pos top bot done) - (setq bot (cons 0 posList)) - (do () (done) - (setq top (cons (car bot) top)) - (setq bot (cdr bot)) - (setq pos (car bot)) - (setq done - (cond - ((< pos newPos) nil) - ((equal pos newPos) t) - ((< newPos pos) - (setq top (cons newPos top)) - t)))) - (cons (cdr (reverse top)) bot))) - -\end{chunk} - -\defun{putFTText}{putFTText} -\calls{putFTText}{getMsgFTTag?} -\calls{putFTText}{poCharPosn} -\calls{putFTText}{getMsgPos} -\calls{putFTText}{setMsgText} -\calls{putFTText}{getMsgText} -\calls{putFTText}{getMsgPos2} -\begin{chunk}{defun putFTText} -(defun |putFTText| (msg chPosList) - (let (charMarker2 pos2 markingText charMarker pos tag) - (setq tag (|getMsgFTTag?| msg)) - (setq pos (|poCharPosn| (|getMsgPos| msg))) - (setq charMarker (cdr (assoc pos chPosList))) - (cond - ((eq tag 'from) - (setq markingText (list "(from " charMarker " and on) ")) - (|setMsgText| msg (append markingText (|getMsgText| msg)))) - ((eq tag 'to) - (setq markingText (list "(up to " charMarker ") ")) - (|setMsgText| msg (append markingText (|getMsgText| msg)))) - ((eq tag 'fromto) - (setq pos2 (|poCharPosn| (|getMsgPos2| msg))) - (setq charMarker2 (cdr (assoc pos2 chPosList))) - (setq markingText (list "(from " charMarker " up to " charMarker2 ") ")) - (|setMsgText| msg (append markingText (|getMsgText| msg))))))) - -\end{chunk} - -\defun{From}{From} -This is called from parameter list of nc message functions -\begin{chunk}{defun From 0} -(defun |From| (pos) (list 'from pos)) - -\end{chunk} - -\defun{To}{To} -This is called from parameter list of nc message functions -\begin{chunk}{defun To 0} -(defun |To| (pos) (list 'to pos)) - -\end{chunk} - -\defun{FromTo}{FromTo} -This is called from parameter list of nc message functions -\begin{chunk}{defun FromTo 0} -(defun |FromTo| (pos1 pos2) (list 'fromto pos1 pos2)) - -\end{chunk} - -\chapter{The Interpreter Syntax} -\section{syntax assignment} -\label{assignment} -\index{assignment} -\index{syntax!assignment} -\index{assignment!syntax} -\begin{chunk}{assignment.help} - -Immediate, Delayed, and Multiple Assignment - -==================================================================== -Immediate Assignment -==================================================================== - -A variable in Axiom refers to a value. A variable has a name beginning -with an uppercase or lowercase alphabetic character, "%", or "!". -Successive characters (if any) can be any of the above, digits, or "?". -Case is distinguished. The following are all examples of valid, distinct -variable names: - - a tooBig? a1B2c3%!? - A %j numberOfPoints - beta6 %J numberofpoints - -The ":=" operator is the immediate assignment operator. Use it to -associate a value with a variable. The syntax for immediate assignment -for a single variable is: - - variable := expression - -The value returned by an immediate assignment is the value of expression. - - a := 1 - 1 - Type: PositiveInteger - -The right-hand side of the expression is evaluated, yielding 1. The value -is then assigned to a. - - b := a - 1 - Type: PositiveInteger - -The right-hand side of the expression is evaluated, yieldig 1. This value -is then assigned to b. Thus a and b both have the value 1 after the sequence -of assignments. - - a := 2 - 2 - Type: PositiveInteger - -What is the value of b if a is assigned the value 2? - - b - 1 - Type: PositiveInteger - -The value of b is left unchanged. - -This is what we mean when we say this kind of assignment is immediate. -The variable b has no dependency on a after the initial assignment. This -is the usual notion of assignment in programming languages such as C, -Pascal, and Fortran. - -==================================================================== -Delayed Assignment -==================================================================== - -Axiom provides delayed assignment with "==". This implements a delayed -evaluation of the right-hand side and dependency checking. The syntax for -delayed assignment is - - variable == expression - -The value returned by a delayed assignment is the unique value of Void. - - a == 1 - Type: Void - - b == a - Type: Void - -Using a and b as above, these are the corresponding delayed assignments. - - a - Compiling body of rule a to compute value of type PositiveInteger - 1 - Type: PositiveInteger - -The right-hand side of each delayed assignment is left unevaluated until -the variables on the left-hand sides are evaluated. - - b - Compiling body of rule b to compute value of type PositiveInteger - 1 - Type: PositiveInteger - -This gives the same results as before. But if we change a to 2 - - a == 2 - Compiled code for a has been cleared. - Compiled code for b has been cleared. - 1 old definition(s) deleted for function or rule a - Type: Void - -Then a evaluates to 2, as expected - - a - Compiling body of rule a to compute value of type PositiveInteger - 2 - Type: PositiveInteger - -but the value of b reflects the change to a - - b - Compiling body of rule b to compute value of type PositiveInteger - 2 - Type: PositiveInteger - -==================================================================== -Multiple Immediate Assignments -==================================================================== - -It is possible to set several variables at the same time by using a -tuple of variables and a tuple of expressions. A tuple is a collection -of things separated by commas, often surrounded by parentheses. The -syntax for multiple immediate assignment is - - ( var1, var2, ..., varN ) := ( expr1, expr2, ..., exprN ) - -The value returned by an immediate assignment is the value of exprN. - - ( x, y ) := ( 1, 2 ) - 2 - Type: PositiveInteger - -This sets x to 1 and y to 2. Multiple immediate assignments are parallel -in the sense that the expressions on the right are all evaluated before -any assignments on the left are made. However, the order of evaluation -of these expressions is undefined. - - ( x, y ) := ( y, x ) - 1 - Type: PositiveInteger - - x - 2 - Type: PositiveInteger - -The variable x now has the previous value of y. - - y - 1 - Type: PositiveInteger - -The variable y now has the previous value of x. - -There is no syntactic form for multiple delayed assignments. - -\end{chunk} - -\section{syntax blocks} -\label{blocks} -\index{blocks} -\index{syntax!blocks} -\index{blocks!syntax} -\begin{chunk}{blocks.help} -==================================================================== -Blocks -==================================================================== - -A block is a sequence of expressions evaluated in the order that they -appear, except as modified by control expressions such as leave, return, -iterate, and if-then-else constructions. The value of a block is the -value of the expression last evaluated in the block. - -To leave a block early, use "=>". For example, - - i < 0 => x - -The expression before the "=>" must evaluate to true or false. The -expression following the "=>" is the return value of the block. - -A block can be constructed in two ways: - - 1. the expressions can be separated by semicolons and the resulting - expression surrounded by parentheses, and - 2. the expressions can be written on succeeding lines with each line - indented the same number of spaces (which must be greater than zero). - A block entered in this form is called a pile - -Only the first form is available if you are entering expressions directly -to Axiom. Both forms are available in .input files. The syntax for a simple -block of expressions entered interactively is - - ( expression1 ; expression2 ; ... ; expressionN ) - -The value returned by a block is the value of an "=>" expression, or -expressionN if no "=>" is encountered. - -In .input files, blocks can also be written in piles. The examples -given here are assumed to come from .input files. - - a := - i := gcd(234,672) - i := 2*i**5 - i + 1 - 1 / i - - 1 - ----- - 23323 - Type: Fraction Integer - -In this example, we assign a rational number to a using a block consisting -of three expressions. This block is written as a pile. Each expression in -the pile has the same indentation, in this case two spaces to the right of -the first line. - - a := ( i := gcd(234,672); i := 2*i**5 - i + 1; 1 / i ) - - 1 - ----- - 23323 - Type: Fraction Integer - -Here is the same block written on one line. This is how you are required -to enter it at the input prompt. - - ( a := 1; b := 2; c := 3; [a,b,c] ) - [1,2,3] - Type: List PositiveInteger - -AAxiom gives you two ways of writing a block and the preferred way in -an .input file is to use a pile. Roughly speaking, a pile is a block -whose consituent expressions are indented the same amount. You begin a -pile by starting a new line for the first expression, indenting it to -the right of the previous line. You then enter the second expression on -a new line, vertically aligning it with the first line. And so on. If -you need to enter an inner pile, further indent its lines to the right -of the outer pile. Axiom knows where a pile ends. It ends when a subsequent -line is indented to the left of the pile or the end of the file. - -Also See: -o )help if -o )help repeat -o )help while -o )help for -o )help suchthat -o )help parallel -o )help lists - -\end{chunk} -\footnote{ -\fnref{if} -\fnref{repeat} -\fnref{while} -\fnref{for} -\fnref{suchthat} -\fnref{parallel} -\fnref{lists}} - -\section{system clef} -\label{clef} -\index{clef} -\index{syntax!clef} -\index{clef!syntax} -\begin{chunk}{clef.help} - -Entering printable keys generally inserts new text into the buffer (unless -in overwrite mode, see below). Other special keys can be used to modify -the text in the buffer. In the description of the keys below, ^n means -Control-n, or holding the CONTROL key down while pressing "n". Errors -will ring the terminal bell. - -^A/^E : Move cursor to beginning/end of the line. -^F/^B : Move cursor forward/backward one character. -^D : Delete the character under the cursor. -^H, DEL : Delete the character to the left of the cursor. -^K : Kill from the cursor to the end of line. -^L : Redraw current line. -^O : Toggle overwrite/insert mode. Initially in insert mode. Text - added in overwrite mode (including yanks) overwrite - existing text, while insert mode does not overwrite. -^P/^N : Move to previous/next item on history list. -^R/^S : Perform incremental reverse/forward search for string on - the history list. Typing normal characters adds to the current - search string and searches for a match. Typing ^R/^S marks - the start of a new search, and moves on to the next match. - Typing ^H or DEL deletes the last character from the search - string, and searches from the starting location of the last search. - Therefore, repeated DEL's appear to unwind to the match nearest - the point at which the last ^R or ^S was typed. If DEL is - repeated until the search string is empty the search location - begins from the start of the history list. Typing ESC or - any other editing character accepts the current match and - loads it into the buffer, terminating the search. -^T : Toggle the characters under and to the left of the cursor. -^Y : Yank previously killed text back at current location. Note that - this will overwrite or insert, depending on the current mode. -^U : Show help (this text). -TAB : Perform command completion based on word to the left of the cursor. - Words are deemed to contain only the alphanumeric and the % ! ? _ - characters. -NL, CR : returns current buffer to the program. - -DOS and ANSI terminal arrow key sequences are recognized, and act like: - - up : same as ^P - down : same as ^N - left : same as ^B - right : same as ^F - -\end{chunk} - -\section{syntax collection} -\label{collection} -\index{collection} -\index{syntax!collection} -\index{collection!syntax} -\begin{chunk}{collection.help} -==================================================================== -Collection -- Creating Lists and Streams with Iterators -==================================================================== - -All of the loop expressions which do not use the repeat leave or -iterate words can be used to create lists and streams. For example: - -This creates a simple list of the integers from 1 to 10: - - list := [i for i in 1..10] - [1,2,3,4,5,6,7,8,9,10] - Type: List PositiveInteger - -Create a stream of the integers greater than or equal to 1: - - stream := [i for i in 1..] - [1,2,3,4,5,6,7,...] - Type: Stream PositiveInteger - -This is a list of the prime numbers between 1 and 10, inclusive: - - [i for i in 1..10 | prime? i] - [2,3,5,7] - Type: List PositiveInteger - -This is a stream of the prime integers greater than or equal to 1: - - [i for i in 1.. | prime? i] - [2,3,5,7,11,13,17,...] - Type: Stream PositiveInteger - -This is a list of the integers between 1 and 10, inclusive, whose -squares are less than 700: - - [i for i in 1..10 while i*i < 700] - [1,2,3,4,5,6,7,8,9,10] - Type: List PositiveInteger - -This is a stream of the integers greater than or equal to 1 whose -squares are less than 700: - - [i for i in 1.. while i*i < 700] - [1,2,3,4,5,6,7,...] - Type: Stream PositiveInteger - -The general syntax of a collection is - - [ collectExpression iterator1 iterator2 ... iteratorN ] - -where each iterator is either a for or a while clause. The loop -terminates immedidately when the end test of any iterator succeeds -or when a return expression is evaluated in collectExpression. The -value returned by the collection is either a list or a stream of -elements, one for each iteration of the collectExpression. - -Be careful when you use while to create a stream. By default Axiom -tries to compute and display the first ten elements of a stream. If -the while condition is not satisfied quickly, Axiom can spend a long -(potentially infinite) time trying to compute the elements. Use - - )set streams calculate - -to change the defaults to something else. This also affects the number -of terms computed and displayed for power series. For the purposes of -these examples we have use this system command to display fewer than -ten terms. - -\end{chunk} - -\section{syntax for} -\label{for} -\index{for} -\index{syntax!for} -\index{for!syntax} -\begin{chunk}{for.help} -==================================================================== -for loops -==================================================================== - -Axiom provide the for and in keywords in repeat loops, allowing you -to integrate across all elements of a list, or to have a variable take -on integral values from a lower bound to an upper bound. We shall refer -to these modifying clauses of repeat loops as for clauses. These clauses -can be present in addition to while clauses (See )help while). As with -all other types of repeat loops, leave (see )help leave) can be used to -prematurely terminate evaluation of the loop. - -The syntax for a simple loop using for is - - for iterator repeat loopbody - -The iterator has several forms. Each form has an end test which is -evaluted before loopbody is evaluated. A for loop terminates immediately -when the end test succeeds (evaluates to true) or when a leave or return -expression is evaluated in loopbody. The value returned by the loop is -the unique value of Void. - -==================================================================== -for i in n..m repeat -==================================================================== - -If for is followed by a variable name, the in keyword and then an integer -segment of the form n..m, the end test for this loop is the predicate -i > m. The body of the loop is evaluated m-n+1 times if this number is -greater than 0. If this number is less than or equal to 0, the loop body -is not evaluated at all. - -The variable i has the value n, n+1, ..., m for successive iterations -of the loop body. The loop variable is a local variable within the loop -body. Its value is not available outside the loop body and its value and -type within the loop body completely mask any outer definition of a -variable with the same name. - - for i in 10..12 repeat output(i**3) - 1000 - 1331 - 1728 - Type: Void - -The loop prints the values of 10^3, 11^3, and 12^3. - - a := [1,2,3] - [1,2,3] - Type: List PositiveInteger - - for i in 1..#a repeat output(a.i) - 1 - 2 - 3 - Type: Void - -Iterate across this list using "." to access the elements of a list -and the # operation to count its elements. - -This type of iteration is applicable to anything that uses ".". You -can also use it with functions that use indices to extract elements. - - m := matrix [ [1,2],[4,3],[9,0] ] - +- -+ - | 1 2 | - | 4 3 | - | 9 0 | - +- -+ - Type: Matrix Integer - -Define m to be a matrix. - - for i in 1..nrows(m) repeat output row(m.i) - [1,2] - [4,3] - [9,0] - Type: Void - -Display the rows of m. - -You can iterate with for-loops. - - for i in 1..5 repeat - if odd?(i) then iterate - output(i) - 2 - 4 - Type: Void - -Display the even integers in a segment. - -==================================================================== -for i in n..m by s repeat -==================================================================== - -By default, the difference between values taken on by a variable in -loops such as - - for i in n..m repeat ... - -is 1. It is possible to supply another, possibly negative, step value -by using the by keyword along with for and in. Like the upper and lower -bounds, the step value following the by keyword must be an integer. Note -that the loop - - for i in 1..2 by 0 repeat output(i) - -will not terminate by itself, as the step value does not change the -index from its initial value of 1. - - for i in 1..5 by 2 repeat output(i) - 1 - 3 - 5 - Type: Void - -This expression displays the odd integers between two bounds. - - for i in 5..1 by -2 repeat output(i) - 5 - 3 - 1 - Type: Void - -Use this to display the numbers in reverse order. - -==================================================================== -for i in n.. repeat -==================================================================== - -If the value after the ".." is omitted, the loop has no end test. A -potentially infinite loop is thus created. The variable is given the -successive values n, n+1, n+2, ... and the loop is terminated only -if a leave or return expression is evaluated in the loop body. However, -you may also add some other modifying clause on the repeat, for example, -a while clause, to stop the loop. - - for i in 15.. while not prime?(i) repeat output(i) - 15 - 16 - Type: Void - -This loop displays the integers greater than or equal to 15 and less -than the first prime number greater than 15. - -==================================================================== -for x in l repeat -==================================================================== - -Another variant of the for loop has the form: - - for x in list repeat loopbody - -This form is used when you want to iterate directly over the elements -of a list. In this form of the for loop, the variable x takes on the -value of each successive element in l. The end test is most simply -stated in English: "are there no more x in l?" - - l := [0, -5, 3] - [0, -5, 3] - Type: List Integer - - for x in l repeat output(x) - 0 - -5 - 3 - Type: Void - -This displays all of the elements of the list l, one per line. - -Since the list constructing expression - - expand [n..m] - -creates the list - - [n, n+1, ..., m] - -you might be tempted to think that the loops - - for i in n..m repeat output(i) - -and - - for x in expand [n..m] repeat output(x) - -are equivalent. The second form first creates the expanded list -(no matter how large it might be) and then does the iteration. The -first form potentially runs in much less space, as the index variable -i is simply incremented once per loop and the list is not actually -created. Using the first form is much more efficient. - -Of course, sometimes you really want to iterate across a specific list. -This displays each of the factors of 2400000: - - for f in factors(factor(2400000)) repeat output(f) - [factor= 2, exponent= 8] - [factor= 3, exponent= 1] - [factor= 5, exponent= 5] - Type: Void - -\end{chunk} - -\section{syntax if} -\label{if} -\index{if} -\index{syntax!if} -\index{if!syntax} -\begin{chunk}{if.help} -==================================================================== -If-then-else -==================================================================== - -Like many other programming languages, Axiom uses the three keywords -if, then, and else to form conditional expressions. The else part of -the conditional is optional. The expression between the if and then -keywords is a predicate: an expression that evaluates to or is -convertible to either true or false, that is, a Boolean. - -The syntax for conditional expressions is - - if predicate then expression1 else expression2 - -where the "else expression2" part is optional. The value returned from -a conditional expression is expression1 if the predicate evaluates to -true and expression2 otherwise. If no else clause is given, the value -is always the unique value of Void. - -An if-then-else expression always returns a value. If the else clause -is missing then the entire expression returns the unique value of Void. -If both clauses are present, the type of the value returned by if is -obtained by resolving the types of the values of the two clauses. - -The predicate must evaluate to, or be convertible to, an object of type -Boolean: true or false. By default, the equal sign "=" creates an equation. - - x + 1 = y - x + 1 = y - Type: Equation Polynomial Integer - -This is an equation, not a boolean condition. In particular, it is -an object of type Equation Polynomial Integer. - -However, for predicates in if expressions, Axiom places a default -target type of Boolean on the predicate and equality testing is performed. -Thus you need not qualify the "=" in any way. In other contexts you may -need to tell Axiom that you want to test for equality rather than create -an equation. In these cases, use "@" and a target type of Boolean. - -The compound symbol meaning "not equal" in Axiom is "~=". This can be -used directly without a package call or a target specification. The -expression "a ~= b" is directly translated to "not(a = b)". - -Many other functions have return values of type Boolean. These include -<, <=, >, >=, ~=, and member?. By convention, operations with names -ending in "?" return Boolean values. - -The usual rules for piles are suspended for conditional expressions. In -.input files, the then and else keywords can begin in the same column -as the corresponding if by may also appear to the right. Each of the -following styles of writing if-then-else expressions is acceptable: - - if i>0 then output("positive") else output("nonpositive") - - if i>0 then output("positive") - else output("nonpositive") - - if i>0 then output("positive") - else output("nonpositive") - - if i>0 - then output("positive") - else output("nonpositive") - - if i>0 - then output("positive") - else output("nonpositive") - -A block can follow the then or else keywords. In the following two -assignments to a, the then and else clauses each are followed by two -line piles. The value returned in each is the value of the second line. - - a := - if i > 0 then - j := sin(i * pi()) - exp(j + 1/j) - else - j := cos(i * 0.5 * pi()) - log(abs(j)**5 + i) - - - a := - if i > 0 - then - j := sin(i * pi()) - exp(j + 1/j) - else - j := cos(i * 0.5 * pi()) - log(abs(j)**5 + i) - -These are both equivalent to the following: - - a := - if i > 0 then (j := sin(i * pi()); exp(j + 1/j)) - else (j := cos(i * 0.5 * pi()); log(abs(j)**5 + i)) - -\end{chunk} - -\section{syntax iterate} -\label{iterate} -\index{iterate} -\index{syntax!iterate} -\index{iterate!syntax} -\begin{chunk}{iterate.help} -==================================================================== -iterate in loops -==================================================================== - -Axiom provides an iterate expression that skips over the remainder -of a loop body and starts the next loop execution. We first initialize -a counter. - - i := 0 - 0 - Type: NonNegativeInteger - -Display the even integers from 2 to 5: - - repeat - i := i + 1 - if i > 5 then leave - if odd?(i) then iterate - output(i) - 2 - 4 - Type: Void - -\end{chunk} - -\section{syntax leave} -\label{leave} -\index{leave} -\index{syntax!leave} -\index{leave!syntax} -\begin{chunk}{leave.help} -==================================================================== -leave in loops -==================================================================== - -The leave keyword is often more useful in terminating a loop. A -leave causes control to transfer to the expression immediately following -the loop. As loops always return the unique value of Void, you cannot -return a value with leave. That is, leave takes no argument. - - f() == - i := 1 - repeat - if factorial(i) > 1000 then leave - i := i + 1 - i - Type: Void - -This example is a modification of the last example in the previous -section. Instead of using return we'll use leave. - - f() - 7 - Type: PositiveInteger - -The loop terminates when factorial(i) gets big enough. The last line -of the function evaluates to the corresponding "good" value of i -and the function terminates, returning that value. - -You can only use leave to terminate the evaluation of one loop. Lets -consider a loop within a loop, that is, a loop with a nested loop. -First, we initialize two counter variables. - - (i,j) := (1,1) - 1 - Type: PositiveInteger - - repeat - repeat - if (i + j) > 10 then leave - j := j + 1 - if (i + j) > 10 then leave - i := i + 1 - Type: Void - -Nested loops must have multiple leave expressions at the appropriate -nesting level. How would you rewrite this so (i + j) > 10 is only -evaluated once? - -==================================================================== -leave vs => in loop bodies -==================================================================== - -Compare the following two loops: - - i := 1 i := 1 - repeat repeat - i := i + 1 i := i + 1 - i > 3 => i if i > 3 then leave - output(i) output(i) - -In the example on the left, the values 2 and 3 for i are displayed but -then the "=>" does not allow control to reach the call to output again. -The loop will not terminate until you run out of space or interrupt the -execution. The variable i will continue to be incremented because the -"=>" only means to leave the block, not the loop. - -In the example on the right, upon reaching 4, the leave will be executed, -and both the block and the loop will terminate. This is one of the reasons -why both "=>" and leave are provided. Using a while clase with the "=>" -lets you simulate the action of leave. - -\end{chunk} - -\section{syntax parallel} -\label{parallel} -\index{parallel} -\index{syntax!parallel} -\index{parallel!syntax} -\begin{chunk}{parallel.help} -==================================================================== -parallel iteration -==================================================================== - -Sometimes you want to iterate across two lists in parallel, or perhaps -you want to traverse a list while incrementing a variable. - -The general syntax of a repeat loop is - - iterator1, iterator2, ..., iteratorN repeat loopbody - -where each iterator is either a for or a while clause. The loop -terminates immediately when the end test of any iterator succeeds or -when a leave or return expression is evaluated in loopbody. The value -returned by the loop is the unique value of Void. - - l := [1,3,5,7] - [1,3,5,7] - Type: List PositiveInteger - - m := [100,200] - [100,200] - Type: List PositiveInteger - - sum := 0 - 0 - Type: NonNegativeInteger - -Here we write a loop to iterate across two lists, computing the sum -of the pairwise product of the elements: - - for x in l for y in m repeat - sum := sum + x*y - Type: Void - -The last two elements of l are not used in the calculation because -m has two fewer elements than l. - - sum - 700 - Type: NonNegativeInteger - -This is the "dot product". - -Next we write a loop to compute the sum of the products of the loop -elements with their positions in the loop. - - l := [2,3,5,7,11,13,17,19,23,29,31,37] - [2,3,5,7,11,13,17,19,23,29,31,37] - Type: List PositiveInteger - - sum := 0 - 0 - Type: NonNegativeInteger - - for i in 0.. for x in l repeat sum := i * x - Type: Void - -Here looping stops when the list l is exhaused, even though the -for i in 0.. specifies no terminating condition. - - sum - 407 - Type: NonNegativeInteger - -When "|" is used to qualify any of the for clauses in a parallel -iteration, the variables in the predicates can be from an outer -scope or from a for clause in or to the left of the modified clause. - -This is correct: - - for i in 1..10 repeat - for j in 200..300 | ood? (i+j) repeat - output [i,j] - -But this is not correct. The variable j has not been defined outside -the inner loop: - - for i in 1..01 | odd? (i+j) repeat -- wrong, j not defined - for j in 200..300 repeat - output [i,j] - -It is possible to mix several of repeat modifying clauses on a loop: - - for i in 1..10 - for j in 151..160 | odd? j - while i + j < 160 repeat - output [i,j] - [1,151] - [3,153] - Type: Void - -Here are useful rules for composing loop expressions: - - 1. while predicates can only refer to variables that are global (or - in an outer scope) or that are defined in for clauses to the left - of the predicate. - 2. A "such that" predicate (somthing following "|") must directly - follow a for clause and can only refer to variables that are - global (or in an outer scope) or defined in the modified for clause - or any for clause to the left. - -\end{chunk} - -\section{syntax repeat} -\label{repeat} -\index{repeat} -\index{syntax!repeat} -\index{repeat!syntax} -\begin{chunk}{repeat.help} -==================================================================== -Repeat Loops -==================================================================== - -A loop is an expression that contains another expression, called the loop -body, which is to be evaluated zero or more times. All loops contain the -repeat keyword and return the unique value of Void. Loops can contain -inner loops to any depth. - -The most basic loop is of the form - - repeat loopbody - -Unless loopbody contains a leave or return expression, the loop repeats -foreer. The value returned by the loop is the unique value of Void. - -Axiom tries to determine completely the type of every object in a loop -and then to translate the loop body to Lisp or even to machine code. This -translation is called compilation. - -If Axiom decides that it cannot compile the loop, it issues a message -stating the problem and then the following message: - - We will attemp to step through and interpret the code - -It is still possible that Axiom can evalute the loop but in interpret-code -mode. - -==================================================================== -Return in Loops -==================================================================== - -A return expression is used to exit a function with a particular value. -In particular, if a return is in a loop within the function, the loop -is terminated whenever the return is evaluated. - - f() == - i := 1 - repeat - if factorial(i) > 1000 then return i - i := i + 1 - Type: Void - - f() - Type: Void - -When factorial(i) is big enough, control passes from inside the loop -all the way outside the function, returning the value of i (so we think). -What went wrong? Isn't it obvious that this function should return an -integer? Well, Axiom makes no attempt to analyze the structure of a -loop to determine if it always returns a value because, in general, this -is impossible. So Axiom has this simple rule: the type of the function is -determined by the type of its body, in this case a block. The normal value -of a block is the value of its last expression, in this case, a loop. And -the value of every loop is the unique value of Void. So the return type -of f is Void. - -There are two ways to fix this. The best way is for you to tell Axiom -what the return type of f is. You do this by giving f a declaration - - f:() -> Integer - -prior to calling for its value. This tells Axiom "trust me -- an integer -is returned". Another way is to add a dummy expression as follows. - - f() == - i := 1 - repeat - if factorial(i) > 1000 then return i - i := i + 1 - 0 - Type: Void - -Note that the dummy expression will never be evaluated but it is the -last expression in the function and will determine the return type. - - f() - 7 - Type: PositiveInteger - -==================================================================== -leave in loops -==================================================================== - -The leave keyword is often more useful in terminating a loop. A -leave causes control to transfer to the expression immediately following -the loop. As loops always return the unique value of Void, you cannot -return a value with leave. That is, leave takes no argument. - - f() == - i := 1 - repeat - if factorial(i) > 1000 then leave - i := i + 1 - i - Type: Void - -This example is a modification of the last example in the previous -section. Instead of using return we'll use leave. - - f() - 7 - Type: PositiveInteger - -The loop terminates when factorial(i) gets big enough. The last line -of the function evaluates to the corresponding "good" value of i -and the function terminates, returning that value. - -You can only use leave to terminate the evaluation of one loop. Lets -consider a loop within a loop, that is, a loop with a nested loop. -First, we initialize two counter variables. - - (i,j) := (1,1) - 1 - Type: PositiveInteger - - repeat - repeat - if (i + j) > 10 then leave - j := j + 1 - if (i + j) > 10 then leave - i := i + 1 - Type: Void - -Nested loops must have multiple leave expressions at the appropriate -nesting level. How would you rewrite this so (i + j) > 10 is only -evaluated once? - -==================================================================== -leave vs => in loop bodies -==================================================================== - -Compare the following two loops: - - i := 1 i := 1 - repeat repeat - i := i + 1 i := i + 1 - i > 3 => i if i > 3 then leave - output(i) output(i) - -In the example on the left, the values 2 and 3 for i are displayed but -then the "=>" does not allow control to reach the call to output again. -The loop will not terminate until you run out of space or interrupt the -execution. The variable i will continue to be incremented because the -"=>" only means to leave the block, not the loop. - -In the example on the right, upon reaching 4, the leave will be executed, -and both the block and the loop will terminate. This is one of the reasons -why both "=>" and leave are provided. Using a while clase with the "=>" -lets you simulate the action of leave. - -==================================================================== -iterate in loops -==================================================================== - -Axiom provides an iterate expression that skips over the remainder -of a loop body and starts the next loop execution. We first initialize -a counter. - - i := 0 - 0 - Type: NonNegativeInteger - -Display the even integers from 2 to 5: - - repeat - i := i + 1 - if i > 5 then leave - if odd?(i) then iterate - output(i) - 2 - 4 - Type: Void - -Also See: -o )help blocks -o )help if -o )help while -o )help for -o )help suchthat -o )help parallel -o )help lists - -\end{chunk} -\footnote{ -\fnref{blocks} -\fnref{if} -\fnref{while} -\fnref{for} -\fnref{suchthat} -\fnref{parallel} -\fnref{lists}} - -\section{syntax suchthat} -\label{suchthat} -\index{suchthat} -\index{syntax!suchthat} -\index{suchthat!syntax} -\begin{chunk}{suchthat.help} -==================================================================== -Such that predicates -==================================================================== - -A for loop can be followed by a "|" and then a predicate. The predicate -qualifies the use of the values from the iterator that follows the for. -Think of the vertical bar "|" as the phrase "such that". - - for n in 0..4 | odd? n repeat output n - 1 - 3 - Type: Void - -This loop expression prints out the integers n in the given segment -such that n is odd. - -A for loop can also be written - - for iterator | predicate repeat loopbody - -which is equivalent to: - - for iterator repeat if predicate then loopbody else iterate - -The predicate need not refer only to the variable in the for clause. -Any variable in an outer scope can be part of the predicate. - - for i in 1..50 repeat - for j in 1..50 | factorial(i+j) < 25 repeat - output [i,j] - [1,1] - [1,2] - [1,3] - [2,1] - [2,2] - [3,1] - Type: Void - -\end{chunk} - -\section{syntax syntax} -\label{syntax} -\begin{chunk}{syntax.help} - -The Axiom Interactive Language has the following features documented here. - -More information is available by typing - - )help feature - -where feature is one of: - - assignment -- Immediate and delayed assignments - blocks -- Blocks of expressions - collection -- creating lists with iterators - for -- for loops - if -- If-then-else statements - iterate -- using iterate in loops - leave -- using leave in loops - parallel -- parallel iterations - repeat -- repeat loops - suchthat -- suchthat predicates - while -- while loops - -\end{chunk} - -\section{syntax while} -\index{while} -\index{syntax!while} -\index{while!syntax} -\begin{chunk}{while.help} -==================================================================== -while loops -==================================================================== - -The repeat in a loop can be modified by adding one or more while -clauses. Each clause contains a predicate immediately following the -while keyword. The predicate is tested before the evaluation of the -body of the loop. The loop body is evaluated whenever the predicate -in a while clause is true. - -The syntax for a simple loop using while is - - while predicate repeat loopbody - -The predicate is evaluated before loopbody is evaluated. A while loop -terminates immediately when predicate evaluates to false or when a -leave or return expression is evaluted. See )help repeat for more -information on leave and return. - -Here is a simple example of using while in a loop. We first initialize -the counter. - - i := 1 - 1 - Type: PositiveInteger - - while i < 1 repeat - output "hello" - i := i + 1 - Type: Void - -The steps involved in computing this example are - (1) set i to 1 - (2) test the condition i < 1 and determine that it is not true - (3) do not evaluate the loop body and therefore do not display "hello" - - (x, y) := (1, 1) - 1 - Type: PositiveInteger - -If you have multiple predicates to be tested use the logical and -operation to separate them. Axiom evaluates these predicates from -left to right. - - while x < 4 and y < 10 repeat - output [x,y] - x := x + 1 - y := y + 2 - [1,1] - [2,3] - [3,5] - Type: Void - - -A leave expression can be included in a loop body to terminate a loop -even if the predicate in any while clauses are not false. - - (x, y) := (1, 1) - 1 - Type: PositiveInteger - - while x < 4 and y < 10 repeat - if x + y > 7 then leave - output [x,y] - x := x + 1 - y := y + 2 - [1,1] - [2,3] - Type: Void - -\end{chunk} - -\chapter{Abstract Syntax Trees (ptrees)} -\begin{verbatim} -Abstract Syntax Trees - -These functions create and examine abstract -syntax trees. These are called pform, for short. - -!! This file also contains constructors for concrete syntax, although -!! they should be somewhere else. - -THE PFORM DATA STRUCTURE - Leaves: [hd, tok, pos] - Trees: [hd, tree, tree, ...] - hd is either an id or (id . alist) - -\end{verbatim} - -\defun{tokConstruct}{Construct a leaf token} -The tokConstruct function is a constructer and selectors for leaf tokens. -A leaf token looks like [head, token, position] -where head is either an id or (id . alist) - -\calls{tokConstruct}{ifcar} -\calls{tokConstruct}{pfNoPosition?} -\calls{tokConstruct}{ncPutQ} -\begin{chunk}{defun tokConstruct} -(defun |tokConstruct| (head token &rest position) - (let (result) - (setq result (cons head token)) - (cond - ((ifcar position) - (cond - ((|pfNoPosition?| (car position)) result) - (t (|ncPutQ| result '|posn| (car position)) result))) - (t result)))) - -\end{chunk} - -\defun{pfAbSynOp}{Return a part of a node} -\calls{pfAbSynOp}{ifcar} -\begin{chunk}{defun pfAbSynOp} -(defun |pfAbSynOp| (form) - (let (hd) - (setq hd (car form)) - (or (ifcar hd) hd))) - -\end{chunk} - -\defun{pfAbSynOp?}{Compare a part of a node} -\calls{pfAbSynOp?}{eqcar} -\begin{chunk}{defun pfAbSynOp?} -(defun |pfAbSynOp?| (form op) - (let (hd) - (setq hd (car form)) - (or (eq hd op) (eqcar hd op)))) - -\end{chunk} - -\defun{pfNoPosition?}{pfNoPosition?} -\calls{pfNoPosition?}{poNoPosition?} -\begin{chunk}{defun pfNoPosition?} -(defun |pfNoPosition?| (pos) - (|poNoPosition?| pos)) - -\end{chunk} - -\defun{poNoPosition?}{poNoPosition?} -\calls{poNoPosition?}{eqcar} -\begin{chunk}{defun poNoPosition? 0} -(defun |poNoPosition?| (pos) - (eqcar pos '|noposition|)) - -\end{chunk} - -\defun{tokType}{tokType} -\calls{tokType}{ncTag} -\begin{chunk}{defun tokType} -(defun |tokType| (x) (|ncTag| x)) - -\end{chunk} - -\defun{tokPart}{tokPart} -\begin{chunk}{defun tokPart 0} -(defun |tokPart| (x) (cdr x)) - -\end{chunk} - -\defun{tokPosn}{tokPosn} -\calls{tokPosn}{qassq} -\calls{tokPosn}{ncAlist} -\calls{tokPosn}{pfNoPosition} -\begin{chunk}{defun tokPosn} -(defun |tokPosn| (x) - (let (a) - (setq a (qassq '|posn| (|ncAlist| x))) - (cond - (a (cdr a)) - (t (|pfNoPosition|))))) - -\end{chunk} - -\defun{pfNoPosition}{pfNoPosition} -\calls{pfNoPosition}{poNoPosition} -\begin{chunk}{defun pfNoPosition} -(defun |pfNoPosition| () (|poNoPosition|)) - -\end{chunk} - -\defun{poNoPosition}{poNoPosition} -\usesdollar{poNoPosition}{nopos} -\begin{chunk}{defun poNoPosition 0} -(defun |poNoPosition| () - (declare (special |$nopos|)) - |$nopos|) - -\end{chunk} - -\chapter{Attributed Structures} -For objects which are pairs where the CAR field is either just a tag -(an identifier) or a pair which is the tag and an association list. - -\defun{ncTag}{ncTag} -Pick off the tag -\calls{ncTag}{ncBug} -\calls{ncTag}{qcar} -\calls{ncTag}{identp} -\begin{chunk}{defun ncTag} -(defun |ncTag| (x) - (cond - ((null (consp x)) (|ncBug| 's2cb0031 nil)) - (t - (setq x (qcar x)) - (cond - ((identp x) x) - ((null (consp x)) (|ncBug| 's2cb0031 nil)) - (t (qcar x)))))) - -\end{chunk} - -\defun{ncAlist}{ncAlist} -Pick off the property list -\calls{ncAlist}{ncBug} -\calls{ncAlist}{qcar} -\calls{ncAlist}{identp} -\calls{ncAlist}{qcdr} -\begin{chunk}{defun ncAlist} -(defun |ncAlist| (x) - (cond - ((null (consp x)) (|ncBug| 's2cb0031 nil)) - (t - (setq x (qcar x)) - (cond - ((identp x) nil) - ((null (consp x)) (|ncBug| 's2cb0031 nil)) - (t (qcdr x)))))) - -\end{chunk} - -\defun{ncEltQ}{ncEltQ} -Get the entry for key k on x's association list - -\calls{ncEltQ}{qassq} -\calls{ncEltQ}{ncAlist} -\calls{ncEltQ}{ncBug} -\begin{chunk}{defun ncEltQ} -(defun |ncEltQ| (x k) - (let (r) - (setq r (qassq k (|ncAlist| x))) - (cond - ((null r) (|ncBug| 's2cb0007 (list k))) - (t (cdr r))))) - -\end{chunk} - -\defun{ncPutQ}{ncPutQ} -\begin{verbatim} -;-- Put (k . v) on the association list of x and return v -;-- case1: ncPutQ(x,k,v) where k is a key (an identifier), v a value -;-- put the pair (k . v) on the association list of x and return v -;-- case2: ncPutQ(x,k,v) where k is a list of keys, v a list of values -;-- equivalent to [ncPutQ(x,key,val) for key in k for val in v] -;ncPutQ(x,k,v) == -; LISTP k => -; for key in k for val in v repeat ncPutQ(x,key,val) -; v -; r := QASSQ(k,ncAlist x) -; if NULL r then -; r := CONS( CONS(k,v), ncAlist x) -; RPLACA(x,CONS(ncTag x,r)) -; else -; RPLACD(r,v) -; v\end{verbatim} -\calls{ncPutQ}{qassq} -\calls{ncPutQ}{ncAlist} -\calls{ncPutQ}{ncTag} -\begin{chunk}{defun ncPutQ} -(defun |ncPutQ| (x k v) - (let (r) - (cond - ((listp k) - ((lambda (Var1 key Var2 val) - (loop - (cond - ((or (atom Var1) - (progn (setq key (car Var1)) nil) - (atom Var2) - (progn (setq val (car Var2)) nil)) - (return nil)) - (t - (|ncPutQ| x key val))) - (setq Var1 (cdr Var1)) - (setq Var2 (cdr Var2)))) - k nil v nil) - v) - (t - (setq r (qassq k (|ncAlist| x))) - (cond - ((null r) - (setq r (cons (cons k v) (|ncAlist| x))) - (rplaca x (cons (|ncTag| x) r))) - (t - (rplacd r v))) - v)))) - -\end{chunk} - -\subsection{Special Category Names} - -\defdollar{EmptyMode} -The CONTAINED predicate is used to walk internal structures -such as modemaps to see if the $X$ object occurs within $Y$. One -particular use is in a function called isPartialMode to decide -if a modemap is only partially complete. If this is true then the -modemap will contain the constant \verb|$EmptyMode|. So the call -ends up being CONTAINED \verb|$EmptyMode| Y. -\begin{chunk}{initvars} -(defvar |$EmptyMode| '|$EmptyMode|) - -\end{chunk} - -\defdollar{AnonymousFunction} -\begin{chunk}{initvars} -(defvar |$AnonymousFunction| '(|AnonymousFunction|)) - -\end{chunk} - -\defdollar{Any} -\begin{chunk}{initvars} -(defvar |$Any| '(|Any|)) - -\end{chunk} - -\defdollar{BFtag} -\begin{chunk}{initvars} -(defvar |$BFtag| '|:BF:|) - -\end{chunk} - -\defdollar{Boolean} -\begin{chunk}{initvars} -(defvar |$Boolean| '(|Boolean|)) - -\end{chunk} - -\defdollar{Category} -\begin{chunk}{initvars} -(defvar |$Category| '(|Category|)) - -\end{chunk} - -\defdollar{Domain} -\begin{chunk}{initvars} -(defvar |$Domain| '(|Domain|)) - -\end{chunk} - -\defdollar{Exit} -\begin{chunk}{initvars} -(defvar |$Exit| '(|Exit|)) - -\end{chunk} - -\defdollar{Expression} -\begin{chunk}{initvars} -(defvar |$Expression| '(|OutputForm|)) - -\end{chunk} - -\defdollar{OutputForm} -\begin{chunk}{initvars} -(defvar |$OutputForm| '(|OutputForm|)) - -\end{chunk} - -\defdollar{BigFloat} -\begin{chunk}{initvars} -(defvar |$BigFloat| '(|Float|)) - -\end{chunk} - -\defdollar{Float} -\begin{chunk}{initvars} -(defvar |$Float| '(|Float|)) - -\end{chunk} - -\defdollar{DoubleFloat} -\begin{chunk}{initvars} -(defvar |$DoubleFloat| '(|DoubleFloat|)) - -\end{chunk} - -\defdollar{FontTable} -\begin{chunk}{initvars} -(defvar |$FontTable| '(|FontTable|)) - -\end{chunk} - -\defdollar{Integer} -\begin{chunk}{initvars} -(defvar |$Integer| '(|Integer|)) - -\end{chunk} - -\defdollar{ComplexInteger} -\begin{chunk}{initvars} -(defvar |$ComplexInteger| (LIST '|Complex| |$Integer|)) - -\end{chunk} - -\defdollar{Mode} -\begin{chunk}{initvars} -(defvar |$Mode| '(|Mode|)) - -\end{chunk} - -\defdollar{NegativeInteger} -\begin{chunk}{initvars} -(defvar |$NegativeInteger| '(|NegativeInteger|)) - -\end{chunk} - -\defdollar{NonNegativeInteger} -\begin{chunk}{initvars} -(defvar |$NonNegativeInteger| '(|NonNegativeInteger|)) - -\end{chunk} - -\defdollar{NonPositiveInteger} -\begin{chunk}{initvars} -(defvar |$NonPositiveInteger| '(|NonPositiveInteger|)) - -\end{chunk} - -\defdollar{PositiveInteger} -\begin{chunk}{initvars} -(defvar |$PositiveInteger| '(|PositiveInteger|)) - -\end{chunk} - -\defdollar{RationalNumber} -\begin{chunk}{initvars} -(defvar |$RationalNumber| '(|Fraction| (|Integer|))) - -\end{chunk} - -\defdollar{String} -\begin{chunk}{initvars} -(defvar |$String| '(|String|)) - -\end{chunk} - -\defdollar{StringCategory} -\begin{chunk}{initvars} -(defvar |$StringCategory| '(|StringCategory|)) - -\end{chunk} - -\defdollar{Symbol} -\begin{chunk}{initvars} -(defvar |$Symbol| '(|Symbol|)) - -\end{chunk} - -\defdollar{Void} -\begin{chunk}{initvars} -(defvar |$Void| '(|Void|)) - -\end{chunk} - -\defdollar{QuotientField} -\begin{chunk}{initvars} -(defvar |$QuotientField| '|Fraction|) - -\end{chunk} - -\defdollar{FunctionalExpression} -\begin{chunk}{initvars} -(defvar |$FunctionalExpression| '|Expression|) - -\end{chunk} - -\defdollar{defaultFunctionTargets} -\begin{chunk}{initvars} -(defvar |$defaultFunctionTargets| '(())) - -\end{chunk} - -;; Old names -\defdollar{SmallInteger} -\begin{chunk}{initvars} -(defvar |$SmallInteger| '(|SingleInteger|)) - -\end{chunk} - -;; New Names -\defdollar{SingleFloat} -\begin{chunk}{initvars} -(defvar |$SingleFloat| '(|SingleFloat|)) - -\end{chunk} - -\defdollar{DoubleFloat} -\begin{chunk}{initvars} -(defvar |$DoubleFloat| '(|DoubleFloat|)) - -\end{chunk} - -\defdollar{SingleInteger} -\begin{chunk}{initvars} -(defvar |$SingleInteger| '(|SingleInteger|)) - -\end{chunk} - - -\chapter{Function Selection} -\begin{verbatim} -New Selection of Modemaps - -selection of applicable modemaps is done in two steps: - first it tries to find a modemap inside an argument domain, and if - this fails, by evaluation of pattern modemaps -the result is a list of functions with signatures, which have the - following form: - [sig,elt,cond] where - sig is the signature gained by evaluating the modemap condition - elt is the slot number to get the implementation - cond are runtime checks which are the results of evaluating the - modemap condition - -the following flags are used: - $Coerce is NIL, if function selection is done which requires exact - matches (e.g. for coercion functions) - if $SubDom is true, then runtime checks have to be compiled -\end{verbatim} - -\defun{ofCategory}{ofCategory} -\calls{ofCategory}{identp} -\calls{ofCategory}{ofCategory} -\calls{ofCategory}{hasCaty} -\defsdollar{ofCategory}{Subst} -\defsdollar{ofCategory}{hope} -\begin{chunk}{defun ofCategory} -(defun |ofCategory| (dom cat) - (let (|$Subst| |$hope|) - (declare (special |$Subst| |$hope|)) - (cond - ((identp dom) nil) - ((and (listp cat) (eq (car cat) '|Join|)) - (every #'(lambda (c) (|ofCategory| dom c)) (cdr cat))) - (t (not (eq (|hasCaty| dom cat nil) '|failed|)))))) - -\end{chunk} - -\defun{isPartialMode}{isPartialMode} -The isPartialMode function tests whether m contains \verb|$EmptyMode|. The -constant \verb|$EmptyMode| evaluates to \verb?|$EmptyMode|?. This constant -is inserted in a modemap during compile time if the modemap is not yet -complete. - -\calls{isPartialMode}{contained} -\refsdollar{isPartialMode}{EmptyMode} -\begin{chunk}{defun isPartialMode} -(defun |isPartialMode| (m) - (declare (special |$EmptyMode|)) - (contained |$EmptyMode| m)) - -\end{chunk} - -\defun{hasCaty}{hasCaty} -This calls hasCat, which looks up a hashtable and returns: -\begin{verbatim} - 1. T, NIL or a (has x1 x2) condition, if cat is not parameterized - 2. a list of pairs (argument to cat,condition) otherwise -\end{verbatim} -then the substitution sl is augmented, or the result is 'failed -\calls{hasCaty}{hasAttSig} -\calls{hasCaty}{subCopy} -\calls{hasCaty}{constructSubst} -\calls{hasCaty}{hasSig} -\calls{hasCaty}{hasAtt} -\calls{hasCaty}{hasCat} -\calls{hasCaty}{opOf} -\calls{hasCaty}{kdr} -\calls{hasCaty}{mkDomPvar} -\calls{hasCaty}{domArg} -\calls{hasCaty}{augmentSub} -\calls{hasCaty}{domArg2} -\calls{hasCaty}{unifyStruct} -\calls{hasCaty}{hasCaty1} -\refsdollar{hasCaty}{domPvar} -\begin{chunk}{defun hasCaty} -(defun |hasCaty| (d cat sl) - (let (x y S z cond sp dom zp s1 ncond i) - (declare (special |$domPvar|)) - (cond - ((and (consp cat) (eq (qcar cat) 'category) (consp (qcdr cat))) - (|hasAttSig| d (|subCopy| (qcddr cat) (|constructSubst| d)) sl)) - ((and (consp cat) (eq (qcar cat) 'signature) (consp (qcdr cat)) - (consp (qcddr cat)) (eq (qcdddr cat) nil)) - (|hasSig| d (qcadr cat) (|subCopy| (qcaddr cat) (|constructSubst| d)) sl)) - ((and (consp cat) (eq (qcar cat) 'attribute) - (consp (qcdr cat)) (eq (qcddr cat) nil)) - (|hasAtt| d (|subCopy| (qcadr cat) (|constructSubst| d)) sl)) - ((setq x (|hasCat| (|opOf| d) (|opOf| cat))) - (cond - ((setq y (kdr cat)) - (setq s (|constructSubst| d)) - (do ((next x (cdr next)) (endtest nil (null (eq s1 '|failed|)))) - ((or (atom next) endtest) nil) - (setq z (caar next)) - (setq cond (cdar next)) - (setq sp - (loop for item in s - collect (cons (car item) (|mkDomPvar| (car item) (cdr item) z y)))) - (when |$domPvar| - (setq i -1) - (setq dom - (cons (car d) - (loop for arg in (rest d) - collect (|domArg| arg (incf i) z y)))) - (setq sl (|augmentSub| |$domPvar| dom (copy sl)))) - (setq zp - (loop for a in z - collect (|domArg2| a s sp))) - (setq s1 (|unifyStruct| y zp (copy sl))) - (cond - ((null (eq s1 '|failed|)) - (setq s1 - (cond - ((atom cond) s1) - (t - (setq ncond (|subCopy| cond s)) - (cond - ((and (consp ncond) (eq (qcar ncond) '|has|) - (consp (qcdr ncond)) (equal (qcadr ncond) d) - (consp (qcddr ncond)) (eq (qcdddr ncond) nil) - (equal (qcaddr ncond) cat)) - '|failed|) - (t (|hasCaty1| ncond s1))))))) - (t nil))) - s1) - ((atom x) sl) - (t - (setq ncond (|subCopy| x (|constructSubst| d))) - (cond - ((and (consp ncond) (eq (qcar ncond) '|has|) (consp (qcdr ncond)) - (equal (qcadr ncond) d) (consp (qcddr ncond)) - (eq (qcdddr ncond) nil) (equal (qcaddr ncond) cat)) - '|failed|) - (t (|hasCaty1| ncond sl)))))) - (t '|failed|)))) - -\end{chunk} - -\defun{domArg}{domArg} -\refsdollar{domArg}{FormalMapVariableList} -\begin{chunk}{defun domArg} -(defun |domArg| (type i subs y) - (let (p) - (declare (special |$FormalMapVariableList|)) - (if (setq p (member (elt |$FormalMapVariableList| i) subs)) - (elt y (- (|#| subs) (|#| p))) - type))) - -\end{chunk} - -\defun{domArg2}{domArg2} -\calls{domArg2}{isSharpVar} -\calls{domArg2}{subCopy} -\refsdollar{domArg2}{domPvar} -\begin{chunk}{defun domArg2} -(defun |domArg2| (arg sl1 sl2) - (declare (special |$domPvar|)) - (cond - ((|isSharpVar| arg) (|subCopy| arg sl1)) - ((and (eq arg '$) |$domPvar|) |$domPvar|) - (t (|subCopy| arg sl2)))) - -\end{chunk} - -\defun{hasSig}{hasSig} -The function hasSig tests whether domain dom has function foo with -signature sig under substitution sl. -\calls{hasSig}{constructor?} -\calls{hasSig}{cnstructSubst} -\calls{hasSig}{assq} -\calls{hasSig}{getOperationAlistFromLisplib} -\calls{hasSig}{hasCate} -\calls{hasSig}{subCopy} -\calls{hasSig}{hasSigAnd} -\calls{hasSig}{hasSigOr} -\calls{hasSig}{keyedSystemError} -\calls{hasSig}{unifyStruct} -\defsdollar{hasSig}{domPvar} -\begin{chunk}{defun hasSig} -(defun |hasSig| (dom foo sig sl) - (let (|$domPvar| fun s0 p x cond s) - (declare (special |$domPvar|)) - (cond - ((setq fun (|constructor?| (car dom))) - (setq s0 (|constructSubst| dom)) - (cond - ((setq p (assq foo (|getOperationAlistFromLisplib| (car dom)))) - (do ((next (cdr p) (cdr next)) - (endtest nil (null (eq s '|failed|)))) - ((or (atom next) endtest) nil) - (setq x (caar next)) - (setq cond (caddar next)) - (setq s - (cond - ((atom cond) (copy sl)) - ((and (consp cond) (eq (qcar cond) '|has|) - (consp (qcdr cond)) (consp (qcddr cond)) - (eq (qcdr (qcddr cond)) nil)) - (|hasCate| (|subCopy| (qcadr cond) s0) - (|subCopy| (qcaddr cond) s0) - (copy sl))) - ((and (consp cond) - (or (eq (qcar cond) 'and) (eq (qcar cond) '|and|))) - (|hasSigAnd| (qcdr cond) s0 sl)) - ((and (consp cond) - (or (eq (qcar cond) 'or) (eq (qcar cond) '|or|))) - (|hasSigOr| (qcdr cond) s0 sl)) - (t - (|keyedSystemError| 'S2GE0016 - (list "hasSig" "unexpected condition for signature"))))) - (unless (eq s '|failed|) - (setq s (|unifyStruct| (|subCopy| x s0) sig s)))) - s) - (t '|failed|))) - (t '|failed|)))) - -\end{chunk} - -\defun{hasAtt}{hasAtt} -The hasAtt function tests whether dom has attribute att under sl -needs s0 similar to hasSig. -\calls{hasAtt}{subCopy} -\calls{hasAtt}{getdatabase} -\calls{hasAtt}{constructSubst} -\calls{hasAtt}{getInfovec} -\calls{hasAtt}{unifyStruct} -\calls{hasAtt}{hasCatExpression} -\defsdollar{hasAtt}{domPvar} -\begin{chunk}{defun hasAtt} -(defun |hasAtt| (dom att sl) - (let (|$domPvar| fun atts u x cond s) - (declare (special |$domPvar|)) - (cond - ((setq fun (car dom)) - (cond - ((setq atts - (|subCopy| (getdatabase fun 'attributes) (|constructSubst| dom))) - (cond - ((consp (setq u (|getInfovec| (car dom)))) - (do ((next atts (cdr next)) - (endtest nil (null (eq s '|failed|)))) - ((or (atom next) endtest) nil) - (setq x (caar next)) - (setq cond (cdar next)) - (setq s (|unifyStruct| x att (copy sl))) - (cond - ((and (null (atom cond)) (null (eq s '|failed|))) - (setq s (|hasCatExpression| cond s))))) - s) - (t - (do ((next atts (cdr next)) - (endtest nil (null (eq s '|failed|)))) - ((or (atom next) endtest) nil) - (setq x (caar next)) - (setq cond (cadar next)) - (setq s (|unifyStruct| x att (copy sl))) - (cond - ((and (null (atom cond)) (null (eq s '|failed|))) - (setq s (|hasCatExpression| cond s))))) - s))) - (t '|failed|))) - (t '|failed|)))) - -\end{chunk} - -\defun{hasSigAnd}{hasSigAnd} -\calls{hasSigAnd}{hasCate} -\calls{hasSigAnd}{subCopy} -\calls{hasSigAnd}{keyedSystemError} -\begin{chunk}{defun hasSigAnd} -(defun |hasSigAnd| (andCls s0 sl) - (let (sa dead) - (setq sa '|failed|) - (loop for cls in andCls - do - (when dead (return)) - (setq sa - (cond - ((atom cls) (copy sl)) - ((and (consp cls) (eq (qcar cls) '|has|) (consp (qcdr cls)) - (consp (qcddr cls)) (eq (qcdddr cls) nil)) - (|hasCate| (|subCopy| (qcadr cls) s0) - (|subCopy| (qcaddr cls) s0) - (copy sl))) - (t - (|keyedSystemError| 'S2GE0016 - (list "hasSigAnd" "unexpected condition for signature"))))) - (when (eq sa '|failed|) (setq dead t))) - sa)) - -\end{chunk} - -\defun{hasSigOr}{hasSigOr} -\calls{hasSigOr}{hasCate} -\calls{hasSigOr}{hasSigAnd} -\calls{hasSigOr}{keyedSystemError} -\begin{chunk}{defun hasSigOr} -(defun |hasSigOr| (orCls s0 sl) - (let (sa found) - (setq sa '|failed|) - (loop for cls in orCls - until found - do - (setq sa - (cond - ((atom cls) (copy sl)) - ((and (consp cls) (eq (qcar cls) '|has|) (consp (qcdr cls)) - (consp (qcddr cls)) (eq (qcdddr cls) nil)) - (|hasCate| (|subCopy| (qcadr cls) s0) - (|subCopy| (qcaddr cls) s0) - (copy sl))) - ((and (consp cls) - (or (eq (qcar cls) 'and) (eq (qcar cls) '|and|))) - (|hasSigAnd| (qcdr cls) s0 sl)) - (t - (|keyedSystemError| 'S2GE0016 - (list "hasSigOr" "unexpected condition for signature"))))) - (unless (eq sa '|failed|) (setq found t))) - sa)) - -\end{chunk} - -\defun{hasAttSig}{hasAttSig} -The argument d is domain, x is a list of attributes and signatures. -The result is an augmented SL, if d has x, 'failed otherwise. - -\calls{hasAttSig}{hasAtt} -\calls{hasAttSig}{hasSig} -\calls{hasAttSig}{keyedSystemError} -\begin{chunk}{defun hasAttSig} -(defun |hasAttSig| (d x sl) - (loop for y in x - until (eq sl '|failed|) - do - (setq sl - (cond - ((and (consp y) (eq (qcar y) 'attribute) - (consp (qcdr y)) (eq (qcddr y) nil)) - (|hasAtt| d (qcadr y) sl)) - ((and (consp y) (eq (qcar y) 'signature) - (consp (qcdr y)) (consp (qcddr y)) (eq (qcdddr y) nil)) - (|hasSig| d (qcadr y) (qcaddr y) sl)) - (t - (|keyedSystemError| 'S2GE0016 - (list "hasAttSig" "unexpected form of unnamed category")))))) - sl) - -\end{chunk} - -\defun{hasCate1}{hasCate1} -\calls{hasCate1}{hasCate} -\defsdollar{hasCate1}{domPvar} -\begin{chunk}{defun hasCate1} -(defun |hasCate1| (dom cat sl domPvar) - (let (|$domPvar|) - (declare (special |$domPvar|)) - (setq |$domPvar| domPvar) - (|hasCate| dom cat sl))) - -\end{chunk} - -\defun{hasCatExpression}{hasCatExpression} -\calls{hasCatExpression}{hasCatExpression} -\calls{hasCatExpression}{hasCate} -\calls{hasCatExpression}{keyedSystemError} -\begin{chunk}{defun hasCatExpression} -(defun |hasCatExpression| (cond sl) - (let (y) - (cond - ((and (consp cond) (eq (qcar cond) 'or)) - (when - (let (result) - (loop for x in (qcdr cond) - do (setq result - (or result - (not (eq (setq y (|hasCatExpression| x sl)) '|failed|))))) - result) - y)) - ((and (consp cond) (eq (qcar cond) 'and)) - (when - (let ((result t)) - (loop for x in (qcdr cond) - do (setq result - (and result - (not (eq (setq sl (|hasCatExpression| x sl)) '|failed|))))) - result) - sl)) - ((and (consp cond) (eq (qcar cond) '|has|) - (consp (qcdr cond)) (consp (qcddr cond)) (eq (qcdddr cond) nil)) - (|hasCate| (qcadr cond) (qcaddr cond) sl)) - (t - (|keyedSystemError| 'S2GE0016 - (list "hasSig" "unexpected condition for attribute")))))) - -\end{chunk} - -\defun{unifyStruct}{unifyStruct} -\calls{unifyStruct}{isPatternVar} -\calls{unifyStruct}{unifyStructVar} -\calls{unifyStruct}{unifyStruct} -\begin{chunk}{defun unifyStruct} -(defun |unifyStruct| (s1 s2 sl) - (declare (special |$domPvar| |$hope| |$Coerce| |$Subst|)) - (cond - ((equal s1 s2) sl) - (t - (when (and (consp s1) (eq (qcar s1) '|:|) - (consp (qcdr s1)) (consp (qcddr s1)) (eq (qcdddr s1) nil)) - (setq s1 (qcadr s1))) - (when (and (consp s2) (eq (qcar s2) '|:|) - (consp (qcdr s2)) (consp (qcddr s2)) (eq (qcdddr s2) nil)) - (setq s2 (qcadr s2))) - (when (and (null (atom s1)) (eq (car s1) '|#|)) - (setq s1 (length (cadr s1)))) - (when (and (null (atom s2)) (eq (car s2) '|#|)) - (setq s2 (length (cadr s2)))) - (cond - ((equal s1 s2) sl) - ((|isPatternVar| s1) (|unifyStructVar| s1 s2 sl)) - ((|isPatternVar| s2) (|unifyStructVar| s2 s1 sl)) - ((or (atom s1) (atom s2)) '|failed|) - (t - (loop until (or (null s1) (null s2) (eq sl '|failed|)) - do - (setq sl (|unifyStruct| (car s1) (car s2) sl)) - (setq s1 (cdr s1)) - (setq s2 (cdr s2))) - (if (or s1 s2) '|failed| sl)))))) - -\end{chunk} - -\defun{unifyStructVar}{unifyStructVar} -The first argument is a pattern variable, which is not substituted by sl -\calls{unifyStructVar}{contained} -\calls{unifyStructVar}{lassoc} -\calls{unifyStructVar}{unifyStruct} -\calls{unifyStructVar}{constructor?} -\calls{unifyStructVar}{subCopy} -\calls{unifyStructVar}{containsVars} -\calls{unifyStructVar}{canCoerce} -\calls{unifyStructVar}{resolveTT} -\calls{unifyStructVar}{isPatternVar} -\calls{unifyStructVar}{augmentSub} -\refsdollar{unifyStructVar}{domPvar} -\refsdollar{unifyStructVar}{Coerce} -\refsdollar{unifyStructVar}{Subst} -\defsdollar{unifyStructVar}{hope} -\begin{chunk}{defun unifyStructVar} -(defun |unifyStructVar| (v ss sl) - (let (ps s1 s0 s ns0 ns1 s3) - (declare (special |$domPvar| |$hope| |$Coerce| |$Subst|)) - (cond - ((contained v ss) '|failed|) - (t - (setq ps (lassoc ss sl)) - (setq s1 (if ps ps ss)) - (cond - ((or (setq s0 (lassoc v sl)) (setq s0 (lassoc v |$Subst|))) - (setq s (|unifyStruct| s0 s1 (copy sl))) - (cond - ((eq s '|failed|) - (cond - ((and |$Coerce| (null (atom s0)) (|constructor?| (car s0))) - (cond - ((or (|containsVars| s0) (|containsVars| s1)) - (setq ns0 (|subCopy| s0 sl)) - (setq ns1 (|subCopy| s1 sl)) - (cond - ((or (|containsVars| ns0) (|containsVars| ns1)) - (setq |$hope| t) - '|failed|) - (t - (cond - ((|canCoerce| ns0 ns1) (setq s3 s1)) - ((|canCoerce| ns1 ns0) (setq s3 s0)) - (t (setq s3 nil))) - (cond - (s3 - (cond - ((not (equal s3 s0)) - (setq sl (|augmentSub| v s3 sl)))) - (cond - ((and (not (equal s3 s1)) (|isPatternVar| ss)) - (setq sl (|augmentSub| ss s3 sl)))) - sl) - (t '|failed|))))) - (|$domPvar| - (setq s3 (|resolveTT| s0 s1)) - (cond - (s3 - (cond - ((not (equal s3 s0)) - (setq sl (|augmentSub| v s3 sl)))) - (cond - ((and (not (equal s3 s1)) (|isPatternVar| ss)) - (setq sl (|augmentSub| ss s3 sl)))) - sl) - (t '|failed|))) - (t '|failed|))) - (t '|failed|))) - (t (|augmentSub| v ss s)))) - (t (|augmentSub| v ss sl))))))) - -\end{chunk} - -\defun{containsVars}{containsVars} -The function containsVars tests whether term t contains a * variable. - -\calls{containsVars}{isPatternVar} -\calls{containsVars}{containsVars1} -\begin{chunk}{defun containsVars} -(defun |containsVars| (arg) - (if (atom arg) - (|isPatternVar| arg) - (|containsVars1| arg))) - -\end{chunk} - -\defun{isPatternVar}{isPatternVar} -\begin{chunk}{defun isPatternVar} -(defun |isPatternVar| (v) - (and (identp v) - (member v - '(** *1 *2 *3 *4 *5 *6 *7 *8 *9 *10 *11 *12 *13 *14 *15 - *16 *17 *18 *19 *20)) - t)) - -\end{chunk} - -\defun{containsVars1}{containsVars1} -The function containsVars1 tests whether term t contains a * variable. -This is a recursive version, which works on a list. - -\calls{containsVars1}{isPatternVar} -\calls{containsVars1}{containsVars1} -\begin{chunk}{defun containsVars1} -(defun |containsVars1| (arg) - (let ((t1 (car arg)) (t2 (cdr arg))) - (if (atom t1) - (or (|isPatternVar| t1) - (if (atom t2) (|isPatternVar| t2) (|containsVars1| t2))) - (or (|containsVars1| t1) - (if (atom t2) (|isPatternVar| t2) (|containsVars1| t2)))))) - -\end{chunk} - -\defun{hasCaty1}{hasCaty1} -The cond is either a (has a b) or an OR clause of such conditions. -SL is augmented, if cond is true, otherwise the result is 'failed - -\calls{hasCaty1}{hasCate} -\calls{hasCaty1}{hasCaty1} -\calls{hasCaty1}{keyedSystemError} -\defsdollar{hasCaty1}{domPvar} -\begin{chunk}{defun hasCaty1} -(defun |hasCaty1| (cond sl) - (let (|$domPvar| a s) - (declare (special |$domPvar|)) - (setq |$domPvar| nil) - (cond - ((and (consp cond) (eq (qcar cond) '|has|) - (consp (qcdr cond)) (consp (qcddr cond)) (eq (qcdddr cond) nil)) - (|hasCate| (qcadr cond) (qcaddr cond) sl)) - ((and (consp cond) (EQ (qcar cond) 'and)) - (loop for x in (qcdr cond) - while (not (eq s '|failed|)) - do - (setq s - (cond - ((and (consp x) (eq (qcar x) '|has|) - (consp (qcdr x)) (consp (qcddr x)) (eq (qcdr (qcddr x)) nil)) - (|hasCate| (qcadr x) (qcaddr x) sl)) - ((and (consp x) (eq (qcdr x) nil) - (consp (qcar x)) (eq (qcaar x) '|has|) - (consp (qcdar x)) (consp (qcddar x)) - (eq (qcdr (qcddar x)) nil)) - (|hasCate| a (qcaddar x) sl)) - (t (|hasCaty1| x sl))))) - s) - ((and (consp cond) (eq (qcar cond) 'or)) - (do ((next (qcdr cond) (cdr next)) (x nil) - (nextitem nil (null (eq s '|failed|)))) - ((or (atom next) - (progn (setq x (car next)) nil) - nextitem) - nil) - (setq s - (cond - ((and (consp x) (eq (qcar x) '|has|) - (consp (qcdr x)) (consp (qcddr x)) (eq (qcdddr x) nil)) - (|hasCate| (qcadr x) (qcaddr x) (copy sl))) - ((and (consp x) (eq (qcdr x) nil) (consp (qcar x)) - (eq (qcaar x) '|has|) (consp (qcdar x)) (consp (qcddar x)) - (eq (qcdddar x) nil)) - (|hasCate| (qcadar x) (qcaddar x) (copy sl))) - (t (|hasCaty1| x (copy sl)))))) - s) - (t - (|keyedSystemError| 'S2GE0016 - (list "hasCaty1" "unexpected condition from category table")))))) - -\end{chunk} - -\defun{mkDomPvar}{mkDomPvar} -\calls{mkDomPvar}{domArg} -\calls{mkDomPvar}{length} -\refsdollar{mkDomPvar}{FormalMapVariableList} -\begin{chunk}{defun mkDomPvar} -(defun |mkDomPvar| (p d subs y) - (let (l) - (declare (special |$FormalMapVariableList|)) - (if (setq l (member p |$FormalMapVariableList|)) - (|domArg| d (- (|#| |$FormalMapVariableList|) (|#| l)) subs y) - d))) - -\end{chunk} - -\defun{hasCate}{hasCate} -\calls{hasCate}{isPatternVar} -\calls{hasCate}{hasCate1} -\calls{hasCate}{hasCateSpecial} -\calls{hasCate}{containsVariables} -\calls{hasCate}{subCopy} -\calls{hasCate}{hasCaty} -\refsdollar{hasCate}{EmptyMode} -\refsdollar{hasCate}{Subst} -\defsdollar{hasCate}{hope} -\begin{chunk}{defun hasCate} -(defun |hasCate| (dom cat sl) - (let (nsl p s sl1) - (declare (special |$hope| |$Subst| |$EmptyMode|)) - (cond - ((equal dom |$EmptyMode|) nil) - ((|isPatternVar| dom) - (cond - ((and (setq p (assq dom sl)) - (not (eq (setq nsl (|hasCate| (cdr p) cat sl)) '|failed|))) - nsl) - ((or (setq p (assq dom |$Subst|)) (setq p (assq dom sl))) - (setq s (|hasCate1| (cdr p) cat sl dom)) - (cond - ((null (eq s '|failed|)) s) - (t (|hasCateSpecial| dom (cdr p) cat sl)))) - (t - (when (not (eq sl '|failed|)) (setq |$hope| t)) - '|failed|))) - (t - (setq sl1 - (loop for item in sl - when (null (|containsVariables| (cdr item))) - collect item)) - (when sl1 (setq cat (|subCopy| cat sl1))) - (|hasCaty| dom cat sl))))) - -\end{chunk} - -\defun{constructSubst}{constructSubst} -\calls{constructSubst}{internl} -\calls{constructSubst}{stringimage} -\begin{chunk}{defun constructSubst} -(defun |constructSubst| (d) - (let (sl (i 0)) - (setq sl (list (cons '$ d))) - (when (listp d) - (dolist (x (cdr d)) - (setq i (1+ i)) - (setq sl (cons (cons (internl "#" (stringimage i)) x) sl)))) - sl)) - -\end{chunk} - -\defun{hasCateSpecial}{hasCateSpecial} -The variable v is a pattern variable, dom is its binding under \verb|$Subst|. -We try to change dom so that it has category cat under sl. -The result is a substitution list or 'failed. - -\calls{hasCateSpecial}{eqcar} -\calls{hasCateSpecial}{isSubDomain} -\calls{hasCateSpecial}{canCoerceFrom} -\calls{hasCateSpecial}{containsVars} -\calls{hasCateSpecial}{augmentSub} -\calls{hasCateSpecial}{hasCate} -\calls{hasCateSpecial}{hasCaty} -\calls{hasCateSpecial}{hasCateSpecialNew} -\refsdollar{hasCateSpecial}{Integer} -\refsdollar{hasCateSpecial}{QuotientField} -\begin{chunk}{defun hasCateSpecial} -(defun |hasCateSpecial| (v dom cat sl) - (let (arg d domp nsl) - (declare (special |$Integer| |$QuotientField|)) - (cond - ((and (consp dom) (eq (qcar dom) '|FactoredForm|) - (consp (qcdr dom)) (eq (qcddr dom) nil)) - (setq arg (qcadr dom)) - (when (|isSubDomain| arg |$Integer|) (setq arg |$Integer|)) - (setq d (list '|FactoredRing| arg)) - (setq sl (|hasCate| arg '(|Ring|) (|augmentSub| v d sl))) - (if (eq sl '|failed|) - '|failed| - (|hasCaty| d cat sl))) - ((or (eqcar cat '|Field|) (eqcar cat '|DivisionRing|)) - (when (|isSubDomain| dom |$Integer|) (setq dom |$Integer|)) - (setq d (list |$QuotientField| dom)) - (|hasCaty| dom '(|IntegralDomain|) (|augmentSub| v d sl))) - ((and (consp cat) (eq (qcar cat) '|PolynomialCategory|) - (consp (qcdr cat))) - (setq domp (cons '|Polynomial| (list (qcadr cat)))) - (and (or (|containsVars| (qcadr cat)) (|canCoerceFrom| dom domp)) - (|hasCaty| domp cat (|augmentSub| v domp sl)))) - ((|isSubDomain| dom |$Integer|) - (setq nsl (|hasCate| |$Integer| cat (|augmentSub| v |$Integer| sl))) - (if (eq nsl '|failed|) - (|hasCateSpecialNew| v dom cat sl) - (|hasCaty| |$Integer| cat nsl))) - (t - (|hasCateSpecialNew| v dom cat sl))))) - -\end{chunk} - -\defun{hasCateSpecialNew}{hasCateSpecialNew} -\calls{hasCateSpecialNew}{member} -\calls{hasCateSpecialNew}{eqcar} -\calls{hasCateSpecialNew}{augmentSub} -\calls{hasCateSpecialNew}{defaultTargetFE} -\calls{hasCateSpecialNew}{isEqualOrSubDomain} -\calls{hasCateSpecialNew}{underDomainOf} -\calls{hasCateSpecialNew}{hasCaty} -\refsdollar{hasCateSpecialNew}{Integer} -\refsdollar{hasCateSpecialNew}{ComplexInteger} -\refsdollar{hasCateSpecialNew}{RationalNumber} -\begin{chunk}{defun hasCateSpecialNew} -(defun |hasCateSpecialNew| (v dom cat sl) - (let (fe alg fefull d partialResult) - (declare (special |$RationalNumber| |$ComplexInteger| |$Integer|)) - (setq fe - (|member| (qcar cat) - '(|ElementaryFunctionCategory| - |TrigonometricFunctionCategory| - |ArcTrigonometricFunctionCategory| - |HyperbolicFunctionCategory| - |ArcHyperbolicFunctionCategory| - |PrimitiveFunctionCategory| - |SpecialFunctionCategory| - |Evalable| - |CombinatorialOpsCategory| - |TranscendentalFunctionCategory| - |AlgebraicallyClosedFunctionSpace| - |ExpressionSpace| - |LiouvillianFunctionCategory| - |FunctionSpace|))) - (setq alg - (|member| (qcar cat) - '(|RadicalCategory| - |AlgebraicallyClosedField|))) - (setq fefull - (or fe alg (eqcar cat '|CombinatorialFunctionCategory|))) - (setq partialResult - (cond - ((or (eqcar dom '|Variable|) (eqcar dom '|Symbol|)) - (cond - ((|member| (car cat) - '(|SemiGroup| - |AbelianSemiGroup| - |Monoid| - |AbelianGroup| - |AbelianMonoid| - |PartialDifferentialRing| - |Ring| - |InputForm|)) - (setq d (list '|Polynomial| |$Integer|)) - (|augmentSub| v d sl)) - ((eqcar cat '|Group|) - (setq d (list '|Fraction| (list '|Polynomial| |$Integer|))) - (|augmentSub| v d sl)) - (fefull - (setq d (|defaultTargetFE| dom)) - (|augmentSub| v d sl)) - (t '|failed|))) - ((|isEqualOrSubDomain| dom |$Integer|) - (cond - (fe - (setq d (|defaultTargetFE| |$Integer|)) - (|augmentSub| v d sl)) - (alg - (setq d '(|AlgebraicNumber|)) - (|augmentSub| v d sl)) - (t '|failed|))) - ((equal (|underDomainOf| dom) |$ComplexInteger|) - (setq d (|defaultTargetFE| |$ComplexInteger|)) - (|hasCaty| d cat (|augmentSub| v d sl))) - ((and (equal dom |$RationalNumber|) alg) - (setq d '(|AlgebraicNumber|)) - (|augmentSub| v d sl)) - (fefull - (setq d (|defaultTargetFE| dom)) - (|augmentSub| v d sl)) - (t '|failed|))) - (if (eq partialResult '|failed|) - '|failed| - (|hasCaty| d cat partialResult)))) - -\end{chunk} - -\defun{defaultTargetFE}{defaultTargetFE} -\calls{defaultTargetFE}{typeIsASmallInteger} -\calls{defaultTargetFE}{isEqualOrSubDomain} -\calls{defaultTargetFE}{ifcar} -\calls{defaultTargetFE}{defaultTargetFE} -\refsdollar{defaultTargetFE}{FunctionalExpression} -\refsdollar{defaultTargetFE}{Integer} -\refsdollar{defaultTargetFE}{Symbol} -\refsdollar{defaultTargetFE}{RationalNumber} -\begin{chunk}{defun defaultTargetFE} -(defun |defaultTargetFE| (&rest dom) - (let (a options) - (declare (special |$FunctionalExpression| |$Integer| |$Symbol| - |$RationalNumber|)) - (setq a (car dom)) - (setq options (cdr dom)) - (cond - ((or (and (consp a) (eq (qcar a) '|Variable|) - (consp (qcdr a)) (eq (qcddr a) nil)) - (equal a |$RationalNumber|) - (member (qcar a) (list (qcar |$Symbol|) '|RationalRadicals| '|Pi|)) - (|typeIsASmallInteger| a) - (|isEqualOrSubDomain| a |$Integer|) - (equal a '(|AlgebraicNumber|))) - (if (ifcar options) - (list |$FunctionalExpression| (list '|Complex| |$Integer|)) - (list |$FunctionalExpression| |$Integer|))) - ((and (consp a) (eq (qcar a) '|Complex|) - (consp (qcdr a)) (eq (qcddr a) nil)) - (|defaultTargetFE| (qcadr a) t)) - ((and (consp a) (consp (qcdr a)) (eq (qcddr a) nil) - (member (qcar a) '(|Polynomial| |RationalFunction| |Fraction|))) - (|defaultTargetFE| (qcadr a) (ifcar options))) - ((and (consp a) (equal (qcar a) |$FunctionalExpression|) - (consp (qcdr a)) (eq (qcddr a) nil)) - a) - ((ifcar options) - (list |$FunctionalExpression| (list '|Complex| a))) - (t - (list |$FunctionalExpression| a))))) - -\end{chunk} - -\defun{isEqualOrSubDomain}{isEqualOrSubDomain} -\calls{isEqualOrSubDomain}{isSubDomain} -\begin{chunk}{defun isEqualOrSubDomain} -(defun |isEqualOrSubDomain| (d1 d2) - (or (equal d1 d2) - (|isSubDomain| d1 d2) - (and (atom d1) - (or (and (consp d2) (eq (qcar d2) '|Variable|) - (consp (qcdr d2)) (eq (qcddr d2) nil) - (equal (qcadr d2) d1)) - (and (consp d2) (eq (qcdr d2) nil) - (equal (qcar d2) d1)))) - (and (atom d2) - (or (and (consp d1) (eq (qcar d1) '|Variable|) - (consp (qcdr d1)) (eq (qcddr d1) nil) - (equal (qcadr d1) d2)) - (and (consp d1) (eq (qcdr d1) nil) - (equal (qcar d1) d2)))))) - -\end{chunk} - -\chapter{System Command Handling} -The system commands are the top-level commands available in Axiom -that can all be invoked by prefixing the symbol with a closed-paren. -Thus, to see they copyright you type: -\begin{verbatim} - )copyright -\end{verbatim} -New commands need to be added to this table. The command invoked will -be the first entry of the pair and the ``user level'' of the command -will be the second entry. - -See:\\ -\begin{itemize} -\item The \fnref{abbreviations} command -\item The \fnref{boot} command -\item The \fnref{browse} command -\item The \fnref{cd} command -\item The \fnref{clear} command -\item The \fnref{close} command -\item The \fnref{compile} command -\item The \fnref{copyright} command -\item The \fnref{credits} command -\item The \fnref{display} command -\item The \fnref{edit} command -\item The \fnref{fin} command -\item The \fnref{frame} command -\item The \fnref{help} command -\item The \fnref{history} command -\item The \fnref{lisp} command -\item The \fnref{library} command -\item The \fnref{load} command -\item The \fnref{ltrace} command -\item The \fnref{pquit} command -\item The \fnref{quit} command -\item The \fnref{read} command -\item The \fnref{regress} command -\item The \fnref{savesystem} command -\item The \fnref{set} command -\item The \fnref{show} command -\item The \fnref{spool} command -\item The \fnref{summary} command -\item The \fnref{synonym} command -\item The \fnref{system} command -\item The \fnref{tangle} command -\item The \fnref{trace} command -\item The \fnref{trademark} command -\item The \fnref{undo} command -\item The \fnref{what} command -\item The \fnref{with} command -\item The \fnref{workfiles} command -\item The \fnref{zsystemdevelopment} command -\end{itemize} - -\section{Variables Used} -\defdollar{systemCommands} -\begin{chunk}{initvars} -(defvar |$systemCommands| nil) - -\end{chunk} - -\begin{chunk}{postvars} -(eval-when (eval load) - (setq |$systemCommands| - '( - (|abbreviations| . |compiler| ) - (|boot| . |development|) - (|browse| . |development|) - (|cd| . |interpreter|) - (|clear| . |interpreter|) - (|close| . |interpreter|) - (|compiler| . |compiler| ) - (|copyright| . |interpreter|) - (|credits| . |interpreter|) - (|describe| . |interpreter|) - (|display| . |interpreter|) - (|edit| . |interpreter|) - (|fin| . |development|) - (|frame| . |interpreter|) - (|help| . |interpreter|) - (|history| . |interpreter|) - (|lisp| . |development|) - (|library| . |interpreter|) - (|load| . |interpreter|) - (|ltrace| . |interpreter|) - (|pquit| . |interpreter|) - (|quit| . |interpreter|) - (|read| . |interpreter|) - (|regress| . |interpreter|) - (|savesystem| . |interpreter|) - (|set| . |interpreter|) - (|show| . |interpreter|) - (|spool| . |interpreter|) - (|summary| . |interpreter|) - (|synonym| . |interpreter|) - (|system| . |interpreter|) - (|tangle| . |interpreter|) - (|trace| . |interpreter|) - (|trademark| . |interpreter|) - (|undo| . |interpreter|) - (|what| . |interpreter|) - (|with| . |interpreter|) - (|workfiles| . |development|) - (|zsystemdevelopment| . |interpreter|) - ))) - -\end{chunk} - -\defdollar{syscommands} -This table is used to look up a symbol to see if it might be a command. -\begin{chunk}{initvars} -(defvar $syscommands nil) - -\end{chunk} - -\begin{chunk}{postvars} -(eval-when (eval load) - (setq $syscommands (mapcar #'car |$systemCommands|))) - -\end{chunk} - -\defdollar{noParseCommands} -This is a list of the commands which have their arguments passed verbatim. -Certain functions, such as the lisp function need to be able to handle -all kinds of input that will not be acceptable to the interpreter. -\begin{chunk}{initvars} -(defvar |$noParseCommands| nil) - -\end{chunk} - -\begin{chunk}{postvars} -(eval-when (eval load) - (setq |$noParseCommands| - '(|boot| |copyright| |credits| |fin| |lisp| |pquit| |quit| - |synonym| |system| |trademark| ))) - -\end{chunk} - -\section{Functions} -\defun{handleNoParseCommands}{handleNoParseCommands} -The system commands given by the global variable -\verb|$noParseCommands| require essentially no preprocessing/parsing -of their arguments. Here we dispatch the functions which implement -these commands. - -There are four standard commands which receive arguments -\begin{itemize} -\item boot -\item lisp -\item synonym -\item system -\end{itemize} - -There are six standard commands which do not receive arguments -- -\begin{itemize} -\item quit -\item fin -\item pquit -\item credits -\item copyright -\item trademark -\end{itemize} - -As these commands do not necessarily -exhaust those mentioned in \verb|$noParseCommands|, we provide a -generic dispatch based on two conventions: commands which do not -require an argument name themselves, those which do have their names -prefixed by ``np''. This makes it possible to dynamically define -new system commands provided you handle the argument parsing. - -\defun{doSystemCommand}{Handle a top level command} -\calls{doSystemCommand}{concat} -\calls{doSystemCommand}{expand-tabs} -\calls{doSystemCommand}{processSynonyms} -\calls{doSystemCommand}{substring} -\calls{doSystemCommand}{getFirstWord} -\calls{doSystemCommand}{unAbbreviateKeyword} -\calls{doSystemCommand}{member} -\calls{doSystemCommand}{handleNoParseCommands} -\calls{doSystemCommand}{splitIntoOptionBlocks} -\calls{doSystemCommand}{handleTokensizeSystemCommands} -\calls{doSystemCommand}{handleParsedSystemCommands} -\usesdollar{doSystemCommand}{tokenCommands} -\usesdollar{doSystemCommand}{noParseCommands} -\uses{doSystemCommand}{line} -\begin{chunk}{defun doSystemCommand} -(defun |doSystemCommand| (string) - (let (line tok unab optionList) - (declare (special line |$tokenCommands| |$noParseCommands|)) - (setq string (concat ")" (expand-tabs string))) - (setq line string) - (|processSynonyms|) - (setq string line) - (setq string (substring string 1 nil)) - (cond - ((string= string "") nil) - (t - (setq tok (|getFirstWord| string)) - (cond - (tok - (setq unab (|unAbbreviateKeyword| tok)) - (cond - ((|member| unab |$noParseCommands|) - (|handleNoParseCommands| unab string)) - (t - (setq optionList (|splitIntoOptionBlocks| string)) - (cond - ((|member| unab |$tokenCommands|) - (|handleTokensizeSystemCommands| unab optionList)) - (t - (|handleParsedSystemCommands| unab optionList) - nil))))) - (t nil)))))) - -\end{chunk} - -\defun{splitIntoOptionBlocks}{Split block into option block} -\calls{splitIntoOptionBlocks}{stripSpaces} -\begin{chunk}{defun splitIntoOptionBlocks} -(defun |splitIntoOptionBlocks| (str) - (let (inString block (blockStart 0) (parenCount 0) blockList) - (dotimes (i (1- (|#| str))) - (cond - ((char= (elt str i) #\" ) (setq inString (null inString))) - (t - (when (and (char= (elt str i) #\( ) (null inString)) - (incf parenCount)) - (when (and (char= (elt str i) #\) ) (null inString)) - (decf parenCount)) - (when - (and (char= (elt str i) #\) ) - (null inString) - (= parenCount -1)) - (setq block (|stripSpaces| (subseq str blockStart i))) - (setq blockList (cons block blockList)) - (setq blockStart (1+ i)) - (setq parenCount 0))))) - (setq blockList (cons (|stripSpaces| (subseq str blockStart)) blockList)) - (nreverse blockList))) - -\end{chunk} - -\defun{handleTokensizeSystemCommands}{Tokenize a system command} -\calls{handleTokensizeSystemCommands}{dumbTokenize} -\calls{handleTokensizeSystemCommands}{tokTran} -\calls{handleTokensizeSystemCommands}{systemCommand} -\begin{chunk}{defun handleTokensizeSystemCommands} -(defun |handleTokensizeSystemCommands| (unabr optionList) - (declare (ignore unabr)) - (let (parcmd) - (setq optionList (mapcar #'(lambda (x) (|dumbTokenize| x)) optionList)) - (setq parcmd - (mapcar #'(lambda (opt) (mapcar #'(lambda (tok) (|tokTran| tok)) opt)) - optionLIst)) - (when parcmd (|systemCommand| parcmd)))) - -\end{chunk} - -\defun{systemCommand}{Handle system commands} -You can type ``)?'' and see trivial help information. -You can type ``)? compile'' and see compiler related information - -\calls{systemCommand}{selectOptionLC} -\calls{systemCommand}{helpSpad2Cmd} -\calls{systemCommand}{selectOption} -\calls{systemCommand}{commandsForUserLevel} -\usesdollar{systemCommand}{options} -\usesdollar{systemCommand}{e} -\usesdollar{systemCommand}{systemCommands} -\usesdollar{systemCommand}{syscommands} -\usesdollar{systemCommand}{CategoryFrame} -\begin{chunk}{defun systemCommand} -(defun |systemCommand| (cmd) - (let (|$options| |$e| op argl options fun) - (declare (special |$options| |$e| |$systemCommands| $syscommands - |$CategoryFrame|)) - (setq op (caar cmd)) - (setq argl (cdar cmd)) - (setq options (cdr cmd)) - (setq |$options| options) - (setq |$e| |$CategoryFrame|) - (setq fun (|selectOptionLC| op $syscommands '|commandError|)) - (if (and argl (eq (elt argl 0) '?) (not (eq fun '|synonym|))) - (|helpSpad2Cmd| (cons fun nil)) - (progn - (setq fun - (|selectOption| fun (|commandsForUserLevel| |$systemCommands|) - '|commandUserLevelError|)) - (funcall fun argl))))) - -\end{chunk} - -\defun{commandsForUserLevel}{Select commands matching this user level} -The \verb|$UserLevel| contains one of three values: -{\tt compiler}, {\tt development}, or {\tt interpreter}. This variable -is used to select a subset of commands from the list stored in -\verb|$systemCommands|, representing all of the commands that are -valid for this level. -\calls{commandsForUserLevel}{satisfiesUserLevel} -\begin{chunk}{defun commandsForUserLevel} -(defun |commandsForUserLevel| (arg) - (let (c) - (dolist (pair arg) - (when (|satisfiesUserLevel| (cdr pair)) - (setq c (cons (car pair) c)))) - (nreverse c))) - -\end{chunk} - -\defun{commandError}{No command begins with this string} -\calls{commandError}{commandErrorMessage} -\begin{chunk}{defun commandError} -(defun |commandError| (x u) - (|commandErrorMessage| '|command| x u)) - -\end{chunk} - -\defun{optionError}{No option begins with this string} -\calls{optionError}{commandErrorMessage} -\begin{chunk}{defun optionError} -(defun |optionError| (x u) - (|commandErrorMessage| '|option| x u)) - -\end{chunk} - -\defdollar{oldline} -\begin{chunk}{initvars} -(defvar $oldline nil "used to output command lines") - -\end{chunk} - -\defun{commandErrorMessage}{No command/option begins with this string} -\calls{commandErrorMessage}{commandAmbiguityError} -\calls{commandErrorMessage}{sayKeyedMsg} -\calls{commandErrorMessage}{terminateSystemCommand} -\usesdollar{commandErrorMessage}{oldline} -\uses{commandErrorMessage}{line} -\begin{chunk}{defun commandErrorMessage} -(defun |commandErrorMessage| (kind x u) - (declare (special $oldline line)) - (setq $oldline line) - (if u - (|commandAmbiguityError| kind x u) - (progn - (|sayKeyedMsg| 'S2IZ0008 (list kind x)) - (|terminateSystemCommand|)))) - -\end{chunk} - -\defun{optionUserLevelError}{Option not available at this user level} -\calls{optionUserLevelError}{userLevelErrorMessage} -\begin{chunk}{defun optionUserLevelError} -(defun |optionUserLevelError| (x u) - (|userLevelErrorMessage| '|option| x u)) - -\end{chunk} - -\defun{commandUserLevelError}{Command not available at this user level} -\calls{commandUserLevelError}{userLevelErrorMessage} -\begin{chunk}{defun commandUserLevelError} -(defun |commandUserLevelError| (x u) - (|userLevelErrorMessage| '|command| x u)) - -\end{chunk} - -\defun{userLevelErrorMessage}{Command not available error message} -\calls{userLevelErrorMessage}{commandAmbiguityError} -\calls{userLevelErrorMessage}{sayKeyedMsg} -\calls{userLevelErrorMessage}{terminateSystemCommand} -\usesdollar{userLevelErrorMessage}{UserLevel} -\begin{chunk}{defun userLevelErrorMessage} -(defun |userLevelErrorMessage| (kind x u) - (declare (special |$UserLevel|)) - (if u - (|commandAmbiguityError| kind x u) - (progn - (|sayKeyedMsg| 'S2IZ0007 (list |$UserLevel| kind)) - (|terminateSystemCommand|)))) - -\end{chunk} - -\defun{satisfiesUserLevel}{satisfiesUserLevel} -\usesdollar{satisfiesUserLevel}{UserLevel} -\begin{chunk}{defun satisfiesUserLevel 0} -(defun |satisfiesUserLevel| (x) - (declare (special |$UserLevel|)) - (cond - ((eq x '|interpreter|) t) - ((eq |$UserLevel| '|interpreter|) nil) - ((eq x '|compiler|) t) - ((eq |$UserLevel| '|compiler|) nil) - (t t))) - -\end{chunk} - -\defun{hasOption}{hasOption} -\calls{hasOption}{stringPrefix?} -\calls{hasOption}{pname} -\begin{chunk}{defun hasOption} -(defun |hasOption| (al opt) - (let ((optPname (pname opt)) found) - (loop for pair in al do - (when (|stringPrefix?| (pname (car pair)) optPname) (setq found pair)) - until found) - found)) - -\end{chunk} - -\defun{terminateSystemCommand}{terminateSystemCommand} -\calls{terminateSystemCommand}{tersyscommand} -\begin{chunk}{defun terminateSystemCommand} -(defun |terminateSystemCommand| nil (tersyscommand)) - -\end{chunk} - -\defun{tersyscommand}{Terminate a system command} -\calls{tersyscommand}{spadThrow} -\begin{chunk}{defun tersyscommand} -(defun tersyscommand () - (let (chr tok) - (fresh-line) - (setq chr 'endoflinechr) - (setq tok 'end_unit) - (|spadThrow|))) - -\end{chunk} - -\defun{commandAmbiguityError}{commandAmbiguityError} -\calls{commandAmbiguityError}{sayKeyedMsg} -\calls{commandAmbiguityError}{sayMSG} -\calls{commandAmbiguityError}{bright} -\calls{commandAmbiguityError}{terminateSystemCommand} -\begin{chunk}{defun commandAmbiguityError} -(defun |commandAmbiguityError| (kind x u) - (|sayKeyedMsg| 's2iz0009 (list kind x)) - (dolist (a u) (|sayMSG| (cons " " (|bright| a)))) - (|terminateSystemCommand|)) - -\end{chunk} - -\defun{getParserMacroNames}{getParserMacroNames} -The \verb|$pfMacros| is a list of all of the user-defined macros. - -\usesdollar{getParserMacroNames}{pfMacros} -\begin{chunk}{defun getParserMacroNames 0} -(defun |getParserMacroNames| () - (declare (special |$pfMacros|)) - (remove-duplicates (mapcar #'car |$pfMacros|))) - -\end{chunk} - -\defun{clearParserMacro}{clearParserMacro} -Note that if a macro is defined twice this will clear the last instance. -Thus: -\begin{verbatim} - a ==> 3 - a ==> 4 - )d macros - a ==> 4 - )clear prop a - )d macros - a ==> 3 - )clear prop a - )d macros - nil -\end{verbatim} -\calls{clearParserMacro}{ifcdr} -\calls{clearParserMacro}{assoc} -\calls{clearParserMacro}{remalist} -\usesdollar{clearParserMacro}{pfMacros} -\begin{chunk}{defun clearParserMacro} -(defun |clearParserMacro| (macro) - (declare (special |$pfMacros|)) - (when (ifcdr (|assoc| macro |$pfMacros|)) - (setq |$pfMacros| (remalist |$pfMacros| macro)))) - -\end{chunk} - -\defun{displayMacro}{displayMacro} -\calls{displayMacro}{isInterpMacro} -\calls{displayMacro}{sayBrightly} -\calls{displayMacro}{bright} -\calls{displayMacro}{strconc} -\calls{displayMacro}{object2String} -\calls{displayMacro}{mathprint} -\usesdollar{displayMacro}{op} -\begin{chunk}{defun displayMacro} -(defun |displayMacro| (name) - (let (|$op| m body args) - (declare (special |$op|)) - (setq m (|isInterpMacro| name)) - (cond - ((null m) - (|sayBrightly| - (cons " " (append (|bright| name) - (cons "is not an interpreter macro." nil))))) - (t - (setq |$op| (strconc "macro " (|object2String| name))) - (setq args (car m)) - (setq body (cdr m)) - (setq args - (cond - ((null args) nil) - ((null (cdr args)) (car args)) - (t (cons '|Tuple| args)))) - (|mathprint| (cons 'map (cons (cons args body) nil))))))) - -\end{chunk} - -\defun{displayWorkspaceNames}{displayWorkspaceNames} -\calls{displayWorkspaceNames}{getInterpMacroNames} -\calls{displayWorkspaceNames}{getParserMacroNames} -\calls{displayWorkspaceNames}{sayMessage} -\calls{displayWorkspaceNames}{msort} -\calls{displayWorkspaceNames}{getWorkspaceNames} -\calls{displayWorkspaceNames}{sayAsManyPerLineAsPossible} -\calls{displayWorkspaceNames}{sayBrightly} -\calls{displayWorkspaceNames}{setdifference} -\begin{chunk}{defun displayWorkspaceNames} -(defun |displayWorkspaceNames| () - (let (pmacs names imacs) - (setq imacs (|getInterpMacroNames|)) - (setq pmacs (|getParserMacroNames|)) - (|sayMessage| "Names of User-Defined Objects in the Workspace:") - (setq names (msort (append (|getWorkspaceNames|) pmacs))) - (if names - (|sayAsManyPerLineAsPossible| (mapcar #'|object2String| names)) - (|sayBrightly| " * None *")) - (setq imacs (setdifference imacs pmacs)) - (when imacs - (|sayMessage| "Names of System-Defined Objects in the Workspace:") - (|sayAsManyPerLineAsPossible| (mapcar #'|object2String| imacs))))) - -\end{chunk} - -\defun{getWorkspaceNames}{getWorkspaceNames} -\begin{verbatim} -;getWorkspaceNames() == -; NMSORT [n for [n,:.] in CAAR $InteractiveFrame | -; (n ^= "--macros--" and n^= "--flags--")] -\end{verbatim} -\calls{getWorkspaceNames}{seq} -\calls{getWorkspaceNames}{nmsort} -\calls{getWorkspaceNames}{exit} -\usesdollar{getWorkspaceNames}{InteractiveFrame} -\begin{chunk}{defun getWorkspaceNames} -(defun |getWorkspaceNames| () - (PROG (n) - (declare (special |$InteractiveFrame|)) - (return - (seq (nmsort (PROG (G166322) - (setq G166322 NIL) - (RETURN - (DO ((G166329 (CAAR |$InteractiveFrame|) - (CDR G166329)) - (G166313 NIL)) - ((OR (ATOM G166329) - (PROGN - (SETQ G166313 (CAR G166329)) - NIL) - (PROGN - (PROGN - (setq n (CAR G166313)) - G166313) - NIL)) - (NREVERSE0 G166322)) - (SEQ (EXIT (COND - ((AND (not (eq n '|--macros--|)) - (not (eq n '|--flags--|))) - (SETQ G166322 - (CONS n G166322)))))))))))))) - -\end{chunk} - -\defun{fixObjectForPrinting}{fixObjectForPrinting} -The \verb|$msgdbPrims| variable is set to: -\begin{verbatim} -(|%b| |%d| |%l| |%i| |%u| %U |%n| |%x| |%ce| |%rj| - "%U" "%b" "%d" "%l" "%i" "%u" "%U" "%n" "%x" "%ce" "%rj") -\end{verbatim} -\calls{fixObjectForPrinting}{object2Identifier} -\calls{fixObjectForPrinting}{member} -\calls{fixObjectForPrinting}{strconc} -\calls{fixObjectForPrinting}{pname} -\usesdollar{fixObjectForPrinting}{msgdbPrims} -\begin{chunk}{defun fixObjectForPrinting} -(defun |fixObjectForPrinting| (v) - (let (vp) - (declare (special |$msgdbPrims|)) - (setq vp (|object2Identifier| v)) - (cond - ((eq vp '%) "\\%") - ((|member| vp |$msgdbPrims|) (strconc "\\" (pname vp))) - (t v)))) - -\end{chunk} - -\defun{displayProperties,sayFunctionDeps}{displayProperties,sayFunctionDeps} -\begin{verbatim} -;displayProperties(option,l) == -; $dependentAlist : local := nil -; $dependeeAlist : local := nil -; [opt,:vl]:= (l or ['properties]) -; imacs := getInterpMacroNames() -; pmacs := getParserMacroNames() -; macros := REMDUP append(imacs, pmacs) -; if vl is ['all] or null vl then -; vl := MSORT append(getWorkspaceNames(),macros) -; if $frameMessages then sayKeyedMsg("S2IZ0065",[$interpreterFrameName]) -; null vl => -; null $frameMessages => sayKeyedMsg("S2IZ0066",NIL) -; sayKeyedMsg("S2IZ0067",[$interpreterFrameName]) -; interpFunctionDepAlists() -; for v in vl repeat -; isInternalMapName(v) => 'iterate -; pl := getIProplist(v) -; option = 'flags => getAndSay(v,"flags") -; option = 'value => displayValue(v,getI(v,'value),nil) -; option = 'condition => displayCondition(v,getI(v,"condition"),nil) -; option = 'mode => displayMode(v,getI(v,'mode),nil) -; option = 'type => displayType(v,getI(v,'value),nil) -; option = 'properties => -; v = "--flags--" => nil -; pl is [ ['cacheInfo,:.],:.] => nil -; v1 := fixObjectForPrinting(v) -; sayMSG ['"Properties of",:bright prefix2String v1,'":"] -; null pl => -; v in pmacs => -; sayMSG '" This is a user-defined macro." -; displayParserMacro v -; isInterpMacro v => -; sayMSG '" This is a system-defined macro." -; displayMacro v -; sayMSG '" none" -; propsSeen:= nil -; for [prop,:val] in pl | ^MEMQ(prop,propsSeen) and val repeat -; prop in '(alias generatedCode IS_-GENSYM mapBody localVars) => -; nil -; prop = 'condition => -; displayCondition(prop,val,true) -; prop = 'recursive => -; sayMSG '" This is recursive." -; prop = 'isInterpreterFunction => -; sayMSG '" This is an interpreter function." -; sayFunctionDeps v where -; sayFunctionDeps x == -; if dependents := GETALIST($dependentAlist,x) then -; null rest dependents => -; sayMSG ['" The following function or rule ", -; '"depends on this:",:bright first dependents] -; sayMSG -; '" The following functions or rules depend on this:" -; msg := ["%b",'" "] -; for y in dependents repeat msg := ['" ",y,:msg] -; sayMSG [:nreverse msg,"%d"] -; if dependees := GETALIST($dependeeAlist,x) then -; null rest dependees => -; sayMSG ['" This depends on the following function ", -; '"or rule:",:bright first dependees] -; sayMSG -; '" This depends on the following functions or rules:" -; msg := ["%b",'" "] -; for y in dependees repeat msg := ['" ",y,:msg] -; sayMSG [:nreverse msg,"%d"] -; prop = 'isInterpreterRule => -; sayMSG '" This is an interpreter rule." -; sayFunctionDeps v -; prop = 'localModemap => -; displayModemap(v,val,true) -; prop = 'mode => -; displayMode(prop,val,true) -; prop = 'value => -; val => displayValue(v,val,true) -; sayMSG ['" ",prop,'": ",val] -; propsSeen:= [prop,:propsSeen] -; sayKeyedMsg("S2IZ0068",[option]) -; terminateSystemCommand() -\end{verbatim} -\calls{displayProperties,sayFunctionDeps}{seq} -\calls{displayProperties,sayFunctionDeps}{getalist} -\calls{displayProperties,sayFunctionDeps}{exit} -\calls{displayProperties,sayFunctionDeps}{sayMSG} -\calls{displayProperties,sayFunctionDeps}{bright} -\usesdollar{displayProperties,sayFunctionDeps}{dependeeAlist} -\usesdollar{displayProperties,sayFunctionDeps}{dependentAlist} -\begin{chunk}{defun displayProperties,sayFunctionDeps} -(defun |displayProperties,sayFunctionDeps| (x) - (prog (dependents dependees msg) - (declare (special |$dependeeAlist| |$dependentAlist|)) - (return - (seq - (if (setq dependents (getalist |$dependentAlist| x)) - (seq - (if (null (cdr dependents)) - (exit - (|sayMSG| (cons " The following function or rule " - (cons "depends on this:" (|bright| (car dependents))))))) - (|sayMSG| " The following functions or rules depend on this:") - (setq msg (cons '|%b| (cons " " nil))) - (do ((G166397 dependents (cdr G166397)) (y nil)) - ((or (atom G166397) (progn (setq y (car G166397)) nil)) nil) - (seq (exit (setq msg (cons " " (cons y msg)))))) - (exit (|sayMSG| (append (nreverse msg) (cons '|%d| nil))))) - nil) - (exit - (if (setq dependees (getalist |$dependeeAlist| x)) - (seq - (if (null (cdr dependees)) - (exit - (|sayMSG| (cons " This depends on the following function " - (cons "or rule:" (|bright| (car dependees))))))) - (|sayMSG| " This depends on the following functions or rules:") - (setq msg (cons '|%b| (cons " " nil))) - (do ((G166406 dependees (cdr G166406)) (y nil)) - ((or (atom G166406) (progn (setq y (car G166406)) nil)) nil) - (seq (exit (setq msg (cons " " (cons y msg)))))) - (exit (|sayMSG| (append (nreverse msg) (cons '|%d| nil))))) - nil)))))) - -\end{chunk} - -\defun{displayValue}{displayValue} -\calls{displayValue}{sayMSG} -\calls{displayValue}{fixObjectForPrinting} -\calls{displayValue}{pname} -\calls{displayValue}{objValUnwrap} -\calls{displayValue}{objMode} -\calls{displayValue}{displayRule} -\calls{displayValue}{strconc} -\calls{displayValue}{prefix2String} -\calls{displayValue}{objMode} -\calls{displayValue}{getdatabase} -\calls{displayValue}{concat} -\calls{displayValue}{form2String} -\calls{displayValue}{mathprint} -\calls{displayValue}{outputFormat} -\calls{displayValue}{objMode} -\usesdollar{displayValue}{op} -\usesdollar{displayValue}{EmptyMode} -\begin{chunk}{defun displayValue} -(defun |displayValue| (|$op| u omitVariableNameIfTrue) - (declare (special |$op|)) - (let (expr op rhs label labmode) - (declare (special |$EmptyMode|)) - (if (null u) - (|sayMSG| - (list '| Value of | (|fixObjectForPrinting| (pname |$op|)) ": (none)")) - (progn - (setq expr (|objValUnwrap| u)) - (if (or (and (consp expr) (progn (setq op (qcar expr)) t) (eq op 'map)) - (equal (|objMode| u) |$EmptyMode|)) - (|displayRule| |$op| expr) - (progn - (cond - (omitVariableNameIfTrue - (setq rhs "): ") - (setq label "Value (has type ")) - (t - (setq rhs ": ") - (setq label (strconc "Value of " (pname |$op|) ": ")))) - (setq labmode (|prefix2String| (|objMode| u))) - (when (atom labmode) (setq labmode (list labmode))) - (if (eq (getdatabase expr 'constructorkind) '|domain|) - (|sayMSG| (|concat| " " label labmode rhs (|form2String| expr))) - (|mathprint| - (cons 'concat - (cons label - (append labmode - (cons rhs - (cons (|outputFormat| expr (|objMode| u)) nil))))))) - nil)))))) - -\end{chunk} - -\defun{displayType}{displayType} -\calls{displayType}{sayMSG} -\calls{displayType}{fixObjectForPrinting} -\calls{displayType}{pname} -\calls{displayType}{prefix2String} -\calls{displayType}{objMode} -\calls{displayType}{concat} -\usesdollar{displayType}{op} -\begin{chunk}{defun displayType} -(defun |displayType| (|$op| u omitVariableNameIfTrue) - (declare (special |$op|) (ignore omitVariableNameIfTrue)) - (let (type) - (if (null u) - (|sayMSG| - (list " Type of value of " (|fixObjectForPrinting| (pname |$op|)) - ": (none)")) - (progn - (setq type (|prefix2String| (|objMode| u))) - (when (atom type) (setq type (list type))) - (|sayMSG| - (|concat| - (cons " Type of value of " - (cons (|fixObjectForPrinting| (pname |$op|)) - (cons ": " type))))) - nil)))) - -\end{chunk} - -\defun{getAndSay}{getAndSay} -\calls{getAndSay}{getI} -\calls{getAndSay}{sayMSG} -\begin{chunk}{defun getAndSay} -(defun |getAndSay| (v prop) - (let (val) - (if (setq val (|getI| v prop)) - (|sayMSG| (cons '| | (cons val (cons '|%l| nil)))) - (|sayMSG| (cons '| none| (cons '|%l| nil)))))) - -\end{chunk} - -\defun{displayProperties}{displayProperties} -\calls{displayProperties}{getInterpMacroNames} -\calls{displayProperties}{getParserMacroNames} -\calls{displayProperties}{remdup} -\calls{displayProperties}{qcdr} -\calls{displayProperties}{qcar} -\calls{displayProperties}{msort} -\calls{displayProperties}{getWorkspaceNames} -\calls{displayProperties}{sayKeyedMsg} -\calls{displayProperties}{interpFunctionDepAlists} -\calls{displayProperties}{isInternalMapName} -\calls{displayProperties}{getIProplist} -\calls{displayProperties}{getAndSay} -\calls{displayProperties}{displayValue} -\calls{displayProperties}{getI} -\calls{displayProperties}{displayCondition} -\calls{displayProperties}{displayMode} -\calls{displayProperties}{displayType} -\calls{displayProperties}{fixObjectForPrinting} -\calls{displayProperties}{sayMSG} -\calls{displayProperties}{bright} -\calls{displayProperties}{prefix2String} -\calls{displayProperties}{member} -\calls{displayProperties}{displayParserMacro} -\calls{displayProperties}{isInterpMacro} -\calls{displayProperties}{displayMacro} -\calls{displayProperties}{displayProperties,sayFunctionDeps} -\calls{displayProperties}{displayModemap} -\calls{displayProperties}{exit} -\calls{displayProperties}{seq} -\calls{displayProperties}{terminateSystemCommand} -\usesdollar{displayProperties}{dependentAlist} -\usesdollar{displayProperties}{dependeeAlist} -\usesdollar{displayProperties}{frameMessages} -\usesdollar{displayProperties}{interpreterFrameName} -\begin{chunk}{defun displayProperties} -(defun |displayProperties| (option al) - (let (|$dependentAlist| |$dependeeAlist| tmp1 opt imacs pmacs macros vl pl - tmp2 vone prop val propsSeen) - (declare (special |$dependentAlist| |$dependeeAlist| |$frameMessages| - |$interpreterFrameName|)) - (setq |$dependentAlist| nil) - (setq |$dependeeAlist| nil) - (setq tmp1 (or al (cons '|properties| nil))) - (setq opt (car tmp1)) - (setq vl (cdr tmp1)) - (setq imacs (|getInterpMacroNames|)) - (setq pmacs (|getParserMacroNames|)) - (setq macros (remdup (append imacs pmacs))) - (when (or - (and (consp vl) (eq (qcdr vl) nil) (eq (qcar vl) '|all|)) - (null vl)) - (setq vl (msort (append (|getWorkspaceNames|) macros)))) - (when |$frameMessages| - (|sayKeyedMsg| 'S2IZ0065 (cons |$interpreterFrameName| nil))) - (cond - ((null vl) - (if (null |$frameMessages|) - (|sayKeyedMsg| 'S2IZ0066 nil)) - (|sayKeyedMsg| 'S2IZ0067 (cons |$interpreterFrameName| nil))) - (t - (|interpFunctionDepAlists|) - (do ((G166440 vl (cdr G166440)) (v nil)) - ((or (atom G166440) (progn (setq v (car G166440)) nil)) nil) - (seq (exit - (cond - ((|isInternalMapName| v) '|iterate|) - (t - (setq pl (|getIProplist| v)) - (cond - ((eq option '|flags|) - (|getAndSay| v '|flags|)) - ((eq option '|value|) - (|displayValue| v (|getI| v '|value|) nil)) - ((eq option '|condition|) - (|displayCondition| v (|getI| v '|condition|) nil)) - ((eq option '|mode|) - (|displayMode| v (|getI| v '|mode|) nil)) - ((eq option '|type|) - (|displayType| v (|getI| v '|value|) nil)) - ((eq option '|properties|) - (cond - ((eq v '|--flags--|) - nil) - ((and (consp pl) - (progn - (setq tmp2 (qcar pl)) - (and (consp tmp2) (eq (qcar tmp2) '|cacheInfo|)))) - nil) - (t - (setq vone (|fixObjectForPrinting| v)) - (|sayMSG| - (cons "Properties of" - (append (|bright| (|prefix2String| vone)) (cons ":" nil)))) - (cond - ((null pl) - (cond - ((|member| v pmacs) - (|sayMSG| " This is a user-defined macro.") - (|displayParserMacro| v)) - ((|isInterpMacro| v) - (|sayMSG| " This is a system-defined macro.") - (|displayMacro| v)) - (t - (|sayMSG| " none")))) - (t - (setq propsSeen nil) - (do ((G166451 pl (cdr G166451)) (G166425 nil)) - ((or (atom G166451) - (progn (setq G166425 (car G166451)) nil) - (progn - (progn - (setq prop (car G166425)) - (setq val (cdr G166425)) - G166425) - nil)) - nil) - (seq (exit - (cond - ((and (null (member prop propsSeen)) val) - (cond - ((|member| prop - '(|alias| |generatedCode| IS-GENSYM - |mapBody| |localVars|)) - nil) - ((eq prop '|condition|) - (|displayCondition| prop val t)) - ((eq prop '|recursive|) - (|sayMSG| " This is recursive.")) - ((eq prop '|isInterpreterFunction|) - (|sayMSG| " This is an interpreter function.") - (|displayProperties,sayFunctionDeps| v)) - ((eq prop '|isInterpreterRule|) - (|sayMSG| " This is an interpreter rule.") - (|displayProperties,sayFunctionDeps| v)) - ((eq prop '|localModemap|) - (|displayModemap| v val t)) - ((eq prop '|mode|) - (|displayMode| prop val t)) - (t - (when (eq prop '|value|) - (exit - (when val - (exit (|displayValue| v val t))))) - (|sayMSG| (list " " prop ": " val)) - (setq propsSeen (cons prop propsSeen)))))))))))))) - (t - (|sayKeyedMsg| 'S2IZ0068 (cons option nil))))))))) - (|terminateSystemCommand|))))) - -\end{chunk} - -\defun{displayParserMacro}{displayParserMacro} -\calls{displayParserMacro}{pfPrintSrcLines} -\usesdollar{displayParserMacro}{pfMacros} -\begin{chunk}{defun displayParserMacro} -(defun |displayParserMacro| (m) - (let ((m (assq m |$pfMacros|))) - (declare (special |$pfMacros|)) - (when m (|pfPrintSrcLines| (caddr m))))) - -\end{chunk} - -\defun{displayCondition}{displayCondition} -\calls{displayCondition}{bright} -\calls{displayCondition}{sayBrightly} -\calls{displayCondition}{concat} -\calls{displayCondition}{pred2English} -\begin{chunk}{defun displayCondition} -(defun |displayCondition| (v condition giveVariableIfNil) - (let (varPart condPart) - (when giveVariableIfNil (setq varPart (cons '| of| (|bright| v)))) - (setq condPart (or condition '|true|)) - (|sayBrightly| - (|concat| '| condition| varPart '|: | (|pred2English| condPart))))) - -\end{chunk} - -\defun{interpFunctionDepAlists}{interpFunctionDepAlists} -\calls{interpFunctionDepAlists}{putalist} -\calls{interpFunctionDepAlists}{getalist} -\calls{interpFunctionDepAlists}{getFlag} -\usesdollar{interpFunctionDepAlists}{e} -\usesdollar{interpFunctionDepAlists}{dependeeAlist} -\usesdollar{interpFunctionDepAlists}{dependentAlist} -\usesdollar{interpFunctionDepAlists}{InteractiveFrame} -\begin{chunk}{defun interpFunctionDepAlists} -(defun |interpFunctionDepAlists| () - (let (|$e|) - (declare (special |$e| |$dependeeAlist| |$dependentAlist| - |$InteractiveFrame|)) - (setq |$e| |$InteractiveFrame|) - (setq |$dependentAlist| (cons (cons nil nil) nil)) - (setq |$dependeeAlist| (cons (cons nil nil) nil)) - (mapcar #'(lambda (dep) - (let (dependee dependent) - (setq dependee (first dep)) - (setq dependent (second dep)) - (setq |$dependentAlist| - (putalist |$dependentAlist| dependee - (cons dependent (getalist |$dependentAlist| dependee)))) - (spadlet |$dependeeAlist| - (putalist |$dependeeAlist| dependent - (cons dependee (getalist |$dependeeAlist| dependent)))))) - (|getFlag| '|$dependencies|)))) - - -\end{chunk} - -\defun{displayModemap}{displayModemap} -\calls{displayModemap}{bright} -\calls{displayModemap}{sayBrightly} -\calls{displayModemap}{concat} -\calls{displayModemap}{formatSignature} -\begin{chunk}{defun displayModemap} -(defun |displayModemap| (v val giveVariableIfNil) - (labels ( - (g (v mm giveVariableIfNil) - (let (local signature fn varPart prefix) - (setq local (caar mm)) - (setq signature (cdar mm)) - (setq fn (cadr mm)) - (unless (eq local '|interpOnly|) - (spadlet varPart (unless giveVariableIfNil (cons " of" (|bright| v)))) - (spadlet prefix - (cons '| Compiled function type| (append varPart (cons '|: | nil)))) - (|sayBrightly| (|concat| prefix (|formatSignature| signature))))))) - (mapcar #'(lambda (x) (g v x giveVariableIfNil)) val))) - -\end{chunk} - -\defun{displayMode}{displayMode} -\calls{displayMode}{bright} -\calls{displayMode}{fixObjectForPrinting} -\calls{displayMode}{sayBrightly} -\calls{displayMode}{concat} -\calls{displayMode}{prefix2String} -\begin{chunk}{defun displayMode} -(defun |displayMode| (v mode giveVariableIfNil) - (let (varPart) - (when mode - (unless giveVariableIfNil - (setq varPart (cons '| of| (|bright| (|fixObjectForPrinting| v))))) - (|sayBrightly| - (|concat| '| Declared type or mode| varPart '|: | - (|prefix2String| mode)))))) - -\end{chunk} - -\defun{dumbTokenize}{Split into tokens delimted by spaces} -\calls{dumbTokenize}{stripSpaces} -\begin{chunk}{defun dumbTokenize} -(defun |dumbTokenize| (str) - (let (inString token (tokenStart 0) previousSpace tokenList) - (dotimes (i (1- (|#| str))) - (cond - ((char= (elt str i) #\") ; don't split strings - (setq inString (null inString)) - (setq previousSpace nil)) - ((and (char= (elt str i) #\space) (null inString)) - (unless previousSpace - (setq token (|stripSpaces| (subseq str tokenStart i))) - (setq tokenList (cons token tokenList)) - (setq tokenStart (1+ i)) - (setq previousSpace t))) - (t - (setq previousSpace nil)))) - (setq tokenList (cons (|stripSpaces| (subseq str tokenStart)) tokenList)) - (nreverse tokenList))) - -\end{chunk} - -\defun{tokTran}{Convert string tokens to their proper type} -\calls{tokTran}{isIntegerString} -\begin{chunk}{defun tokTran} -(defun |tokTran| (tok) - (let (tmp) - (if (stringp tok) - (cond - ((eql (|#| tok) 0) nil) - ((setq tmp (|isIntegerString| tok)) tmp) - ((char= (elt tok 0) #\" ) (subseq tok 1 (1- (|#| tok)))) - (t (intern tok))) - tok))) - -\end{chunk} - -\defun{isIntegerString}{Is the argument string an integer?} -\begin{chunk}{defun isIntegerString 0} -(defun |isIntegerString| (tok) - (multiple-value-bind (int len) (parse-integer tok :junk-allowed t) - (when (and int (= len (length tok))) int))) - -\end{chunk} - -\defun{handleParsedSystemCommands}{Handle parsed system commands} -\calls{handleParsedSystemCommands}{dumbTokenize} -\calls{handleParsedSystemCommands}{parseSystemCmd} -\calls{handleParsedSystemCommands}{tokTran} -\calls{handleParsedSystemCommands}{systemCommand} -\begin{chunk}{defun handleParsedSystemCommands} -(defun |handleParsedSystemCommands| (unabr optionList) - (declare (ignore unabr)) - (let (restOptionList parcmd trail) - (setq restOptionList (mapcar #'|dumbTokenize| (cdr optionList))) - (setq parcmd (|parseSystemCmd| (car optionList))) - (setq trail - (mapcar #'(lambda (opt) - (mapcar #'(lambda (tok) (|tokTran| tok)) opt)) restOptionList)) - (|systemCommand| (cons parcmd trail)))) - -\end{chunk} - -\defun{parseSystemCmd}{Parse a system command} -\calls{parseSystemCmd}{tokTran} -\calls{parseSystemCmd}{stripSpaces} -\calls{parseSystemCmd}{parseFromString} -\calls{parseSystemCmd}{dumbTokenize} -\begin{chunk}{defun parseSystemCmd} -(defun |parseSystemCmd| (opt) - (let (spaceIndex) - (if (setq spaceIndex (search " " opt)) - (list - (|tokTran| (|stripSpaces| (subseq opt 0 spaceIndex))) - (|parseFromString| (|stripSpaces| (subseq opt spaceIndex)))) - (mapcar #'|tokTran| (|dumbTokenize| opt))))) - -\end{chunk} - -\defun{getFirstWord}{Get first word in a string} -\calls{getFirstWord}{subseq} -\calls{getFirstWord}{stringSpaces} -\begin{chunk}{defun getFirstWord} -(defun |getFirstWord| (string) - (let (spaceIndex) - (setq spaceIndex (search " " string)) - (if spaceIndex - (|stripSpaces| (subseq string 0 spaceIndex)) - string))) - -\end{chunk} - -\defun{unAbbreviateKeyword}{Unabbreviate keywords in commands} -\calls{unAbbreviateKeyword}{selectOptionLC} -\calls{unAbbreviateKeyword}{selectOption} -\calls{unAbbreviateKeyword}{commandsForUserLevel} -\usesdollar{unAbbreviateKeyword}{systemCommands} -\usesdollar{unAbbreviateKeyword}{currentLine} -\usesdollar{unAbbreviateKeyword}{syscommands} -\uses{unAbbreviateKeyword}{line} -\begin{chunk}{defun unAbbreviateKeyword} -(defun |unAbbreviateKeyword| (x) - (let (xp) - (declare (special |$systemCommands| |$currentLine| $syscommands line)) - (setq xp (|selectOptionLC| x $syscommands '|commandErrorIfAmbiguous|)) - (cond - ((null xp) - (setq xp '|system|) - (setq line (concat ")system " (substring line 1 (1- (|#| line))))) - (spadlet |$currentLine| line))) - (|selectOption| xp (|commandsForUserLevel| |$systemCommands|) - '|commandUserLevelError|))) - -\end{chunk} - -\defun{commandErrorIfAmbiguous}{The command is ambiguous error} -\calls{commandErrorIfAmbiguous}{commandAmbiguityError} -\usesdollar{commandErrorIfAmbiguous}{oldline} -\uses{commandErrorIfAmbiguous}{line} -\begin{chunk}{defun commandErrorIfAmbiguous} -(defun |commandErrorIfAmbiguous| (x u) - (declare (special $oldline line)) - (when u - (setq $oldline line) - (|commandAmbiguityError| '|command| x u))) - -\end{chunk} - -\calls{handleNoParseCommands}{stripSpaces} -\calls{handleNoParseCommands}{nplisp} -\calls{handleNoParseCommands}{stripLisp} -\calls{handleNoParseCommands}{sayKeyedMsg} -\calls{handleNoParseCommands}{npboot} -\calls{handleNoParseCommands}{npsystem} -\calls{handleNoParseCommands}{npsynonym} -\calls{handleNoParseCommands}{member} -\calls{handleNoParseCommands}{concat} -\begin{chunk}{defun handleNoParseCommands} -(defun |handleNoParseCommands| (unab string) - (let (spaceindex funname) - (setq string (|stripSpaces| string)) - (setq spaceindex (search " " string)) - (cond - ((eq unab '|lisp|) - (if spaceindex - (|nplisp| (|stripLisp| string)) - (|sayKeyedMsg| 's2iv0005 nil))) - ((eq unab '|boot|) - (if spaceindex - (|npboot| (subseq string (1+ spaceindex))) - (|sayKeyedMsg| 's2iv0005 nil))) - ((eq unab '|system|) - (if spaceindex - (|npsystem| unab string) - (|sayKeyedMsg| 's2iv0005 nil))) - ((eq unab '|synonym|) - (if spaceindex - (|npsynonym| unab (subseq string (1+ spaceindex))) - (|npsynonym| unab ""))) - ((null spaceindex) - (funcall unab)) - ((|member| unab '(|quit| |fin| |pquit| |credits| |copyright| |trademark|)) - (|sayKeyedMsg| 's2iv0005 nil)) - (t - (setq funname (intern (concat "np" (string unab)))) - (funcall funname (subseq string (1+ spaceindex))))))) - -\end{chunk} - -\defun{stripSpaces}{Remove the spaces surrounding a string} -\tpdhere{This should probably be a macro or eliminated} -\begin{chunk}{defun stripSpaces 0} -(defun |stripSpaces| (str) - (string-trim '(#\space) str)) - -\end{chunk} - -\defun{stripLisp}{Remove the lisp command prefix} -\begin{chunk}{defun stripLisp 0} -(defun |stripLisp| (str) - (if (string= (subseq str 0 4) "lisp") - (subseq str 4) - str)) - -\end{chunk} - -\defun{nplisp}{Handle the )lisp command} -\usesdollar{nplisp}{ans} -\begin{chunk}{defun nplisp 0} -(defun |nplisp| (str) - (declare (special |$ans|)) - (setq |$ans| (eval (read-from-string str))) - (format t "~&Value = ~S~%" |$ans|)) - -\end{chunk} - -\defun{npboot}{The )boot command is no longer supported} -\tpdhere{Remove all boot references from top level} -\begin{chunk}{defun npboot 0} -(defun |npboot| (str) - (declare (ignore str)) - (format t "The )boot command is no longer supported~%")) - -\end{chunk} - -\defun{npsystem}{Handle the )system command} -Note that unAbbreviateKeyword returns the word ``system'' for unknown words -so we have to search for this case. This complication may never arrive -in practice. - -\calls{npsystem}{sayKeyedMsg} -\begin{chunk}{defun npsystem} -(defun |npsystem| (unab str) - (let (spaceIndex sysPart) - (setq spaceIndex (search " " str)) - (cond - ((null spaceIndex) (|sayKeyedMsg| 'S2IZ0080 (list str))) - (t - (setq sysPart (subseq str 0 spaceIndex)) - (if (search sysPart (string unab)) - (obey (subseq str (1+ spaceIndex))) - (|sayKeyedMsg| 'S2IZ0080 (list sysPart))))))) - -\end{chunk} - -\defun{npsynonym}{Handle the )synonym command} -\calls{npsynonym}{npProcessSynonym} -\begin{chunk}{defun npsynonym} -(defun |npsynonym| (unab str) - (declare (ignore unab)) - (|npProcessSynonym| str)) - -\end{chunk} - -\defun{npProcessSynonym}{Handle the synonym system command} -\calls{npProcessSynonym}{printSynonyms} -\calls{npProcessSynonym}{processSynonymLine} -\calls{npProcessSynonym}{putalist} -\calls{npProcessSynonym}{terminateSystemCommand} -\usesdollar{npProcessSynonym}{CommandSynonymAlist} -\begin{chunk}{defun npProcessSynonym} -(defun |npProcessSynonym| (str) - (let (pair) - (declare (special |$CommandSynonymAlist|)) - (if (= (length str) 0) - (|printSynonyms| nil) - (progn - (setq pair (|processSynonymLine| str)) - (if |$CommandSynonymAlist| - (putalist |$CommandSynonymAlist| (car pair) (cdr pair))) - (setq |$CommandSynonymAlist| (cons pair nil)))) - (|terminateSystemCommand|))) - -\end{chunk} - -\defun{printSynonyms}{printSynonyms} -\calls{printSynonyms}{centerAndHighlight} -\calls{printSynonyms}{specialChar} -\calls{printSynonyms}{filterListOfStringsWithFn} -\calls{printSynonyms}{synonymsForUserLevel} -\calls{printSynonyms}{printLabelledList} -\usesdollar{printSynonyms}{CommandSynonymAlist} -\usesdollar{printSynonyms}{linelength} -\begin{chunk}{defun printSynonyms} -(defun |printSynonyms| (patterns) - (prog (ls t1) - (declare (special |$CommandSynonymAlist| $linelength)) - (|centerAndHighlight| '|System Command Synonyms| - $linelength (|specialChar| '|hbar|)) - (setq ls - (|filterListOfStringsWithFn| patterns - (do ((t2 (|synonymsForUserLevel| |$CommandSynonymAlist|) (cdr t2))) - ((atom t2) (nreverse0 t1)) - (push (cons (princ-to-string (caar t2)) (cdar t2)) t1)) - #'car)) - (|printLabelledList| ls "user" "synonyms" ")" patterns))) - -\end{chunk} - -\defun{printLabelledList}{Print a list of each matching synonym} -The prefix goes before each element on each side of the list, eg, ")" - -\calls{printLabelledList}{sayMessage} -\calls{printLabelledList}{blankList} -\calls{printLabelledList}{substring} -\calls{printLabelledList}{entryWidth} -\calls{printLabelledList}{sayBrightly} -\calls{printLabelledList}{concat} -\calls{printLabelledList}{fillerSpaces} -\begin{chunk}{defun printLabelledList} -(defun |printLabelledList| (ls label1 label2 prefix patterns) - (let (comm syn wid) - (if (null ls) - (if (null patterns) - (|sayMessage| (list " No " label1 "-defined " label2 " in effect.")) - (|sayMessage| - `(" No " ,label1 "-defined " ,label2 " satisfying patterns:" - |%l| " " |%b| ,@(append (|blankList| patterns) (list '|%d|))))) - (progn - (when patterns - (|sayMessage| - `(,label1 "-defined " ,label2 " satisfying patterns:" |%l| " " - |%b| ,@(append (|blankList| patterns) (list '|%d|))))) - (do ((t1 ls (cdr t1))) - ((atom t1) nil) - (setq syn (caar t1)) - (setq comm (cdar t1)) - (when (string= (substring syn 0 1) "|") - (setq syn (substring syn 1 nil))) - (when (string= syn "%i") (setq syn "%i ")) - (setq wid (max (- 30 (|entryWidth| syn)) 1)) - (|sayBrightly| - (|concat| '|%b| prefix syn '|%d| (|fillerSpaces| wid ".") - " " prefix comm))) - (|sayBrightly| ""))))) - -\end{chunk} - -\defdollar{tokenCommands} -This is a list of the commands that expect the interpreter to parse -their arguments. Thus the history command expects that Axiom will have -tokenized and validated the input before calling the history function. -\begin{chunk}{initvars} -(defvar |$tokenCommands| nil) - -\end{chunk} - -\begin{chunk}{postvars} -(eval-when (eval load) - (setq |$tokenCommands| - '( |abbreviations| - |cd| - |clear| - |close| - |compiler| - |depends| - |display| - |describe| - |edit| - |frame| - |frame| - |help| - |history| - |input| - |library| - |load| - |ltrace| - |read| - |regress| - |savesystem| - |set| - |spool| - |tangle| - |undo| - |what| - |with| - |workfiles| - |zsystemdevelopment| - ))) - -\end{chunk} - -\defdollar{InitialCommandSynonymAlist} -Axiom can create ``synonyms'' for commands. We create an initial table -of synonyms which are in common use. -\begin{chunk}{initvars} -(defvar |$InitialCommandSynonymAlist| nil) - -\end{chunk} - -\defun{axiomVersion}{Print the current version information} -\uses{axiomVersion}{*yearweek*} -\uses{axiomVersion}{*build-version*} -\begin{chunk}{defun axiomVersion 0} -(defun axiomVersion () - (declare (special *build-version* *yearweek*)) - (concatenate 'string "Axiom " *build-version* " built on " *yearweek*)) - -\end{chunk} - -\begin{chunk}{postvars} -(eval-when (eval load) - (setq |$InitialCommandSynonymAlist| - '( - (|?| . "what commands") - (|ap| . "what things") - (|apr| . "what things") - (|apropos| . "what things") - (|cache| . "set functions cache") - (|cl| . "clear") - (|cls| . "zsystemdevelopment )cls") - (|cms| . "system") - (|co| . "compiler") - (|d| . "display") - (|dep| . "display dependents") - (|dependents| . "display dependents") - (|e| . "edit") - (|expose| . "set expose add constructor") - (|fc| . "zsystemdevelopment )c") - (|fd| . "zsystemdevelopment )d") - (|fdt| . "zsystemdevelopment )dt") - (|fct| . "zsystemdevelopment )ct") - (|fctl| . "zsystemdevelopment )ctl") - (|fe| . "zsystemdevelopment )e") - (|fec| . "zsystemdevelopment )ec") - (|fect| . "zsystemdevelopment )ect") - (|fns| . "exec spadfn") - (|fortran| . "set output fortran") - (|h| . "help") - (|hd| . "system hypertex &") - (|kclam| . "boot clearClams ( )") - (|killcaches| . "boot clearConstructorAndLisplibCaches ( )") - (|patch| . "zsystemdevelopment )patch") - (|pause| . "zsystemdevelopment )pause") - (|prompt| . "set message prompt") - (|recurrence| . "set functions recurrence") - (|restore| . "history )restore") - (|save| . "history )save") - (|startGraphics| . "system $AXIOM/lib/viewman &") - (|startNAGLink| . "system $AXIOM/lib/nagman &") - (|stopGraphics| . "lisp (|sockSendSignal| 2 15)") - (|stopNAGLink| . "lisp (|sockSendSignal| 8 15)") - (|time| . "set message time") - (|type| . "set message type") - (|unexpose| . "set expose drop constructor") - (|up| . "zsystemdevelopment )update") - (|version| . "lisp (axiomVersion)") - (|w| . "what") - (|wc| . "what categories") - (|wd| . "what domains") - (|who| . "lisp (pprint credits)") - (|wp| . "what packages") - (|ws| . "what synonyms") -))) - -\end{chunk} - -\defdollar{CommandSynonymAlist} -The actual list of synonyms is initialized to be the same as the -above initial list of synonyms. The user synonyms that are added -during a session are pushed onto this list for later lookup. -\begin{chunk}{initvars} -(defvar |$CommandSynonymAlist| nil) - -\end{chunk} - -\begin{chunk}{postvars} -(eval-when (eval load) - (setq |$CommandSynonymAlist| (copy-alist |$InitialCommandSynonymAlist|))) - -\end{chunk} - -\defun{ncloopCommand}{ncloopCommand} -The \$systemCommandFunction is set in SpadInterpretStream -to point to the function InterpExecuteSpadSystemCommand. -The system commands are handled by the function in the ``hook'' -variable \verb|$systemCommandFunction| which -has the default function \verb|InterpExecuteSpadSystemCommand|. -Thus, when a system command is entered this function is called. - -The only exception is the \verb|)include| function which inserts -the contents of a file inline in the input stream. This is useful -for processing \verb|)read| of input files. - -\calls{ncloopCommand}{ncloopPrefix?} -\calls{ncloopCommand}{ncloopInclude1} -\callsdollar{ncloopCommand}{systemCommandFunction} -\usesdollar{ncloopCommand}{systemCommandFunction} -\label{ncloopCommand} -\begin{chunk}{defun ncloopCommand} -(defun |ncloopCommand| (line n) - (let (a) - (declare (special |$systemCommandFunction|)) - (if (setq a (|ncloopPrefix?| ")include" line)) - (|ncloopInclude1| a n) - (progn - (funcall |$systemCommandFunction| line) - n)))) - -\end{chunk} - -\defun{ncloopPrefix?}{ncloopPrefix?} -If we find the prefix string in the whole string starting at position zero -we return the remainder of the string without the leading prefix. -\begin{chunk}{defun ncloopPrefix? 0} -(defun |ncloopPrefix?| (prefix whole) - (when (eql (search prefix whole) 0) - (subseq whole (length prefix)))) - -\end{chunk} - -\defun{selectOptionLC}{selectOptionLC} -\calls{selectOptionLC}{selectOption} -\calls{selectOptionLC}{downcase} -\calls{selectOptionLC}{object2Identifier} -\begin{chunk}{defun selectOptionLC} -(defun |selectOptionLC| (x l errorFunction) - (|selectOption| (downcase (|object2Identifier| x)) l errorFunction)) - -\end{chunk} - -\defun{selectOption}{selectOption} -\calls{selectOption}{member} -\calls{selectOption}{identp} -\calls{selectOption}{stringPrefix?} -\calls{selectOption}{pname} -\calls{selectOption}{qcdr} -\calls{selectOption}{qcar} -\begin{chunk}{defun selectOption} -(defun |selectOption| (x l errorfunction) - (let (u y) - (cond - ((|member| x l) x) - ((null (identp x)) - (cond - (errorfunction (funcall errorfunction x u)) - (t nil))) - (t - (setq u - (let (t0) - (do ((t1 l (cdr t1)) (y nil)) - ((or (atom t1) (progn (setq y (car t1)) nil)) (nreverse0 t0)) - (if (|stringPrefix?| (pname x) (pname y)) - (setq t0 (cons y t0)))))) - (cond - ((and (consp u) (eq (qcdr u) nil) (progn (setq y (qcar u)) t)) y) - (errorfunction (funcall errorfunction x u)) - (t nil)))))) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{abbreviations} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{abbreviations.help} -==================================================================== -A.2. )abbreviation -==================================================================== - -User Level Required: compiler - -Command Syntax: - - - )abbreviation query [nameOrAbbrev] - - )abbreviation category abbrev fullname [)quiet] - - )abbreviation domain abbrev fullname [)quiet] - - )abbreviation package abbrev fullname [)quiet] - - )abbreviation remove nameOrAbbrev - -Command Description: - -This command is used to query, set and remove abbreviations for category, -domain and package constructors. Every constructor must have a unique -abbreviation. This abbreviation is part of the name of the subdirectory under -which the components of the compiled constructor are stored. Furthermore, by -issuing this command you let the system know what file to load automatically -if you use a new constructor. Abbreviations must start with a letter and then -be followed by up to seven letters or digits. Any letters appearing in the -abbreviation must be in uppercase. - -When used with the query argument, this command may be used to list the name -associated with a particular abbreviation or the abbreviation for a -constructor. If no abbreviation or name is given, the names and corresponding -abbreviations for all constructors are listed. - -The following shows the abbreviation for the constructor List: - -)abbreviation query List - -The following shows the constructor name corresponding to the abbreviation -NNI: - -)abbreviation query NNI - -The following lists all constructor names and their abbreviations. - -)abbreviation query - -To add an abbreviation for a constructor, use this command with category, -domain or package. The following add abbreviations to the system for a -category, domain and package, respectively: - -)abbreviation domain SET Set -)abbreviation category COMPCAT ComplexCategory -)abbreviation package LIST2MAP ListToMap - -If the )quiet option is used, no output is displayed from this command. You -would normally only define an abbreviation in a library source file. If this -command is issued for a constructor that has already been loaded, the -constructor will be reloaded next time it is referenced. In particular, you -can use this command to force the automatic reloading of constructors. - -To remove an abbreviation, the remove argument is used. This is usually only -used to correct a previous command that set an abbreviation for a constructor -name. If, in fact, the abbreviation does exist, you are prompted for -confirmation of the removal request. Either of the following commands will -remove the abbreviation VECTOR2 and the constructor name VectorFunctions2 -from the system: - -)abbreviation remove VECTOR2 -)abbreviation remove VectorFunctions2 - -Also See: -o )compile - -\end{chunk} - -\defun{abbreviations}{abbreviations} -\calls{abbreviations}{abbreviationsSpad2Cmd} -\begin{chunk}{defun abbreviations} -(defun |abbreviations| (l) - (|abbreviationsSpad2Cmd| l)) - -\end{chunk} -\defun{abbreviationsSpad2Cmd}{abbreviationsSpad2Cmd} -\calls{abbreviationsSpad2Cmd}{listConstructorAbbreviations} -\calls{abbreviationsSpad2Cmd}{abbreviation?} -\calls{abbreviationsSpad2Cmd}{abbQuery} -\calls{abbreviationsSpad2Cmd}{deldatabase} -\calls{abbreviationsSpad2Cmd}{size} -\calls{abbreviationsSpad2Cmd}{sayKeyedMsg} -\calls{abbreviationsSpad2Cmd}{mkUserConstructorAbbreviation} -\calls{abbreviationsSpad2Cmd}{setdatabase} -\calls{abbreviationsSpad2Cmd}{seq} -\calls{abbreviationsSpad2Cmd}{exit} -\calls{abbreviationsSpad2Cmd}{opOf} -\calls{abbreviationsSpad2Cmd}{helpSpad2Cmd} -\calls{abbreviationsSpad2Cmd}{selectOptionLC} -\calls{abbreviationsSpad2Cmd}{qcar} -\calls{abbreviationsSpad2Cmd}{qcdr} -\usesdollar{abbreviationsSpad2Cmd}{options} -\begin{chunk}{defun abbreviationsSpad2Cmd} -(defun |abbreviationsSpad2Cmd| (arg) - (let (abopts quiet opt key type constructor t2 a b al) - (declare (special |$options|)) - (if (null arg) - (|helpSpad2Cmd| '(|abbreviations|)) - (progn - (setq abopts '(|query| |domain| |category| |package| |remove|)) - (setq quiet nil) - (do ((t0 |$options| (cdr t0)) (t1 nil)) - ((or (atom t0) - (progn (setq t1 (car t0)) nil) - (progn (progn (setq opt (car t1)) t1) nil)) - nil) - (setq opt (|selectOptionLC| opt '(|quiet|) '|optionError|)) - (when (eq opt '|quiet|) (setq quiet t))) - (when - (and (consp arg) - (progn - (setq opt (qcar arg)) - (setq al (qcdr arg)) - t)) - (setq key (|opOf| (car al))) - (setq type (|selectOptionLC| opt abopts '|optionError|)) - (cond - ((eq type '|query|) - (cond - ((null al) (|listConstructorAbbreviations|)) - ((setq constructor (|abbreviation?| key)) - (|abbQuery| constructor)) - (t (|abbQuery| key)))) - ((eq type '|remove|) - (deldatabase key 'abbreviation)) - ((oddp (size al)) - (|sayKeyedMsg| 's2iz0002 (list type))) - (t - (do () (nil nil) - (seq - (exit - (cond - ((null al) (return '|fromLoop|)) - (t - (setq t2 al) - (setq a (car t2)) - (setq b (cadr t2)) - (setq al (cddr t2)) - (|mkUserConstructorAbbreviation| b a type) - (setdatabase b 'abbreviation a) - (setdatabase b 'constructorkind type)))))) - (unless quiet - (|sayKeyedMsg| 's2iz0001 (list a type (|opOf| b))))))))))) - -\end{chunk} - -\defun{listConstructorAbbreviations}{listConstructorAbbreviations} -\calls{listConstructorAbbreviations}{upcase} -\calls{listConstructorAbbreviations}{queryUserKeyedMsg} -\calls{listConstructorAbbreviations}{string2id-n} -\calls{listConstructorAbbreviations}{whatSpad2Cmd} -\calls{listConstructorAbbreviations}{sayKeyedMsg} -\begin{chunk}{defun listConstructorAbbreviations} -(defun |listConstructorAbbreviations| () - (let (x) - (setq x (upcase (|queryUserKeyedMsg| 's2iz0056 nil))) - (if (member (string2id-n x 1) '(Y YES)) - (progn - (|whatSpad2Cmd| '(|categories|)) - (|whatSpad2Cmd| '(|domains|)) - (|whatSpad2Cmd| '(|packages|))) - (|sayKeyedMsg| 's2iz0057 nil)))) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{boot} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{boot.help} -==================================================================== -A.3. )boot -==================================================================== - -User Level Required: development - -Command Syntax: - - - )boot bootExpression - -Command Description: - -This command is used by AXIOM system developers to execute expressions -written in the BOOT language. For example, - -)boot times3(x) == 3*x - -creates and compiles the Lisp function ``times3'' obtained by translating the -BOOT code. - -Also See: -o )fin -o )lisp -o )set -o )system - -\end{chunk} -\footnote{ -\fnref{fin} -\fnref{lisp} -\fnref{set} -\fnref{system}} - -This command is in the list of \verb|$noParseCommands| -\ref{noParseCommands} which means that its arguments are passed -verbatim. This will eventually result in a call to the function -\verb|handleNoParseCommands| \ref{handleNoParseCommands} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{browse} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{browse.help} - -User Level Required: development - -Command Syntax: - - )browse - -Command Description: - -This command is used by Axiom system users to start the Axiom top level -loop listening for browser connections. - -\end{chunk} -\section{Overview} -The Axiom book on the help browser is a complete rewrite of the -hyperdoc mechanism. There are several components that were needed -to make this function. Most of the web browser components are -described in bookvol11.pamphlet. This portion describes some of -the design issues needed to support the interface. - -The axServer command takes a port (defaulting to 8085) and a -program to handle the browser interaction (defaulting to multiServ). -The axServer function opens the port, constructs the stream, and -passes the stream to multiServ. The multiServ loop processes one -interaction at a time. - -So the basic process is that the Axiom ``)browse'' command opens a -socket and listens for http requests. Based on the type of request -(either 'GET' or 'POST') and the content of the request, which is -one of: -\begin{itemize} -\item command - algebra request/response -\item lispcall - a lisp s-expression to be evaluated -\item showcall - an Axiom )show command -\end{itemize} -the multiServ function will call a handler function to evaluate -the command line and construct a response. GET requests result -in a new browser page. POST requests result in an inline result. - -Most responses contain the fields: -\begin{itemize} -\item stepnum - this is the Axiom step number -\item command - this is the original command from the browser -\item algebra - this is the Axiom 2D algebra output -\item mathml - this is the MathML version of the Axiom algebra -\item type - this is the type of the Axiom result -\end{itemize} - -\section{Browsers, MathML, and Fonts} -This work has the Firefox browser as its target. Firefox has built-in -support for MathML, javascript, and XMLHttpRequests. More details -are available in bookvol11.pamphlet but the very basic machinery for -communication with the browser involves a dance between the browser -and the multiServ function (see the axserver.spad.pamphlet). - -In particular, a simple request is embedded in a web page as: -\begin{verbatim} -
    -
  • - -
    -
    • -
-\end{verbatim} -which says that this is an html ``input'' field of type ``submit''. -The CSS display class is ``subbut'' which is of a different color -than the surrounding text to make it obvious that you can click on -this field. Clickable fields that have no response text are of class -``noresult''. - -The javascript call to ``makeRequest'' gives the ``id'' of this input -field, which must be unique in the page, as an argument. In this case, -the argument is 'p3'. The ``value'' field holds the display text which -will be passed back to Axiom as a command. - -When the result arrives the ``showanswer'' function will select out -the mathml field of the response, construct the ``id'' of the html -div to hold the response by concatenating the string ``ans'' (answer) -to the ``id'' of the request resulting, in this case, as ``ansp3''. -The ``showanswer'' function will find this div and replace it with a -div containing the mathml result. - -The ``makeRequest'' function is: -\begin{verbatim} - function makeRequest(arg) { - http_request = new XMLHttpRequest(); - var command = commandline(arg); - //alert(command); - http_request.open('POST', '127.0.0.1:8085', true); - http_request.onreadystatechange = handleResponse; - http_request.setRequestHeader('Content-Type', 'text/plain'); - http_request.send("command="+command); - return(false); -\end{verbatim} -It contains a request to open a local server connection to Axiom, -sets ``handleResponse'' as the function to call on reply, sets up -the type of request, fills in the command field, and sends off the -http request. - -When a response is received, the ``handleResponse'' function checks -for the correct reply state, strips out the important text, and -calls ``showanswer''. -\begin{verbatim} - function handleResponse() { - if (http_request.readyState == 4) { - if (http_request.status == 200) { - showanswer(http_request.responseText,'mathAns'); - } else - { - alert('There was a problem with the request.'+ http_request.statusText); - } - } - } -\end{verbatim} -See bookvol11.pamphlet for further details. - -\section{The axServer/multiServ loop} -The basic call to start an Axiom browser listener is: -\begin{verbatim} - )set message autoload off - )set output mathml on - axServer(8085,multiServ)$AXSERV -\end{verbatim} - -This call sets the port, opens a socket, attaches it to a stream, -and then calls ``multiServ'' with that stream. The ``multiServ'' -function loops serving web responses to that port. - -\section{\enspace{}The )browse command} -In order to make the whole process cleaner the function ``)browse'' -handles the details. This code creates the command-line function for )browse - -The browse function does the internal equivalent of the following 3 command -line statments: -\begin{verbatim} - )set message autoload off - )set output mathml on - axServer(8085,multiServ)$AXSERV -\end{verbatim} -which causes Axiom to start serving web pages on port 8085 - -For those unfamiliar with calling algebra from lisp there are a -few points to mention. - -The loadLib needs to be called to load the algebra code into the image. -Normally this is automatic but we are not using the interpreter so -we need to do this ``by hand''. - -Each algebra file contains a "constructor function" which builds the -domain, which is a vector, and then caches the vector so that every -call to the contructor returns an EQ vector, that is, the same vector. -In this case, we call the constructor $\vert$AxiomServer$\vert$ - -The axServer function was mangled internally to -$\vert$AXSERV;axServer;IMV;2$\vert$. -The multiServ function was mangled to $\vert$AXSERV;multiServ;SeV;3$\vert$ -Note well that if you change axserver.spad these names might change -which will generate the error message along the lines of: -\begin{verbatim} - System error: - The function $\vert$AXSERV;axServer;IMV;2$\vert$ is undefined. -\end{verbatim} - -To fix this you need to look at int/algebra/AXSERV.nrlib/code.lsp -and find the new mangled function name. A better solution would -be to dynamically look up the surface names in the domain vector. - -Each Axiom function expects the domain vector as the last argument. -This is not obvious from the call as the interpreter supplies it. -We must do that ``by hand''. - -We don't call the multiServ function. We pass it as a parameter to -the axServer function. When it does get called by the SPADCALL -macro it needs to be a lisp pair whose car is the function and -whose cdr is the domain vector. We construct that pair here as -the second argument to axServer. The third, hidden, argument to -axServer is the domain vector which we supply ``by hand''. - -The socket can be supplied on the command line but defaults to 8085. -Axiom supplies the arguments as a list. - -\calls{browse}{set} -\calls{browse}{loadLib} -\calls{browse}{AxiomServer} -\calls{browse}{AXSERV;axServer;IMV;2} -\begin{chunk}{defun browse} -(defun |browse| (socket) - (let (axserv browser) - (if socket - (setq socket (car socket)) - (setq socket 8085)) - (|set| '(|mes| |auto| |off|)) - (|set| '(|out| |mathml| |on|)) - (|loadLib| '|AxiomServer|) - (setq axserv (|AxiomServer|)) - (setq browser - (|AXSERV;axServer;IMV;2| socket - (cons #'|AXSERV;multiServ;SeV;3| axserv) axserv)))) - -\end{chunk} -Now we have to bolt it into Axiom. This involves two lookups. - -We create the lisp pair -\begin{verbatim} - (|browse| . |development|) -\end{verbatim} -and cons it into the \$systemCommands command table. This allows the -command to be executed in development mode. This lookup decides if -this command is allowed. It also has the side-effect of putting the -command into the \$SYSCOMMANDS variable which is used to determine -if the token is a command. - -\section{\enspace{}The server support code} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{cd} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{cd.help} -==================================================================== -A.4. )cd -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )cd directory - -Command Description: - -This command sets the AXIOM working current directory. The current directory -is used for looking for input files (for )read), AXIOM library source files -(for )compile), saved history environment files (for )history )restore), -compiled AXIOM library files (for )library), and files to edit (for )edit). -It is also used for writing spool files (via )spool), writing history input -files (via )history )write) and history environment files (via )history -)save),and compiled AXIOM library files (via )compile). - -If issued with no argument, this command sets the AXIOM current directory to -your home directory. If an argument is used, it must be a valid directory -name. Except for the ``)'' at the beginning of the command, this has the same -syntax as the operating system cd command. - -Also See: -o )compile -o )edit -o )history -o )library -o )read -o )spool - -\end{chunk} -\footnote{ -\fnref{edit} -\fnref{history} -\fnref{library} -\fnref{read} -\fnref{spool}} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{clear} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{clear.help} -==================================================================== -A.6. )clear -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )clear all - - )clear completely - - )clear properties all - - )clear properties obj1 [obj2 ...] - - )clear value all - - )clear value obj1 [obj2 ...] - - )clear mode all - - )clear mode obj1 [obj2 ...] - -Command Description: - -This command is used to remove function and variable declarations, -definitions and values from the workspace. To empty the entire workspace and -reset the step counter to 1, issue - -)clear all - -To remove everything in the workspace but not reset the step counter, issue - -)clear properties all - -To remove everything about the object x, issue - -)clear properties x - -To remove everything about the objects x, y and f, issue - -)clear properties x y f - -The word properties may be abbreviated to the single letter ``p''. - -)clear p all -)clear p x -)clear p x y f - -All definitions of functions and values of variables may be removed by either - -)clear value all -)clear v all - -This retains whatever declarations the objects had. To remove definitions and -values for the specific objects x, y and f, issue - -)clear value x y f -)clear v x y f - -To remove the declarations of everything while leaving the definitions and -values, issue - -)clear mode all -)clear m all - -To remove declarations for the specific objects x, y and f, issue - -)clear mode x y f -)clear m x y f - -The )display names and )display properties commands may be used to see what -is currently in the workspace. - -The command - -)clear completely - -does everything that )clear all does, and also clears the internal system -function and constructor caches. - -Also See: -o )display -o )history -o )undo - -\end{chunk} -\footnote{ -\fnref{display} -\fnref{history} -\fnref{undo}} - -\defdollar{clearOptions} -\begin{chunk}{initvars} -(defvar |$clearOptions| '(|modes| |operations| |properties| |types| |values|)) - -\end{chunk} - -\defun{clear}{clear} -\calls{clear}{clearSpad2Cmd} -\begin{chunk}{defun clear} -(defun |clear| (l) - (|clearSpad2Cmd| l)) - -\end{chunk} - -\defdollar{clearExcept} -\begin{chunk}{initvars} -(defvar |$clearExcept| nil) - -\end{chunk} - -\defun{clearSpad2Cmd}{clearSpad2Cmd} -TPDHERE: Note that this function also seems to parse out )except -)completely and )scaches which don't seem to be documented. -\calls{clearSpad2Cmd}{selectOptionLC} -\calls{clearSpad2Cmd}{sayKeyedMsg} -\calls{clearSpad2Cmd}{clearCmdAll} -\calls{clearSpad2Cmd}{clearCmdCompletely} -\calls{clearSpad2Cmd}{clearCmdSortedCaches} -\calls{clearSpad2Cmd}{clearCmdExcept} -\calls{clearSpad2Cmd}{clearCmdParts} -\calls{clearSpad2Cmd}{updateCurrentInterpreterFrame} -\usesdollar{clearSpad2Cmd}{clearExcept} -\usesdollar{clearSpad2Cmd}{options} -\usesdollar{clearSpad2Cmd}{clearOptions} -\begin{chunk}{defun clearSpad2Cmd} -(defun |clearSpad2Cmd| (l) - (let (|$clearExcept| opt optlist arg) - (declare (special |$clearExcept| |$options| |$clearOptions|)) - (cond - (|$options| - (setq |$clearExcept| - (prog (t0) - (setq t0 t) - (return - (do ((t1 nil (null t0)) - (t2 |$options| (cdr t2)) - (t3 nil)) - ((or t1 - (atom t2) - (progn (setq t3 (car t2)) nil) - (progn (progn (setq opt (car t3)) t3) nil)) - t0) - (setq t0 - (and t0 - (eq - (|selectOptionLC| opt '(|except|) '|optionError|) - '|except|))))))))) - (cond - ((null l) - (setq optlist - (prog (t4) - (setq t4 nil) - (return - (do ((t5 |$clearOptions| (cdr t5)) (x nil)) - ((or (atom t5) (progn (setq x (car t5)) nil)) t4) - (setq t4 (append t4 `(|%l| " " ,x))))))) - (|sayKeyedMsg| 's2iz0010 (list optlist))) - (t - (setq arg - (|selectOptionLC| (car l) '(|all| |completely| |scaches|) nil)) - (cond - ((eq arg '|all|) (|clearCmdAll|)) - ((eq arg '|completely|) (|clearCmdCompletely|)) - ((eq arg '|scaches|) (|clearCmdSortedCaches|)) - (|$clearExcept| (|clearCmdExcept| l)) - (t - (|clearCmdParts| l) - (|updateCurrentInterpreterFrame|))))))) - -\end{chunk} - -\defun{clearCmdSortedCaches}{clearCmdSortedCaches} -\calls{clearCmdSortedCaches}{compiledLookupCheck} -\calls{clearCmdSortedCaches}{spadcall} -\usesdollar{clearCmdSortedCaches}{lookupDefaults} -\usesdollar{clearCmdSortedCaches}{Void} -\usesdollar{clearCmdSortedCaches}{ConstructorCache} -\begin{chunk}{defun clearCmdSortedCaches} -(defun |clearCmdSortedCaches| () - (let (|$lookupDefaults| domain pair) - (declare (special |$lookupDefaults| |$Void| |$ConstructorCache|)) - (do ((t0 (hget |$ConstructorCache| '|SortedCache|) (cdr t0)) - (t1 nil)) - ((or (atom t0) - (progn - (setq t1 (car t0)) - (setq domain (cddr t1)) - nil)) - nil) - (setq pair (|compiledLookupCheck| '|clearCache| (list |$Void|) domain)) - (spadcall pair)))) - -\end{chunk} - -\defun{compiledLookupCheck}{compiledLookupCheck} -\calls{compiledLookupCheck}{compiledLookup} -\calls{compiledLookupCheck}{keyedSystemError} -\calls{compiledLookupCheck}{formatSignature} -\begin{chunk}{defun compiledLookupCheck} -(defun |compiledLookupCheck| (op sig dollar) - (let (fn) - (setq fn (|compiledLookup| op sig dollar)) - (cond - ((and (null fn) (eq op '^)) - (setq fn (|compiledLookup| '** sig dollar))) - ((and (null fn) (eq op '**)) - (setq fn (|compiledLookup| '^ sig dollar))) - (t nil)) - (cond - ((null fn) - (|keyedSystemError| 'S2NR0001 - (list op (|formatSignature| sig) (elt dollar 0)))) - (t fn)))) - -\end{chunk} - -\defdollar{functionTable} -\begin{chunk}{initvars} -(defvar |$functionTable| nil) - -\end{chunk} - -\defun{clearCmdCompletely}{clearCmdCompletely} -\calls{clearCmdCompletely}{clearCmdAll} -\calls{clearCmdCompletely}{sayKeyedMsg} -\calls{clearCmdCompletely}{clearClams} -\calls{clearCmdCompletely}{clearConstructorCaches} -\calls{clearCmdCompletely}{reclaim} -\usesdollar{clearCmdCompletely}{localExposureData} -\usesdollar{clearCmdCompletely}{xdatabase} -\usesdollar{clearCmdCompletely}{CatOfCatDatabase} -\usesdollar{clearCmdCompletely}{DomOfCatDatabase} -\usesdollar{clearCmdCompletely}{JoinOfCatDatabase} -\usesdollar{clearCmdCompletely}{JoinOfDomDatabase} -\usesdollar{clearCmdCompletely}{attributeDb} -\usesdollar{clearCmdCompletely}{functionTable} -\usesdollar{clearCmdCompletely}{existingFiles} -\usesdollar{clearCmdCompletely}{localExposureDataDefault} -\begin{chunk}{defun clearCmdCompletely} -(defun |clearCmdCompletely| () - (declare (special |$localExposureData| |$xdatabase| |$CatOfCatDatabase| - |$DomOfCatDatabase| |$JoinOfCatDatabase| |$JoinOfDomDatabase| - |$attributeDb| |$functionTable| |$existingFiles| - |$localExposureDataDefault|)) - (|clearCmdAll|) - (setq |$localExposureData| (copy-seq |$localExposureDataDefault|)) - (setq |$xdatabase| nil) - (setq |$CatOfCatDatabase| nil) - (setq |$DomOfCatDatabase| nil) - (setq |$JoinOfCatDatabase| nil) - (setq |$JoinOfDomDatabase| nil) - (setq |$attributeDb| nil) - (setq |$functionTable| nil) - (|sayKeyedMsg| 's2iz0013 nil) - (|clearClams|) - (|clearConstructorCaches|) - (setq |$existingFiles| (make-hash-table :test #'equal)) - (|sayKeyedMsg| 's2iz0014 nil) - (reclaim) - (|sayKeyedMsg| 's2iz0015 nil)) - -\end{chunk} - -\defun{clearCmdAll}{clearCmdAll} -\calls{clearCmdAll}{clearCmdSortedCaches} -\calls{clearCmdAll}{untraceMapSubNames} -\calls{clearCmdAll}{resetInCoreHist} -\calls{clearCmdAll}{deleteFile} -\calls{clearCmdAll}{histFileName} -\calls{clearCmdAll}{updateCurrentInterpreterFrame} -\calls{clearCmdAll}{clearMacroTable} -\calls{clearCmdAll}{sayKeyedMsg} -\usesdollar{clearCmdAll}{frameRecord} -\usesdollar{clearCmdAll}{previousBindings} -\usesdollar{clearCmdAll}{variableNumberAlist} -\usesdollar{clearCmdAll}{InteractiveFrame} -\usesdollar{clearCmdAll}{useInternalHistoryTable} -\usesdollar{clearCmdAll}{internalHistoryTable} -\usesdollar{clearCmdAll}{frameMessages} -\usesdollar{clearCmdAll}{interpreterFrameName} -\usesdollar{clearCmdAll}{currentLine} -\begin{chunk}{defun clearCmdAll} -(defun |clearCmdAll| () - (declare (special |$frameRecord| |$previousBindings| |$variableNumberAlist| - |$InteractiveFrame| |$useInternalHistoryTable| |$internalHistoryTable| - |$frameMessages| |$interpreterFrameName| |$currentLine|)) - (|clearCmdSortedCaches|) - (setq |$frameRecord| nil) - (setq |$previousBindings| nil) - (setq |$variableNumberAlist| nil) - (|untraceMapSubNames| /tracenames) - (setq |$InteractiveFrame| (list (list nil))) - (|resetInCoreHist|) - (when |$useInternalHistoryTable| - (setq |$internalHistoryTable| nil) - (|deleteFile| (|histFileName|))) - (setq |$IOindex| 1) - (|updateCurrentInterpreterFrame|) - (setq |$currentLine| ")clear all") - (|clearMacroTable|) - (when |$frameMessages| - (|sayKeyedMsg| 's2iz0011 (list |$interpreterFrameName|)) - (|sayKeyedMsg| 's2iz0012 nil))) - -\end{chunk} - -\defun{clearMacroTable}{clearMacroTable} -\usesdollar{clearMacroTable}{pfMacros} -\begin{chunk}{defun clearMacroTable 0} -(defun |clearMacroTable| () - (declare (special |$pfMacros|)) - (setq |$pfMacros| nil)) - -\end{chunk} - -\defun{clearCmdExcept}{clearCmdExcept} -Clear all the options except the argument. -\calls{clearCmdExcept}{stringPrefix?} -\calls{clearCmdExcept}{object2String} -\calls{clearCmdExcept}{clearCmdParts} -\usesdollar{clearCmdExcept}{clearOptions} -\begin{chunk}{defun clearCmdExcept} -(defun |clearCmdExcept| (arg) - (let ((opt (car arg)) (vl (cdr arg))) - (declare (special |$clearOptions|)) - (dolist (option |$clearOptions|) - (unless (|stringPrefix?| (|object2String| opt) (|object2String| option)) - (|clearCmdParts| (cons option vl)))))) - -\end{chunk} - -\defun{clearCmdParts}{clearCmdParts} -\calls{clearCmdParts}{selectOptionLC} -\calls{clearCmdParts}{pname} -\calls{clearCmdParts}{types} -\calls{clearCmdParts}{modes} -\calls{clearCmdParts}{values} -\calls{clearCmdParts}{boot-equal} -\calls{clearCmdParts}{assocleft} -\calls{clearCmdParts}{remdup} -\calls{clearCmdParts}{assoc} -\calls{clearCmdParts}{isMap} -\calls{clearCmdParts}{get} -\calls{clearCmdParts}{exit} -\calls{clearCmdParts}{untraceMapSubNames} -\calls{clearCmdParts}{seq} -\calls{clearCmdParts}{recordOldValue} -\calls{clearCmdParts}{recordNewValue} -\calls{clearCmdParts}{deleteAssoc} -\calls{clearCmdParts}{sayKeyedMsg} -\calls{clearCmdParts}{getParserMacroNames} -\calls{clearCmdParts}{getInterpMacroNames} -\calls{clearCmdParts}{clearDependencies} -\calls{clearCmdParts}{member} -\calls{clearCmdParts}{clearParserMacro} -\calls{clearCmdParts}{sayMessage} -\calls{clearCmdParts}{fixObjectForPrinting} -\usesdollar{clearCmdParts}{e} -\usesdollar{clearCmdParts}{InteractiveFrame} -\usesdollar{clearCmdParts}{clearOptions} -\begin{chunk}{defun clearCmdParts} -(defun |clearCmdParts| (arg) - (let (|$e| (opt (car arg)) option pmacs imacs (vl (cdr arg)) p1 lm prop p2) - (declare (special |$e| |$InteractiveFrame| |$clearOptions|)) - (setq option (|selectOptionLC| opt |$clearOptions| '|optionError|)) - (setq option (intern (pname option))) - (setq option - (case option - (|types| '|mode|) - (|modes| '|mode|) - (|values| '|value|) - (t option))) - (if (null vl) - (|sayKeyedMsg| 's2iz0055 nil) - (progn - (setq pmacs (|getParserMacroNames|)) - (setq imacs (|getInterpMacroNames|)) - (cond - ((boot-equal vl '(|all|)) - (setq vl (assocleft (caar |$InteractiveFrame|))) - (setq vl (remdup (append vl pmacs))))) - (setq |$e| |$InteractiveFrame|) - (do ((t0 vl (cdr t0)) (x nil)) - ((or (atom t0) (progn (setq x (car t0)) nil)) nil) - (|clearDependencies| x t) - (when (and (eq option '|properties|) (|member| x pmacs)) - (|clearParserMacro| x)) - (when (and (eq option '|properties|) - (|member| x imacs) - (null (|member| x pmacs))) - (|sayMessage| (cons - " You cannot clear the definition of the system-defined macro " - (cons (|fixObjectForPrinting| x) - (cons (intern "." "BOOT") nil))))) - (cond - ((setq p1 (|assoc| x (caar |$InteractiveFrame|))) - (cond - ((eq option '|properties|) - (cond - ((|isMap| x) - (seq - (cond - ((setq lm - (|get| x '|localModemap| |$InteractiveFrame|)) - (cond - ((consp lm) - (exit (|untraceMapSubNames| (cons (cadar lm) nil)))))) - (t nil))))) - (dolist (p2 (cdr p1)) - (setq prop (car p2)) - (|recordOldValue| x prop (cdr p2)) - (|recordNewValue| x prop nil)) - (setf (caar |$InteractiveFrame|) - (|deleteAssoc| x (caar |$InteractiveFrame|)))) - ((setq p2 (|assoc| option (cdr p1))) - (|recordOldValue| x option (cdr p2)) - (|recordNewValue| x option nil) - (rplacd p2 nil)))))) - nil)))) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{close} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{close.help} -==================================================================== -A.5. )close -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )close - - )close )quietly - -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 example and you -do not want the extra window around anymore, issue - -)close - -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 - - This is the last AXIOM session. Do you want to kill AXIOM? - -Type "y" (followed by the Return key) if this is what you had in mind. Type -"n" (followed by the Return key) to cancel the command. - -You can use the )quietly option to force AXIOM to close down the interpreter -client process without closing down the entire AXIOM session. - -Also See: -o )quit -o )pquit - -\end{chunk} -\footnote{ -\fnref{quit} -\fnref{pquit}} - -\defun{queryClients}{queryClients} -Returns the number of active scratchpad clients - -\calls{queryClients}{sockSendInt} -\calls{queryClients}{sockGetInt} -\usesdollar{queryClients}{SessionManager} -\usesdollar{queryClients}{QueryClients} -\begin{chunk}{defun queryClients} -(defun |queryClients| () - (declare (special |$SessionManager| |$QueryClients|)) - (|sockSendInt| |$SessionManager| |$QueryClients|) - (|sockGetInt| |$SessionManager|)) - -\end{chunk} - -\defun{close}{close} -\calls{close}{throwKeyedMsg} -\calls{close}{sockSendInt} -\calls{close}{closeInterpreterFrame} -\calls{close}{selectOptionLC} -\calls{close}{upcase} -\calls{close}{queryUserKeyedMsg} -\calls{close}{string2id-n} -\calls{close}{queryClients} -\usesdollar{close}{SpadServer} -\usesdollar{close}{SessionManager} -\usesdollar{close}{CloseClient} -\usesdollar{close}{currentFrameNum} -\usesdollar{close}{options} -\begin{chunk}{defun close} -(defun |close| (args) - (declare (ignore args)) - (let (numClients opt fullopt quiet x) - (declare (special |$SpadServer| |$SessionManager| |$CloseClient| - |$currentFrameNum| |$options|)) - (if (null |$SpadServer|) - (|throwKeyedMsg| 's2iz0071 nil)) - (progn - (setq 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 (setq opt (car t1)) t1) nil)) - nil) - (setq fullopt (|selectOptionLC| opt '(|quiet|) '|optionError|)) - (unless quiet (setq quiet (eq fullopt '|quiet|)))) - (cond - (quiet - (|sockSendInt| |$SessionManager| |$CloseClient|) - (|sockSendInt| |$SessionManager| |$currentFrameNum|) - (|closeInterpreterFrame| nil)) - (t - (setq x (upcase (|queryUserKeyedMsg| 's2iz0072 nil))) - (when (member (string2id-n x 1) '(yes y)) (bye))))))))) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{compile} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{compile.help} -==================================================================== -A.7. )compile -==================================================================== - -User Level Required: compiler - -Command Syntax: - - - )compile - - )compile fileName - - )compile fileName.spad - - )compile directory/fileName.spad - - )compile fileName )quiet - - )compile fileName )noquiet - - )compile fileName )break - - )compile fileName )nobreak - - )compile fileName )library - - )compile fileName )nolibrary - - )compile fileName )vartrace - - )compile fileName )constructor nameOrAbbrev - -Command Description: - -You use this command to invoke the AXIOM library compiler. This -compiles files with file extension .spad with the AXIOM system -compiler. The command first looks in the standard system directories -for files with extension .spad. - -Should you not want the )library command automatically invoked, call )compile -with the )nolibrary option. For example, - -)compile mycode )nolibrary - -By default, the )library system command exposes all domains and categories it -processes. This means that the AXIOM intepreter will consider those domains -and categories when it is trying to resolve a reference to a function. -Sometimes domains and categories should not be exposed. For example, a domain -may just be used privately by another domain and may not be meant for -top-level use. The )library command should still be used, though, so that the -code will be loaded on demand. In this case, you should use the )nolibrary -option on )compile and the )noexpose option in the )library command. For -example, - -)compile mycode.spad )nolibrary -)library mycode )noexpose - -Once you have established your own collection of compiled code, you may find -it handy to use the )dir option on the )library command. This causes )library -to process all compiled code in the specified directory. For example, - -)library )dir /u/jones/as/quantum - -You must give an explicit directory after )dir, even if you want all compiled -code in the current working directory processed. - -)library )dir . - -You can compile category, domain, and package constructors contained in files -with file extension .spad. You can compile individual constructors or every -constructor in a file. - -The full filename is remembered between invocations of this command and )edit -commands. The sequence of commands - -)compile matrix.spad -)edit -)compile - -will call the compiler, edit, and then call the compiler again on the file -matrix.spad. If you do not specify a directory, the working current directory -(see description of command )cd ) is searched for the file. If the file is -not found, the standard system directories are searched. - -If you do not give any options, all constructors within a file are compiled. -Each constructor should have an )abbreviation command in the file in which it -is defined. We suggest that you place the )abbreviation commands at the top -of the file in the order in which the constructors are defined. The list of -commands serves as a table of contents for the file. - -The )library option causes directories containing the compiled code for each -constructor to be created in the working current directory. The name of such -a directory consists of the constructor abbreviation and the .NRLIB file -extension. For example, the directory containing the compiled code for the -MATRIX constructor is called MATRIX.NRLIB. The )nolibrary option says that -such files should not be created. - -The )vartrace option causes the compiler to generate extra code for the -constructor to support conditional tracing of variable assignments. (see -description of command )trace ). Without this option, this code is suppressed -and one cannot use the )vars option for the trace command. - -The )constructor option is used to specify a particular constructor to -compile. All other constructors in the file are ignored. The constructor name -or abbreviation follows )constructor. Thus either - -)compile matrix.spad )constructor RectangularMatrix - -or - -)compile matrix.spad )constructor RMATRIX - -compiles the RectangularMatrix constructor defined in matrix.spad. - -The )break and )nobreak options determine what the compiler does -when it encounters an error. )break is the default and it indicates that -processing should stop at the first error. The value of the )set break -variable then controls what happens. - -Also See: -o )abbreviation -o )edit -o )library - -\end{chunk} -\footnote{ -\fnref{abbreviation} -\fnref{edit} -\fnref{library}} - -\defvar{/editfile} -\begin{chunk}{initvars} -(defvar /editfile nil) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{copyright} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{copyright.help} -The term Axiom, in the field of computer algebra software, -along with AXIOM and associated images are common-law -trademarks. While the software license allows copies, the -trademarks may only be used when referring to this project. - -Axiom is distributed under terms of the Modified BSD license. -Axiom was released under this license as of September 3, 2002. -Source code is freely available at: -http://savannah.nongnu.org/projects/axiom -Copyrights remain with the original copyright holders. -Use of this material is by permission and/or license. -Individual files contain reference to these applicable copyrights. -The copyright and license statements are collected here for reference. - -Portions Copyright (c) 2003- The Axiom Team - -The Axiom Team is the collective name for the people who have -contributed to this project. Where no other copyright statement -is noted in a file this copyright will apply. - -Portions Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: - - - Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - - Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in - the documentation and/or other materials provided with the - distribution. - - - Neither the name of The Numerical ALgorithms Group Ltd. nor the - names of its contributors may be used to endorse or promote products - derived from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS -IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER -OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -Portions Copyright (C) 1989-95 GROUPE BULL - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to -deal in the Software without restriction, including without limitation the -rights to use, copy, modify, merge, publish, distribute, sublicense, and/or -sell copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in -all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -GROUPE BULL BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN -AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - -Except as contained in this notice, the name of GROUPE BULL shall not be -used in advertising or otherwise to promote the sale, use or other dealings -in this Software without prior written authorization from GROUPE BULL. - -Portions Copyright (C) 2002, Codemist Ltd. All rights reserved. -acn@codemist.co.uk - - - CCL Public License 1.0 - ====================== - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: - -(1) Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. - -(2) Redistributions in binary form must reproduce the above copyright -notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -(3) Neither the name of Codemist nor the names of other contributors may -be used to endorse or promote products derived from this software without -specific prior written permission. - -(4) If you distribute a modified form or either source or binary code - (a) you must make the source form of these modification available - to Codemist; - (b) you grant Codemist a royalty-free license to use, modify - or redistribute your modifications without limitation; - (c) you represent that you are legally entitled to grant these rights - and that you are not providing Codemist with any code that violates - any law or breaches any contract. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS -FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -Portions Copyright (C) 1995-1997 Eric Young (eay@mincom.oz.au) -All rights reserved. - -This package is an SSL implementation written -by Eric Young (eay@mincom.oz.au). -The implementation was written so as to conform with Netscapes SSL. - -This library is free for commercial and non-commercial use as long as -the following conditions are aheared to. The following conditions -apply to all code found in this distribution, be it the RC4, RSA, -lhash, DES, etc., code; not just the SSL code. The SSL documentation -included with this distribution is covered by the same copyright terms -except that the holder is Tim Hudson (tjh@mincom.oz.au). - -Copyright remains Eric Young's, and as such any Copyright notices in -the code are not to be removed. -If this package is used in a product, Eric Young should be given attribution -as the author of the parts of the library used. -This can be in the form of a textual message at program startup or -in documentation (online or textual) provided with the package. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: -1. Redistributions of source code must retain the copyright - notice, this list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. -3. All advertising materials mentioning features or use of this software - must display the following acknowledgement: - "This product includes cryptographic software written by - Eric Young (eay@mincom.oz.au)" - The word 'cryptographic' can be left out if the rouines from the library - being used are not cryptographic related :-). -4. If you include any Windows specific code (or a derivative thereof) from - the apps directory (application code) you must include an acknowledgement: - "This product includes software written by Tim Hudson (tjh@mincom.oz.au)" - -THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -SUCH DAMAGE. - -The licence and distribution terms for any publically available version or -derivative of this code cannot be changed. i.e. this code cannot simply be -copied and put under another distribution licence -[including the GNU Public Licence.] - -Portions Copyright (C) 1988 by Leslie Lamport. - -Portions Copyright (c) 1998 Free Software Foundation, Inc. - -Permission is hereby granted, free of charge, to any person obtaining a -copy of this software and associated documentation files (the -"Software"), to deal in the Software without restriction, including -without limitation the rights to use, copy, modify, merge, publish, -distribute, distribute with modifications, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included -in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -THE USE OR OTHER DEALINGS IN THE SOFTWARE. - -Except as contained in this notice, the name(s) of the above copyright -holders shall not be used in advertising or otherwise to promote the -sale, use or other dealings in this Software without prior written -authorization. - -Portions Copyright 1989-2000 by Norman Ramsey. All rights reserved. - -Noweb is protected by copyright. It is not public-domain -software or shareware, and it is not protected by a ``copyleft'' -agreement like the one used by the Free Software Foundation. - -Noweb is available free for any use in any field of endeavor. You may -redistribute noweb in whole or in part provided you acknowledge its -source and include this COPYRIGHT file. You may modify noweb and -create derived works, provided you retain this copyright notice, but -the result may not be called noweb without my written consent. - -You may sell noweb if you wish. For example, you may sell a CD-ROM -including noweb. - -You may sell a derived work, provided that all source code for your -derived work is available, at no additional charge, to anyone who buys -your derived work in any form. You must give permisson for said -source code to be used and modified under the terms of this license. -You must state clearly that your work uses or is based on noweb and -that noweb is available free of change. You must also request that -bug reports on your work be reported to you. - -Portions Copyright (c) 1987 The RAND Corporation. All rights reserved. - -Portions Copyright 1988-1995 by Stichting Mathematisch Centrum, Amsterdam, The -Netherlands. - - All Rights Reserved - -Permission to use, copy, modify, and distribute this software and its -documentation for any purpose and without fee is hereby granted, -provided that the above copyright notice appear in all copies and that -both that copyright notice and this permission notice appear in -supporting documentation, and that the names of Stichting Mathematisch -Centrum or CWI not be used in advertising or publicity pertaining to -distribution of the software without specific, written prior permission. - -STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO -THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE -FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT -OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - -Portions Copyright (c) Renaud Rioboo and the University Paris 6. - -Portions Copyright (c) 2003-2010 Jocelyn Guidry - -Portions Copyright (c) 2001-2010 Timothy Daly - -\end{chunk} -\defun{copyright}{copyright} -\calls{copyright}{obey} -\calls{copyright}{concat} -\calls{copyright}{getenviron} -\begin{chunk}{defun copyright} -(defun |copyright| () - (obey (concat "cat " (getenviron "AXIOM") "/doc/spadhelp/copyright.help"))) - -\end{chunk} -\defun{trademark}{trademark} -\begin{chunk}{defun trademark 0} -(defun |trademark| () - (format t "The term Axiom, in the field of computer algebra software, ~%") - (format t "along with AXIOM and associated images are common-law ~%") - (format t "trademarks. While the software license allows copies, the ~%") - (format t "trademarks may only be used when referring to this project ~%")) - -\end{chunk} - -This command is in the list of \verb|$noParseCommands| -\ref{noParseCommands} which means that its arguments are passed -verbatim. This will eventually result in a call to the function -\verb|handleNoParseCommands| \ref{handleNoParseCommands} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{credits} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -\defun{credits}{credits} -\uses{credits}{credits} -\begin{chunk}{defun credits 0} -(defun |credits| () - (declare (special credits)) - (mapcar #'(lambda (x) (princ x) (terpri)) creditlist)) - -\end{chunk} - -This command is in the list of \verb|$noParseCommands| -\ref{noParseCommands} which means that its arguments are passed -verbatim. This will eventually result in a call to the function -\verb|handleNoParseCommands| \ref{handleNoParseCommands} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{describe} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{describe.help} -==================================================================== - )describe -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )describe categoryName - - )describe domainName - - )describe packageName - -Command Description: - -This command is used to display the comments for the operation, category, -domain or package. The comments are part of the algebra source code. - -The commands - -)describe [internal] -)describe [internal] -)describe [internal] - -will show a properly formatted version of the "Description:" keyword -from the comments in the algebra source for the category, domain, -or package requested. - -If 'internal' is requested, then the internal format of the domain or -package is described. Categories do not have an internal representation. - -\end{chunk} - -\defdollar{describeOptions} -The current value of \$describeOptions is -\begin{chunk}{initvars} -(defvar $describeOptions '(|category| |domain| |package|)) - -\end{chunk} - -\defun{describe}{Print comment strings from algebra libraries} -This trivial function satisfies the standard pattern of making a -user command match the name of the function which implements the -command. That command immediatly invokes a ``Spad2Cmd'' version. -\calls{describe}{describespad2cmd} -\begin{chunk}{defun describe} -(defun |describe| (l) - (describeSpad2Cmd l)) - -\end{chunk} - -\defun{describeSpad2Cmd}{describeSpad2Cmd} -The describe command prints cleaned-up comment strings from the algebra -libraries. It can print strings associated with a category, domain, package, -or by operation. - -This implements command line options of the form: -\begin{verbatim} - )describe categoryName [internal] - )describe domainName [internal] - )describe packageName [internal] -\end{verbatim} -The describeInternal function will either call the ``dc'' function -to describe the internal representation of the argument or it will -print a cleaned up version of the text for the "Description" keyword -in the Category, Domain, or Package source code. - -\calls{describeSpad2Cmd}{selectOptionLC} -\calls{describeSpad2Cmd}{flatten} -\calls{describeSpad2Cmd}{cleanline} -\calls{describeSpad2Cmd}{getdatabase} -\calls{describeSpad2Cmd}{sayMessage} -\usesdollar{describeSpad2Cmd}{e} -\usesdollar{describeSpad2Cmd}{EmptyEnvironment} -\usesdollar{describeSpad2Cmd}{describeOptions} -\begin{chunk}{defun describeSpad2Cmd} -(defun describeSpad2Cmd (l) - (labels ( - (fullname (arg) - "Convert abbreviations to the full constructor name" - (let ((abb (getdatabase arg 'abbreviation))) - (if abb arg (getdatabase arg 'constructor)))) - (describeInternal (cdp internal?) - (if internal? - (progn - (unless (eq (getdatabase cdp 'constructorkind) '|category|) (|dc| cdp)) - (showdatabase cdp)) - (mapcar #'(lambda (x) (if (stringp x) (cleanline x))) - (flatten (car (getdatabase (fullname cdp) 'documentation))))))) - (let ((|$e| |$EmptyEnvironment|) (opt (second l))) - (declare (special |$e| |$EmptyEnvironment| $describeOptions)) - (if (and (consp l) (not (eq opt '?))) - (describeInternal (first l) (second l)) - (|sayMessage| - (append - '(" )describe keyword arguments are") - (mapcar #'(lambda (x) (format nil "~% ~a" x)) $describeOptions) - (format nil "~% or abbreviations thereof"))))))) - -\end{chunk} - -\defun{cleanline}{cleanline} -\begin{chunk}{defun cleanline} -(defun cleanline (line) - (labels ( - (replaceInLine (thing other line) - (do ((mark (search thing line) (search thing line))) - ((null mark) line) - (setq line - (concatenate 'string (subseq line 0 mark) other - (subseq line (+ mark (length thing))))))) - - (removeFromLine (thing line) (replaceInLine thing "" line)) - - (removeKeyword (str line) - (do ((mark (search str line) (search str line))) - ((null mark) line) - (let (left point mid right) - (setq left (subseq line 0 mark)) - (setq point (search "}" line :start2 mark)) - (setq mid (subseq line (+ mark (length str)) point)) - (setq right (subseq line (+ point 1))) - (setq line (concatenate 'string left mid right))))) - - (addSpaces (str line) - (do ((mark (search str line) (search str line)) (cnt)) - ((null mark) line) - (let (left point mid right) - (setq left (subseq line 0 mark)) - (setq point (search "}" line :start2 mark)) - (setq mid (subseq line (+ mark (length str)) point)) - (if (setq cnt (parse-integer mid :junk-allowed t)) - (setq mid (make-string cnt :initial-element #\ )) - (setq mid "")) - (setq right (subseq line (+ point 1))) - (setq line (concatenate 'string left mid right))))) - - (splitAtNewline (line) - (do ((mark (search "~%" line) (search "~%" line)) (lines)) - ((null mark) - (push " " lines) - (push line lines) - (nreverse lines)) - (push (subseq line 0 mark) lines) - (setq line (subseq line (+ mark 2))))) - - (wrapOneLine (line margin result) - (if (null line) - (nreverse result) - (if (< (length line) margin) - (wrapOneLine nil margin (append (list line) result)) - (let (oneline spill aspace) - (setq aspace (position #\space (subseq line 0 margin) :from-end t)) - (setq oneline (string-trim '(#\space) (subseq line 0 aspace))) - (setq spill (string-trim '(#\space) (subseq line aspace))) - (wrapOneLine spill margin (append (list oneline) result)))))) - - (reflowParagraph (line) - (let (lst1) - (setq lst1 (splitAtNewLine line)) - (dolist (x lst1) - (mapcar #'(lambda(y) (format t "~a~%" y)) - (wrapOneLine x 70 nil)))))) - - (setq line (removeFromLine "{}" line)) - (setq line (replaceInLine "\\blankline" "~%~%" line)) - (setq line (replaceInLine "\\br" "~%" line)) - (setq line (removeFromLine "\\" line)) - (dolist (str '("spad{" "spadtype{" "spadop{" "spadfun{" "spadatt{" - "axiom{" "axiomType{" "spadignore{" "axiomFun{" - "centerline{" "inputbitmap{" "axiomOp{" "spadgloss{")) - (setq line (removeKeyword str line))) - (setq line (replaceInLine "{e.g.}" "e.g." line)) - (dolist (str '("tab{" "indented{" )) - (setq line (addSpaces str line))) - (reflowParagraph line))) - -\end{chunk} - -\defun{flatten}{flatten} -\begin{chunk}{defun flatten 0} -(defun flatten (x) - (labels ( - (rec (x acc) - (cond - ((null x) acc) - ((atom x) (cons x acc)) - (t (rec (car x) (rec (cdr x) acc)))))) - (rec x nil))) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{display} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{display.help} -==================================================================== -A.8. )display -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )display all - - )display properties - - )display properties all - - )display properties [obj1 [obj2 ...] ] - - )display value all - - )display value [obj1 [obj2 ...] ] - - )display mode all - - )display mode [obj1 [obj2 ...] ] - - )display names - - )display operations opName - -Command Description: - -This command is used to display the contents of the workspace and signatures -of functions with a given name. (A signature gives the argument and return -types of a function.) - -The command - -)display names - -lists the names of all user-defined objects in the workspace. This is useful -if you do not wish to see everything about the objects and need only be -reminded of their names. - -The commands - -)display all -)display properties -)display properties all - -all do the same thing: show the values and types and declared modes of all -variables in the workspace. If you have defined functions, their signatures -and definitions will also be displayed. - -To show all information about a particular variable or user functions, for -example, something named d, issue - -)display properties d - -To just show the value (and the type) of d, issue - -)display value d - -To just show the declared mode of d, issue - -)display mode d - -All modemaps for a given operation may be displayed by using )display -operations. A modemap is a collection of information about a particular -reference to an operation. This includes the types of the arguments and the -return value, the location of the implementation and any conditions on the -types. The modemap may contain patterns. The following displays the modemaps -for the operation FromcomplexComplexCategory: - -)d op complex - -Also See: -o )clear -o )history -o )set -o )show -o )what - -\end{chunk} -\footnote{ -\fnref{clear} -\fnref{history} -\fnref{set} -\fnref{show} -\fnref{what}} - -\defdollar{displayOptions} -The current value of \$displayOptions is -\begin{chunk}{initvars} -(defvar |$displayOptions| - '(|abbreviations| |all| |macros| |modes| |names| |operations| - |properties| |types| |values|)) - -\end{chunk} - -\defun{display}{display} -This trivial function satisfies the standard pattern of making a -user command match the name of the function which implements the -command. That command immediatly invokes a ``Spad2Cmd'' version. -\calls{display}{displayspad2cmd} -\begin{chunk}{defun display} -(defun |display| (l) - (displaySpad2Cmd l)) - -\end{chunk} - -\subsection{displaySpad2Cmd} -We process the options to the command and call the appropriate -display function. There are really only 4 display functions. -All of the other options are just subcases. - -There is a slight mismatch between the \$displayOptions list of -symbols and the options this command accepts so we have a cond -branch to clean up the option variable. This allows for the options -to be plural. - -If we fall all the way thru we use the \$displayOptions list -to construct a list of strings for the sayMessage function -and tell the user what options are available. -\calls{displaySpad2Cmd}{abbQuery} -\calls{displaySpad2Cmd}{opOf} -\calls{displaySpad2Cmd}{listConstructorAbbreviations} -\calls{displaySpad2Cmd}{displayOperations} -\calls{displaySpad2Cmd}{displayMacros} -\calls{displaySpad2Cmd}{displayWorkspaceNames} -\calls{displaySpad2Cmd}{displayProperties} -\calls{displaySpad2Cmd}{selectOptionLC} -\calls{displaySpad2Cmd}{sayMessage} -\usesdollar{displaySpad2Cmd}{e} -\usesdollar{displaySpad2Cmd}{EmptyEnvironment} -\usesdollar{displaySpad2Cmd}{displayOptions} -\begin{chunk}{defun displaySpad2Cmd} -(defun displaySpad2Cmd (l) - (let ((|$e| |$EmptyEnvironment|) (opt (car l)) (vl (cdr l)) option) - (declare (special |$e| |$EmptyEnvironment| |$displayOptions|)) - (if (and (consp l) (not (eq opt '?))) - (progn - (setq option (|selectOptionLC| opt |$displayOptions| '|optionError|)) - (cond - ((eq option '|all|) - (setq l (list '|properties|)) - (setq option '|properties|)) - ((or (eq option '|modes|) (eq option '|types|)) - (setq l (cons '|type| vl)) - (setq option '|type|)) - ((eq option '|values|) - (setq l (cons '|value| vl)) - (setq option '|value|))) - (cond - ((eq option '|abbreviations|) - (if (null vl) - (|listConstructorAbbreviations|) - (dolist (v vl) (|abbQuery| (|opOf| v))))) - ((eq option '|operations|) (|displayOperations| vl)) - ((eq option '|macros|) (|displayMacros| vl)) - ((eq option '|names|) (|displayWorkspaceNames|)) - (t (|displayProperties| option l)))) - (|sayMessage| - (append - '(" )display keyword arguments are") - (mapcar #'(lambda (x) (format nil "~% ~a" x)) |$displayOptions|) - (format nil "~% or abbreviations thereof")))))) - -\end{chunk} - -\defun{abbQuery}{abbQuery} -\calls{abbQuery}{getdatabase} -\calls{abbQuery}{sayKeyedMsg} -\begin{chunk}{defun abbQuery} -(defun |abbQuery| (x) - (let (abb) - (cond - ((setq abb (getdatabase x 'abbreviation)) - (|sayKeyedMsg| 's2iz0001 (list abb (getdatabase x 'constructorkind) x))) - ((setq abb (getdatabase x 'constructor)) - (|sayKeyedMsg| 's2iz0001 (list x (getdatabase abb 'constructorkind) abb))) - (t - (|sayKeyedMsg| 's2iz0003 (list x)))))) - -\end{chunk} -\defun{displayOperations}{displayOperations} -This function takes a list of operation names. If the list is null -we query the user to see if they want all operations printed. Otherwise -we print the information for the requested symbols. - -\calls{displayOperations}{reportOpSymbol} -\calls{displayOperations}{yesanswer} -\calls{displayOperations}{sayKeyedMsg} -\begin{chunk}{defun displayOperations} -(defun |displayOperations| (l) - (if l - (dolist (op l) (|reportOpSymbol| op)) - (if (yesanswer) - (dolist (op (|allOperations|)) (|reportOpSymbol| op)) - (|sayKeyedMsg| 's2iz0059 nil)))) - -\end{chunk} -\defun{yesanswer}{yesanswer} -This is a trivial function to simplify the logic of displaySpad2Cmd. -If the user didn't supply an argument to the )display op command -we ask if they wish to have all information about all Axiom operations -displayed. If the answer is either Y or YES we return true else nil. - -\calls{yesanswer}{string2id-n} -\calls{yesanswer}{upcase} -\calls{yesanswer}{queryUserKeyedMsg} -\begin{chunk}{defun yesanswer} -(defun yesanswer () - (member - (string2id-n (upcase (|queryUserKeyedMsg| 's2iz0058 nil)) 1) '(y yes))) - -\end{chunk} - -\defun{displayMacros}{displayMacros} -\calls{displayMacros}{getInterpMacroNames} -\calls{displayMacros}{getParserMacroNames} -\calls{displayMacros}{remdup} -\calls{displayMacros}{sayBrightly} -\calls{displayMacros}{member} -\calls{displayMacros}{displayParserMacro} -\calls{displayMacros}{seq} -\calls{displayMacros}{exit} -\calls{displayMacros}{displayMacro} -\begin{chunk}{defun displayMacros} -(defun |displayMacros| (names) - (let (imacs pmacs macros first) - (setq imacs (|getInterpMacroNames|)) - (setq pmacs (|getParserMacroNames|)) - (if names - (setq macros names) - (setq macros (append imacs pmacs))) - (setq macros (remdup macros)) - (cond - ((null macros) (|sayBrightly| " There are no Axiom macros.")) - (t - (setq first t) - (do ((t0 macros (cdr t0)) (macro nil)) - ((or (atom t0) (progn (setq macro (car t0)) nil)) nil) - (seq - (exit - (cond - ((|member| macro pmacs) - (cond - (first (|sayBrightly| - (cons '|%l| (cons "User-defined macros:" nil))) (setq first nil))) - (|displayParserMacro| macro)) - ((|member| macro imacs) '|iterate|) - (t (|sayBrightly| - (cons " " - (cons '|%b| - (cons macro - (cons '|%d| (cons " is not a known Axiom macro." nil))))))))))) - (setq first t) - (do ((t1 macros (cdr t1)) (macro nil)) - ((or (atom t1) (progn (setq macro (car t1)) nil)) nil) - (seq - (exit - (cond - ((|member| macro imacs) - (cond - ((|member| macro pmacs) '|iterate|) - (t - (cond - (first - (|sayBrightly| - (cons '|%l| - (cons "System-defined macros:" nil))) (setq first nil))) - (|displayMacro| macro)))) - ((|member| macro pmacs) '|iterate|))))) - nil)))) - -\end{chunk} - -\defun{sayExample}{sayExample} -This function expects 2 arguments, the documentation string and -the name of the operation. It searches the documentation string for -\verb|++X| lines. These lines are examples lines for functions. -They look like ordinary \verb|++| comments and fit into the ordinary -comment blocks. So, for example, in the plot.spad.pamphlet file we -find the following function signature: -\begin{verbatim} - plot: (F -> F,R) -> % - ++ plot(f,a..b) plots the function \spad{f(x)} - ++ on the interval \spad{[a,b]}. - ++ - ++X fp:=(t:DFLOAT):DFLOAT +-> sin(t) - ++X plot(fp,-1.0..1.0)$PLOT -\end{verbatim} -This function splits out and prints the lines that begin with \verb|++X|. - -A minor complication of printing the examples is that the lines have -been processed into internal compiler format. Thus the lines that read: -\begin{verbatim} - ++X fp:=(t:DFLOAT):DFLOAT +-> sin(t) - ++X plot(fp,-1.0..1.0)$PLOT -\end{verbatim} -are actually stored as one long line containing the example lines -\begin{verbatim} -"\\indented{1}{plot(\\spad{f},{}a..\\spad{b}) plots the function - \\spad{f(x)}} \\indented{1}{on the interval \\spad{[a,{}b]}.} - \\blankline - \\spad{X} fp:=(t:DFLOAT):DFLOAT +-> sin(\\spad{t}) - \\spad{X} plot(\\spad{fp},{}\\spad{-1}.0..1.0)\\$PLOT" -\end{verbatim} - -So when we have an example line starting with ++X, it gets -converted to the compiler to \verb|\spad{X}|. So each -example line is delimited by \verb|\spad{X}|. - -The compiler also removes the newlines so -if there is a subsequent \verb|\spad{X}| in the docstring -then it implies multiple example lines and we loop over them, -splitting them up at the delimiter. - -If there is only one then we clean it up and print it. - -\calls{sayexample}{cleanupline} -\calls{sayexample}{sayNewLine} -\begin{chunk}{defun sayExample} -(defun sayExample (docstring) - (let (line point) - (when (setq point (search "spad{X}" docstring)) - (setq line (subseq docstring (+ point 8))) - (do ((mark (search "spad{X}" line) (search "spad{X}" line))) - ((null mark)) - (princ (cleanupLine (subseq line 0 mark))) - (|sayNewLine|) - (setq line (subseq line (+ mark 8)))) - (princ (cleanupLine line)) - (|sayNewLine|) - (|sayNewLine|)))) - -\end{chunk} - -\defun{cleanupLine}{cleanupLine} -This function expects example lines in internal format that has been -partially processed to remove the prefix. Thus we get lines that look -like: -\begin{verbatim} - fp:=(t:DFLOAT):DFLOAT +-> sin(\\spad{t}) - plot(\\spad{fp},{}\\spad{-1}.0..1.0)\\$PLOT -\end{verbatim} - -It removes all instances of \verb|{}|, and \verb|\|, and unwraps the -\verb|spad{}| call, leaving only the argument. - -We return lines that look like: -\begin{verbatim} - fp:=(t:DFLOAT):DFLOAT +-> sin(t) - plot(fp,-1.0..1.0)$PLOT -\end{verbatim} -which is hopefully exactly what the user wrote. - -The compiler inserts \verb|{}| as a space so we remove it. -We remove all of the \verb|\| characters. -We remove all of the \verb|spad{...}| delimiters which will -occur around other spad variables. Technically we should -search recursively for the matching delimiter rather than the -next brace but the problem does not arise in practice. -\begin{chunk}{defun cleanupLine 0} -(defun cleanupLine (line) - (do ((mark (search "{}" line) (search "{}" line))) - ((null mark)) - (setq line - (concatenate 'string (subseq line 0 mark) (subseq line (+ mark 2))))) - (do ((mark (search "\\" line) (search "\\" line))) - ((null mark)) - (setq line - (concatenate 'string (subseq line 0 mark) (subseq line (+ mark 1))))) - (do ((mark (search "spad{" line) (search "spad{" line))) - ((null mark)) - (let (left point mid right) - (setq left (subseq line 0 mark)) - (setq point (search "}" line :start2 mark)) - (setq mid (subseq line (+ mark 5) point)) - (setq right (subseq line (+ point 1))) - (setq line (concatenate 'string left mid right)))) - line) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{edit} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{edit.help} -==================================================================== -A.9. )edit -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )edit [filename] - -Command Description: - -This command is used to edit files. It works in conjunction with the )read -and )compile commands to remember the name of the file on which you are -working. By specifying the name fully, you can edit any file you wish. Thus - -)edit /u/julius/matrix.input - -will place you in an editor looking at the file /u/julius/matrix.input. By -default, the editor is vi, but if you have an EDITOR shell environment -variable defined, that editor will be used. When AXIOM is running under the X -Window System, it will try to open a separate xterm running your editor if it -thinks one is necessary. For example, under the Korn shell, if you issue - -export EDITOR=emacs - -then the emacs editor will be used by )edit. - -If you do not specify a file name, the last file you edited, read or compiled -will be used. If there is no ``last file'' you will be placed in the editor -editing an empty unnamed file. - -It is possible to use the )system command to edit a file directly. For -example, - -)system emacs /etc/rc.tcpip - -calls emacs to edit the file. - -Also See: -o )system -o )compile -o )read - -\end{chunk} -\footnote{ -\fnref{system} -\fnref{read}} - -\defun{edit}{edit} -\calls{edit}{editSpad2Cmd} -\begin{chunk}{defun edit} -(defun |edit| (l) (|editSpad2Cmd| l)) - -\end{chunk} - -\defun{editSpad2Cmd}{editSpad2Cmd} -\calls{editSpad2Cmd}{pathname} -\calls{editSpad2Cmd}{pathnameDirectory} -\calls{editSpad2Cmd}{pathnameType} -\callsdollar{editSpad2Cmd}{FINDFILE} -\calls{editSpad2Cmd}{pathnameName} -\calls{editSpad2Cmd}{editFile} -\calls{editSpad2Cmd}{updateSourceFiles} -\uses{editSpad2Cmd}{/editfile} -\begin{chunk}{defun editSpad2Cmd} -(defun |editSpad2Cmd| (l) - (let (olddir filetypes ll rc) - (declare (special /editfile)) - (setq l (cond ((null l) /editfile) (t (car l)))) - (setq l (|pathname| l)) - (setq olddir (|pathnameDirectory| l)) - (setq filetypes - (cond - ((|pathnameType| l) (list (|pathnameType| l))) - ((eq |$UserLevel| '|interpreter|) '("input" "INPUT" "spad" "SPAD")) - ((eq |$UserLevel| '|compiler|) '("input" "INPUT" "spad" "SPAD")) - (t '("input" "INPUT" "spad" "SPAD" "boot" "BOOT" - "lisp" "LISP" "meta" "META")))) - (setq ll - (cond - ((string= olddir "") - (|pathname| ($findfile (|pathnameName| l) filetypes))) - (t l))) - (setq l (|pathname| ll)) - (setq /editfile l) - (setq rc (|editFile| l)) - (|updateSourceFiles| l) - rc)) - -\end{chunk} - -\defun{editFile}{Implement the )edit command} -\calls{editFile}{strconc} -\calls{editFile}{namestring} -\calls{editFile}{pathname} -\calls{editFile}{obey} -\begin{chunk}{defun editFile} -(defun |editFile| (file) - (cond - ((member (intern "WIN32" (find-package 'keyword)) *features*) - (obey (strconc "notepad " (|namestring| (|pathname| file))))) - (t - (obey - (strconc "$AXIOM/lib/SPADEDIT " (|namestring| (|pathname| file))))))) - -\end{chunk} - -\subsubsection{The SPADEDIT command} -Axiom execute a shell script called SPADEDIT to open a file using -the user's chosen editor. That editor name is, by convention, in -the EDITOR shell variable. If that variable is not set we default -to the 'vi' editor. -\begin{chunk}{spadedit} -#!/bin/sh -# this script is invoked by the spad )edit command -# can be replaced by users favorite editor -# optional second argument should be character offset in file - -thefile=$1 -if [ ! -f $1 ] ; then - thefile=$AXIOM/../../src/algebra/$1 -else - thefile=$1 -fi - - -if [ $# = 2 ] ; then - START=`grep -n \^$2\( $thefile | awk -F: '{print $1}'` -else - START=1 -fi - -if [ ! "$EDITOR" ] ; then - EDITOR=vi -fi - -if [ "$DISPLAY" ] ; then - if [ "$EDITOR" = "emacs" ] ; then - emacs +$START $thefile & - elif [ "$EDITOR" = "vi" ] ; then - xterm -e vi +$START $thefile & - else - xterm -e $EDITOR $thefile & - fi -else - $EDITOR $thefile -fi -\end{chunk} - -\defun{updateSourceFiles}{updateSourceFiles} -\calls{updateSourceFiles}{pathname} -\calls{updateSourceFiles}{pathnameName} -\calls{updateSourceFiles}{pathnameType} -\calls{updateSourceFiles}{makeInputFilename} -\calls{updateSourceFiles}{member} -\calls{updateSourceFiles}{pathnameTypeId} -\calls{updateSourceFiles}{insert} -\usesdollar{updateSourceFiles}{sourceFiles} -\begin{chunk}{defun updateSourceFiles} -(defun |updateSourceFiles| (arg) - (declare (special |$sourceFiles|)) - (setq arg (|pathname| arg)) - (setq arg (|pathname| (list (|pathnameName| arg) (|pathnameType| arg) "*"))) - (when (and (makeInputFilename arg) - (|member| (|pathnameTypeId| arg) '(boot lisp meta))) - (setq |$sourceFiles| (|insert| arg |$sourceFiles|))) - arg) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{fin} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{fin.help} -==================================================================== -A.10. )fin -==================================================================== - -User Level Required: development - -Command Syntax: - - - )fin - -Command Description: - -This command is used by AXIOM developers to leave the AXIOM system and return -to the underlying Lisp system. To return to AXIOM, issue the ``(spad)'' -function call to Lisp. - -Also See: -o )pquit -o )quit - -\end{chunk} -\footnote{ -\fnref{pquit} -\fnref{quit}} - -\defun{fin}{Exit from the interpreter to lisp} -\throws{fin}{spad-reader} -\uses{fin}{eof} -\begin{chunk}{defun fin 0} -(defun |fin| () - (setq *eof* t) - (throw 'spad_reader nil)) - -\end{chunk} - -This command is in the list of \verb|$noParseCommands| -\ref{noParseCommands} which means that its arguments are passed -verbatim. This will eventually result in a call to the function -\verb|handleNoParseCommands| \ref{handleNoParseCommands} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{frame} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{frame.help} -==================================================================== -A.11. )frame -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )frame new frameName - - )frame drop [frameName] - - )frame next - - )frame last - - )frame names - - )frame import frameName [objectName1 [objectName2 ...] ] - - )set message frame on | off - - )set message prompt frame - -Command Description: - -A frame can be thought of as a logical session within the physical session -that you get when you start the system. You can have as many frames as you -want, within the limits of your computer's storage, paging space, and so on. -Each frame has its own step number, environment and history. You can have a -variable named a in one frame and it will have nothing to do with anything -that might be called a in any other frame. - -Some frames are created by the HyperDoc program and these can have pretty -strange names, since they are generated automatically. To find out the names -of all frames, issue - -)frame names - -It will indicate the name of the current frame. - -You create a new frame ``quark'' by issuing - -)frame new quark - -The history facility can be turned on by issuing either )set history on or -)history )on. If the history facility is on and you are saving history -information in a file rather than in the AXIOM environment then a history -file with filename quark.axh will be created as you enter commands. If you -wish to go back to what you were doing in the ``initial'' frame, use - -)frame next - -or - -)frame last - -to cycle through the ring of available frames to get back to ``initial''. - -If you want to throw away a frame (say ``quark''), issue - -)frame drop quark - -If you omit the name, the current frame is dropped. - -If you do use frames with the history facility on and writing to a file, you -may want to delete some of the older history files. These are directories, so -you may want to issue a command like rm -r quark.axh to the operating system. - -You can bring things from another frame by using )frame import. For example, -to bring the f and g from the frame ``quark'' to the current frame, issue - -)frame import quark f g - -If you want everything from the frame ``quark'', issue - -)frame import quark - -You will be asked to verify that you really want everything. - -There are two )set flags to make it easier to tell where you are. - -)set message frame on | off - -will print more messages about frames when it is set on. By default, it is -off. - -)set message prompt frame - -will give a prompt that looks like - -initial (1) -> - -when you start up. In this case, the frame name and step make up the prompt. - -Also See: -o )history -o )set - -\end{chunk} -\footnote{ -\fnref{history} -\fnref{set}} - -The frame mechanism uses several dollar variables. - -Primary variables are those which exist solely to make the frame -mechanism work. - -The \$interpreterFrameName contains a symbol which is the name -of the current frame in use. - -The \$interpreterFrameRing contains a list of all of the existing -frames. The first frame on the list is the ``current'' frame. When -AXIOMsys is started directly there is only one frame named ``initial''. - -If the system is started under sman (using the axiom shell script, -for example), there are two frames, ``initial'' and ``frame0''. In -this case, ``frame0'' is the current frame. This can cause subtle -problems because functions defined in the axiom initialization file -(.axiom.input) will be defined in frame ``initial'' but the current -frame will be ``frame0''. They will appear to be undefined. However, -if the user does ``)frame next'' they can switch to the ``initial'' -frame and see the functions correctly defined. - -The \$frameMessages variable controls when frame messages will be -displayed. The variable is initially NIL. It can be set on (T) or off (NIL) -using the system command: -\begin{verbatim} - )set message frame on | off -\end{verbatim} -Setting frame messages on will output a line detailing the -current frame after every output is complete. - -The frame collects and uses a few top level variables. These are: -\$InteractiveFrame, \$IOindex, \$HiFiAccess, \$HistList, \$HistListLen, -\$HistListAct, \$HistRecord, \$internalHistoryTable, and \$localExposureData. - -These variables can also be changed by the frame mechanism when the user -requests changing to a different frame. - -\section{Data Structures} -\subsection{Frames and the Interpreter Frame Ring} -\label{TheFrameMechanism} - -Axiom has the notion of ``frames''. A frame is a data structure which -holds all the vital data from an Axiom session. There can be multiple -frames and these live in a top-level variable called -\$interpreterFrameRing. This variable holds a circular list of frames. -The parts of a frame and their initial, default values are: - -\begin{verbatim} - $interpreterFrameName a string, named on creation - $InteractiveFrame (list (list nil)) - $IOindex an integer, 1 - $HiFiAccess $HiFiAccess, see the variable description - $HistList $HistList, see the variable description - $HistListLen $HistListLen, see the variable description - $HistListAct $HistListAct, see the variable description - $HistRecord $HistRecord, see the variable description - $internalHistoryTable nil - $localExposureData a copy of $localExposureData -\end{verbatim} - -\subsection{Accessor Functions} -These could be macros but we wish to export them to the API code -in the algebra so we keep them as functions. - -0th Frame Component -- frameName -\defmacro{frameName} -\begin{chunk}{defmacro frameName 0} -(defmacro frameName (frame) - `(car ,frame)) - -\end{chunk} - -1st Frame Component -- frameInteractive -\defmacro{frameInteractive} -\begin{chunk}{defmacro frameInteractive 0} -(defmacro frameInteractive (frame) - `(nth 1 ,frame)) - -\end{chunk} - -2nd Frame Component -- frameIOIndex -\defmacro{frameIOIndex} -\begin{chunk}{defmacro frameIOIndex 0} -(defmacro frameIOIndex (frame) - `(nth 2 ,frame)) - -\end{chunk} - -3rd Frame Component -- frameHiFiAccess -\defmacro{frameHiFiAccess} -\begin{chunk}{defmacro frameHiFiAccess 0} -(defmacro frameHiFiAccess (frame) - `(nth 3 ,frame)) - -\end{chunk} - -4th Frame Component -- frameHistList -\defmacro{frameHistList} -\begin{chunk}{defmacro frameHistList 0} -(defmacro frameHistList (frame) - `(nth 4 ,frame)) - -\end{chunk} - -5th Frame Component -- frameHistListLen -\defmacro{frameHistListLen} -\begin{chunk}{defmacro frameHistListLen 0} -(defmacro frameHistListLen (frame) - `(nth 5 ,frame)) - -\end{chunk} - -6th Frame Component -- frameHistListAct -\defmacro{frameHistListAct} -\begin{chunk}{defmacro frameHistListAct 0} -(defmacro frameHistListAct (frame) - `(nth 6 ,frame)) - -\end{chunk} - -7th Frame Component -- frameHistRecord -\defmacro{frameHistRecord} -\begin{chunk}{defmacro frameHistRecord 0} -(defmacro frameHistRecord (frame) - `(nth 7 ,frame)) - -\end{chunk} - -8th Frame Component -- frameHistoryTable -\defmacro{frameHistoryTable} -\begin{chunk}{defmacro frameHistoryTable 0} -(defmacro frameHistoryTable (frame) - `(nth 8 ,frame)) - -\end{chunk} - -9th Frame Component -- frameExposureData -\defmacro{frameExposureData} -\begin{chunk}{defmacro frameExposureData 0} -(defmacro frameExposureData (frame) - `(nth 9 ,frame)) - -\end{chunk} - -\section{Functions} -\defunsec{initializeInterpreterFrameRing} -{Initializing the Interpreter Frame Ring} - -Now that we know what a frame looks like we need a function to -initialize the list of frames. This function sets the initial frame -name to ``initial'' and creates a list of frames containing an empty -frame. This list is the interpreter frame ring and is not actually -circular but is managed as a circular list. - -As a final step we update the world from this frame. This has the -side-effect of resetting all the important global variables to their -initial values. - -\calls{initializeInterpreterFrameRing}{emptyInterpreterFrame} -\calls{initializeInterpreterFrameRing}{updateFromCurrentInterpreterFrame} -\usesdollar{initializeInterpreterFrameRing}{interpreterFrameName} -\usesdollar{initializeInterpreterFrameRing}{interpreterFrameRing} -\begin{chunk}{defun initializeInterpreterFrameRing} -(defun |initializeInterpreterFrameRing| () - "Initializing the Interpreter Frame Ring" - (declare (special |$interpreterFrameName| |$interpreterFrameRing|)) - (setq |$interpreterFrameName| '|initial|) - (setq |$interpreterFrameRing| - (list (|emptyInterpreterFrame| |$interpreterFrameName|))) - (|updateFromCurrentInterpreterFrame|) - nil) - -\end{chunk} -\defunsec{frameNames}{Creating a List of all of the Frame Names} -This function simply walks across the frame in the frame ring and -returns a list of the name of each frame. -\usesdollar{frameNames}{interpreterFrameRing} -\begin{chunk}{defun frameNames 0} -(defun |frameNames| () - "Creating a List of all of the Frame Names" - (declare (special |$interpreterFrameRing|)) - (mapcar #'frameName |$interpreterFrameRing|)) - -\end{chunk} - -\defunsec{frameEnvironment}{Get Named Frame Environment (aka Interactive)} -If the frame is found we return the environment portion of the frame -otherwise we construct an empty environment and return it. -The initial values of an empty frame are created here. This function -returns a single frame that will be placed in the frame ring. - -\calls{frameEnvironment}{frameInteractive} -\begin{chunk}{defun frameEnvironment} -(defun |frameEnvironment| (fname) - "Get Named Frame Environment (aka Interactive)" - (let ((frame (|findFrameInRing| fname))) - (if frame - (frameInteractive frame) - (list (list nil))))) - -\end{chunk} -\defunsec{emptyInterpreterFrame}{Create a new, empty Interpreter Frame} -\usesdollar{emptyInterpreterFrame}{HiFiAccess} -\usesdollar{emptyInterpreterFrame}{HistList} -\usesdollar{emptyInterpreterFrame}{HistListLen} -\usesdollar{emptyInterpreterFrame}{HistListAct} -\usesdollar{emptyInterpreterFrame}{HistRecord} -\usesdollar{emptyInterpreterFrame}{localExposureDataDefault} -\begin{chunk}{defun emptyInterpreterFrame 0} -(defun |emptyInterpreterFrame| (name) - "Create a new, empty Interpreter Frame" - (declare (special |$HiFiAccess| |$HistList| |$HistListLen| |$HistListAct| - |$HistRecord| |$localExposureDataDefault|)) - (list name ; frame name - (list (list nil)) ; environment - 1 ; $IOindex - |$HiFiAccess| - |$HistList| - |$HistListLen| - |$HistListAct| - |$HistRecord| - nil ; $internalHistoryTable - (copy-seq |$localExposureDataDefault|))) ; $localExposureData - -\end{chunk} -\defunsec{createCurrentInterpreterFrame} -{Collecting up the Environment into a Frame} - -We can collect up all the current environment information into -one frame element with this call. It creates a list of the current -values of the global variables and returns this as a frame element. - -\usesdollar{createCurrentInterpreterFrame}{interpreterFrameName} -\usesdollar{createCurrentInterpreterFrame}{InteractiveFrame} -\usesdollar{createCurrentInterpreterFrame}{IOindex} -\usesdollar{createCurrentInterpreterFrame}{HiFiAccess} -\usesdollar{createCurrentInterpreterFrame}{HistList} -\usesdollar{createCurrentInterpreterFrame}{HistListLen} -\usesdollar{createCurrentInterpreterFrame}{HistListAct} -\usesdollar{createCurrentInterpreterFrame}{HistRecord} -\usesdollar{createCurrentInterpreterFrame}{internalHistoryTable} -\usesdollar{createCurrentInterpreterFrame}{localExposureData} -\begin{chunk}{defun createCurrentInterpreterFrame 0} -(defun |createCurrentInterpreterFrame| () - "Collecting up the Environment into a Frame" - (declare (special |$interpreterFrameName| |$InteractiveFrame| |$IOindex| - |$HiFiAccess| |$HistList| |$HistListLen| |$HistListAct| |$HistRecord| - |$internalHistoryTable| |$localExposureData|)) - (list - |$interpreterFrameName| - |$InteractiveFrame| - |$IOindex| - |$HiFiAccess| - |$HistList| - |$HistListLen| - |$HistListAct| - |$HistRecord| - |$internalHistoryTable| - |$localExposureData|)) - -\end{chunk} - -\defunsec{updateFromCurrentInterpreterFrame}{Update from the Current Frame} -The frames are kept on a circular list. The first element on that -list is known as ``the current frame''. This will initialize all -of the interesting interpreter data structures from that frame. -\calls{updateFromCurrentInterpreterFrame}{sayMessage} -\usesdollar{updateFromCurrentInterpreterFrame}{interpreterFrameRing} -\usesdollar{updateFromCurrentInterpreterFrame}{interpreterFrameName} -\usesdollar{updateFromCurrentInterpreterFrame}{InteractiveFrame} -\usesdollar{updateFromCurrentInterpreterFrame}{IOindex} -\usesdollar{updateFromCurrentInterpreterFrame}{HiFiAccess} -\usesdollar{updateFromCurrentInterpreterFrame}{HistList} -\usesdollar{updateFromCurrentInterpreterFrame}{HistListLen} -\usesdollar{updateFromCurrentInterpreterFrame}{HistListAct} -\usesdollar{updateFromCurrentInterpreterFrame}{HistRecord} -\usesdollar{updateFromCurrentInterpreterFrame}{internalHistoryTable} -\usesdollar{updateFromCurrentInterpreterFrame}{localExposureData} -\usesdollar{updateFromCurrentInterpreterFrame}{frameMessages} -\begin{chunk}{defun updateFromCurrentInterpreterFrame} -(defun |updateFromCurrentInterpreterFrame| () - "Update from the Current Frame" - (let (tmp1) - (declare (special |$interpreterFrameRing| |$interpreterFrameName| - |$InteractiveFrame| |$IOindex| |$HiFiAccess| |$HistList| |$HistListLen| - |$HistListAct| |$HistRecord| |$internalHistoryTable| |$localExposureData| - |$frameMessages|)) - (setq tmp1 (first |$interpreterFrameRing|)) - (setq |$interpreterFrameName| (nth 0 tmp1)) - (setq |$InteractiveFrame| (nth 1 tmp1)) - (setq |$IOindex| (nth 2 tmp1)) - (setq |$HiFiAccess| (nth 3 tmp1)) - (setq |$HistList| (nth 4 tmp1)) - (setq |$HistListLen| (nth 5 tmp1)) - (setq |$HistListAct| (nth 6 tmp1)) - (setq |$HistRecord| (nth 7 tmp1)) - (setq |$internalHistoryTable| (nth 8 tmp1)) - (setq |$localExposureData| (nth 9 tmp1)) - (when |$frameMessages| - (|sayMessage| - `(" Current interpreter frame is called" - ,#(|bright| |$interpreterFrameName|)))))) - -\end{chunk} -\defunsec{findFrameInRing}{Find a Frame in the Frame Ring by Name} -Each frame contains its name as the 0th element. We simply walk all -the frames and if we find one we return it. -\calls{findFrameInRing}{boot-equal} -\calls{findFrameInRing}{frameName} -\usesdollar{findFrameInRing}{interpreterFrameRing} -\begin{chunk}{defun findFrameInRing 0} -(defun |findFrameInRing| (name) - "Find a Frame in the Frame Ring by Name" - (let (result) - (declare (special |$interpreterFrameRing|)) - (dolist (frame |$interpreterFrameRing|) - (when (boot-equal (frameName frame) name) - (setq result frame))) - result)) - -\end{chunk} - -\defunsec{updateCurrentInterpreterFrame}{Update the Current Interpreter Frame} -This function collects the normal contents of the world into a -frame object, places it first on the frame list, and then sets -the current values of the world from the frame object. - -\calls{updateCurrentInterpreterFrame}{createCurrentInterpreterFrame} -\calls{updateCurrentInterpreterFrame}{updateFromCurrentInterpreterFrame} -\usesdollar{updateCurrentInterpreterFrame}{interpreterFrameRing} -\begin{chunk}{defun updateCurrentInterpreterFrame} -(defun |updateCurrentInterpreterFrame| () - "Update the Current Interpreter Frame" - (declare (special |$interpreterFrameRing|)) - (rplaca |$interpreterFrameRing| (|createCurrentInterpreterFrame|)) - (|updateFromCurrentInterpreterFrame|)) - -\end{chunk} -\defunsec{nextInterpreterFrame}{Move to the next Interpreter Frame in Ring} -This function updates the current frame to make sure all of the -current information is recorded. If there are more frame elements -in the list then this will destructively move the current frame -to the end of the list, that is, assume the frame list reads (1 2 3) -this function will destructively change it to (2 3 1). - -\calls{nextInterpreterFrame}{updateFromCurrentInterpreterFrame} -\usesdollar{nextInterpreterFrame}{interpreterFrameRing} -\begin{chunk}{defun nextInterpreterFrame} -(defun |nextInterpreterFrame| () - "Move to the next Interpreter Frame in Ring" - (declare (special |$interpreterFrameRing|)) - (when (cdr |$interpreterFrameRing|) - (setq |$interpreterFrameRing| - (nconc (cdr |$interpreterFrameRing|) (list (car |$interpreterFrameRing|)))) - (|updateFromCurrentInterpreterFrame|))) - -\end{chunk} -\defunsec{changeToNamedInterpreterFrame}{Change to the Named Interpreter Frame} -\calls{changeToNamedInterpreterFrame}{updateCurrentInterpreterFrame} -\calls{changeToNamedInterpreterFrame}{findFrameInRing} -\calls{changeToNamedInterpreterFrame}{nremove} -\calls{changeToNamedInterpreterFrame}{updateFromCurrentInterpreterFrame} -\usesdollar{changeToNamedInterpreterFrame}{interpreterFrameRing} -\begin{chunk}{defun changeToNamedInterpreterFrame} -(defun |changeToNamedInterpreterFrame| (name) - "Change to the Named Interpreter Frame" - (let (frame) - (declare (special |$interpreterFrameRing|)) - (|updateCurrentInterpreterFrame|) - (setq frame (|findFrameInRing| name)) - (when frame - (setq |$interpreterFrameRing| - (cons frame (nremove |$interpreterFrameRing| frame))) - (|updateFromCurrentInterpreterFrame|)))) - -\end{chunk} -\defunsec{previousInterpreterFrame} -{Move to the previous Interpreter Frame in Ring} -\calls{previousInterpreterFrame}{updateCurrentInterpreterFrame} -\calls{previousInterpreterFrame}{updateFromCurrentInterpreterFrame} -\usesdollar{previousInterpreterFrame}{interpreterFrameRing} -\begin{chunk}{defun previousInterpreterFrame} -(defun |previousInterpreterFrame| () - "Move to the previous Interpreter Frame in Ring" - (let (tmp1 l b) - (declare (special |$interpreterFrameRing|)) - (|updateCurrentInterpreterFrame|) - (when (cdr |$interpreterFrameRing|) - (setq tmp1 (reverse |$interpreterFrameRing|)) - (setq l (car tmp1)) - (setq b (nreverse (cdr tmp1))) - (setq |$interpreterFrameRing| (nconc (cons l nil) b)) - (|updateFromCurrentInterpreterFrame|)))) - -\end{chunk} -\defunsec{addNewInterpreterFrame}{Add a New Interpreter Frame} -\calls{addNewInterpreterFrame}{boot-equal} -\calls{addNewInterpreterFrame}{framename} -\calls{addNewInterpreterFrame}{throwKeyedMsg} -\calls{addNewInterpreterFrame}{updateCurrentInterpreterFrame} -\calls{addNewInterpreterFrame}{initHistList} -\calls{addNewInterpreterFrame}{emptyInterpreterFrame} -\calls{addNewInterpreterFrame}{updateFromCurrentInterpreterFrame} -\callsdollar{addNewInterpreterFrame}{erase} -\calls{addNewInterpreterFrame}{histFileName} -\usesdollar{addNewInterpreterFrame}{interpreterFrameRing} -\begin{chunk}{defun addNewInterpreterFrame} -(defun |addNewInterpreterFrame| (name) - "Add a New Interpreter Frame" - (declare (special |$interpreterFrameRing|)) - (if (null name) - (|throwKeyedMsg| 's2iz0018 nil) ; you must provide a name for new frame - (progn - (|updateCurrentInterpreterFrame|) - (dolist (f |$interpreterFrameRing|) - (when (boot-equal name (frameName f)) ; existing frame with same name - (|throwKeyedMsg| 's2iz0019 (list name)))) - (|initHistList|) - (setq |$interpreterFrameRing| - (cons (|emptyInterpreterFrame| name) |$interpreterFrameRing|)) - (|updateFromCurrentInterpreterFrame|) - ($erase (|histFileName|))))) - -\end{chunk} -\defunsec{closeInterpreterFrame}{Close an Interpreter Frame} -\calls{closeInterpreterFrame}{framename} -\calls{closeInterpreterFrame}{throwKeyedMsg} -\callsdollar{closeInterpreterFrame}{erase} -\calls{closeInterpreterFrame}{makeHistFileName} -\calls{closeInterpreterFrame}{updateFromCurrentInterpreterFrame} -\usesdollar{closeInterpreterFrame}{interpreterFrameRing} -\usesdollar{closeInterpreterFrame}{interpreterFrameName} -\begin{chunk}{defun closeInterpreterFrame} -(defun |closeInterpreterFrame| (name) - "Close an Interpreter Frame" - (declare (special |$interpreterFrameRing| |$interpreterFrameName|)) - (let (ifr found) - (if (null (cdr |$interpreterFrameRing|)) - (if (and name (not (equal name |$interpreterFrameName|))) - (|throwKeyedMsg| 's2iz0020 ; 1 frame left. not the correct name. - (cons |$interpreterFrameName| nil)) - (|throwKeyedMsg| 's2iz0021 nil)) ; only 1 frame left, not closed - (progn - (if (null name) - (setq |$interpreterFrameRing| (cdr |$interpreterFrameRing|)) - (progn - (setq found nil) - (setq ifr nil) - (dolist (f |$interpreterFrameRing|) - (if (or found (not (equal name (frameName f)))) - (setq ifr (cons f ifr))) - (setq found t)) - (if (null found) - (|throwKeyedMsg| 's2iz0022 (cons name nil)) - (progn - ($erase (|makeHistFileName| name)) - (setq |$interpreterFrameRing| (nreverse ifr)))))) - (|updateFromCurrentInterpreterFrame|))))) - -\end{chunk} -\defunsec{displayFrameNames}{Display the Frame Names} -\calls{displayFrameNames}{bright} -\calls{displayFrameNames}{framename} -\calls{displayFrameNames}{sayKeyedMsg} -\usesdollar{displayFrameNames}{interpreterFrameRing} -\begin{chunk}{defun displayFrameNames} -(defun |displayFrameNames| () - "Display the Frame Names" - (declare (special |$interpreterFrameRing|)) - (let (t1) - (setq t1 - (mapcar #'(lambda (f) `(|%l| " " ,@(|bright| (frameName f)))) - |$interpreterFrameRing|)) - (|sayKeyedMsg| 's2iz0024 (list (apply #'append t1))))) - -\end{chunk} -\defunsec{importFromFrame}{Import items from another frame} -\calls{importFromFrame}{member} -\calls{importFromFrame}{frameNames} -\calls{importFromFrame}{throwKeyedMsg} -\calls{importFromFrame}{boot-equal} -\calls{importFromFrame}{framename} -\calls{importFromFrame}{frameEnvironment} -\calls{importFromFrame}{upcase} -\calls{importFromFrame}{queryUserKeyedMsg} -\calls{importFromFrame}{string2id-n} -\calls{importFromFrame}{importFromFrame} -\calls{importFromFrame}{sayKeyedMsg} -\calls{importFromFrame}{clearCmdParts} -\calls{importFromFrame}{seq} -\calls{importFromFrame}{exit} -\calls{importFromFrame}{putHist} -\calls{importFromFrame}{get} -\calls{importFromFrame}{getalist} -\usesdollar{importFromFrame}{interpreterFrameRing} -\begin{chunk}{defun importFromFrame} -(defun |importFromFrame| (args) - "Import items from another frame" - (prog (temp1 fname fenv x v props vars plist prop val m) - (declare (special |$interpreterFrameRing|)) - (when (and args (atom args)) (setq args (cons args nil))) - (if (null args) - (|throwKeyedMsg| 'S2IZ0073 nil) ; missing frame name - (progn - (setq temp1 args) - (setq fname (car temp1)) - (setq args (cdr temp1)) - (cond - ((null (|member| fname (|frameNames|))) - (|throwKeyedMsg| 'S2IZ0074 (cons fname nil))) ; not frame name - ((boot-equal fname (frameName (car |$interpreterFrameRing|))) - (|throwKeyedMsg| 'S2IZ0075 NIL)) ; cannot import from curr frame - (t - (setq fenv (|frameEnvironment| fname)) - (cond - ((null args) - (setq x - (upcase (|queryUserKeyedMsg| 'S2IZ0076 (cons fname nil)))) - ; import everything? - (cond - ((member (string2id-n x 1) '(y yes)) - (setq vars nil) - (do ((tmp0 (caar fenv) (cdr tmp0)) (tmp1 nil)) - ((or (atom tmp0) - (progn (setq tmp1 (car tmp0)) nil) - (progn - (progn - (setq v (car tmp1)) - (setq props (cdr tmp1)) - tmp1) - nil)) - nil) - (cond - ((eq v '|--macros|) - (do ((tmp2 props (cdr tmp2)) - (tmp3 nil)) - ((or (atom tmp2) - (progn (setq tmp3 (car tmp2)) nil) - (progn - (progn (setq m (car tmp3)) tmp3) - nil)) - nil) - (setq vars (cons m vars)))) - (t (setq vars (cons v vars))))) - (|importFromFrame| (cons fname vars))) - (t - (|sayKeyedMsg| 'S2IZ0077 (cons fname nil))))) - (t - (do ((tmp4 args (cdr tmp4)) (v nil)) - ((or (atom tmp4) (progn (setq v (car tmp4)) nil)) nil) - (seq - (exit - (progn - (setq plist (getalist (caar fenv) v)) - (cond - (plist - (|clearCmdParts| (cons '|propert| (cons v nil))) - (do ((tmp5 plist (cdr tmp5)) (tmp6 nil)) - ((or (atom tmp5) - (progn (setq tmp6 (car tmp5)) nil) - (progn - (progn - (setq prop (car tmp6)) - (setq val (cdr tmp6)) - tmp6) - nil)) - nil) - (seq - (exit (|putHist| v prop val |$InteractiveFrame|))))) - ((setq m (|get| '|--macros--| v fenv)) - (|putHist| '|--macros--| v m |$InteractiveFrame|)) - (t - (|sayKeyedMsg| 'S2IZ0079 ; frame not found - (cons v (cons fname nil))))))))) - (|sayKeyedMsg| 'S2IZ0078 ; import complete - (cons fname nil)))))))))) - -\end{chunk} -\defunsec{frame}{The top level frame command} -\calls{frame}{frameSpad2Cmd} -\begin{chunk}{defun frame} -(defun |frame| (l) - "The top level frame command" - (|frameSpad2Cmd| l)) - -\end{chunk} -\defunsec{frameSpad2Cmd}{The top level frame command handler} -\calls{frameSpad2Cmd}{throwKeyedMsg} -\calls{frameSpad2Cmd}{helpSpad2Cmd} -\calls{frameSpad2Cmd}{selectOptionLC} -\calls{frameSpad2Cmd}{qcdr} -\calls{frameSpad2Cmd}{qcar} -\calls{frameSpad2Cmd}{object2Identifier} -\seebook{frameSpad2Cmd}{drop}{9} -\calls{frameSpad2Cmd}{closeInterpreterFrame} -\calls{frameSpad2Cmd}{import} -\calls{frameSpad2Cmd}{importFromFrame} -\calls{frameSpad2Cmd}{last} -\calls{frameSpad2Cmd}{previousInterpreterFrame} -\calls{frameSpad2Cmd}{names} -\calls{frameSpad2Cmd}{displayFrameNames} -\calls{frameSpad2Cmd}{new} -\calls{frameSpad2Cmd}{addNewInterpreterFrame} -\calls{frameSpad2Cmd}{next} -\calls{frameSpad2Cmd}{nextInterpreterFrame} -\usesdollar{frameSpad2Cmd}{options} -\begin{chunk}{defun frameSpad2Cmd} -(defun |frameSpad2Cmd| (args) - "The top level frame command handler" - (let (frameArgs arg a) - (declare (special |$options|)) - (setq frameArgs '(|drop| |import| |last| |names| |new| |next|)) - (cond - (|$options| - (|throwKeyedMsg| 'S2IZ0016 ; frame command does not take options - (cons ")frame" nil))) - ((null args) (|helpSpad2Cmd| (cons '|frame| nil))) - (t - (setq arg (|selectOptionLC| (car args) frameArgs '|optionError|)) - (setq args (cdr args)) - (when (and (consp args) - (eq (qcdr args) nil) - (progn (setq a (qcar args)) t)) - (setq args a)) - (when (atom args) (setq args (|object2Identifier| args))) - (case arg - (|drop| - (if (and args (consp args)) - (|throwKeyedMsg| 'S2IZ0017 ; not a valid frame name - (cons args nil)) - (|closeInterpreterFrame| args))) - (|import| (|importFromFrame| args)) - (|last| (|previousInterpreterFrame|)) - (|names| (|displayFrameNames|)) - (|new| - (if (and args (consp args)) - (|throwKeyedMsg| 'S2IZ0017 ; not a valid frame name - (cons args nil)) - (|addNewInterpreterFrame| args))) - (|next| (|nextInterpreterFrame|)) - (t nil)))))) - -\end{chunk} -\section{Frame File Messages} -\begin{chunk}{Frame File Messages} -S2IZ0016 - The %1b system command takes arguments but no options. -S2IZ0017 - %1b is not a valid frame name -S2IZ0018 - You must provide a name for the new frame. -S2IZ0019 - You cannot use the name %1b for a new frame because an existing - frame already has that name. -S2IZ0020 - There is only one frame active and therefore that cannot be closed. - Furthermore, the frame name you gave is not the name of the current frame. - The current frame is called %1b . -S2IZ0021 - The current frame is the only active one. Issue %b )clear all %d to - clear its contents. -S2IZ0022 - There is no frame called %1b and so your command cannot be - processed. -S2IZ0024 - The names of the existing frames are: %1 %l - The current frame is the first one listed. -S2IZ0073 - %b )frame import %d must be followed by the frame name. The names - of objects in that frame can then optionally follow the frame name. - For example, - %ceon %b )frame import calculus %d %ceoff - imports all objects in the %b calculus %d frame, and - %ceon %b )frame import calculus epsilon delta %d %ceoff - imports the objects named %b epsilon %d and %b delta %d from the - frame %b calculus %d . - Please note that if the current frame contained any information - about objects with these names, then that information would be - cleared before the import took place. -S2IZ0074 - You cannot import anything from the frame %1b because that is not - the name of an existing frame. -S2IZ0075 - You cannot import from the current frame (nor is there a need!). -S2IZ0076 - User verification required: - do you really want to import everything from the frame %1b ? - If so, please enter %b y %d or %b yes %d : -S2IZ0077 - On your request, AXIOM will not import everything from frame %1b. -S2IZ0078 - Import from frame %1b is complete. Please issue %b )display all %d - if you wish to see the contents of the current frame. -S2IZ0079 - AXIOM cannot import %1b from frame %2b because it cannot be found. -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{help} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{help.help} -==================================================================== -A.12. )help -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )help - - )help commandName - - )help syntax - -Command Description: - -This command displays help information about system commands. If you issue - -)help - -then this very text will be shown. You can also give the name or abbreviation -of a system command to display information about it. For example, - -)help clear - -will display the description of the )clear system command. - -The command - -)help syntax - -will give further information about the Axiom language syntax. - -All this material is available in the AXIOM User Guide and in HyperDoc. In -HyperDoc, choose the Commands item from the Reference menu. - -==================================================================== -A.1. Introduction -==================================================================== - - -System commands are used to perform AXIOM environment management. Among the -commands are those that display what has been defined or computed, set up -multiple logical AXIOM environments (frames), clear definitions, read files -of expressions and commands, show what functions are available, and terminate -AXIOM. - -Some commands are restricted: the commands - -)set userlevel interpreter -)set userlevel compiler -)set userlevel development - -set the user-access level to the three possible choices. All commands are -available at development level and the fewest are available at interpreter -level. The default user-level is interpreter. In addition to the )set command -(discussed in description of command )set ) you can use the HyperDoc settings -facility to change the user-level. Click on [Settings] here to immediately go -to the settings facility. - -Each command listing begins with one or more syntax pattern descriptions plus -examples of related commands. The syntax descriptions are intended to be easy -to read and do not necessarily represent the most compact way of specifying -all possible arguments and options; the descriptions may occasionally be -redundant. - -All system commands begin with a right parenthesis which should be in the -first available column of the input line (that is, immediately after the -input prompt, if any). System commands may be issued directly to AXIOM or be -included in .input files. - -A system command argument is a word that directly follows the command name -and is not followed or preceded by a right parenthesis. A system command -option follows the system command and is directly preceded by a right -parenthesis. Options may have arguments: they directly follow the option. -This example may make it easier to remember what is an option and what is an -argument: - - )syscmd arg1 arg2 )opt1 opt1arg1 opt1arg2 )opt2 opt2arg1 ... - -In the system command descriptions, optional arguments and options are -enclosed in brackets (``['' and ``]''). If an argument or option name is in -italics, it is meant to be a variable and must have some actual value -substituted for it when the system command call is made. For example, the -syntax pattern description - -)read fileName [)quietly] - -would imply that you must provide an actual file name for fileName but need -not use the )quietly option. Thus - -)read matrix.input - -is a valid instance of the above pattern. - -System command names and options may be abbreviated and may be in upper or -lower case. The case of actual arguments may be significant, depending on the -particular situation (such as in file names). System command names and -options may be abbreviated to the minimum number of starting letters so that -the name or option is unique. Thus - -)s Integer - -is not a valid abbreviation for the )set command, because both )set and )show -begin with the letter ``s''. Typically, two or three letters are sufficient -for disambiguating names. In our descriptions of the commands, we have used -no abbreviations for either command names or options. - -In some syntax descriptions we use a vertical line ``|'' to indicate that you -must specify one of the listed choices. For example, in - -)set output fortran on | off - -only on and off are acceptable words for following boot. We also sometimes -use ``...'' to indicate that additional arguments or options of the listed -form are allowed. Finally, in the syntax descriptions we may also list the -syntax of related commands. - -==================================================================== -Other help topics -==================================================================== -Available help topics are: - -abbreviations assignment blocks browse boot cd -clear clef close collection compile describe -display edit fin for frame help -history if iterate leave library lisp -load ltrace parallel pquit quit read -repeat savesystem set show spool suchthat -synonym system syntax trace undo what -while - -Available algebra help topics are: - -\end{chunk} - -\defunsec{help}{The top level help command} -\calls{help}{helpSpad2Cmd} -\begin{chunk}{defun help} -(defun |help| (l) - "The top level help command" - (|helpSpad2Cmd| l)) - -\end{chunk} - -\defunsec{helpSpad2Cmd}{The top level help command handler} -\calls{helpSpad2Cmd}{newHelpSpad2Cmd} -\calls{helpSpad2Cmd}{sayKeyedMsg} -\begin{chunk}{defun helpSpad2Cmd} -(defun |helpSpad2Cmd| (args) - "The top level help command handler" - (unless (|newHelpSpad2Cmd| args) - (|sayKeyedMsg| 's2iz0025 (cons args nil)))) - -\end{chunk} - -\defun{newHelpSpad2Cmd}{newHelpSpad2Cmd} -\calls{newHelpSpad2Cmd}{makeInputFilename} -\calls{newHelpSpad2Cmd}{obey} -\calls{newHelpSpad2Cmd}{concat} -\calls{newHelpSpad2Cmd}{namestring} -\calls{newHelpSpad2Cmd}{make-instream} -\calls{newHelpSpad2Cmd}{say} -\calls{newHelpSpad2Cmd}{abbreviation?} -\calls{newHelpSpad2Cmd}{poundsign} -\calls{newHelpSpad2Cmd}{sayKeyedMsg} -\calls{newHelpSpad2Cmd}{pname} -\calls{newHelpSpad2Cmd}{selectOptionLC} -\usesdollar{newHelpSpad2Cmd}{syscommands} -\usesdollar{newHelpSpad2Cmd}{useFullScreenHelp} -\begin{chunk}{defun newHelpSpad2Cmd} -(defun |newHelpSpad2Cmd| (args) - (let (sarg arg narg helpfile filestream line unabbrev) - (declare (special $syscommands |$useFullScreenHelp|)) - (when (null args) (setq args (list '?))) - (if (> (|#| args) 1) - (|sayKeyedMsg| 's2iz0026 nil) - (progn - (setq sarg (pname (car args))) - (cond - ((string= sarg "?") (setq args (list '|help|))) - ((string= sarg "%") (setq args (list '|history|))) - ((string= sarg "%%") (setq args (list '|history|))) - (t nil)) - (setq arg (|selectOptionLC| (car args) $syscommands nil)) - (cond ((null arg) (setq arg (car args)))) - (setq narg (pname arg)) - ; expand abbreviations to full constructor names - (when - (setq unabbrev (|abbreviation?| (intern narg))) - (setq narg (symbol-name unabbrev))) - (cond - ; if the help file does not exist, exit - ((null (setq helpfile (makeInputFilename (list narg "help")))) - nil) - ; if we expect to use full screen help, call SPADEDIT - (|$useFullScreenHelp| - (obey (concat "$AXIOM/lib/SPADEDIT " (|namestring| helpfile))) t) - ; otherwise dump the help file to the console - (t - (setq filestream (make-instream helpfile)) - (do ((line (|read-line| filestream nil) (|read-line| filestream nil))) - ((null line) (shut filestream)) - (say line)))))))) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{history} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{history.help} -==================================================================== -A.13. )history -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )history )on - - )history )off - - )history )write historyInputFileName - - )history )show [n] [both] - - )history )save savedHistoryName - - )history )restore [savedHistoryName] - - )history )reset - - )history )change n - - )history )memory - - )history )file - - % - - %%(n) - - )set history on | off - -Command Description: - -The history facility within AXIOM allows you to restore your environment to -that of another session and recall previous computational results. Additional -commands allow you to review previous input lines and to create an .input -file of the lines typed to AXIOM. - -AXIOM saves your input and output if the history facility is turned on (which -is the default). This information is saved if either of - -)set history on -)history )on - -has been issued. Issuing either - -)set history off -)history )off - -will discontinue the recording of information. - -Whether the facility is disabled or not, the value of % in AXIOM always -refers to the result of the last computation. If you have not yet entered -anything, % evaluates to an object of type Variable('%). The function %% may -be used to refer to other previous results if the history facility is -enabled. In that case, %%(n) is the output from step n if n > 0. If n < 0, -the step is computed relative to the current step. Thus %%(-1) is also the -previous step, %%(-2), is the step before that, and so on. If an invalid step -number is given, AXIOM will signal an error. - -The environment information can either be saved in a file or entirely in -memory (the default). Each frame ( description of command )frame ) has its -own history database. When it is kept in a file, some of it may also be kept -in memory for efficiency. When the information is saved in a file, the name -of the file is of the form FRAME.axh where ``FRAME'' is the name of the -current frame. The history file is placed in the current working directory -(see description of command )cd ). Note that these history database files are -not text files (in fact, they are directories themselves), and so are not in -human-readable format. - -The options to the )history command are as follows: - - )change n - will set the number of steps that are saved in memory to n. This option - only has effect when the history data is maintained in a file. If you - have issued )history )memory (or not changed the default) there is no - need to use )history )change. - - )on - will start the recording of information. If the workspace is not empty, - you will be asked to confirm this request. If you do so, the workspace - will be cleared and history data will begin being saved. You can also - turn the facility on by issuing )set history on. - - )off - will stop the recording of information. The )history )show command will - not work after issuing this command. Note that this command may be issued - to save time, as there is some performance penalty paid for saving the - environment data. You can also turn the facility off by issuing )set - history off. - - )file - indicates that history data should be saved in an external file on disk. - - )memory - indicates that all history data should be kept in memory rather than - saved in a file. Note that if you are computing with very large objects - it may not be practical to kept this data in memory. - - )reset - will flush the internal list of the most recent workspace calculations so - that the data structures may be garbage collected by the underlying Lisp - system. Like )history )change, this option only has real effect when - history data is being saved in a file. - - )restore [savedHistoryName] - completely clears the environment and restores it to a saved session, if - possible. The )save option below allows you to save a session to a file - with a given name. If you had issued )history )save jacobi the command - )history )restore jacobi would clear the current workspace and load the - contents of the named saved session. If no saved session name is - specified, the system looks for a file called last.axh. - - )save savedHistoryName - is used to save a snapshot of the environment in a file. This file is - placed in the current working directory (see description of command )cd - ). Use )history )restore to restore the environment to the state - preserved in the file. This option also creates an input file containing - all the lines of input since you created the workspace frame (for - example, by starting your AXIOM session) or last did a )clear all or - )clear completely. - - )show [n] [both] - can show previous input lines and output results. )show will display up - to twenty of the last input lines (fewer if you haven't typed in twenty - lines). )show n will display up to n of the last input lines. )show both - will display up to five of the last input lines and output results. )show - n both will display up to n of the last input lines and output results. - - )write historyInputFile - creates an .input file with the input lines typed since the start of the - session/frame or the last )clear all or )clear completely. If - historyInputFileName does not contain a period (``.'') in the filename, - .input is appended to it. For example, )history )write chaos and )history - )write chaos.input both write the input lines to a file called - chaos.input in your current working directory. If you issued one or more - )undo commands, )history )write eliminates all input lines backtracked - over as a result of )undo. You can edit this file and then use )read to - have AXIOM process the contents. - -Also See: -o )frame -o )read -o )set -o )undo - -\end{chunk} -\footnote{ -\fnref{frame} -\fnref{read} -\fnref{set} -\fnref{undo}} - -History recording is done in two different ways: -\begin{itemize} -\item all changes in variable bindings (i.e. previous values) are -written to \verb|$HistList|, which is a circular list -\item all new bindings (including the binding to \verb|%|) are written to a -file called histFileName() -one older session is accessible via the file \verb|$oldHistFileName()| -\end{itemize} - -\section{Initialized history variables} -The following global variables are used: -\begin{list}{} -\item \verb|$HistList|, \verb|$HistListLen| and \verb|$HistListAct| - which is the actual number of ``undoable'' steps) -\item \verb|$HistRecord| collects the input line, all variable bindings - and the output of a step, before it is written to the file - histFileName(). -\item \verb|$HiFiAccess| is a flag, which is reset by )history )off -\end{list} - -The result of step n can be accessed by \verb|%n|, which is translated -into a call of fetchOutput(n). The updateHist is called after every -interpreter step. The putHist function records all changes in the -environment to \verb|$HistList| and \verb|$HistRecord|. - -\defdollar{oldHistoryFileName} -\begin{chunk}{initvars} -(defvar |$oldHistoryFileName| '|last| "vm/370 filename name component") - -\end{chunk} -\defdollar{historyFileType} -\begin{chunk}{initvars} -(defvar |$historyFileType| '|axh| "vm/370 filename type component") - -\end{chunk} -\defdollar{historyDirectory} -\begin{chunk}{initvars} -(defvar |$historyDirectory| 'A "vm/370 filename disk component") - -\end{chunk} -\defdollar{useInternalHistoryTable} -\begin{chunk}{initvars} -(defvar |$useInternalHistoryTable| t "t means keep history in core") - -\end{chunk} - -\defun{makeHistFileName}{makeHistFileName} -\calls{makeHistFileName}{makePathname} -\begin{chunk}{defun makeHistFileName} -(defun |makeHistFileName| (fname) - (|makePathname| fname |$historyFileType| |$historyDirectory|)) - -\end{chunk} -\defun{oldHistFileName}{oldHistFileName} -\calls{oldHistFileName}{makeHistFileName} -\usesdollar{oldHistFileName}{oldHistoryFileName} -\begin{chunk}{defun oldHistFileName} -(defun |oldHistFileName| () - (declare (special |$oldHistoryFileName|)) - (|makeHistFileName| |$oldHistoryFileName|)) - -\end{chunk} -\defun{histFileName}{histFileName} -\calls{histFileName}{makeHistFileName} -\usesdollar{histFileName}{interpreterFrameName} -\begin{chunk}{defun histFileName} -(defun |histFileName| () - (declare (special |$interpreterFrameName|)) - (|makeHistFileName| |$interpreterFrameName|)) - -\end{chunk} -\defun{histInputFileName}{histInputFileName} -\calls{histInputFileName}{makePathname} -\usesdollar{histInputFileName}{interpreterFrameName} -\usesdollar{histInputFileName}{historyDirectory} -\begin{chunk}{defun histInputFileName} -(defun |histInputFileName| (fn) - (declare (special |$interpreterFrameName| |$historyDirectory|)) - (if (null fn) - (|makePathname| |$interpreterFrameName| 'input |$historyDirectory|) - (|makePathname| fn 'input |$historyDirectory|))) - -\end{chunk} - -\defun{initHist}{initHist} -\calls{initHist}{initHistList} -\calls{initHist}{oldHistFileName} -\calls{initHist}{histFileName} -\calls{initHist}{histFileErase} -\calls{initHist}{makeInputFilename} -\callsdollar{initHist}{replace} -\usesdollar{initHist}{useInternalHistoryTable} -\usesdollar{initHist}{HiFiAccess} -\begin{chunk}{defun initHist} -(defun |initHist| () - (let (oldFile newFile) - (declare (special |$useInternalHistoryTable| |$HiFiAccess|)) - (if |$useInternalHistoryTable| - (|initHistList|) - (progn - (setq oldFile (|oldHistFileName|)) - (setq newFile (|histFileName|)) - (|histFileErase| oldFile) - (when (makeInputFilename newFile) (replaceFile oldFile newFile)) - (setq |$HiFiAccess| t) - (|initHistList|))))) - -\end{chunk} -\defun{initHistList}{initHistList} -\usesdollar{initHistList}{HistListLen} -\usesdollar{initHistList}{HistList} -\usesdollar{initHistList}{HistListAct} -\usesdollar{initHistList}{HistRecord} -\begin{chunk}{defun initHistList} -(defun |initHistList| () - (let (li) - (declare (special |$HistListLen| |$HistList| |$HistListAct| |$HistRecord|)) - (setq |$HistListLen| 20) - (setq |$HistList| (list nil)) - (setq li |$HistList|) - (do ((i 1 (1+ i))) - ((> i |$HistListLen|) nil) - (setq li (cons nil li))) - (rplacd |$HistList| li) - (setq |$HistListAct| 0) - (setq |$HistRecord| nil))) - -\end{chunk} -\defunsec{history}{The top level history command} -\calls{history}{sayKeyedMsg} -\calls{history}{historySpad2Cmd} -\usesdollar{history}{options} -\begin{chunk}{defun history} -(defun |history| (l) - "The top level history command" - (declare (special |$options|)) - (if (or l (null |$options|)) - (|sayKeyedMsg| 's2ih0006 nil) ; syntax error - (|historySpad2Cmd|))) - -\end{chunk} -\defunsec{historySpad2Cmd}{The top level history command handler} -\calls{historySpad2Cmd}{selectOptionLC} -\calls{historySpad2Cmd}{member} -\calls{historySpad2Cmd}{sayKeyedMsg} -\calls{historySpad2Cmd}{initHistList} -\calls{historySpad2Cmd}{upcase} -\calls{historySpad2Cmd}{queryUserKeyedMsg} -\calls{historySpad2Cmd}{string2id-n} -\calls{historySpad2Cmd}{histFileErase} -\calls{historySpad2Cmd}{histFileName} -\calls{historySpad2Cmd}{clearSpad2Cmd} -\calls{historySpad2Cmd}{disableHist} -\calls{historySpad2Cmd}{setHistoryCore} -\calls{historySpad2Cmd}{resetInCoreHist} -\calls{historySpad2Cmd}{saveHistory} -\calls{historySpad2Cmd}{showHistory} -\calls{historySpad2Cmd}{changeHistListLen} -\calls{historySpad2Cmd}{restoreHistory} -\calls{historySpad2Cmd}{writeInputLines} -\calls{historySpad2Cmd}{seq} -\calls{historySpad2Cmd}{exit} -\usesdollar{historySpad2Cmd}{options} -\usesdollar{historySpad2Cmd}{HiFiAccess} -\usesdollar{historySpad2Cmd}{IOindex} -\begin{chunk}{defun historySpad2Cmd} -(defun |historySpad2Cmd| () - "The top level history command handler" - (let (histOptions opts opt optargs x) - (declare (special |$options| |$HiFiAccess| |$IOindex|)) - (setq histOptions - '(|on| |off| |yes| |no| |change| |reset| |restore| |write| - |save| |show| |file| |memory|)) - (setq opts - (prog (tmp1) - (setq tmp1 nil) - (return - (do ((tmp2 |$options| (cdr tmp2)) (tmp3 nil)) - ((or (atom tmp2) - (progn - (setq tmp3 (car tmp2)) - nil) - (progn - (progn - (setq opt (car tmp3)) - (setq optargs (cdr tmp3)) - tmp3) - nil)) - (nreverse0 tmp1)) - (setq tmp1 - (cons - (cons - (|selectOptionLC| opt histOptions '|optionError|) - optargs) - tmp1)))))) - (do ((tmp4 opts (cdr tmp4)) (tmp5 nil)) - ((or (atom tmp4) - (progn - (setq tmp5 (car tmp4)) - nil) - (progn - (progn - (setq opt (car tmp5)) - (setq optargs (cdr tmp5)) - tmp5) - nil)) - nil) - (seq - (exit - (cond - ((|member| opt '(|on| |yes|)) - (cond - (|$HiFiAccess| - (|sayKeyedMsg| 'S2IH0007 nil)) ; history already on - ((eql |$IOindex| 1) - (setq |$HiFiAccess| t) - (|initHistList|) - (|sayKeyedMsg| 'S2IH0008 nil)) ; history now on - (t - (setq x ; really want to turn history on? - (upcase (|queryUserKeyedMsg| 'S2IH0009 nil))) - (cond - ((member (string2id-n x 1) '(Y YES)) - (|histFileErase| (|histFileName|)) - (setq |$HiFiAccess| t) - (setq |$options| nil) - (|clearSpad2Cmd| '(|all|)) - (|sayKeyedMsg| 'S2IH0008 nil) ; history now on - (|initHistList|)) - (t - (|sayKeyedMsg| 'S2IH0010 nil)))))) ; history still off - ((|member| opt '(|off| |no|)) - (cond - ((null |$HiFiAccess|) - (|sayKeyedMsg| 'S2IH0011 nil)) ; history already off - (t - (setq |$HiFiAccess| nil) - (|disableHist|) - (|sayKeyedMsg| 'S2IH0012 nil)))) ; history now off - ((eq opt '|file|) (|setHistoryCore| nil)) - ((eq opt '|memory|) (|setHistoryCore| t)) - ((eq opt '|reset|) (|resetInCoreHist|)) - ((eq opt '|save|) (|saveHistory| optargs)) - ((eq opt '|show|) (|showHistory| optargs)) - ((eq opt '|change|) (|changeHistListLen| (car optargs))) - ((eq opt '|restore|) (|restoreHistory| optargs)) - ((eq opt '|write|) (|writeInputLines| optargs 1)))))) - '|done|)) - -\end{chunk} - -\defun{showHistory}{showHistory} -\calls{showHistory}{sayKeyedMsg} -\calls{showHistory}{selectOptionLC} -\calls{showHistory}{sayMSG} -\calls{showHistory}{concat} -\calls{showHistory}{bright} -\calls{showHistory}{showInOut} -\calls{showHistory}{setIOindex} -\calls{showHistory}{showInput} -\usesdollar{showHistory}{printTimeSum} -\usesdollar{showHistory}{evalTimePrint} -\begin{chunk}{defun showHistory} -(defun |showHistory| (arg) - (let (|$printTimeSum| |$evalTimePrint| maxi mini arg2 arg1 - nset n showInputOrBoth) - (declare (special |$printTimeSum| |$evalTimePrint| |$HiFiAccess|)) - (setq |$evalTimePrint| 0) - (setq |$printTimeSum| 0) - (cond - ((null |$HiFiAccess|) (|sayKeyedMsg| 'S2IH0026 (list '|show|))) - (t - (setq showInputOrBoth '|input|) - (setq n 20) - (when arg - (setq arg1 (car arg)) - (when (integerp arg1) - (setq n arg1) - (setq nset t) - (cond - ((ifcdr arg) (setq arg1 (cadr arg))) - (t (setq arg1 nil)))) - (when arg1 - (setq arg2 (|selectOptionLC| arg1 '(|input| |both|) nil)) - (cond - (arg2 - (cond - ((and (eq (setq showInputOrBoth arg2) '|both|) - (null nset)) - (setq n 5)))) - (t - (|sayMSG| - (|concat| " " (|bright| arg1) "is an invalid argument.")))))) - (cond ((not (< n |$IOindex|)) (setq n (- |$IOindex| 1)))) - (setq mini (- |$IOindex| n)) - (setq maxi (- |$IOindex| 1)) - (cond - ((eq showInputOrBoth '|both|) - (unwind-protect - (|showInOut| mini maxi) - (|setIOindex| (+ maxi 1)))) - (t (|showInput| mini maxi))))))) -\end{chunk} - -\defun{setHistoryCore}{setHistoryCore} -We case on the inCore argument value -\begin{list}{} -\item If history is already on and is kept in the same location as requested -(file or memory) then complain. -\item If history is not in use then start using the file or memory as -requested. This is done by simply setting the \verb|$useInternalHistoryTable| -to the requested value, where T means use memory and NIL means -use a file. We tell the user. -\item If history should be in memory, that is inCore is not NIL, -and the history file already contains information we read the information -from the file, store it in memory, and erase the history file. We modify -\verb|$useInternalHistoryTable| to T to indicate that we're maintining -the history in memory and tell the user. -\item Otherwise history must be on and in memory. We erase any old history -file and then write the in-memory history to a new file -\end{list} -\calls{setHistoryCore}{boot-equal} -\calls{setHistoryCore}{sayKeyedMsg} -\calls{setHistoryCore}{rkeyids} -\calls{setHistoryCore}{histFileName} -\calls{setHistoryCore}{readHiFi} -\calls{setHistoryCore}{disableHist} -\calls{setHistoryCore}{histFileErase} -\calls{setHistoryCore}{rdefiostream} -\calls{setHistoryCore}{spadrwrite} -\calls{setHistoryCore}{object2Identifier} -\calls{setHistoryCore}{rshut} -\usesdollar{setHistoryCore}{useInternalHistoryTable} -\usesdollar{setHistoryCore}{internalHistoryTable} -\usesdollar{setHistoryCore}{HiFiAccess} -\usesdollar{setHistoryCore}{IOindex} -\begin{chunk}{defun setHistoryCore} -(defun |setHistoryCore| (inCore) - (let (l vec str n rec) - (declare (special |$useInternalHistoryTable| |$internalHistoryTable| - |$HiFiAccess| |$IOindex|)) - (cond - ((boot-equal inCore |$useInternalHistoryTable|) - (if inCore - (|sayKeyedMsg| 's2ih0030 nil) ; memory history already in use - (|sayKeyedMsg| 's2ih0029 nil))) ; file history already in use - ((null |$HiFiAccess|) - (setq |$useInternalHistoryTable| inCore) - (if inCore - (|sayKeyedMsg| 's2ih0032 nil) ; use memory history - (|sayKeyedMsg| 's2ih0031 nil))) ; use file history - (inCore - (setq |$internalHistoryTable| nil) - (cond - ((not (eql |$IOindex| 0)) - (setq l (length (rkeyids (|histFileName|)))) - (do ((i 1 (1+ i))) - ((> i l) nil) - (setq vec (unwind-protect (|readHiFi| i) (|disableHist|))) - (setq |$internalHistoryTable| - (cons (cons i vec) |$internalHistoryTable|))) - (|histFileErase| (|histFileName|)))) - (setq |$useInternalHistoryTable| t) - (|sayKeyedMsg| 'S2IH0032 nil)) ; use memory history - (t - (setq |$HiFiAccess| nil) - (|histFileErase| (|histFileName|)) - (setq str - (rdefiostream - (cons - '(mode . output) - (cons - (cons 'file (|histFileName|)) - nil)))) - (do ((tmp0 (reverse |$internalHistoryTable|) (cdr tmp0)) - (tmp1 nil)) - ((or (atom tmp0) - (progn - (setq tmp1 (car tmp0)) - nil) - (progn - (progn - (setq n (car tmp1)) - (setq rec (cdr tmp1)) - tmp1) - nil)) - nil) - (spadrwrite (|object2Identifier| n) rec str)) - (rshut str) - (setq |$HiFiAccess| t) - (setq |$internalHistoryTable| nil) - (setq |$useInternalHistoryTable| nil) - (|sayKeyedMsg| 's2ih0031 nil))))) ; use file history - -\end{chunk} -\defdollar{underbar} -Also used in the output routines. -\begin{chunk}{initvars} -(defvar underbar "_") - -\end{chunk} - -\defun{writeInputLines}{writeInputLines} -\calls{writeInputLines}{sayKeyedMsg} -\calls{writeInputLines}{throwKeyedMsg} -\calls{writeInputLines}{size} -\calls{writeInputLines}{spaddifference} -\calls{writeInputLines}{concat} -\calls{writeInputLines}{substring} -\calls{writeInputLines}{readHiFi} -\calls{writeInputLines}{histInputFileName} -\calls{writeInputLines}{histFileErase} -\calls{writeInputLines}{defiostream} -\calls{writeInputLines}{namestring} -\calls{writeInputLines}{shut} -\uses{writeInputLines}{underbar} -\usesdollar{writeInputLines}{HiFiAccess} -\usesdollar{writeInputLines}{IOindex} -\begin{chunk}{defun writeInputLines} -(defun |writeInputLines| (fn initial) - (let (maxn breakChars vecl k svec done n lineList file inp) - (declare (special underbar |$HiFiAccess| |$IOindex|)) - (cond - ((null |$HiFiAccess|) (|sayKeyedMsg| 's2ih0013 nil)) ; history is not on - ((null fn) (|throwKeyedMsg| 's2ih0038 nil)) ; missing file name - (t - (setq maxn 72) - (setq breakChars (cons '| | (cons '+ nil))) - (do ((tmp0 (spaddifference |$IOindex| 1)) - (i initial (+ i 1))) - ((> i tmp0) nil) - (setq vecl (car (|readHiFi| i))) - (when (stringp vecl) (setq vecl (cons vecl nil))) - (dolist (vec vecl) - (setq n (size vec)) - (do () - ((null (> n maxn)) nil) - (setq done nil) - (do ((j 1 (1+ j))) - ((or (> j maxn) (null (null done))) nil) - (setq k (spaddifference (1+ maxn) j)) - (when (member (elt vec k) breakChars) - (setq svec (concat (substring vec 0 (1+ k)) underbar)) - (setq lineList (cons svec lineList)) - (setq done t) - (setq vec (substring vec (1+ k) nil)) - (setq n (size vec)))) - (when done (setq n 0))) - (setq lineList (cons vec lineList)))) - (setq file (|histInputFileName| fn)) - (|histFileErase| file) - (setq inp - (defiostream - (cons - '(mode . output) - (cons (cons 'file file) nil)) 255 0)) - (dolist (x (|removeUndoLines| (nreverse lineList))) - (write-line x inp)) - (cond - ((not (eq fn '|redo|)) - (|sayKeyedMsg| 's2ih0014 ; edit this file to see input lines - (list (|namestring| file))))) - (shut inp) - nil)))) - -\end{chunk} -\defun{resetInCoreHist}{resetInCoreHist} -\usesdollar{resetInCoreHist}{HistListAct} -\usesdollar{resetInCoreHist}{HistListLen} -\usesdollar{resetInCoreHist}{HistList} -\begin{chunk}{defun resetInCoreHist} -(defun |resetInCoreHist| () - (declare (special |$HistListAct| |$HistListLen| |$HistList|)) - (setq |$HistListAct| 0) - (do ((i 1 (1+ i))) - ((> i |$HistListLen|) nil) - (setq |$HistList| (cdr |$HistList|)) - (rplaca |$HistList| nil))) - -\end{chunk} -\defun{changeHistListLen}{changeHistListLen} -\calls{changeHistListLen}{sayKeyedMsg} -\calls{changeHistListLen}{spaddifference} -\usesdollar{changeHistListLen}{HistListLen} -\usesdollar{changeHistListLen}{HistList} -\usesdollar{changeHistListLen}{HistListAct} -\begin{chunk}{defun changeHistListLen} -(defun |changeHistListLen| (n) - (let (dif l) - (declare (special |$HistListLen| |$HistList| |$HistListAct|)) - (if (null (integerp n)) - (|sayKeyedMsg| 's2ih0015 (list n)) ; only positive integers - (progn - (setq dif (spaddifference n |$HistListLen|)) - (setq |$HistListLen| n) - (setq l (cdr |$HistList|)) - (cond - ((> dif 0) - (do ((i 1 (1+ i))) - ((> i dif) nil) - (setq l (cons nil l)))) - ((minusp dif) - (do ((tmp0 (spaddifference dif)) - (i 1 (1+ i))) - ((> i tmp0) nil) - (setq l (cdr l))) - (cond - ((> |$HistListAct| n) (setq |$HistListAct| n)) - (t nil)))) - (rplacd |$HistList| l) - '|done|)))) - -\end{chunk} -\defun{updateHist}{updateHist} -\calls{updateHist}{startTimingProcess} -\calls{updateHist}{updateInCoreHist} -\calls{updateHist}{writeHiFi} -\calls{updateHist}{disableHist} -\calls{updateHist}{updateCurrentInterpreterFrame} -\calls{updateHist}{stopTimingProcess} -\usesdollar{updateHist}{IOindex} -\usesdollar{updateHist}{HiFiAccess} -\usesdollar{updateHist}{HistRecord} -\usesdollar{updateHist}{mkTestInputStack} -\usesdollar{updateHist}{currentLine} -\begin{chunk}{defun updateHist} -(defun |updateHist| () - (declare (special |$IOindex| |$HiFiAccess| |$HistRecord| |$mkTestInputStack| - |$currentLine|)) - (when |$IOindex| - (|startTimingProcess| '|history|) - (|updateInCoreHist|) - (when |$HiFiAccess| - (unwind-protect (|writeHiFi|) (|disableHist|)) - (setq |$HistRecord| nil)) - (incf |$IOindex|) - (|updateCurrentInterpreterFrame|) - (setq |$mkTestInputStack| nil) - (setq |$currentLine| nil) - (|stopTimingProcess| '|history|))) - -\end{chunk} -\defun{updateInCoreHist}{updateInCoreHist} -\usesdollar{updateInCoreHist}{HistList} -\usesdollar{updateInCoreHist}{HistListLen} -\usesdollar{updateInCoreHist}{HistListAct} -\begin{chunk}{defun updateInCoreHist} -(defun |updateInCoreHist| () - (declare (special |$HistList| |$HistListLen| |$HistListAct|)) - (setq |$HistList| (cdr |$HistList|)) - (rplaca |$HistList| nil) - (when (> |$HistListLen| |$HistListAct|) - (setq |$HistListAct| (1+ |$HistListAct|)))) - -\end{chunk} -\defun{putHist}{putHist} -\calls{putHist}{recordOldValue} -\calls{putHist}{get} -\calls{putHist}{recordNewValue} -\calls{putHist}{putIntSymTab} -\usesdollar{putHist}{HiFiAccess} -\begin{chunk}{defun putHist} -(defun |putHist| (x prop val e) - (declare (special |$HiFiAccess|)) - (when (null (eq x '%)) (|recordOldValue| x prop (|get| x prop e))) - (when |$HiFiAccess| (|recordNewValue| x prop val)) - (|putIntSymTab| x prop val e)) - -\end{chunk} -\defun{recordNewValue}{recordNewValue} -\calls{recordNewValue}{startTimingProcess} -\calls{recordNewValue}{recordNewValue0} -\calls{recordNewValue}{stopTimingProcess} -\begin{chunk}{defun recordNewValue} -(defun |recordNewValue| (x prop val) - (|startTimingProcess| '|history|) - (|recordNewValue0| x prop val) - (|stopTimingProcess| '|history|)) - -\end{chunk} -\defun{recordNewValue0}{recordNewValue0} -\calls{recordNewValue0}{assq} -\usesdollar{recordNewValue0}{HistRecord} -\begin{chunk}{defun recordNewValue0} -(defun |recordNewValue0| (x prop val) - (let (p1 p2 p) - (declare (special |$HistRecord|)) - (if (setq p1 (assq x |$HistRecord|)) - (if (setq p2 (assq prop (cdr p1))) - (rplacd p2 val) - (rplacd p1 (cons (cons prop val) (cdr p1)))) - (progn - (setq p (cons x (list (cons prop val)))) - (setq |$HistRecord| (cons p |$HistRecord|)))))) - -\end{chunk} -\defun{recordOldValue}{recordOldValue} -\calls{recordOldValue}{startTimingProcess} -\calls{recordOldValue}{recordOldValue0} -\calls{recordOldValue}{stopTimingProcess} -\calls{recordOldValue0}{assq} -\begin{chunk}{defun recordOldValue} -(defun |recordOldValue| (x prop val) - (|startTimingProcess| '|history|) - (|recordOldValue0| x prop val) - (|stopTimingProcess| '|history|)) - -\end{chunk} -\defun{recordOldValue0}{recordOldValue0} -\usesdollar{recordOldValue0}{HistList} -\begin{chunk}{defun recordOldValue0} -(defun |recordOldValue0| (x prop val) - (let (p1 p) - (declare (special |$HistList|)) - (when (setq p1 (assq x (car |$HistList|))) - (when (null (assq prop (cdr p1))) - (rplacd p1 (cons (cons prop val) (cdr p1))))) - (setq p (cons x (list (cons prop val)))) - (rplaca |$HistList| (cons p (car |$HistList|))))) - -\end{chunk} -\defun{undoInCore}{undoInCore} -\calls{undoInCore}{undoChanges} -\calls{undoInCore}{spaddifference} -\calls{undoInCore}{readHiFi} -\calls{undoInCore}{disableHist} -\calls{undoInCore}{assq} -\calls{undoInCore}{sayKeyedMsg} -\calls{undoInCore}{putHist} -\calls{undoInCore}{updateHist} -\usesdollar{undoInCore}{HistList} -\usesdollar{undoInCore}{HistListLen} -\usesdollar{undoInCore}{IOindex} -\usesdollar{undoInCore}{HiFiAccess} -\usesdollar{undoInCore}{InteractiveFrame} -\begin{chunk}{defun undoInCore} -(defun |undoInCore| (n) - (let (li vec p p1 val) - (declare (special |$HistList| |$HistListLen| |$IOindex| |$HiFiAccess| - |$InteractiveFrame|)) - (setq li |$HistList|) - (do ((i n (+ i 1))) - ((> i |$HistListLen|) nil) - (setq li (cdr li))) - (|undoChanges| li) - (setq n (spaddifference (spaddifference |$IOindex| n) 1)) - (and - (> n 0) - (if |$HiFiAccess| - (progn - (setq vec (cdr (unwind-protect (|readHiFi| n) (|disableHist|)))) - (setq val - (and - (setq p (assq '% vec)) - (setq p1 (assq '|value| (cdr p))) - (cdr p1)))) - (|sayKeyedMsg| 's2ih0019 (cons n nil)))) ; no history file - (setq |$InteractiveFrame| (|putHist| '% '|value| val |$InteractiveFrame|)) - (|updateHist|))) - -\end{chunk} -\defun{undoChanges}{undoChanges} -\calls{undoChanges}{boot-equal} -\calls{undoChanges}{undoChanges} -\calls{undoChanges}{putHist} -\usesdollar{undoChanges}{HistList} -\usesdollar{undoChanges}{InteractiveFrame} -\begin{chunk}{defun undoChanges} -(defun |undoChanges| (li) - (let (x) - (declare (special |$HistList| |$InteractiveFrame|)) - (when (null (boot-equal (cdr li) |$HistList|)) (|undoChanges| (cdr li))) - (dolist (p1 (car li)) - (setq x (car p1)) - (dolist (p2 (cdr p1)) - (|putHist| x (car p2) (cdr p2) |$InteractiveFrame|))))) - -\end{chunk} -\defun{undoFromFile}{undoFromFile} -\calls{undoFromFile}{seq} -\calls{undoFromFile}{exit} -\calls{undoFromFile}{recordOldValue} -\calls{undoFromFile}{recordNewValue} -\calls{undoFromFile}{readHiFi} -\calls{undoFromFile}{disableHist} -\calls{undoFromFile}{putHist} -\calls{undoFromFile}{assq} -\calls{undoFromFile}{updateHist} -\usesdollar{undoFromFile}{InteractiveFrame} -\usesdollar{undoFromFile}{HiFiAccess} -\begin{chunk}{defun undoFromFile} -(defun |undoFromFile| (n) - (let (varl prop vec x p p1 val) - (declare (special |$InteractiveFrame| |$HiFiAccess|)) - (do ((tmp0 (caar |$InteractiveFrame|) (cdr tmp0)) (tmp1 nil)) - ((or (atom tmp0) - (progn (setq tmp1 (car tmp0)) nil) - (progn - (progn - (setq x (car tmp1)) - (setq varl (cdr tmp1)) - tmp1) - nil)) - nil) - (seq - (exit - (do ((tmp2 varl (cdr tmp2)) (p nil)) - ((or (atom tmp2) (progn (setq p (car tmp2)) nil)) nil) - (seq - (exit - (progn - (setq prop (car p)) - (setq val (cdr p)) - (when val - (progn - (when (null (eq x '%)) - (|recordOldValue| x prop val)) - (when |$HiFiAccess| - (|recordNewValue| x prop val)) - (rplacd p nil)))))))))) - (do ((i 1 (1+ i))) - ((> i n) nil) - (setq vec - (unwind-protect (cdr (|readHiFi| i)) (|disableHist|))) - (do ((tmp3 vec (cdr tmp3)) (p1 nil)) - ((or (atom tmp3) (progn (setq p1 (car tmp3)) nil)) nil) - (setq x (car p1)) - (do ((tmp4 (cdr p1) (cdr tmp4)) (p2 nil)) - ((or (atom tmp4) (progn (setq p2 (car tmp4)) nil)) nil) - (setq |$InteractiveFrame| - (|putHist| x (car p2) (CDR p2) |$InteractiveFrame|))))) - (setq val - (and - (setq p (assq '% vec)) - (setq p1 (assq '|value| (cdr p))) - (cdr p1))) - (setq |$InteractiveFrame| (|putHist| '% '|value| val |$InteractiveFrame|)) - (|updateHist|))) - -\end{chunk} -\defun{saveHistory}{saveHistory} -\calls{saveHistory}{sayKeyedMsg} -\calls{saveHistory}{makeInputFilename} -\calls{saveHistory}{histFileName} -\calls{saveHistory}{throwKeyedMsg} -\calls{saveHistory}{makeHistFileName} -\calls{saveHistory}{histInputFileName} -\calls{saveHistory}{writeInputLines} -\calls{saveHistory}{histFileErase} -\calls{saveHistory}{rdefiostream} -\calls{saveHistory}{spadrwrite0} -\calls{saveHistory}{object2Identifier} -\calls{saveHistory}{rshut} -\calls{saveHistory}{namestring} -\usesdollar{saveHistory}{seen} -\usesdollar{saveHistory}{HiFiAccess} -\usesdollar{saveHistory}{useInternalHistoryTable} -\usesdollar{saveHistory}{internalHistoryTable} -\begin{chunk}{defun saveHistory} -(defun |saveHistory| (fn) - (let (|$seen| savefile inputfile saveStr n rec val) - (declare (special |$seen| |$HiFiAccess| |$useInternalHistoryTable| - |$internalHistoryTable|)) - (setq |$seen| (make-hash-table :test #'eq)) - (cond - ((null |$HiFiAccess|) - (|sayKeyedMsg| 's2ih0016 nil)) ; the history file is not on - ((and (null |$useInternalHistoryTable|) - (null (makeInputFilename (|histFileName|)))) - (|sayKeyedMsg| 's2ih0022 nil)) ; no history saved yet - ((null fn) - (|throwKeyedMsg| 's2ih0037 nil)) ; need to specify a history filename - (t - (setq savefile (|makeHistFileName| fn)) - (setq inputfile (|histInputFileName| fn)) - (|writeInputLines| fn 1) - (|histFileErase| savefile) - (when |$useInternalHistoryTable| - (setq saveStr - (rdefiostream - (cons '(mode . output) - (cons (cons 'file savefile) nil)))) - (do ((tmp0 (reverse |$internalHistoryTable|) (cdr tmp0)) - (tmp1 nil)) - ((or (atom tmp0) - (progn (setq tmp1 (car tmp0)) nil) - (progn - (progn - (setq n (car tmp1)) - (setq rec (cdr tmp1)) - tmp1) - nil)) - nil) - (setq val (spadrwrite0 (|object2Identifier| n) rec saveStr)) - (when (eq val '|writifyFailed|) - (|sayKeyedMsg| 's2ih0035 ; can't save the value of step - (list n inputfile)))) - (rshut saveStr)) - (|sayKeyedMsg| 's2ih0018 ; saved history file is - (cons (|namestring| savefile) nil)) - nil)))) - -\end{chunk} -\defun{restoreHistory}{restoreHistory} -\calls{restoreHistory}{qcdr} -\calls{restoreHistory}{qcar} -\calls{restoreHistory}{identp} -\calls{restoreHistory}{throwKeyedMsg} -\calls{restoreHistory}{makeHistFileName} -\calls{restoreHistory}{putHist} -\calls{restoreHistory}{makeInputFilename} -\calls{restoreHistory}{sayKeyedMsg} -\calls{restoreHistory}{namestring} -\calls{restoreHistory}{clearSpad2Cmd} -\calls{restoreHistory}{histFileName} -\calls{restoreHistory}{histFileErase} -\callsdollar{restoreHistory}{fcopy} -\calls{restoreHistory}{rkeyids} -\calls{restoreHistory}{readHiFi} -\calls{restoreHistory}{disableHist} -\calls{restoreHistory}{updateInCoreHist} -\calls{restoreHistory}{get} -\calls{restoreHistory}{rempropI} -\calls{restoreHistory}{clearCmdSortedCaches} -\usesdollar{restoreHistory}{options} -\usesdollar{restoreHistory}{internalHistoryTable} -\usesdollar{restoreHistory}{HiFiAccess} -\usesdollar{restoreHistory}{e} -\usesdollar{restoreHistory}{useInternalHistoryTable} -\usesdollar{restoreHistory}{InteractiveFrame} -\usesdollar{restoreHistory}{oldHistoryFileName} -\begin{chunk}{defun restoreHistory} -(defun |restoreHistory| (fn) - (let (|$options| fnq restfile curfile l oldInternal vec line x a) - (declare (special |$options| |$internalHistoryTable| |$HiFiAccess| |$e| - |$useInternalHistoryTable| |$InteractiveFrame| |$oldHistoryFileName|)) - (cond - ((null fn) (setq fnq |$oldHistoryFileName|)) - ((and (consp fn) - (eq (qcdr fn) nil) - (progn - (setq fnq (qcar fn)) - t) - (identp fnq)) - (setq fnq fnq)) - (t (|throwKeyedMsg| 's2ih0023 (cons fnq nil)))) ; invalid filename - (setq restfile (|makeHistFileName| fnq)) - (if (null (makeInputFilename restfile)) - (|sayKeyedMsg| 's2ih0024 ; file does not exist - (cons (|namestring| restfile) nil)) - (progn - (setq |$options| nil) - (|clearSpad2Cmd| '(|all|)) - (setq curfile (|histFileName|)) - (|histFileErase| curfile) - ($fcopy restfile curfile) - (setq l (length (rkeyids curfile))) - (setq |$HiFiAccess| t) - (setq oldInternal |$useInternalHistoryTable|) - (setq |$useInternalHistoryTable| nil) - (when oldInternal (setq |$internalHistoryTable| nil)) - (do ((i 1 (1+ i))) - ((> i l) nil) - (setq vec (unwind-protect (|readHiFi| i) (|disableHist|))) - (when oldInternal - (setq |$internalHistoryTable| - (cons (cons i vec) |$internalHistoryTable|))) - (setq line (car vec)) - (dolist (p1 (cdr vec)) - (setq x (car p1)) - (do ((tmp1 (cdr p1) (cdr tmp1)) (p2 nil)) - ((or (atom tmp1) (progn (setq p2 (car tmp1)) nil)) nil) - (setq |$InteractiveFrame| - (|putHist| x - (car p2) (cdr p2) |$InteractiveFrame|)))) - (|updateInCoreHist|)) - (setq |$e| |$InteractiveFrame|) - (do ((tmp2 (caar |$InteractiveFrame|) (cdr tmp2)) (tmp3 nil)) - ((or (atom tmp2) - (progn - (setq tmp3 (car tmp2)) - nil) - (progn - (progn - (setq a (car tmp3)) - tmp3) - nil)) - nil) - (when (|get| a '|localModemap| |$InteractiveFrame|) - (|rempropI| a '|localModemap|) - (|rempropI| a '|localVars|) - (|rempropI| a '|mapBody|))) - (setq |$IOindex| (1+ l)) - (setq |$useInternalHistoryTable| oldInternal) - (|sayKeyedMsg| 'S2IH0025 ; workspace restored - (cons (|namestring| restfile) nil)) - (|clearCmdSortedCaches|) - nil)))) - -\end{chunk} - -\defun{setIOindex}{setIOindex} -\usesdollar{setIOindex}{IOindex} -\begin{chunk}{defun setIOindex} -(defun |setIOindex| (n) - (declare (special |$IOindex|)) - (setq |$IOindex| n)) - -\end{chunk} -\defun{showInput}{showInput} -\calls{showInput}{tab} -\calls{showInput}{readHiFi} -\calls{showInput}{disableHist} -\calls{showInput}{sayMSG} -\begin{chunk}{defun showInput} -(defun |showInput| (mini maxi) - (let (vec l) - (do ((|ind| mini (+ |ind| 1))) - ((> |ind| maxi) nil) - (setq vec (unwind-protect (|readHiFi| |ind|) (|disableHist|))) - (cond - ((> 10 |ind|) (tab 2)) - ((> 100 |ind|) (tab 1)) - (t nil)) - (setq l (car vec)) - (if (stringp l) - (|sayMSG| (list " [" |ind| "] " (car vec))) - (progn - (|sayMSG| (list " [" |ind| "] ")) - (do ((tmp0 l (cdr tmp0)) (ln nil)) - ((or (atom tmp0) (progn (setq ln (car tmp0)) nil)) nil) - (|sayMSG| (list " " ln)))))))) - -\end{chunk} -\defun{showInOut}{showInOut} -\calls{showInOut}{assq} -\calls{showInOut}{spadPrint} -\calls{showInOut}{objValUnwrap} -\calls{showInOut}{objMode} -\calls{showInOut}{readHiFi} -\calls{showInOut}{disableHist} -\calls{showInOut}{sayMSG} -\begin{chunk}{defun showInOut} -(defun |showInOut| (mini maxi) - (let (vec Alist triple) - (do ((ind mini (+ ind 1))) - ((> ind maxi) nil) - (setq vec (unwind-protect (|readHiFi| ind) (|disableHist|))) - (|sayMSG| (cons (car vec) nil)) - (cond - ((setq Alist (assq '% (cdr vec))) - (setq triple (cdr (assq '|value| (cdr Alist)))) - (setq |$IOindex| ind) - (|spadPrint| (|objValUnwrap| triple) (|objMode| triple))))))) - -\end{chunk} -\defun{fetchOutput}{fetchOutput} -\calls{fetchOutput}{boot-equal} -\calls{fetchOutput}{spaddifference} -\calls{fetchOutput}{getI} -\calls{fetchOutput}{throwKeyedMsg} -\calls{fetchOutput}{readHiFi} -\calls{fetchOutput}{disableHist} -\calls{fetchOutput}{assq} -\begin{chunk}{defun fetchOutput} -(defun |fetchOutput| (n) - (let (vec Alist val) - (cond - ((and (boot-equal n (spaddifference 1)) (setq val (|getI| '% '|value|))) - val) - (|$HiFiAccess| - (setq n - (cond - ((minusp n) (+ |$IOindex| n)) - (t n))) - (cond - ((>= n |$IOindex|) - (|throwKeyedMsg| 'S2IH0001 (cons n nil))) ; no step n yet - ((> 1 n) - (|throwKeyedMsg| 's2ih0002 (cons n nil))) ; only nonzero steps - (t - (setq vec (unwind-protect (|readHiFi| n) (|disableHist|))) - (cond - ((setq Alist (assq '% (cdr vec))) - (cond - ((setq val (cdr (assq '|value| (cdr Alist)))) - val) - (t - (|throwKeyedMsg| 's2ih0003 (cons n nil))))) ; no step value - (t (|throwKeyedMsg| 's2ih0003 (cons n nil))))))) ; no step value - (t (|throwKeyedMsg| 's2ih0004 nil))))) ; history not on - -\end{chunk} -\defunsec{readHiFi}{Read the history file using index n} -\calls{readHiFi}{assoc} -\calls{readHiFi}{keyedSystemError} -\calls{readHiFi}{qcdr} -\calls{readHiFi}{rdefiostream} -\calls{readHiFi}{histFileName} -\calls{readHiFi}{spadrread} -\calls{readHiFi}{object2Identifier} -\calls{readHiFi}{rshut} -\usesdollar{readHiFi}{useInternalHistoryTable} -\usesdollar{readHiFi}{internalHistoryTable} -\begin{chunk}{defun readHiFi} -(defun |readHiFi| (n) - "Read the history file using index n" - (let (pair HiFi vec) - (declare (special |$useInternalHistoryTable| |$internalHistoryTable|)) - (if |$useInternalHistoryTable| - (progn - (setq pair (|assoc| n |$internalHistoryTable|)) - (if (atom pair) - (|keyedSystemError| 's2ih0034 nil) ; missing element - (setq vec (qcdr pair)))) - (progn - (setq HiFi - (rdefiostream - (cons - '(mode . input) - (cons - (cons 'file (|histFileName|)) nil)))) - (setq vec (spadrread (|object2Identifier| n) HiFi)) - (rshut HiFi))) - vec)) - -\end{chunk} -\defunsec{writeHiFi}{Write information of the current step to history file} -\calls{writeHiFi}{rdefiostream} -\calls{writeHiFi}{histFileName} -\calls{writeHiFi}{spadrwrite} -\calls{writeHiFi}{object2Identifier} -\calls{writeHiFi}{rshut} -\usesdollar{writeHiFi}{useInternalHistoryTable} -\usesdollar{writeHiFi}{internalHistoryTable} -\usesdollar{writeHiFi}{IOindex} -\usesdollar{writeHiFi}{HistRecord} -\usesdollar{writeHiFi}{currentLine} -\begin{chunk}{defun writeHiFi} -(defun |writeHiFi| () - "Writes information of the current step to history file" - (let (HiFi) - (declare (special |$useInternalHistoryTable| |$internalHistoryTable| - |$IOindex| |$HistRecord| |$currentLine|)) - (if |$useInternalHistoryTable| - (setq |$internalHistoryTable| - (cons - (cons |$IOindex| - (cons |$currentLine| |$HistRecord|)) - |$internalHistoryTable|)) - (progn - (setq HiFi - (rdefiostream - (cons - '(mode . output) - (cons (cons 'file (|histFileName|)) nil)))) - (spadrwrite (|object2Identifier| |$IOindex|) - (cons |$currentLine| |$HistRecord|) HiFi) - (rshut HiFi))))) - -\end{chunk} -\defunsec{disableHist}{Disable history if an error occurred} -\calls{disableHist}{histFileErase} -\calls{disableHist}{histFileName} -\usesdollar{disableHist}{HiFiAccess} -\begin{chunk}{defun disableHist} -(defun |disableHist| () - "Disable history if an error occurred" - (declare (special |$HiFiAccess|)) - (cond - ((null |$HiFiAccess|) - (|histFileErase| (|histFileName|))) - (t nil))) - -\end{chunk} -\defun{writeHistModesAndValues}{writeHistModesAndValues} -\calls{writeHistModesAndValues}{get} -\calls{writeHistModesAndValues}{putHist} -\usesdollar{writeHistModesAndValues}{InteractiveFrame} -\begin{chunk}{defun writeHistModesAndValues} -(defun |writeHistModesAndValues| () - (let (a x) - (declare (special |$InteractiveFrame|)) - (do ((tmp0 (caar |$InteractiveFrame|) (cdr tmp0)) (tmp1 nil)) - ((or (atom tmp0) - (progn - (setq tmp1 (car tmp0)) - nil) - (progn - (progn - (setq a (car tmp1)) - tmp1) - nil)) - nil) - (cond - ((setq x (|get| a '|value| |$InteractiveFrame|)) - (|putHist| a '|value| x |$InteractiveFrame|)) - ((setq x (|get| a '|mode| |$InteractiveFrame|)) - (|putHist| a '|mode| x |$InteractiveFrame|)))))) - -\end{chunk} - -Lisplib output transformations - -Some types of objects cannot be saved by LISP/VM in lisplibs. -These functions transform an object to a writable form and back. -\defun{spadrwrite0}{spadrwrite0} -\calls{spadrwrite0}{safeWritify} -\calls{spadrwrite0}{rwrite} -\begin{chunk}{defun spadrwrite0} -(defun spadrwrite0 (vec item stream) - (let (val) - (setq val (|safeWritify| item)) - (if (eq val '|writifyFailed|) - val - (progn - (|rwrite| vec val stream) - item)))) - -\end{chunk} - -\defun{rwrite}{Random write to a stream} -\calls{rwrite}{rwrite} -\calls{rwrite}{pname} -\calls{rwrite}{identp} -\begin{chunk}{defun rwrite} -(defun |rwrite| (key val stream) - (when (identp key) (setq key (pname key))) - (rwrite key val stream)) - -\end{chunk} - -\defun{spadrwrite}{spadrwrite} -\calls{spadrwrite}{spadrwrite0} -\calls{spadrwrite}{throwKeyedMsg} -\begin{chunk}{defun spadrwrite} -(defun spadrwrite (vec item stream) - (let (val) - (setq val (spadrwrite0 vec item stream)) - (if (eq val '|writifyFailed|) - (|throwKeyedMsg| 's2ih0036 nil) ; cannot save value to file - item))) - -\end{chunk} -\defun{spadrread}{spadrread} -\calls{SPADRREAD}{dewritify} -\calls{SPADRREAD}{rread} -\begin{chunk}{defun spadrread} -(defun spadrread (vec stream) - (|dewritify| (|rread| vec stream nil))) - -\end{chunk} - -\defun{rread}{Random read a key from a stream} -RREAD takes erroval to return if key is missing - -\calls{rread}{rread} -\calls{rwrite}{identp} -\calls{rwrite}{pname} -\begin{chunk}{defun rread} -(defun |rread| (key rstream errorval) - (when (identp key) (setq key (pname key))) - (rread key rstream errorval)) - -\end{chunk} - -\defun{unwritable?}{unwritable?} -\calls{unwritable?}{vecp} -\calls{unwritable?}{placep} -\begin{chunk}{defun unwritable?} -(defun |unwritable?| (ob) - (cond - ((or (consp ob) (vecp ob)) nil) - ((or (compiled-function-p ob) (hash-table-p ob)) t) - ((or (placep ob) (readtablep ob)) t) - ((floatp ob) t) - (t nil))) - -\end{chunk} -\defun{writifyComplain}{writifyComplain} -Create a full isomorphic object to be saved in a lisplib. Note -that {\tt dewritify(writify(x))} preserves UEQUALity of hashtables. -HASHTABLEs go both ways. READTABLEs cannot presently be transformed -back. -\calls{writifyComplain}{sayKeyedMsg} -\usesdollar{writifyComplain}{writifyComplained} -\begin{chunk}{defun writifyComplain} -(defun |writifyComplain| (s) - (declare (special |$writifyComplained|)) - (unless |$writifyComplained| - (setq |$writifyComplained| t) - (|sayKeyedMsg| 's2ih0027 (list s)))) ; cannot save value - -\end{chunk} -\defun{safeWritify}{safeWritify} -\catches{safeWritify}{writifyTag} -\calls{safeWritify}{writify} -\begin{chunk}{defun safeWritify} -(defun |safeWritify| (ob) - (catch '|writifyTag| (|writify| ob))) - -\end{chunk} -\defun{writify,writifyInner}{writify,writifyInner} -\throws{writify,writifyInner}{writifyTag} -\calls{writify,writifyInner}{seq} -\calls{writify,writifyInner}{exit} -\calls{writify,writifyInner}{hget} -\calls{writify,writifyInner}{qcar} -\calls{writify,writifyInner}{qcdr} -\calls{writify,writifyInner}{spadClosure?} -\calls{writify,writifyInner}{writify,writifyInner} -\calls{writify,writifyInner}{hput} -\calls{writify,writifyInner}{qrplaca} -\calls{writify,writifyInner}{qrplacd} -\calls{writify,writifyInner}{vecp} -\calls{writify,writifyInner}{isDomainOrPackage} -\calls{writify,writifyInner}{mkEvalable} -\calls{writify,writifyInner}{devaluate} -\calls{writify,writifyInner}{qvmaxindex} -\calls{writify,writifyInner}{qsetvelt} -\calls{writify,writifyInner}{qvelt} -\calls{writify,writifyInner}{constructor?} -\calls{writify,writifyInner}{hkeys} -\calls{writify,writifyInner}{hashtable-class} -\calls{writify,writifyInner}{placep} -\calls{writify,writifyInner}{boot-equal} -\usesdollar{writify,writifyInner}{seen} -\usesdollar{writify,writifyInner}{NonNullStream} -\usesdollar{writify,writifyInner}{NullStream} -\begin{chunk}{defun writify,writifyInner} -(defun |writify,writifyInner| (ob) - (prog (e name tmp1 tmp2 tmp3 x qcar qcdr d n keys nob) - (declare (special |$seen| |$NonNullStream| |$NullStream|)) - (return - (seq - (when (null ob) (exit nil)) - (when (setq e (hget |$seen| ob)) (exit e)) - (when (consp ob) - (exit - (seq - (setq qcar (qcar ob)) - (setq qcdr (qcdr ob)) - (when (setq name (|spadClosure?| ob)) - (exit - (seq - (setq d (|writify,writifyInner| (qcdr ob))) - (setq nob - (cons 'writified!! - (cons 'spadclosure - (cons d (cons name nil))))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)))) - (when - (and - (and (consp ob) - (eq (qcar ob) 'lambda-closure) - (progn - (setq tmp1 (qcdr ob)) - (and (consp tmp1) - (progn - (setq tmp2 (qcdr tmp1)) - (and - (consp tmp2) - (progn - (setq tmp3 (qcdr tmp2)) - (and (consp tmp3) - (progn - (setq x (qcar tmp3)) - t)))))))) x) - (exit - (throw '|writifyTag| '|writifyFailed|))) - (setq nob (cons qcar qcdr)) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (setq qcar (|writify,writifyInner| qcar)) - (setq qcdr (|writify,writifyInner| qcdr)) - (qrplaca nob qcar) - (qrplacd nob qcdr) - (exit nob)))) - (when (vecp ob) - (exit - (seq - (when (|isDomainOrPackage| ob) - (setq d (|mkEvalable| (|devaluate| ob))) - (setq nob (list 'writified!! 'devaluated (|writify,writifyInner| d))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)) - (setq n (qvmaxindex ob)) - (setq nob (make-array (1+ n))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (do ((i 0 (=! i))) - ((> i n) nil) - (qsetvelt nob i (|writify,writifyInner| (qvelt ob i)))) - (exit nob)))) - (when (eq ob 'writified!!) - (exit - (cons 'writified!! (cons 'self nil)))) - (when (|constructor?| ob) - (exit ob)) - (when (compiled-function-p ob) - (exit - (throw '|writifyTag| '|writifyFailed|))) - (when (hash-table-p ob) - (setq nob (cons 'writified!! nil)) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (setq keys (hkeys ob)) - (qrplacd nob - (cons - 'hashtable - (cons - (hashtable-class ob) - (cons - (|writify,writifyInner| keys) - (cons - (prog (tmp0) - (setq tmp0 nil) - (return - (do ((tmp1 keys (cdr tmp1)) (k nil)) - ((or (atom tmp1) - (progn - (setq k (car tmp1)) - nil)) - (nreverse0 tmp0)) - (setq tmp0 - (cons (|writify,writifyInner| (hget ob k)) tmp0))))) - nil))))) - (exit nob)) - (when (placep ob) - (setq nob (cons 'writified!! (cons 'place nil))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)) - (when (readtablep ob) - (exit - (throw '|writifyTag| '|writifyFailed|))) - (when (stringp ob) - (exit - (seq - (when (eq ob |$NullStream|) - (exit - (cons 'writified!! (cons 'nullstream nil)))) - (when (eq ob |$NonNullStream|) - (exit - (cons 'writified!! (cons 'nonnullstream nil)))) - (exit ob)))) - (when (floatp ob) - (exit - (seq - (when (boot-equal ob (read-from-string (princ-to-string ob))) - (exit ob)) - (exit - (cons 'writified!! - (cons 'float - (cons ob - (multiple-value-list (integer-decode-float ob))))))))) - (exit ob))))) - -\end{chunk} -\defun{writify}{writify} -\calls{writify}{ScanOrPairVec} -\calls{writify}{function} -\calls{writify}{writify,writifyInner} -\usesdollar{writify}{seen} -\usesdollar{writify}{writifyComplained} -\begin{chunk}{defun writify} -(defun |writify| (ob) - (let (|$seen| |$writifyComplained|) - (declare (special |$seen| |$writifyComplained|)) - (if (null (|ScanOrPairVec| #'|unwritable?| ob)) - ob - (progn - (setq |$seen| (make-hash-table :test #'eq)) - (setq |$writifyComplained| nil) - (|writify,writifyInner| ob))))) - -\end{chunk} -\defun{spadClosure?}{spadClosure?} -\calls{spadClosure?}{qcar} -\calls{spadClosure?}{bpiname} -\calls{spadClosure?}{qcdr} -\calls{spadClosure?}{vecp} -\begin{chunk}{defun spadClosure?} -(defun |spadClosure?| (ob) - (let (fun name vec) - (setq fun (qcar ob)) - (if (null (setq name (bpiname fun))) - nil - (progn - (setq vec (qcdr ob)) - (if (null (vecp vec)) - nil - name))))) - -\end{chunk} - -\defdollar{NonNullStream} -\begin{chunk}{initvars} -(defvar |$NonNullStream| "NonNullStream") - -\end{chunk} - -\defdollar{NullStream} -\begin{chunk}{initvars} -(defvar |$NullStream| "NullStream") - -\end{chunk} - -\defun{dewritify,dewritifyInner}{dewritify,dewritifyInner} -\calls{dewritify,dewritifyInner}{seq} -\calls{dewritify,dewritifyInner}{exit} -\calls{dewritify,dewritifyInner}{hget} -\calls{dewritify,dewritifyInner}{intp} -\calls{dewritify,dewritifyInner}{gensymmer} -\calls{dewritify,dewritifyInner}{error} -\calls{dewritify,dewritifyInner}{poundsign} -\calls{dewritify,dewritifyInner}{hput} -\calls{dewritify,dewritifyInner}{dewritify,dewritifyInner} -\calls{dewritify,dewritifyInner}{concat} -\calls{dewritify,dewritifyInner}{vmread} -\calls{dewritify,dewritifyInner}{make-instream} -\calls{dewritify,dewritifyInner}{spaddifference} -\calls{dewritify,dewritifyInner}{qcar} -\calls{dewritify,dewritifyInner}{qcdr} -\calls{dewritify,dewritifyInner}{qrplaca} -\calls{dewritify,dewritifyInner}{qrplacd} -\calls{dewritify,dewritifyInner}{vecp} -\calls{dewritify,dewritifyInner}{qvmaxindex} -\calls{dewritify,dewritifyInner}{qsetvelt} -\calls{dewritify,dewritifyInner}{qvelt} -\usesdollar{dewritify,dewritifyInner}{seen} -\usesdollar{dewritify,dewritifyInner}{NullStream} -\usesdollar{dewritify,dewritifyInner}{NonNullStream} -\begin{chunk}{defun dewritify,dewritifyInner} -(defun |dewritify,dewritifyInner| (ob) - (prog (e type oname f vec name tmp1 signif expon sign fval qcar qcdr n nob) - (declare (special |$seen| |$NullStream| |$NonNullStream|)) - (return - (seq - (when (null ob) - (exit nil)) - (when (setq e (hget |$seen| ob)) - (exit e)) - (when (and (consp ob) (eq (car ob) 'writified!!)) - (exit - (seq - (setq type (elt ob 1)) - (when (eq type 'self) - (exit 'writified!!)) - (when (eq type 'bpi) - (exit - (seq - (setq oname (elt ob 2)) - (setq f - (seq - (when (integerp oname) (exit (eval (gensymmer oname)))) - (exit (symbol-function oname)))) - (when (null (compiled-function-p f)) - (exit (|error| "A required BPI does not exist."))) - (when (and (> (|#| ob) 3) (not (equal (sxhash f) (elt ob 3)))) - (exit (|error| "A required BPI has been redefined."))) - (hput |$seen| ob f) - (exit f)))) - (when (eq type 'hashtable) - (exit - (seq - (setq nob (make-hash-table :test #'equal)) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (do ((tmp0 (elt ob 3) (cdr tmp0)) - (k nil) - (tmp1 (elt ob 4) (cdr tmp1)) - (e nil)) - ((or (atom tmp0) - (progn - (setq k (car tmp0)) - nil) - (atom tmp1) - (progn - (setq e (car tmp1)) - nil)) - nil) - (seq - (exit - (hput nob (|dewritify,dewritifyInner| k) - (|dewritify,dewritifyInner| e))))) - (exit nob)))) - (when (eq type 'devaluated) - (exit - (seq - (setq nob (eval (|dewritify,dewritifyInner| (elt ob 2)))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)))) - (when (eq type 'spadclosure) - (exit - (seq - (setq vec (|dewritify,dewritifyInner| (elt ob 2))) - (setq name (ELT ob 3)) - (when (null (fboundp name)) - (exit - (|error| - (concat "undefined function: " (symbol-name name))))) - (setq nob (cons (symbol-function name) vec)) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)))) - (when (eq type 'place) - (exit - (seq - (setq nob (vmread (make-instream nil))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)))) - (when (eq type 'readtable) - (exit (|error| "Cannot de-writify a read table."))) - (when (eq type 'nullstream) - (exit |$NullStream|)) - (when (eq type 'nonnullstream) - (exit |$NonNullStream|)) - (when (eq type 'float) - (exit - (seq - (progn - (setq tmp1 (cddr ob)) - (setq fval (car tmp1)) - (setq signif (cadr tmp1)) - (setq expon (caddr tmp1)) - (setq sign (cadddr tmp1)) - tmp1) - (setq fval (scale-float (float signif fval) expon)) - (when (minusp sign) - (exit (spaddifference fval))) - (exit fval)))) - (exit (|error| "Unknown type to de-writify."))))) - (when (consp ob) - (exit - (seq - (setq qcar (qcar ob)) - (setq qcdr (qcdr ob)) - (setq nob (cons qcar qcdr)) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (qrplaca nob (|dewritify,dewritifyInner| qcar)) - (qrplacd nob (|dewritify,dewritifyInner| qcdr)) - (exit nob)))) - (when (vecp ob) - (exit - (seq - (setq n (qvmaxindex ob)) - (setq nob (make-array (1+ n))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (do ((i 0 (1+ i))) - ((> i n) nil) - (seq - (exit - (qsetvelt nob i - (|dewritify,dewritifyInner| (qvelt ob i)))))) - (exit nob)))) - (exit ob))))) - -\end{chunk} - -\defun{dewritify}{dewritify} -\calls{dewritify}{ScanOrPairVec} -\calls{dewritify}{function} -\calls{dewritify}{dewritify,dewritifyInner} -\usesdollar{dewritify}{seen} -\begin{chunk}{defun dewritify} -(defun |dewritify| (ob) - (let (|$seen|) - (declare (special |$seen|)) - (if (null (|ScanOrPairVec| #'(lambda (a) (eq a 'writified!!)) ob)) - ob - (progn - (setq |$seen| (make-hash-table :test #'eq)) - (|dewritify,dewritifyInner| ob))))) - -\end{chunk} - -\defun{ScanOrPairVec,ScanOrInner}{ScanOrPairVec,ScanOrInner} -\throws{ScanOrPairVec,ScanOrInner}{ScanOrPairVecAnswer} -\calls{ScanOrPairVec,ScanOrInner}{hget} -\calls{ScanOrPairVec,ScanOrInner}{hput} -\calls{ScanOrPairVec,ScanOrInner}{ScanOrPairVec,ScanOrInner} -\calls{ScanOrPairVec,ScanOrInner}{qcar} -\calls{ScanOrPairVec,ScanOrInner}{qcdr} -\calls{ScanOrPairVec,ScanOrInner}{vecp} -\usesdollar{ScanOrPairVec,ScanOrInner}{seen} -\begin{chunk}{defun ScanOrPairVec,ScanOrInner} -(defun |ScanOrPairVec,ScanOrInner| (f ob) - (declare (special |$seen|)) - (when (hget |$seen| ob) nil) - (when (consp ob) - (hput |$seen| ob t) - (|ScanOrPairVec,ScanOrInner| f (qcar ob)) - (|ScanOrPairVec,ScanOrInner| f (qcdr ob))) - (when (vecp ob) - (hput |$seen| ob t) - (do ((tmp0 (spaddifference (|#| ob) 1)) (i 0 (1+ i))) - ((> i tmp0) nil) - (|ScanOrPairVec,ScanOrInner| f (elt ob i)))) - (when (funcall f ob) (throw '|ScanOrPairVecAnswer| t)) - nil) - -\end{chunk} - -\defun{ScanOrPairVec}{ScanOrPairVec} -\catches{ScanOrPairVec}{ScanOrPairVecAnswer} -\calls{ScanOrPairVec}{ScanOrPairVec,ScanOrInner} -\usesdollar{ScanOrPairVec}{seen} -\begin{chunk}{defun ScanOrPairVec} -(defun |ScanOrPairVec| (f ob) - (let (|$seen|) - (declare (special |$seen|)) - (setq |$seen| (make-hash-table :test #'eq)) - (catch '|ScanOrPairVecAnswer| (|ScanOrPairVec,ScanOrInner| f ob)))) - -\end{chunk} -\defun{gensymInt}{gensymInt} -\calls{gensymInt}{gensymp} -\calls{gensymInt}{error} -\calls{gensymInt}{pname} -\calls{gensymInt}{charDigitVal} -\begin{chunk}{defun gensymInt} -(defun |gensymInt| (g) - (let (p n) - (if (null (gensymp g)) - (|error| "Need a GENSYM") - (progn - (setq p (pname g)) - (setq n 0) - (do ((tmp0 (spaddifference (|#| p) 1)) (i 2 (1+ i))) - ((> i tmp0) nil) - (setq n (+ (* 10 n) (|charDigitVal| (elt p i))))) - n)))) - -\end{chunk} -\defun{charDigitVal}{charDigitVal} -\calls{charDigitVal}{spaddifference} -\calls{charDigitVal}{error} -\begin{chunk}{defun charDigitVal} -(defun |charDigitVal| (c) - (let (digits n) - (setq digits "0123456789") - (setq n (spaddifference 1)) - (do ((tmp0 (spaddifference (|#| digits) 1)) (i 0 (1+ i))) - ((or (> i tmp0) (null (minusp n))) nil) - (if (char= c (elt digits i)) - (setq n i) - nil)) - (if (minusp n) - (|error| "Character is not a digit") - n))) - -\end{chunk} -\defun{histFileErase}{histFileErase} -\begin{chunk}{defun histFileErase} -(defun |histFileErase| (file) - (when (probe-file file) (delete-file file))) - -\end{chunk} - -\begin{chunk}{History File Messages} -S2IH0001 - You have not reached step %1b yet, and so its value cannot be - supplied. -S2IH0002 - Cannot supply value for step %1b because 1 is the first step. -S2IH0003 - Step %1b has no value. -S2IH0004 - The history facility is not on, so you cannot use %b %% %d . -S2IH0006 - You have not used the correct syntax for the %b history %d command. - Issue %b )help history %d for more information. -S2IH0007 - The history facility is already on. -S2IH0008 - The history facility is now on. -S2IH0009 - Turning on the history facility will clear the contents of the - workspace. - Please enter %b y %d or %b yes %d if you really want to do this: -S2IH0010 - The history facility is still off. -S2IH0011 - The history facility is already off. -S2IH0012 - The history facility is now off. -S2IH0013 - The history facility is not on, so the .input file containing your user input - cannot be created. -S2IH0014 - Edit %b %1 %d to see the saved input lines. -S2IH0015 - The argument %b n %d for %b )history )change n must be a nonnegative - integer and your argument, %1b , is not one. -S2IH0016 - The history facility is not on, so no information can be saved. -S2IH0018 - The saved history file is %1b . -S2IH0019 - There is no history file, so value of step %1b is - undefined. -S2IH0022 - No history information had been saved yet. -S2IH0023 - %1b is not a valid filename for the history file. -S2IH0024 - History information cannot be restored from %1b because the file does - not exist. -S2IH0025 - The workspace has been successfully restored from the history file - %1b . -S2IH0026 - The history facility command %1b cannot be performed because the - history facility is not on. -S2IH0027 - A value containing a %1b is being saved in a history file or a - compiled input file INLIB. This type - is not yet usable in other history operations. You might want to issue - %b )history )off %d -S2IH0029 - History information is already being maintained in an external file - (and not in memory). -S2IH0030 - History information is already being maintained in memory (and not - in an external file). -S2IH0031 - When the history facility is active, history information will be - maintained in a file (and not in an internal table). -S2IH0032 - When the history facility is active, history information will be - maintained in memory (and not in an external file). -S2IH0034 - Missing element in internal history table. -S2IH0035 - Can't save the value of step number %1b. You can re-generate this value - by running the input file %2b. -S2IH0036 - The value specified cannot be saved to a file. -S2IH0037 - You must specify a file name to the history save command -S2IH0038 - You must specify a file name to the history write command -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{include} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{include.help} - -User Level Required: interpreter - -Command Syntax: - - )include filename - -Command Description: - -The )include command can be used in .input files to place the contents -of another file inline with the current file. The path can be an -absolute or relative pathname. - -\end{chunk} - -\defun{ncloopInclude1}{ncloopInclude1} -\calls{ncloopInclude1}{ncloopIncFileName} -\calls{ncloopInclude1}{ncloopInclude} -\begin{chunk}{defun ncloopInclude1} -(defun |ncloopInclude1| (name n) - (let (a) - (if (setq a (|ncloopIncFileName| name)) - (|ncloopInclude| a n) - n))) - -\end{chunk} -\defunsec{ncloopIncFileName} -{Returns the first non-blank substring of the given string} -\calls{ncloopIncFileName}{incFileName} -\calls{ncloopIncFileName}{concat} -\begin{chunk}{defun ncloopIncFileName} -(defun |ncloopIncFileName| (string) - "Returns the first non-blank substring of the given string" - (let (fn) - (unless (setq fn (|incFileName| string)) - (write-line (concat string " not found"))) - fn)) - -\end{chunk} - -\defunsec{ncloopInclude}{Open the include file and read it in} -The ncloopInclude0 function is part -of the parser and lives in int-top.boot. - -\calls{ncloopInclude}{ncloopInclude0} -\begin{chunk}{defun ncloopInclude} -(defun |ncloopInclude| (name n) - "Open the include file and read it in" - (with-open-file (st name) (|ncloopInclude0| st name n))) - -\end{chunk} - -\defunsec{incFileName}{Return the include filename} -Given a string we return the first token from the string which is -the first non-blank substring. -\calls{incFileName}{incBiteOff} -\begin{chunk}{defun incFileName} -(defun |incFileName| (x) - "Return the include filename" - (car (|incBiteOff| x))) - -\end{chunk} - -\defunsec{incBiteOff}{Return the next token} -Takes a sequence and returns the a list of the first token and the -remaining string characters. If there are no remaining string characters -the second string is of length 0. Effectively it "bites off" the first -token in the string. If the string only 0 or more blanks it returns nil. -\begin{chunk}{defun incBiteOff} -(defun |incBiteOff| (x) - "Return the next token" - (let (blank nonblank) - (setq x (string x)) - (when (setq nonblank (position #\space x :test-not #'char=)) - (setq blank (position #\space x :start nonblank)) - (if blank - (list (subseq x nonblank blank) (subseq x blank)) - (list (subseq x nonblank) ""))))) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{library} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{library.help} -==================================================================== -A.14. )library -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )library libName1 [libName2 ...] - - )library )dir dirName - - )library )only objName1 [objlib2 ...] - - )library )noexpose - -Command Description: - -This command replaces the )load system command that was available in AXIOM -releases before version 2.0. The )library command makes available to AXIOM -the compiled objects in the libraries listed. - -For example, if you )compile dopler.spad in your home directory, issue )library -dopler to have AXIOM look at the library, determine the category and domain -constructors present, update the internal database with various properties of -the constructors, and arrange for the constructors to be automatically loaded -when needed. If the )noexpose option has not been given, the constructors -will be exposed (that is, available) in the current frame. - -If you compiled a file you will have an NRLIB present, for example, -DOPLER.NRLIB, where DOPLER is a constructor abbreviation. The command -)library DOPLER will then do the analysis and database updates as above. - -To tell the system about all libraries in a directory, use )library )dir -dirName where dirName is an explicit directory. You may specify ``.'' as the -directory, which means the current directory from which you started the -system or the one you set via the )cd command. The directory name is required. - -You may only want to tell the system about particular constructors within a -library. In this case, use the )only option. The command )library dopler -)only Test1 will only cause the Test1 constructor to be analyzed, autoloaded, -etc.. - -Finally, each constructor in a library are usually automatically exposed when -the )library command is used. Use the )noexpose option if you not want them -exposed. At a later time you can use )set expose add constructor to expose -any hidden constructors. - -Note for AXIOM beta testers: At various times this command was called )local -and )with before the name )library became the official name. - -Also See: -o )cd -o )compile -o )frame -o )set - -\end{chunk} -\footnote{ -\fnref{cd} -\fnref{frame} -\fnref{set}} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{lisp} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{lisp.help} -==================================================================== -A.15. )lisp -==================================================================== - -User Level Required: development - -Command Syntax: - - - )lisp [lispExpression] - -Command Description: - -This command is used by AXIOM system developers to have single expressions -evaluated by the Lisp system on which AXIOM is built. The lispExpression is -read by the Lisp reader and evaluated. If this expression is not complete -(unbalanced parentheses, say), the reader will wait until a complete -expression is entered. - -Since this command is only useful for evaluating single expressions, the )fin -command may be used to drop out of AXIOM into Lisp. - -Also See: -o )system -o )boot -o )fin - -\end{chunk} -\footnote{ -\fnref{system} -\fnref{boot} -\fnref{fin}} - -This command is in the list of \verb|$noParseCommands| -\ref{noParseCommands} which means that its arguments are passed -verbatim. This will eventually result in a call to the function -\verb|handleNoParseCommands| \ref{handleNoParseCommands} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{ltrace} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{ltrace.help} -==================================================================== -A.17. )ltrace -==================================================================== - -User Level Required: development - -Command Syntax: - -This command has the same arguments as options as the )trace command. - -Command Description: - -This command is used by AXIOM system developers to trace Lisp or BOOT -functions. It is not supported for general use. - -Also See: -o )boot -o )lisp -o )trace - -\end{chunk} -\footnote{ -\fnref{boot} -\fnref{lisp} -\fnref{trace}} - -\defun{ltrace}{The top level )ltrace function} -\calls{ltrace}{trace} -\begin{chunk}{defun ltrace} -(defun |ltrace| (arg) (|trace| arg)) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{pquit} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{pquit.help} -==================================================================== -A.18. )pquit -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )pquit - -Command Description: - -This command is used to terminate AXIOM and return to the operating system. -Other than by redoing all your computations or by using the )history )restore -command to try to restore your working environment, you cannot return to -AXIOM in the same state. - -)pquit differs from the )quit in that it always asks for confirmation that -you want to terminate AXIOM (the ``p'' is for ``protected''). When you enter -the )pquit command, AXIOM responds - - Please enter y or yes if you really want to leave the interactive - environment and return to the operating system: - -If you respond with y or yes, you will see the message - - You are now leaving the AXIOM interactive environment. - Issue the command axiom to the operating system to start a new session. - -and AXIOM will terminate and return you to the operating system (or the -environment from which you invoked the system). If you responded with -something other than y or yes, then the message - - You have chosen to remain in the AXIOM interactive environment. - -will be displayed and, indeed, AXIOM would still be running. - -Also See: -o )fin -o )history -o )close -o )quit -o )system - -\end{chunk} -\footnote{ -\fnref{fin} -\fnref{history} -\fnref{close} -\fnref{quit} -\fnref{system}} - -\defunsec{pquit}{The top level pquit command} -\calls{pquit}{pquitSpad2Cmd} -\begin{chunk}{defun pquit} -(defun |pquit| () - "The top level pquit command" - (|pquitSpad2Cmd|)) - -\end{chunk} - -\defunsec{pquitSpad2Cmd}{The top level pquit command handler} -\calls{pquitSpad2Cmd}{quitSpad2Cmd} -\usesdollar{pquitSpad2Cmd}{quitCommandType} -\begin{chunk}{defun pquitSpad2Cmd} -(defun |pquitSpad2Cmd| () - "The top level pquit command handler" - (let ((|$quitCommandType| '|protected|)) - (declare (special |$quitCommandType|)) - (|quitSpad2Cmd|))) - -\end{chunk} - -This command is in the list of \verb|$noParseCommands| -\ref{noParseCommands} which means that its arguments are passed -verbatim. This will eventually result in a call to the function -\verb|handleNoParseCommands| \ref{handleNoParseCommands} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{quit} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{quit.help} -==================================================================== -A.19. )quit -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )quit - - )set quit protected | unprotected - -Command Description: - -This command is used to terminate AXIOM and return to the operating system. -Other than by redoing all your computations or by using the )history )restore -command to try to restore your working environment, you cannot return to -AXIOM in the same state. - -)quit differs from the )pquit in that it asks for confirmation only if the -command - -)set quit protected - -has been issued. Otherwise, )quit will make AXIOM terminate and return you to -the operating system (or the environment from which you invoked the system). - -The default setting is )set quit protected so that )quit and )pquit behave in -the same way. If you do issue - -)set quit unprotected - -we suggest that you do not (somehow) assign )quit to be executed when you -press, say, a function key. - -Also See: -o )fin -o )history -o )close -o )pquit -o )system - -\end{chunk} -\footnote{ -\fnref{fin} -\fnref{history} -\fnref{close} -\fnref{pquit} -\fnref{system}} - -\defunsec{quit}{The top level quit command} -\calls{quit}{quitSpad2Cmd} -\begin{chunk}{defun quit} -(defun |quit| () - "The top level quit command" - (|quitSpad2Cmd|)) - -\end{chunk} -\defunsec{quitSpad2Cmd}{The top level quit command handler} -\calls{quitSpad2Cmd}{upcase} -\calls{quitSpad2Cmd}{queryUserKeyedMsg} -\calls{quitSpad2Cmd}{string2id-n} -\calls{quitSpad2Cmd}{leaveScratchpad} -\calls{quitSpad2Cmd}{sayKeyedMsg} -\calls{quitSpad2Cmd}{tersyscommand} -\usesdollar{quitSpad2Cmd}{quitCommandType} -\begin{chunk}{defun quitSpad2Cmd} -(defun |quitSpad2Cmd| () - "The top level quit command handler" - (declare (special |$quitCommandType|)) - (if (eq |$quitCommandType| '|protected|) - (let (x) - (setq x (upcase (|queryUserKeyedMsg| 's2iz0031 nil))) - (when (member (string2id-n x 1) '(y yes)) (|leaveScratchpad|)) - (|sayKeyedMsg| 's2iz0032 nil) - (tersyscommand)) - (|leaveScratchpad|))) - -\end{chunk} - -\defunsec{leaveScratchpad}{Leave the Axiom interpreter} -\begin{chunk}{defun leaveScratchpad} -(defun |leaveScratchpad| () - "Leave the Axiom interpreter" - (bye)) - -\end{chunk} - -This command is in the list of \verb|$noParseCommands| -\ref{noParseCommands} which means that its arguments are passed -verbatim. This will eventually result in a call to the function -\verb|handleNoParseCommands| \ref{handleNoParseCommands} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{read} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{read.help} -==================================================================== -A.20. )read -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )read [fileName] - - )read [fileName] [)quiet] [)ifthere] - -Command Description: - -This command is used to read .input files into AXIOM. The command - -)read matrix.input - -will read the contents of the file matrix.input into AXIOM. The ``.input'' -file extension is optional. See the AXIOM User Guide index for more -information about .input files. - -This command remembers the previous file you edited, read or compiled. If you -do not specify a file name, the previous file will be read. - -The )ifthere option checks to see whether the .input file exists. If it does -not, the )read command does nothing. If you do not use this option and the -file does not exist, you are asked to give the name of an existing .input -file. - -The )quiet option suppresses output while the file is being read. - -Also See: -o )compile -o )edit -o )history - -\end{chunk} -\footnote{ -\fnref{edit} -\fnref{history}} - -\defun{read}{The )read command} -\calls{read}{readSpad2Cmd} -\begin{chunk}{defun read} -(defun |read| (arg) (|readSpad2Cmd| arg)) - -\end{chunk} - -\defun{readSpad2Cmd}{Implement the )read command} -\calls{readSpad2Cmd}{selectOptionLC} -\calls{readSpad2Cmd}{optionError} -\calls{readSpad2Cmd}{pathname} -\calls{readSpad2Cmd}{pathnameTypeId} -\calls{readSpad2Cmd}{makePathname} -\calls{readSpad2Cmd}{pathnameName} -\calls{readSpad2Cmd}{mergePathnames} -\calls{readSpad2Cmd}{findfile} -\calls{readSpad2Cmd}{throwKeyedMsg} -\calls{readSpad2Cmd}{namestring} -\calls{readSpad2Cmd}{upcase} -\calls{readSpad2Cmd}{member} -\calls{readSpad2Cmd}{/read} -\usesdollar{readSpad2Cmd}{InteractiveMode} -\usesdollar{readSpad2Cmd}{findfile} -\usesdollar{readSpad2Cmd}{UserLevel} -\usesdollar{readSpad2Cmd}{options} -\uses{readSpad2Cmd}{/editfile} -\begin{chunk}{defun readSpad2Cmd} -(defun |readSpad2Cmd| (arg) - (prog (|$InteractiveMode| fullopt ifthere quiet ef devFTs fileTypes - ll ft upft fs) - (declare (special |$InteractiveMode| $findfile |$UserLevel| |$options| - /editfile)) - (setq |$InteractiveMode| t) - (dolist (opt |$options|) - (setq fullopt - (|selectOptionLC| (car opt) '(|quiet| |test| |ifthere|) '|optionError|)) - (cond - ((eq fullopt '|ifthere|) (setq ifthere t)) - ((eq fullopt '|quiet|) (setq quiet t)))) - (setq ef (|pathname| /editfile)) - (when (eq (|pathnameTypeId| ef) 'spad) - (setq ef (|makePathname| (|pathnameName| ef) "*" "*"))) - (if arg - (setq arg (|mergePathnames| (|pathname| arg) ef)) - (setq arg ef)) - (setq devFTs '("input" "INPUT" "boot" "BOOT" "lisp" "LISP")) - (setq fileTypes - (cond - ((eq |$UserLevel| '|interpreter|) '("input" "INPUT")) - ((eq |$UserLevel| '|compiler|) '("input" "INPUT")) - (t devFTs))) - (setq ll ($findfile arg fileTypes)) - (unless ll - (if ifthere - (return nil) - (|throwKeyedMsg| 'S2IL0003 (list (|namestring| arg))))) - (setq ll (|pathname| ll)) - (setq ft (|pathnameType| ll)) - (setq upft (upcase ft)) - (cond - ((null (|member| upft fileTypes)) - (setq fs (|namestring| arg)) - (if (|member| upft devFTs) - (|throwKeyedMsg| 'S2IZ0033 (list fs)) - (|throwKeyedMsg| 'S2IZ0034 (list fs)))) - (t - (setq /editfile ll) - (when (string= upft "BOOT") (setq |$InteractiveMode| nil)) - (/read ll quiet))))) - -\end{chunk} - -\defun{/read}{/read} -\seebook{/read}{/rf}{9} -\seebook{/read}{/rq}{9} -\uses{/read}{/editfile} -\begin{chunk}{defun /read} -(defun /read (l q) - (declare (special /editfile)) - (setq /editfile l) - (cond - (q (/rq)) - (t (/rf)) ) - (flag |boot-NewKEY| 'key) - (|terminateSystemCommand|) - (|spadPrompt|)) - - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{regress} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{regress.help} -==================================================================== -A.18. )regress -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )regress fileName - -Command Description: - -The regress command will run the regress function that was compiled -as part of the lisp image build process. This function expects an -input filename, possibly containing a path prefix. - -If the filename contains a period then we consider it a fully formed -filename, otherwise we append ``.output'', which is the default file -extension. - - )regress matrix - )regress matrix.output - )regress /path/to/file/matrix - )regress /path/to/file/matrix.output - -will test the contents of the file matrix.output. - -The idea behind regression testing is to check that the results -we currently get match the results we used to get. In order to -do that we create input files with a special comment format that -contains the prior results. These are easy to create as all you -need to do is run the Axiom function, capture the results, and -turn them input specially formed comments using the -- comment. - -A regression file caches the result of an Axiom function so we -can automate the testing process. It is a file of many tests, -each with their own output. - -The regression file format uses the Axiom -- comment syntax to keep -a copy of the expected output from an Axiom command. This expected -output is compared character by character against the actual output. - -The regression file is broken into numbered blocks, delimited by -a --S for the beginning and a --E for the end. The total number of -blocks is also given so missing or failed tests also raise an error. - -There are 4 special kinds of -- comments in regression files: - - --S n of M this is test n of M tests in this file - --E n this marks the end of test n - --R any output this marks the actual expected output line - --I any output this line is compared but ignored - -A regression test file looks like: - - )set break resume - )spool foo.output - )set message type off - )clear all - - --S 1 of 3 - 2+3 - --R this is the exact Axiom output - --R (1) 5 - --E 1 - - --S 2 of 3 - 2+3 - --R this should fail to match - --R (2) 7 - --E 2 - - --S 3 of 3 - 2+3 - --R this fails to match but we - --I (3) 7 use --I to ignore this line - --E 3 - -We can now run this file with - - )read foo.input - -Note that when this file is run it will create a spool file called -"foo.output" because of the lines: - - )spool foo.output - )spool - -The "foo.output" file contains the console image of the result. -It will look like: - - Starts dribbling to foo.output (2012/2/28, 12:25:7). - )set message type off - )clear all - - --S 1 of 3 - 2+3 - - (1) 5 - --R - --R (1) 5 - --E 1 - - --S 2 of 3 - 2+3 - - (2) 5 - --R - --R (2) 7 - --E 2 - - --S 3 of 3 - 2+3 - - (3) 5 - --R - --I (3) 7 - --E 3 - - )spool - -This "foo.output" file can now be checked using the )regress command. - -When we run the )regress foo.output we see; - - testing foo - passed foo 1 of 3 - MISMATCH - expected:" (2) 7" - got:" (2) 5" - FAILED foo 2 of 2 - passed foo 3 of 3 - regression result FAILED 1 of 3 stanzas file foo - -Tests either pass or fail. A passing test generates the message: - - passed foo 1 of 3 - -A failing test will give a reversed printout of the expected vs -actual output as well as a FAILED message, as in: - - MISMATCH - expected:" (2) 7" - got:" (2) 5" - FAILED foo 2 of 3 - -The last line of output is a summary: - - regression result FAILED 1 of 3 stanzas file foo - - -\end{chunk} - -\begin{chunk}{defun regress command} -(defun |regress| (arg) - (let (|$InteractiveMode| namestring dot1 outfile (extension "output")) - (declare (special |$InteractiveMode|)) - (setq |$InteractiveMode| t) - (setq namestring (symbol-name (car arg))) - (setq dot1 (position #\. namestring)) - (unless dot1 - (setq outfile (concatenate 'string (subseq namestring 0) "." extension))) - (if (probe-file outfile) - (regress outfile) - (format t (concatenate 'string outfile "~% file not found"))))) - -\end{chunk} - -\subsection{The regress function details} -This is the regression test mechanism. The input files have been -rewritten to have a standard structure. This fixed format identifies -the tests within a file. Each test is run and any mismatch between -the actual and expected results is reported. - -In order to regression test axiom results we created a standard -file format. This format has 3 kinds of markers: -\begin{itemize} -\item ``--S'' marker which must have a integer test number -\item ``--R'' marker lines, one per expected output from axiom -\item ``--E'' marker which has an integer matching the preceeding ``--S'' -\item ``--I'' marker ignores the line, useful for gensyms and random -\end{itemize} -Because these markers use Axiom's standard comment prefix they -are valid lines in input files and are ignored by the ``)read'' -command. They are simply copied to the output file. This allows -us to include the expected output in the output file so we can -compare what Axiom computes with what it should compute. - -To create these regression files all you need to do is create an -input file and run it through Axiom. Then, for each test case in -the file you mark it up by putting a ``--S number'' {\bf before} -the Axiom input line. You put ``--R'' prefixes on each line of -Axiom output, including the blank lines. Then you put a ``--E number'' -line after the last output line, usually the {\tt Type:} line. -This newly marked-up input file is now a regression test. - -To actually run the regression test you simply include the -marked up the input file in the {\tt src/input} subdirectory. -This file will automatically be run at build time and any failing -tests will be marked. This code will ignore any input that does -not contain proper regression markups. - -Ideally the regression test files should be pamphlet files that -explain the content and purpose of each regression test case. - -Thus you run the marked-up input file {\tt foo.input} -and spool the result to {\tt foo.output} and then run the -lisp function\\ -{\tt (regress ``foo.output'')} - -If the file does not contain proper regression markups it is -ignored. Comments or any other commands in the file that are not -surrounded by ``--S'' and ``--E'' boundaries are ignored. - -\defvar{*all-tests-ran*} -This variable is used to check whether all of the tests actually -ran. This is needed to see if the execution ended early. -\begin{chunk}{initvars} -(defvar *all-tests-ran* nil "true implies that all tests ran") - -\end{chunk} - -\defun{regress}{Scan a spool output file for failures} -This function takes an output file which has been created by the -Axiom {\tt )spool} command and looks for regression test markups. -Each regression test is checked against the actual result and any -failures are marked. - -\calls{regress}{getspoolname} -\calls{regress}{findnexttest} -\calls{regress}{testpassed} -\uses{regress}{*all-tests-ran*} -\begin{chunk}{defun regress} -(defun regress (infile) - (let (name comment test (count 0) (passed 0) (failed 0)) - (declare (special *all-tests-ran*)) - (setq *all-tests-ran* nil) - (with-open-file (stream infile :direction :input) - (setq name (getspoolname stream)) - (when name - (format t "testing ~a~%" name) - (loop - (setq *ok* nil) - (multiple-value-setq (comment test) (findnexttest stream)) - (unless comment (return)) - (setq count (+ count 1)) - (if (testpassed test) - (progn - (setq passed (+ passed 1)) - (format t "passed ~a ~a~%" name comment)) - (progn - (setq failed (+ failed 1)) - (format t "FAILED ~a ~a~%" name comment)))) - (if (= failed 0) - (format t "regression result passed ~a of ~a stanzas ~Tfile ~a~%" - passed count name) - (format t "regression result FAILED ~a of ~a stanzas ~Tfile ~a~%" - failed count name)) - (unless *all-tests-ran* - (format t "regression result FAILED early exit in file ~a?~%" name)))))) - -\end{chunk} - -\defun{getspoolname}{Parse test name from the spool command} -We need to parse out the name of the test. The ``)spool'' command -writes a line into the output file containing the name of the test. -We parse out the name of the test from this line. -\begin{chunk}{defun getspoolname 0} -(defun getspoolname (stream) - (let (line point) - (setq line (read-line stream)) - (setq point (position #\. line)) - (if (or (null point) - (< (length line) 30) - (not (string= (subseq line (+ point 1) (+ point 7)) "output"))) - nil - (subseq line 20 point)))) - -\end{chunk} - -\defun{findnexttest}{Find the next --S marker} -We need to break the file into separate test cases. This routine -looks for the ``--S'' line which indicates a test is starting. It -collects up input lines until it encounters the ``--E'' line marking -the end of the test case. These lines are returned as a list of strings. - -\calls{findnexttest}{testnumberp} -\begin{chunk}{defun findnexttest} -(defun findnexttest (stream) - (let (teststart result) - (do ((line (read-line stream nil 'done) (read-line stream nil 'done))) - ((or (eq line 'done) (endedp line)) - (values (if line teststart) result)) - (if teststart - (push line result) - (setq teststart (testnumberp line)))))) - -\end{chunk} - -\defun{testnumberp}{Parse out the test number from --S lines} -The ``--S'' line has a test number on the line. We parse out the -test number for printing. -\calls{testnumberp}{startp} -\begin{chunk}{defun testnumberp} -(defun testnumberp (oneline) - (when (startp oneline) (subseq oneline 3))) - -\end{chunk} - -\defvar{*ok*} -We can mark a test as always ok by putting the word ``ok'' anywhere -on the start line. The regress function resets this value. The startp -function checks the --S line for the word ``ok''. If found, it sets -this value to true which causes a failing test to be considered as -passed. -\begin{chunk}{initvars} -(defvar *ok* nil "did we mark this test as always ok?") - -\end{chunk} - -\defun{testpassed}{Compare the computed and expected results} -This routine takes the test input, passes it to split to clean up -and break into two lists, and then compares the resulting lists -element by element, complaining about any mismatches. The result -is either true if everything passes or false if a mismatch occurs. - -A test line can also be considered at passing if the expected line -is the string ``ignore''. - -The ok variable allows us to mark failing tests as ``ok'' because -we expect the test might fail due to random values or testing known -bugs against expected output. We filter these tests marked ``ok'' -so they do not count as ``real'' failures. - -\calls{testpassed}{split} -\uses{testpassed}{*ok*} -\begin{chunk}{defun testpassed} -(defun testpassed (test) - (let (answer expected (passed t) mismatchedLines) - (declare (special *ok*)) - (multiple-value-setq (answer expected) (split test)) - (dotimes (i (length answer)) - (unless - (or (string= (first expected) "ignore") - (string= (first expected) (first answer))) - (unless *ok* (setq passed nil)) - (push (cons (first expected) (first answer)) mismatchedLines)) - (pop answer) - (pop expected)) - (when mismatchedLines - (dolist (pair mismatchedLines) - (format t "expected:~s~% got:~s~%" (car pair) (cdr pair)))) - passed)) - -\end{chunk} - -\defun{split}{Split the calculated and expect results into lists} -We have a list containing all of the lines in a test. The input is of -the form: -\begin{verbatim} -("--R Type: List Integer" - "--R (1) [1,4,2,- 6,0,3,5,4,2,3]" - "--R" - "--R " - " Type: List Integer" - " (1) [1,4,2,- 6,0,3,5,4,2,3]" - "" - " " - "l := [1,4,2,-6,0,3,5,4,2,3]") -\end{verbatim} -It removes the ``--R'' prefix from the result strings -and generates two hopefully equal-length lists, thus: -\begin{verbatim} -(" Type: List Integer" - " (1) [1,4,2,- 6,0,3,5,4,2,3]" - "" - " ") -(" Type: List Integer" - " (1) [1,4,2,- 6,0,3,5,4,2,3]" - "" - " ")) -\end{verbatim} -Thus the first line is the start line, the second line is the Axiom -input line, followed by the Axiom output. Then we have the lines marked -``--R'' which are the expected result. We split these into two separate -lists and throw way the lines that are the start and end lines. - -Once we have classified all of the lines we need to throw away the -input lines. By assumption there will be more answer lines than -expected lines because the input lines are included. And given the way -we process the file these input lines are on the top of the answer -stack. Since the number of answer lines should equal the number of -expected lines we pop the stack until the numbers are equal. - -Each element of the answer list should -be {\tt string=} to the corresponding element of the result list. - -If the input line starts with ``--I'' we push the string ``ignore''. -This is useful for handling random results or gensym symbols. - -\calls{split}{startp} -\calls{split}{endedp} -\calls{split}{ignorep} -\calls{split}{resultp} -\begin{chunk}{defun split} -(defun split (test) - (let (answer (acnt 0) expected (ecnt 0)) - (dolist (oneline test) - (cond - ((startp oneline)) - ((endedp oneline)) - ((ignorep oneline) - (setq ecnt (+ ecnt 1)) - (push "ignore" expected)) - ((resultp oneline) - (setq ecnt (+ ecnt 1)) - (push (subseq oneline 3) expected)) - (t - (setq acnt (+ acnt 1)) - (push oneline answer)))) - (dotimes (i (- acnt ecnt)) (pop answer)) - (values (nreverse answer) (nreverse expected)))) - -\end{chunk} - -\defun{startp}{Returns true on --S lines} -This test returns true if we have a ``start'' line. That is, a line -with a ``--S'' prefix. - -The *all-tests-ran* variable is true if the start line is of the form -"--S N of M" and N=M, that is, it checks that all tests were performed -since this should only occur on the last start line. This will detect -``premature exit'' in processing. - -If a test is failing because of random input values or we want the -test to fail but not to count toward failing values then put the -string ``ok'' somewhere on the ``--S'' line as in: -\begin{verbatim} ---S 29 of 42 fails due to random values but that is ok -\end{verbatim} - -\calls{startp}{lastcount} -\uses{startp}{*ok*} -\begin{chunk}{defun startp} -(defun startp (oneline) - (let (result) - (declare (special *ok*)) - (when - (setq result - (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--S"))) - (setq *ok* (search "ok" oneline)) - (setq *all-tests-ran* (lastcount oneline))) - result)) - -\end{chunk} - -\defun{endedp}{Returns true on --E lines} -This test returns true if we have a ``ended'' line. That is, a line -with a ``--E'' prefix. -\begin{chunk}{defun endedp 0} -(defun endedp (oneline) - (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--E"))) - -\end{chunk} - -\defun{resultp}{Returns true on --R lines} -This test returns true if we have a ``results'' line. That is, a line -with a ``--R'' prefix. -\begin{chunk}{defun resultp 0} -(defun resultp (oneline) - (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--R"))) - -\end{chunk} - -\defun{ignorep}{Returns true on --I lines} -This test returns true if we have an ``ignore'' line. That is, a line -with a ``--I'' prefix. -\begin{chunk}{defun ignorep 0} -(defun ignorep (oneline) - (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--I"))) - -\end{chunk} - -\defun{lastcount}{Check the last --S line ran} -If the ``--S'' line has the format ``--S n of m'' we return true if -n=m, false otherwise. -Thus, -\begin{verbatim} - "--S" => nil - "--S 1 of 4" => nil - "--S 10 of 40" => nil - "--S 4 of 4" => t - "--S 40 of 40" => t - "--S 1 of a" => nil -\end{verbatim} -This is used as a final end check to make sure that all of the -tests actually ran rather than having the regression test exit -early and quietly. This will be false on all but the last test -and will be false if the ``--S'' line does not contain the optional -count marker. It is not required but is highly recommended. - -\begin{chunk}{defun lastcount 0} -(defun lastcount (oneline) - (let ((n :done) (m :done) next somemore isof) - (when (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--S")) - (setq somemore (string-trim " " (subseq oneline 3))) - (when somemore - (multiple-value-setq (n next) (read-from-string somemore nil :done)) - (when (integerp n) - (setq somemore (string-trim " " (subseq somemore next))) - (multiple-value-setq (isof next) (read-from-string somemore nil :done)) - (when (string= isof "OF") - (setq somemore (string-trim " " (subseq somemore next))) - (multiple-value-setq (m next) (read-from-string somemore nil :done)))))) - (and (integerp m) (integerp n) (= m n)))) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{savesystem} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{savesystem.help} -==================================================================== -A.8. )savesystem -==================================================================== - -User Level Required: interpreter - - -Command Syntax: - - - )savesystem filename - -Command Description: - - This command is used to save an AXIOM image to disk. This creates an -executable file which, when started, has everything loaded into it -that was there when the image was saved. Thus, after executing commands -which cause the loading of some packages, the command: - -)savesystem /tmp/savesys - -will create an image that can be restarted with the UNIX command: - -axiom -ws /tmp/savesys - -This new system will not need to reload the packages and domains that -were already loaded when the system was saved. - -There is currently a restriction that only systems started with the -command "AXIOMsys" may be saved. - - axiom - (1) -> t1:=4 - (1) -> )savesystem foo - -and Axiom exits. Then do - - ./foo - (1) -> t1 - 4 - -\end{chunk} - -\defun{savesystem}{The )savesystem command} -\calls{savesystem}{helpSpad2Cmd} -\calls{savesystem}{spad-save} -\begin{chunk}{defun savesystem} -(defun |savesystem| (arg) - (if (or (not (eql (|#| arg) 1)) (null (symbolp (car arg)))) - (|helpSpad2Cmd| '(|savesystem|)) - (spad-save (symbol-name (car arg))))) - -\end{chunk} - -\newpage -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\cmdhead{set} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{chunk}{set.help} -==================================================================== -A.21. )set -==================================================================== - -User Level Required: interpreter - -Command Syntax: - - - )set - - )set label1 [... labelN] - - )set label1 [... labelN] newValue - -Command Description: - -The )set command is used to view or set system variables that control what -messages are displayed, the type of output desired, the status of the history -facility, the way AXIOM user functions are cached, and so on. Since this -collection is very large, we will not discuss them here. Rather, we will show -how the facility is used. We urge you to explore the )set options to -familiarize yourself with how you can modify your AXIOM working environment. -There is a HyperDoc version of this same facility available from the main -HyperDoc menu. Click [here] to go to it. - -The )set command is command-driven with a menu display. It is -tree-structured. To see all top-level nodes, issue )set by itself. - -)set - -Variables with values have them displayed near the right margin. Subtrees of -selections have ``...'' displayed in the value field. For example, there are -many kinds of messages, so issue )set message to see the choices. - -)set message - -The current setting for the variable that displays whether computation times -are displayed is visible in the menu displayed by the last command. To see -more information, issue - -)set message time - -This shows that time printing is on now. To turn it off, issue - -)set message time off - -As noted above, not all settings have so many qualifiers. For example, to -change the )quit command to being unprotected (that is, you will not be -prompted for verification), you need only issue - -)set quit unprotected - -Also See: -o )quit - -\end{chunk} -\footnote{\fnref{quit}} - -\subsection{Overview} -This section contains tree of information used to initialize the {\bf )set} -command in the interpreter. The current list is: -\begin{verbatim} - -Variable Description Current Value ------------------------------------------------------------------ -compile Library compiler options ... -breakmode execute break processing on error break -expose control interpreter constructor exposure ... -functions some interpreter function options ... -fortran view and set options for FORTRAN output ... -kernel library functions built into the kernel for - efficiency ... -hyperdoc options in using HyperDoc ... -help view and set some help options ... -history save workspace values in a history file on -messages show messages for various system features ... -naglink options for NAGLink ... -output view and set some output options ... -quit protected or unprotected quit unprotected -streams set some options for working with streams ... -system set some system development variables ... -userlevel operation access level of system user development - -Variables with current values of ... have further sub-options. -For example, issue )set system to see what the options are -for system. For more information, issue )help set . - -\end{verbatim} - -\defunsec{initializeSetVariables}{Initialize the set variables} -The argument settree is initially the \verb|$setOption| variable. -The fourth element is a union-style switch symbol. -The fifth element is usually a variable to set. -The sixth element is a subtree to recurse for the TREE switch. -The seventh element is usually the default value. For more detailed -explanations see the list structure section \ref{Theliststructure}. -\calls{initializeSetVariables}{sayMSG} -\calls{initializeSetVariables}{literals} -\calls{initializeSetVariables}{translateYesNo2TrueFalse} -\calls{initializeSetVariables}{tree} -\calls{initializeSetVariables}{initializeSetVariables} -\begin{chunk}{defun initializeSetVariables} -(defun |initializeSetVariables| (settree) - "Initialize the set variables" - (dolist (setdata settree) - (case (fourth setdata) - (function - (if (canFuncall? (fifth setdata)) - (funcall (fifth setdata) '|%initialize%|) - (|sayMSG| (concatenate 'string " Function not implemented. " - (package-name *package*) ":" (string (fifth setdata)))))) - (integer (set (fifth setdata) (seventh setdata))) - (string (set (fifth setdata) (seventh setdata))) - (literals - (set (fifth setdata) (|translateYesNo2TrueFalse| (seventh setdata)))) - (tree (|initializeSetVariables| (sixth setdata)))))) - -\end{chunk} - -\defunsec{resetWorkspaceVariables}{Reset the workspace variables} -\calls{resetWorkspaceVariables}{copy} -\calls{resetWorkspaceVariables}{initializeSetVariables} -\uses{resetWorkspaceVariables}{/countlist} -\uses{resetWorkspaceVariables}{/editfile} -\uses{resetWorkspaceVariables}{/sourcefiles} -\uses{resetWorkspaceVariables}{/pretty} -\uses{resetWorkspaceVariables}{/spacelist} -\uses{resetWorkspaceVariables}{/timerlist} -\usesdollar{resetWorkspaceVariables}{sourceFiles} -\usesdollar{resetWorkspaceVariables}{existingFiles} -\usesdollar{resetWorkspaceVariables}{functionTable} -\usesdollar{resetWorkspaceVariables}{boot} -\usesdollar{resetWorkspaceVariables}{compileMapFlag} -\usesdollar{resetWorkspaceVariables}{echoLineStack} -\usesdollar{resetWorkspaceVariables}{operationNameList} -\usesdollar{resetWorkspaceVariables}{slamFlag} -\usesdollar{resetWorkspaceVariables}{CommandSynonymAlist} -\usesdollar{resetWorkspaceVariables}{InitialCommandSynonymAlist} -\usesdollar{resetWorkspaceVariables}{UserAbbreviationsAlist} -\usesdollar{resetWorkspaceVariables}{msgAlist} -\usesdollar{resetWorkspaceVariables}{msgDatabase} -\usesdollar{resetWorkspaceVariables}{msgDatabaseName} -\usesdollar{resetWorkspaceVariables}{dependeeClosureAlist} -\usesdollar{resetWorkspaceVariables}{IOindex} -\usesdollar{resetWorkspaceVariables}{coerceIntByMapCounter} -\usesdollar{resetWorkspaceVariables}{e} -\usesdollar{resetWorkspaceVariables}{env} -\usesdollar{resetWorkspaceVariables}{setOptions} -\begin{chunk}{defun resetWorkspaceVariables} -(defun |resetWorkspaceVariables| () - "Reset the workspace variables" - (declare (special /countlist /editfile /sourcefiles |$sourceFiles| /pretty - /spacelist /timerlist |$existingFiles| |$functionTable| $boot - |$compileMapFlag| |$echoLineStack| |$operationNameList| |$slamFlag| - |$CommandSynonymAlist| |$InitialCommandSynonymAlist| - |$UserAbbreviationsAlist| |$msgAlist| |$msgDatabase| |$msgDatabaseName| - |$dependeeClosureAlist| |$IOindex| |$coerceIntByMapCounter| |$e| |$env| - |$setOptions|)) - (setq /countlist nil) - (setq /editfile nil) - (setq /sourcefiles nil) - (setq |$sourceFiles| nil) - (setq /pretty nil) - (setq /spacelist nil) - (setq /timerlist nil) - (setq |$existingFiles| (make-hash-table :test #'equal)) - (setq |$functionTable| nil) - (setq $boot nil) - (setq |$compileMapFlag| nil) - (setq |$echoLineStack| nil) - (setq |$operationNameList| nil) - (setq |$slamFlag| nil) - (setq |$CommandSynonymAlist| (copy |$InitialCommandSynonymAlist|)) - (setq |$UserAbbreviationsAlist| nil) - (setq |$msgAlist| nil) - (setq |$msgDatabase| nil) - (setq |$msgDatabaseName| nil) - (setq |$dependeeClosureAlist| nil) - (setq |$IOindex| 1) - (setq |$coerceIntByMapCounter| 0) - (setq |$e| (cons (cons nil nil) nil)) - (setq |$env| (cons (cons nil nil) nil)) - (|initializeSetVariables| |$setOptions|)) - -\end{chunk} - -\defunsec{displaySetOptionInformation}{Display the set option information} -\calls{displaySetOptionInformation}{displaySetVariableSettings} -\calls{displaySetOptionInformation}{centerAndHighlight} -\calls{displaySetOptionInformation}{concat} -\calls{displaySetOptionInformation}{object2String} -\calls{displaySetOptionInformation}{specialChar} -\calls{displaySetOptionInformation}{sayBrightly} -\calls{displaySetOptionInformation}{bright} -\calls{displaySetOptionInformation}{sayMSG} -\calls{displaySetOptionInformation}{boot-equal} -\calls{displaySetOptionInformation}{sayMessage} -\calls{displaySetOptionInformation}{eval} -\calls{displaySetOptionInformation}{literals} -\calls{displaySetOptionInformation}{translateTrueFalse2YesNo} -\usesdollar{displaySetOptionInformation}{linelength} -\begin{chunk}{defun displaySetOptionInformation} -(defun |displaySetOptionInformation| (arg setdata) - "Display the set option information" - (let (current) - (declare (special $linelength)) - (cond - ((eq (fourth setdata) 'tree) - (|displaySetVariableSettings| (sixth setdata) (first setdata))) - (t - (|centerAndHighlight| - (concat "The " (|object2String| arg) " Option") - $linelength (|specialChar| '|hbar|)) - (|sayBrightly| - `(|%l| ,@(|bright| "Description:") ,(second setdata))) - (case (fourth setdata) - (function - (terpri) - (if (canFuncall? (fifth setdata)) - (funcall (fifth setdata) '|%describe%|) - (|sayMSG| " Function not implemented."))) - (integer - (|sayMessage| - `(" The" ,@(|bright| arg) "option" - " may be followed by an integer in the range" - ,@(|bright| (elt (sixth setdata) 0)) "to" - |%l| ,@(|bright| (elt (sixth setdata) 1)) "inclusive." - " The current setting is" ,@(|bright| (|eval| (fifth setdata)))))) - (string - (|sayMessage| - `(" The" ,@(|bright| arg) "option" - " is followed by a string enclosed in double quote marks." - '|%l| " The current setting is" - ,@(|bright| (list '|"| (|eval| (fifth setdata)) '|"|))))) - (literals - (|sayMessage| - `(" The" ,@(|bright| arg) "option" - " may be followed by any one of the following:")) - (setq current - (|translateTrueFalse2YesNo| (|eval| (fifth setdata)))) - (dolist (name (sixth setdata)) - (if (boot-equal name current) - (|sayBrightly| `( " ->" ,@(|bright| (|object2String| name)))) - (|sayBrightly| (list " " (|object2String| name))))) - (|sayMessage| " The current setting is indicated."))))))) - -\end{chunk} - -\defunsec{displaySetVariableSettings}{Display the set variable settings} -\calls{displaySetVariableSettings}{concat} -\calls{displaySetVariableSettings}{object2String} -\calls{displaySetVariableSettings}{centerAndHighlight} -\calls{displaySetVariableSettings}{sayBrightly} -\calls{displaySetVariableSettings}{say} -\calls{displaySetVariableSettings}{fillerSpaces} -\calls{displaySetVariableSettings}{specialChar} -\calls{displaySetVariableSettings}{concat} -\calls{displaySetVariableSettings}{satisfiesUserLevel} -\calls{displaySetVariableSettings}{spaddifference} -\calls{displaySetVariableSettings}{poundsign} -\calls{displaySetVariableSettings}{eval} -\calls{displaySetVariableSettings}{bright} -\calls{displaySetVariableSettings}{literals} -\calls{displaySetVariableSettings}{translateTrueFalse2YesNo} -\calls{displaySetVariableSettings}{tree} -\usesdollar{displaySetVariableSettings}{linelength} -\begin{chunk}{defun displaySetVariableSettings} -(defun |displaySetVariableSettings| (settree label) - "Display the set variable settings" - (let (setoption opt subtree subname) - (declare (special $linelength)) - (if (eq label '||) - (setq label ")set") - (setq label (concat " " (|object2String| label) " "))) - (|centerAndHighlight| - (concat "Current Values of" label " Variables") $linelength '| |) - (terpri) - (|sayBrightly| - (list "Variable " "Description " - "Current Value" )) - (say (|fillerSpaces| $linelength (|specialChar| '|hbar|))) - (setq subtree nil) - (dolist (setdata settree) - (when (|satisfiesUserLevel| (third setdata)) - (setq setoption (|object2String| (first setdata))) - (setq setoption - (concat setoption - (|fillerSpaces| (spaddifference 13 (|#| setoption)) " ") - (second setdata))) - (setq setoption - (concat setoption - (|fillerSpaces| (spaddifference 55 (|#| setoption)) " "))) - (case (fourth setdata) - (function - (setq opt - (if (canFuncall? (fifth setdata)) - (funcall (fifth setdata) '|%display%|) - "unimplemented")) - (cond - ((consp opt) - (setq opt - (do ((t2 opt (cdr t2)) t1 (o nil)) - ((or (atom t2) (progn (setq o (car t2)) nil)) t1) - (setq t1 (append t1 (cons o (cons " " nil)))))))) - (|sayBrightly| (|concat| setoption '|%b| opt '|%d|))) - (string - (setq opt (|object2String| (|eval| (fifth setdata)))) - (|sayBrightly| `(,setoption ,@(|bright| opt)))) - (integer - (setq opt (|object2String| (|eval| (fifth setdata)))) - (|sayBrightly| `(,setoption ,@(|bright| opt)))) - (literals - (setq opt (|object2String| - (|translateTrueFalse2YesNo| (|eval| (fifth setdata))))) - (|sayBrightly| `(,setoption ,@(|bright| opt)))) - (TREE - (|sayBrightly| `(,setoption ,@(|bright| "..."))) - (setq subtree t) - (setq subname (|object2String| (first setdata))))))) - (terpri) - (when subtree - (|sayBrightly| - `("Variables with current values of" ,@(|bright| "...") - "have further sub-options. For example,")) - (|sayBrightly| - `("issue" ,@(|bright| ")set ") ,subname - " to see what the options are for" ,@(|bright| subname) "." - |%l| "For more information, issue" ,@(|bright| ")help set") "."))))) - -\end{chunk} - -\defunsec{translateYesNo2TrueFalse}{Translate options values to t or nil} -\calls{translateYesNo2TrueFalse}{member} -\begin{chunk}{defun translateYesNo2TrueFalse} -(defun |translateYesNo2TrueFalse| (x) - "Translate options values to t or nil" - (cond - ((|member| x '(|yes| |on|)) t) - ((|member| x '(|no| |off|)) nil) - (t x))) - -\end{chunk} - -\defunsec{translateTrueFalse2YesNo}{Translate t or nil to option values} -\begin{chunk}{defun translateTrueFalse2YesNo} -(defun |translateTrueFalse2YesNo| (x) - "Translate t or nil to option values" - (cond - ((eq x t) '|on|) - ((null x) '|off|) - (t x))) - -\end{chunk} -\subsection{The list structure} -\label{Theliststructure} -The structure of each list item consists of 7 items. Consider this -example: -\begin{verbatim} - (userlevel - "operation access level of system user" - interpreter - LITERALS - $UserLevel - (interpreter compiler development) - development) -\end{verbatim} -The list contains (the names in bold are accessor names that can be -found in {\bf property.lisp.pamphlet}. Look for "setName".): -\begin{list}{} -\item {\bf 1} {\sl Name} the keyword the user will see. In this example -the user would say "{\bf )set output userlevel}". -\item {\bf 2} {\sl Label} the message the user will see. In this example -the user would see "operation access level of system user". -\item {\bf 3} {\sl Level} the level where the command will be -accepted. There are three levels: interpreter, compiler, development. -These commands are restricted to keep the user from causing damage. -\item {\bf 4} {\sl Type} a symbol, one of {\bf FUNCTION}, {\bf INTEGER}, -{\bf STRING}, {\bf LITERALS}, {\bf FILENAME} or {\bf TREE}. -\item {\bf 5} {\sl Var} -\begin{list}{} -\item FUNCTION is the function to call -\item INTEGER is the variable holding the current user setting. -\item STRING is the variable holding the current user setting. -\item LITERALS variable which holds the current user setting. -\item FILENAME is the variable that holds the current user setting. -\item TREE -\end{list} -\item {\bf 6} {\sl Leaf} -\begin{list}{} -\item FUNCTION is the list of all possible values -\item INTEGER is the range of possible values -\item STRING is a list of all possible values -\item LITERALS is a list of all of the possible values -\item FILENAME is the function to check the filename -\item TREE -\end{list} -\item {\bf 7} {\sl Def} is the default value -\begin{list}{} -\item FUNCTION is the default setting -\item INTEGER is the default setting -\item STRING is the default setting -\item LITERALS is the default setting -\item FILENAME is the default value -\item TREE -\end{list} -\end{list} - -\section{\enspace{}set breakmode} -\begin{verbatim} --------------------- The breakmode Option --------------------- - - Description: execute break processing on error - - The breakmode option may be followed by any one of the - following: - - nobreak - -> break - query - resume - fastlinks - quit - - The current setting is indicated. - -\end{verbatim} -\defdollar{BreakMode} -\begin{chunk}{initvars} -(defvar |$BreakMode| '|nobreak| "execute break processing on error") - -\end{chunk} -\begin{chunk}{breakmode} - (|breakmode| - "execute break processing on error" - |interpreter| - LITERALS - |$BreakMode| - (|nobreak| |break| |query| |resume| |fastlinks| |quit|) - |nobreak|) ; needed to avoid possible startup looping -\end{chunk} - -\section{\enspace{}set debug} -\begin{verbatim} - Current Values of debug Variables - -Variable Description Current Value ------------------------------------------------------------------ -lambdatype Show type information for #1 syntax off -dalymode Interpret leading open paren as lisp off - -\end{verbatim} -\begin{chunk}{debug} - (|debug| - "debug options" - |interpreter| - TREE - |novar| - ( -\getchunk{debuglambdatype} -\getchunk{debugdalymode} - )) -\end{chunk} - -\subsection{set debug lambdatype} -\begin{verbatim} ----------------------- The lambdatype Option ---------------------- - - Description: Show type information for #1 syntax - -\end{verbatim} -\defdollar{lambdatype} -\begin{chunk}{initvars} -(defvar $lambdatype nil "show type information for #1 syntax") - -\end{chunk} - -\begin{chunk}{debuglambdatype} - (|lambdatype| - "show type information for #1 syntax" - |interpreter| - LITERALS - $lambdatype - (|on| |off|) - |off|) -\end{chunk} - -\section{\enspace{}set compiler} -\begin{verbatim} - Current Values of compiler Variables - -Variable Description Current Value ------------------------------------------------------------------ -output library in which to place compiled code -input controls libraries from which to load compiled code - -\end{verbatim} -\begin{chunk}{compile} - (|compiler| - "Library compiler options" - |interpreter| - TREE - |novar| - ( -\getchunk{compileoutput} -\getchunk{compileinput} - )) -\end{chunk} - -\subsection{set compiler output} -\begin{verbatim} ----------------------- The output Option ---------------------- - - Description: library in which to place compiled code - -\end{verbatim} -\begin{chunk}{compileoutput} - (|output| - "library in which to place compiled code" - |interpreter| - FUNCTION - |setOutputLibrary| - NIL - |htSetOutputLibrary| - ) -\end{chunk} - -\defunsec{setOutputLibrary}{The set output command handler} -\calls{setOutputLibrary}{poundsign} -\calls{setOutputLibrary}{describeOutputLibraryArgs} -\calls{setOutputLibrary}{filep} -\calls{setOutputLibrary}{openOutputLibrary} -\usesdollar{setOutputLibrary}{outputLibraryName} -\begin{chunk}{defun setOutputLibrary} -(defun |setOutputLibrary| (arg) - "The set output command handler" - (let (fn) - (declare (special |$outputLibraryName|)) +\Defun{setExpose}{The top level set expose command handler} +\calls{setExpose}{displayExposedGroups} +\calls{setExpose}{sayMSG} +\calls{setExpose}{displayExposedConstructors} +\calls{setExpose}{displayHiddenConstructors} +\calls{setExpose}{sayKeyedMsg} +\calls{setExpose}{namestring} +\calls{setExpose}{pathname} +\calls{setExpose}{qcar} +\calls{setExpose}{qcdr} +\calls{setExpose}{selectOptionLC} +\calls{setExpose}{setExposeAdd} +\calls{setExpose}{setExposeDrop} +\calls{setExpose}{setExpose} +\begin{chunk}{defun setExpose} +(defun |setExpose| (arg) + "The top level set expose command handler" + (let (fnargs fn) (cond - ((eq arg '|%initialize%|) (setq |$outputLibraryName| nil)) - ((eq arg '|%display%|) (or |$outputLibraryName| "user.lib")) - ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?) (/= (|#| arg) 1)) - (|describeOutputLibraryArgs|)) - (t - (when (probe-file (setq fn (princ-to-string (car arg)))) - (setq fn (truename fn))) - (|openOutputLibrary| (setq |$outputLibraryName| fn)))))) - -\end{chunk} - -\defunsec{describeOutputLibraryArgs}{Describe the set output library arguments} -\calls{describeOutputLibraryArgs}{sayBrightly} -\begin{chunk}{defun describeOutputLibraryArgs} -(defun |describeOutputLibraryArgs| () - "Describe the set output library arguments" - (|sayBrightly| (list - '|%b| ")set compile output library" - '|%d| "is used to tell the compiler where to place" - '|%l| "compiled code generated by the library compiler. By default it goes" - '|%l| "in a file called" - '|%b| "user.lib" - '|%d| "in the current directory."))) + ((eq arg '|%initialize%|)) + ((eq arg '|%display%|) "...") + ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?)) + (|displayExposedGroups|) + (|sayMSG| " ") + (|displayExposedConstructors|) + (|sayMSG| " ") + (|displayHiddenConstructors|) + (|sayMSG| " ")) + ((and (consp arg) + (progn (setq fn (qcar arg)) (setq fnargs (qcdr arg)) t) + (setq fn (|selectOptionLC| fn '(|add| |drop|) nil))) + (cond + ((eq fn '|add|) (|setExposeAdd| fnargs)) + ((eq fn '|drop|) (|setExposeDrop| fnargs)) + (t nil))) + (t (|setExpose| nil))))) \end{chunk} -\defvar{output-library} -\begin{chunk}{initvars} -(defvar output-library nil) +\Defun{setExposeAdd}{The top level set expose add command handler} +\calls{setExposeAdd}{centerAndHighlight} +\calls{setExposeAdd}{specialChar} +\calls{setExposeAdd}{displayExposedGroups} +\calls{setExposeAdd}{sayMSG} +\calls{setExposeAdd}{displayExposedConstructors} +\calls{setExposeAdd}{sayKeyedMsg} +\calls{setExposeAdd}{qcar} +\calls{setExposeAdd}{qcdr} +\calls{setExposeAdd}{selectOptionLC} +\calls{setExposeAdd}{setExposeAddGroup} +\calls{setExposeAdd}{setExposeAddConstr} +\calls{setExposeAdd}{setExposeAdd} +\usesdollar{setExposeAdd}{linelength} +\begin{chunk}{defun setExposeAdd} +(defun |setExposeAdd| (arg) + "The top level set expose add command handler" + (declare (special $linelength)) + (let (fnargs fn) + (cond + ((null arg) + (|centerAndHighlight| + '|The add Option| $linelength (|specialChar| '|hbar|)) + (|displayExposedGroups|) + (|sayMSG| " ") + (|displayExposedConstructors|) + (|sayMSG| " ") + (|sayKeyedMsg| 's2iz0049e nil)) + ((and (consp arg) + (progn (setq fn (qcar arg)) (setq fnargs (qcdr arg)) t) + (setq fn (|selectOptionLC| fn '(|group| |constructor|) nil))) + (cond + ((eq fn '|group|) (|setExposeAddGroup| fnargs)) + ((eq fn '|constructor|) (|setExposeAddConstr| fnargs)) + (t nil))) + (t (|setExposeAdd| nil))))) \end{chunk} -\defunsec{openOutputLibrary}{Open the output library} -The input-libraries and output-library are now truename based. - -\calls{openOutputLibrary}{dropInputLibrary} -\uses{openOutputLibrary}{output-library} -\uses{openOutputLibrary}{input-libraries} -\begin{chunk}{defun openOutputLibrary} -(defun |openOutputLibrary| (lib) - "Open the output library" - (declare (special output-library input-libraries)) - (|dropInputLibrary| lib) - (setq output-library (truename lib)) - (push output-library input-libraries)) +\Defun{setExposeAddConstr}{The top level set expose add constructor handler} +\calls{setExposeAddConstr}{unabbrev} +\calls{setExposeAddConstr}{qcar} +\calls{setExposeAddConstr}{getdatabase} +\calls{setExposeAddConstr}{sayKeyedMsg} +\calls{setExposeAddConstr}{member} +\calls{setExposeAddConstr}{setelt} +\calls{setExposeAddConstr}{delete} +\calls{setExposeAddConstr}{msort} +\calls{setExposeAddConstr}{clearClams} +\calls{setExposeAddConstr}{centerAndHighlight} +\calls{setExposeAddConstr}{specialChar} +\calls{setExposeAddConstr}{displayExposedConstructors} +\usesdollar{setExposeAddConstr}{linelength} +\usesdollar{setExposeAddConstr}{localExposureData} +\usesdollar{setExposeAddConstr}{interpreterFrameName} +\begin{chunk}{defun setExposeAddConstr} +(defun |setExposeAddConstr| (arg) + "The top level set expose add constructor handler" + (declare (special $linelength |$localExposureData| |$interpreterFrameName|)) + (if (null arg) + (progn + (|centerAndHighlight| + '|The constructor Option| $linelength (|specialChar| '|hbar|)) + (|displayExposedConstructors|)) + (dolist (x arg) + (setq x (|unabbrev| x)) + (when (consp x) (setq x (qcar x))) + (cond + ((null (getdatabase x 'constructorkind)) + (|sayKeyedMsg| 's2iz0049j (list x))) + ((|member| x (elt |$localExposureData| 1)) + (|sayKeyedMsg| 's2iz0049k (list x |$interpreterFrameName| ))) + (t + (when (|member| x (elt |$localExposureData| 2)) + (setelt |$localExposureData| 2 + (|delete| x (elt |$localExposureData| 2)))) + (setelt |$localExposureData| 1 + (msort (cons x (elt |$localExposureData| 1)))) + (|clearClams|) + (|sayKeyedMsg| 's2iz0049p (list x |$interpreterFrameName| ))))))) \end{chunk} -\subsection{set compiler input} -\begin{verbatim} ----------------------- The input Option ----------------------- - - Description: controls libraries from which to load compiled code +\Defun{setExposeDrop}{The top level set expose drop handler} +\calls{setExposeDrop}{centerAndHighlight} +\calls{setExposeDrop}{specialChar} +\calls{setExposeDrop}{displayHiddenConstructors} +\calls{setExposeDrop}{sayMSG} +\calls{setExposeDrop}{sayKeyedMsg} +\calls{setExposeDrop}{qcar} +\calls{setExposeDrop}{qcdr} +\calls{setExposeDrop}{selectOptionLC} +\calls{setExposeDrop}{setExposeDropGroup} +\calls{setExposeDrop}{setExposeDropConstr} +\calls{setExposeDrop}{setExposeDrop} +\usesdollar{setExposeDrop}{linelength} +\begin{chunk}{defun setExposeDrop} +(defun |setExposeDrop| (arg) + "The top level set expose drop handler" + (declare (special $linelength)) + (let (fnargs fn) + (cond + ((null arg) + (|centerAndHighlight| + '|The drop Option| $linelength (|specialChar| '|hbar|)) + (|displayHiddenConstructors|) + (|sayMSG| " ") + (|sayKeyedMsg| 's2iz0049f nil)) + ((and (consp arg) + (progn (setq fn (qcar arg)) (setq fnargs (qcdr arg)) t) + (setq fn (|selectOptionLC| fn '(|group| |constructor|) nil))) + (cond + ((eq fn '|group|) (|setExposeDropGroup| fnargs)) + ((eq fn '|constructor|) (|setExposeDropConstr| fnargs)) + (t nil))) + (t (|setExposeDrop| nil))))) - )set compile input add library is used to tell AXIOM to add - library to the front of the path which determines where - compiled code is loaded from. - )set compile input drop library is used to tell AXIOM to remove - library from this path. -\end{verbatim} -\begin{chunk}{compileinput} - (|input| - "controls libraries from which to load compiled code" - |interpreter| - FUNCTION - |setInputLibrary| - NIL - |htSetInputLibrary|) \end{chunk} - -\defunsec{setInputLibrary}{The set input library command handler} -The input-libraries is now maintained as a list of truenames. - -\calls{setInputLibrary}{describeInputLibraryArgs} -\calls{setInputLibrary}{qcar} -\calls{setInputLibrary}{qcdr} -\calls{setInputLibrary}{selectOptionLC} -\calls{setInputLibrary}{addInputLibrary} -\calls{setInputLibrary}{dropInputLibrary} -\calls{setInputLibrary}{setInputLibrary} -\uses{setInputLibrary}{input-libraries} -\begin{chunk}{defun setInputLibrary} -(defun |setInputLibrary| (arg) - "The set input library command handler" - (declare (special input-libraries)) - (let (tmp1 filename act) - (cond - ((eq arg '|%initialize%|) t) - ((eq arg '|%display%|) (mapcar #'namestring input-libraries)) - ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?)) - (|describeInputLibraryArgs|)) - ((and (consp arg) - (progn - (setq act (qcar arg)) - (setq tmp1 (qcdr arg)) - (and (consp tmp1) - (eq (qcdr tmp1) nil) - (progn (setq filename (qcar tmp1)) t))) - (setq act (|selectOptionLC| act '(|add| |drop|) nil))) +\Defun{setExposeDropGroup}{The top level set expose drop group handler} +\calls{setExposeDropGroup}{qcar} +\calls{setExposeDropGroup}{setelt} +\calls{setExposeDropGroup}{displayExposedGroups} +\calls{setExposeDropGroup}{sayMSG} +\calls{setExposeDropGroup}{displayExposedConstructors} +\calls{setExposeDropGroup}{displayHiddenConstructors} +\calls{setExposeDropGroup}{clearClams} +\calls{setExposeDropGroup}{member} +\calls{setExposeDropGroup}{delete} +\calls{setExposeDropGroup}{sayKeyedMsg} +\calls{setExposeDropGroup}{getalist} +\calls{setExposeDropGroup}{centerAndHighlight} +\calls{setExposeDropGroup}{specialChar} +\usesdollar{setExposeDropGroup}{linelength} +\usesdollar{setExposeDropGroup}{localExposureData} +\usesdollar{setExposeDropGroup}{interpreterFrameName} +\usesdollar{setExposeDropGroup}{globalExposureGroupAlist} +\begin{chunk}{defun setExposeDropGroup} +(defun |setExposeDropGroup| (arg) + "The top level set expose drop group handler" + (declare (special $linelength |$localExposureData| |$interpreterFrameName| + |$globalExposureGroupAlist|)) + (if (null arg) + (progn + (|centerAndHighlight| + '|The group Option| $linelength (|specialChar| '|hbar|)) + (|sayKeyedMsg| 's2iz0049l nil) + (|sayMSG| " ") + (|displayExposedGroups|)) + (dolist (x arg) + (when (consp x) (setq x (qcar x))) (cond - ((eq act '|add|) - (|addInputLibrary| (truename (princ-to-string filename)))) - ((eq act '|drop|) - (|dropInputLibrary| (truename (princ-to-string filename)))))) - (t (|setInputLibrary| nil))))) + ((eq x '|all|) + (setelt |$localExposureData| 0 nil) + (setelt |$localExposureData| 1 nil) + (setelt |$localExposureData| 2 nil) + (|displayExposedGroups|) + (|sayMSG| " ") + (|displayExposedConstructors|) + (|sayMSG| " ") + (|displayHiddenConstructors|) + (|clearClams|)) + ((|member| x (elt |$localExposureData| 0)) + (setelt |$localExposureData| 0 + (|delete| x (elt |$localExposureData| 0))) + (|clearClams|) + (|sayKeyedMsg| 's2iz0049s (list x |$interpreterFrameName| ))) + ((getalist |$globalExposureGroupAlist| x) + (|sayKeyedMsg| 's2iz0049i (list x |$interpreterFrameName| ))) + (t (|sayKeyedMsg| 's2iz0049h (list x ))))))) \end{chunk} -\defunsec{describeInputLibraryArgs}{Describe the set input library arguments} -\calls{describeInputLibraryArgs}{sayBrightly} -\begin{chunk}{defun describeInputLibraryArgs} -(defun |describeInputLibraryArgs| () - "Describe the set input library arguments" - (|sayBrightly| (list - '|%b| ")set compile input add library" - '|%d| "is used to tell AXIOM to add" - '|%b| "library" - '|%d| "to" - '|%l| "the front of the path used to find compile code." - '|%l| - '|%b| ")set compile input drop library" - '|%d| "is used to tell AXIOM to remove" - '|%b| "library" - '|%d| - '|%l| "from this path."))) +\Defun{setExposeDropConstr} +{The top level set expose drop constructor handler} +\calls{setExposeDropConstr}{unabbrev} +\calls{setExposeDropConstr}{qcar} +\calls{setExposeDropConstr}{getdatabase} +\calls{setExposeDropConstr}{sayKeyedMsg} +\calls{setExposeDropConstr}{member} +\calls{setExposeDropConstr}{setelt} +\calls{setExposeDropConstr}{delete} +\calls{setExposeDropConstr}{msort} +\calls{setExposeDropConstr}{clearClams} +\calls{setExposeDropConstr}{centerAndHighlight} +\calls{setExposeDropConstr}{specialChar} +\calls{setExposeDropConstr}{sayMSG} +\calls{setExposeDropConstr}{displayExposedConstructors} +\calls{setExposeDropConstr}{displayHiddenConstructors} +\usesdollar{setExposeDropConstr}{linelength} +\usesdollar{setExposeDropConstr}{localExposureData} +\usesdollar{setExposeDropConstr}{interpreterFrameName} +\begin{chunk}{defun setExposeDropConstr} +(defun |setExposeDropConstr| (arg) + "The top level set expose drop constructor handler" + (declare (special $linelength |$localExposureData| |$interpreterFrameName|)) + (if (null arg) + (progn + (|centerAndHighlight| + '|The constructor Option| $linelength (|specialChar| '|hbar|)) + (|sayKeyedMsg| 's2iz0049n nil) + (|sayMSG| " ") + (|displayExposedConstructors|) + (|sayMSG| " ") + (|displayHiddenConstructors|)) + (dolist (x arg) + (setq x (|unabbrev| x)) + (when (consp x) (setq x (qcar x))) + (cond + ((null (getdatabase x 'constructorkind)) + (|sayKeyedMsg| 's2iz0049j (list x))) + ((|member| x (elt |$localExposureData| 2)) + (|sayKeyedMsg| 's2iz0049o (list x |$interpreterFrameName|))) + (t + (when (|member| x (elt |$localExposureData| 1)) + (setelt |$localExposureData| 1 + (|delete| x (elt |$localExposureData| 1)))) + (setelt |$localExposureData| 2 + (msort (cons x (elt |$localExposureData| 2)))) + (|clearClams|) + (|sayKeyedMsg| 's2iz0049q (list x |$interpreterFrameName|))))))) \end{chunk} -\defunsec{addInputLibrary}{Add the input library to the list} -The input-libraries variable is now maintained as a list of truenames. -\calls{addInputLibrary}{dropInputLibrary} -\uses{addInputLibrary}{input-libraries} -\begin{chunk}{defun addInputLibrary} -(defun |addInputLibrary| (lib) - "Add the input library to the list" - (declare (special input-libraries)) - (|dropInputLibrary| lib) - (push (truename lib) input-libraries)) +\Defun{displayExposedGroups}{Display exposed groups} +\calls{displayExposedGroups}{sayKeyedMsg} +\calls{displayExposedGroups}{centerAndHighlight} +\usesdollar{displayExposedGroups}{interpreterFrameName} +\usesdollar{displayExposedGroups}{localExposureData} +\begin{chunk}{defun displayExposedGroups} +(defun |displayExposedGroups| () + "Display exposed groups" + (declare (special |$interpreterFrameName| |$localExposureData|)) + (|sayKeyedMsg| 's2iz0049a (list |$interpreterFrameName|)) + (if (null (elt |$localExposureData| 0)) + (|centerAndHighlight| "there are no exposed groups") + (dolist (c (elt |$localExposureData| 0)) + (|centerAndHighlight| c)))) \end{chunk} -\defvar{input-libraries} -\begin{chunk}{initvars} -(defvar input-libraries nil) +\Defun{displayExposedConstructors}{Display exposed constructors} +\calls{displayExposedConstructors}{sayKeyedMsg} +\calls{displayExposedConstructors}{centerAndHighlight} +\usesdollar{displayExposedConstructors}{localExposureData} +\begin{chunk}{defun displayExposedConstructors} +(defun |displayExposedConstructors| () + "Display exposed constructors" + (declare (special |$localExposureData|)) + (|sayKeyedMsg| 's2iz0049b nil) + (if (null (elt |$localExposureData| 1)) + (|centerAndHighlight| "there are no explicitly exposed constructors") + (dolist (c (elt |$localExposureData| 1)) + (|centerAndHighlight| c)))) \end{chunk} -\defunsec{dropInputLibrary}{Drop an input library from the list} -\uses{dropInputLibrary}{input-libraries} -\begin{chunk}{defun dropInputLibrary} -(defun |dropInputLibrary| (lib) - "Drop an input library from the list" - (declare (special input-libraries)) - (setq input-libraries (delete (truename lib) input-libraries :test #'equal))) +\Defun{displayHiddenConstructors}{Display hidden constructors} +\calls{displayHiddenConstructors}{sayKeyedMsg} +\calls{displayHiddenConstructors}{centerAndHighlight} +\usesdollar{displayHiddenConstructors}{localExposureData} +\begin{chunk}{defun displayHiddenConstructors} +(defun |displayHiddenConstructors| () + "Display hidden constructors" + (declare (special |$localExposureData|)) + (|sayKeyedMsg| 's2iz0049c nil) + (if (null (elt |$localExposureData| 2)) + (|centerAndHighlight| "there are no explicitly hidden constructors") + (dolist (c (elt |$localExposureData| 2)) + (|centerAndHighlight| c)))) \end{chunk} -\section{\enspace{}set debug dalymode} -The \verb|$dalymode| variable is used in a case statement in -intloopReadConsole. This variable can be set to any non-nil -value. When not nil the interpreter will send any line that begins -with an ``('' to be sent to the underlying lisp. This is useful -for debugging Axiom. The normal value of this variable is NIL. - -This variable was created as an alternative to prefixing every lisp -command with )lisp. When doing a lot of debugging this is tedious -and error prone. This variable was created to shortcut that process. -Clearly it breaks some semantics of the language accepted by the -interpreter as parens are used for grouping expressions. - -\begin{verbatim} ----------------------- The dalymode Option ---------------------- - - Description: Interpret leading open paren as lisp - -\end{verbatim} -\defdollar{dalymode} -\begin{chunk}{initvars} -(defvar $dalymode nil "Interpret leading open paren as lisp") +\section{Exposure Data Structures} +\defdollar{localExposureData} +\begin{chunk}{postvars} +(defvar |$localExposureData| (copy-seq |$localExposureDataDefault|)) \end{chunk} -\begin{chunk}{debugdalymode} - (|dalymode| - "Interpret leading open paren as lisp" - |interpreter| - LITERALS - $dalymode - (|on| |off|) - |off|) -\end{chunk} - -\section{\enspace{}set expose} -\begin{verbatim} ----------------------- The expose Option ---------------------- - Description: control interpreter constructor exposure +\defdollar{localExposureDataDefault} +\begin{chunk}{initvars} +(defvar |$localExposureDataDefault| + (vector + ;;These groups will be exposed + (list '|basic| '|categories| '|naglink| '|anna|) + ;;These constructors will be explicitly exposed + (list ) + ;;These constructors will be explicitly hidden + (list ))) - The following groups are explicitly exposed in the current - frame (called initial ): - basic - categories - naglink - anna - - The following constructors are explicitly exposed in the - current frame: - there are no explicitly exposed constructors - - The following constructors are explicitly hidden in the - current frame: - there are no explicitly hidden constructors - - When )set expose is followed by no arguments, the information - you now see is displayed. When followed by the initialize - argument, the exposure group data in the file interp.exposed - is read and is then available. The arguments add and drop are - used to add or drop exposure groups or explicit constructors - from the local frame exposure data. Issue - )set expose add or )set expose drop - for more information. -\end{verbatim} -\begin{chunk}{expose} - (|expose| - "control interpreter constructor exposure" - |interpreter| - FUNCTION - |setExpose| - NIL - |htSetExpose|) \end{chunk} NOTE: If you add new algebra you must also update this list @@ -31560,400 +2691,29409 @@ otherwise the new algebra won't be loaded by the interpreter when needed. \end{chunk} -\defdollar{localExposureDataDefault} -\begin{chunk}{initvars} -(defvar |$localExposureDataDefault| - (vector - ;;These groups will be exposed - (list '|basic| '|categories| '|naglink| '|anna|) - ;;These constructors will be explicitly exposed - (list ) - ;;These constructors will be explicitly hidden - (list ))) +\chapter{The global variables} + +\subsection{Credits} +Axiom has a very long history and many people have contributed to the +effort, some in large ways and some in small ways. Any and all effort +deserves recognition. There is no other criteria than contribution +of effort. We would like to acknowledge and thank the following people: +\defvar{creditlist} +\begin{chunk}{initvars} +(defvar creditlist '( +"An alphabetical listing of contributors to AXIOM:" +"Michael Albaugh Cyril Alberga Roy Adler" +"Christian Aistleitner Richard Anderson George Andrews" +"S.J. Atkins Henry Baker Martin Baker" +"Stephen Balzac Yurij Baransky David R. Barton" +"Thomas Baruchel Gerald Baumgartner Gilbert Baumslag" +"Michael Becker Nelson H. F. Beebe Jay Belanger" +"David Bindel Fred Blair Vladimir Bondarenko" +"Mark Botch Raoul Bourquin Alexandre Bouyer" +"Karen Braman Peter A. Broadbery Martin Brock" +"Manuel Bronstein Stephen Buchwald Florian Bundschuh" +"Luanne Burns William Burge Ralph Byers" +"Quentin Carpent Robert Caviness Bruce Char" +"Ondrej Certik Tzu-Yi Chen Cheekai Chin" +"David V. Chudnovsky Gregory V. Chudnovsky Mark Clements" +"James Cloos Jia Zhao Cong Josh Cohen" +"Christophe Conil Don Coppersmith George Corliss" +"Robert Corless Gary Cornell Meino Cramer" +"Jeremy Du Croz David Cyganski Nathaniel Daly" +"Timothy Daly Sr. Timothy Daly Jr. James H. Davenport" +"David Day James Demmel Didier Deshommes" +"Michael Dewar Jack Dongarra Jean Della Dora" +"Gabriel Dos Reis Claire DiCrescendo Sam Dooley" +"Lionel Ducos Iain Duff Lee Duhem" +"Martin Dunstan Brian Dupee Dominique Duval" +"Robert Edwards Heow Eide-Goodman Lars Erickson" +"Richard Fateman Bertfried Fauser Stuart Feldman" +"John Fletcher Brian Ford Albrecht Fortenbacher" +"George Frances Constantine Frangos Timothy Freeman" +"Korrinn Fu Marc Gaetano Rudiger Gebauer" +"Van de Geijn Kathy Gerber Patricia Gianni" +"Gustavo Goertkin 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" +"Ming Gu Jocelyn Guidry Gaetan Hache" +"Steve Hague Satoshi Hamaguchi Sven Hammarling" +"Mike Hansen Richard Hanson Richard Harke" +"Bill Hart Vilya Harvey Martin Hassner" +"Arthur S. Hathaway Dan Hatton Waldek Hebisch" +"Karl Hegbloom Ralf Hemmecke Henderson" +"Antoine Hersen Roger House Gernot Hueber" +"Pietro Iglio Alejandro Jakubi Richard Jenks" +"William Kahan Kyriakos Kalorkoti Kai Kaminski" +"Grant Keady Wilfrid Kendall Tony Kennedy" +"Ted Kosan Paul Kosinski Klaus Kusche" +"Bernhard Kutzler Tim Lahey Larry Lambe" +"Kaj Laurson George L. Legendre Franz Lehner" +"Frederic Lehobey Michel Levaud Howard Levy" +"Ren-Cang Li Rudiger Loos Michael Lucks" +"Richard Luczak Camm Maguire Francois Maltey" +"Alasdair McAndrew Bob McElrath Michael McGettrick" +"Edi Meier 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 Patrice Naudin 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 David Parnas Susan Pelzel" +"Michel Petitot Didier Pinchon Ayal Pinkus" +"Frederick H. Pitts Jose Alfredo Portes Gregorio Quintana-Orti" +"Claude Quitte Arthur C. Ralfs Norman Ramsey" +"Anatoly Raportirenko Albert D. Rich Michael Richardson" +"Guilherme Reis Huan Ren 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 Steven Segletes" +"V. Sima Nick Simicich William Sit" +"Elena Smirnova Jonathan Steinbach Fabio Stumbo" +"Christine Sundaresan Robert Sutor Moss E. Sweedler" +"Eugene Surowitz Max Tegmark T. Doug Telford" +"James Thatcher Balbir Thomas Mike Thomas" +"Dylan Thurston Steve Toleque 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 R. Clint Whaley" +"James T. Wheeler John M. Wiley Berhard Will" +"Clifton J. Williamson Stephen Wilson Shmuel Winograd" +"Robert Wisbauer Sandra Wityak Waldemar Wiwianka" +"Knut Wolf Yanyang Xiao Liu Xiaojun" +"Clifford Yapp David Yun Vadim Zhytnikov" +"Richard Zippel Evelyn Zoernack Bruno Zuercher" +"Dan Zwillinger" + +)) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +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} + +\defdollar{current-directory} +\begin{chunk}{initvars} +(defvar $current-directory nil) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +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} + +\defdollar{defaultMsgDatabaseName} +\begin{chunk}{initvars} +(defvar |$defaultMsgDatabaseName| nil) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +The \verb|$directory-list| is a runtime list of absolute pathnames. +This list is generated by \refto{reroot} 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} + +\defdollar{directory-list} +\begin{chunk}{initvars} +(defvar $directory-list nil) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +The \verb|$InitialModemapFrame| is used as the initial value. + +See the function \fnref{makeInitialModemapFrame}. + +An example of a runtime value is: +\begin{verbatim} +$InitialModemapFrame = '((nil)) +\end{verbatim} + +\defdollar{InitialModemapFrame} +\begin{chunk}{initvars} +(defvar |$InitialModemapFrame| '((nil))) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +The \verb|$library-directory-list| variable is the system-wide search +path for library files. \refto{reroot} +prepends 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} + +\defdollar{library-directory-list} +\begin{chunk}{initvars} +(defvar $library-directory-list '("/algebra/")) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +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} + +\defdollar{msgDatabaseName} +\begin{chunk}{initvars} +(defvar |$msgDatabaseName| nil) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +The \verb|$openServerIfTrue| It appears to control whether the interpreter +will be used as an open server, probably for OpenMath use. + +If an open server is not requested then this variable to NIL + +See the function \fnref{openserver}. + +An example of a runtime value is: +\begin{verbatim} +$openServerIfTrue = nil +\end{verbatim} + +\defdollar{openServerIfTrue} +\begin{chunk}{initvars} +(defvar $openServerIfTrue nil) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +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} + +\defdollar{relative-directory-list} +\begin{chunk}{initvars} +(defvar $relative-directory-list + '("/../../src/input/" + "/doc/msgs/" + "/../../src/algebra/" + "/../../src/interp/" ; for lisp files (helps fd) + "/doc/spadhelp/" )) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +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} + +\defdollar{relative-library-directory-list} +\begin{chunk}{initvars} +(defvar $relative-library-directory-list '("/algebra/")) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +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} + +\defdollar{spadroot} +\begin{chunk}{initvars} +(defvar $spadroot nil) + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +The \verb|$SpadServer| determines whether Axiom acts as a remote server. + +See the function \fnref{openserver}. + +An example of a runtime value is: +\begin{verbatim} +$SpadServer = nil +\end{verbatim} + +\defdollar{SpadServer} +\begin{chunk}{initvars} +(defvar $SpadServer nil "t means Axiom acts as a remote server") + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +The \verb|$SpadServerName| defines the name of the spad server socket. +In unix these exist in the tmp directory as names. + +See the function \fnref{openserver}. + +An example of a runtime value is: +\begin{verbatim} +$SpadServerName = "/tmp/.d" +\end{verbatim} + +\defdollar{SpadServerName} +\begin{chunk}{initvars} +(defvar $SpadServerName "/tmp/.d" "the name of the spad server socket") + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Starting Axiom} + +This chapter details the internal processing behind an Axiom console +session where the user types ``1'' and gets a result. + +\begin{verbatim} +axiom -nox + AXIOM Computer Algebra System + Version: Axiom (August 2014) + Timestamp: Friday September 12, 2014 at 06:24:14 +----------------------------------------------------------------------------- + Issue )copyright to view copyright notices. + Issue )summary for a summary of useful system commands. + Issue )quit to leave AXIOM and return to shell. + Visit http://axiom-developer.org for more information +----------------------------------------------------------------------------- + + Re-reading interp.daase + Re-reading operation.daase + Re-reading category.daase + Re-reading browse.daase +(1) -> +(1) -> 1 + + (1) 1 + Type: PositiveInteger +(2) -> +\end{verbatim} + +By working through this example we introduce, motivate, and explain +how the interpreter works, where and why functions are called, how +the system transitions from input strings to algebra, how the databases +are used, and more. + +If you plan to maintain or modify the interpreter this information is +necessary. If you really want to know how Axiom works, this information +is useful. + +Each function call we describe has a link to the actual function so +you can read the detailed code and see why it reacts as it does to +the given input. + +I've taken the liberty of adding comments that show the function +signature. Some of the types only exist as unnamed data structures +in the interpreter (e.g. "Server", which is really just a small +integer). They are introduced without definition simply as a +documentation aid but may sometimes be defined a Common Lisp +deftypes for performance reasons. + +{\bf A Note on Common Lisp Circular Notation} + +You may not be familiar with circular notation in Common Lisp. +If a list contains a pointer back to itself or a sublist then the +output would be an infinite stream. In order to prevent this +the circular notation is used. So for a list X, +\begin{verbatim} + +---|---+ +---|---+ +---|---+ +---|---+ + + A | + --> + B | + --> + C | + --> + D | / + + +---|---+ +---|---+ +---|---+ +---|---+ +\end{verbatim} +which is the list (A . (B . (C . (D . ())))). The printing rule +says that if a period is followed by a parenthesis then both +are suppressed. So this would print as (A B C D). +But it could be that we execute +\begin{verbatim} + (rplaca (last X) (cdr X)) +\end{verbatim} +so the list now is +\begin{verbatim} + +---|---+ +---|---+ +---|---+ +---|---+ + + A | + --> + B | + --> + C | + --> + | / + + +---|---+ +---|---+ +---|---+ +---|---+ + ^ | + +---------------------------+ +\end{verbatim} +and now the list X is cicular. This prints as +\begin{verbatim} + (A . #0=(B C #0#)) +\end{verbatim} +As you can see the \verb|#0=| introduces a unique label for the +cons cell pointed at by (CDR A). We stored that address in the +CAR of the last node. So the last node in the list uses the +previously defined label with the notation \verb|#0#|. + +Circular notation is used extensively in Axiom since a lot of the +structures are shared or self-referential. You have to be careful +because, as a result of structure sharing, changing something in one +place can change an apparently unrelated structure by side-effect. + +Axiom starts by invoking a function value of the lisp symbol +\verb|*top-level-hook*| which is normally unbound. +The normal function invocation path is: +\begin{verbatim} +axiom -nox + +lisp + -> restart + -> |spad| + -> |runspad| + -> |ncTopLevel| + -> |ncIntLoop| + -> |intloop| + -> |SpadInterpretStream| + -> mkprompt -- outputs "(1) ->" to the console + -> |intloopReadConsole| -- the Read-Eval-Print loop function + -> |serverReadLine| -- does the actual read to the console + -> process the input and recursively call |intloopReadConsole| +\end{verbatim} + +\bfref{SpadInterpretStream} is called with a third arguments, {\bf +interactive?} set to {\bf t} so it sets up an interactive loop to read +from the console. The other two arguments are ignored on the main +interpreter path. + +\bfref{SpadInterpretStream} can also be called by the compiler, +with the {\bf interactive?} argument {\bf nil} to read from +a file. See bookvol9. + +\bfref{mkprompt} puts one of several kinds of prompts on the screen. In +the default case we include the step number. The return value is not +used. + +The \bfref{intloopReadConsole} function does tail-recursive calls to +itself and never exits. It is the primary Read-Eval-Print-Loop (REPL). + +\bfref{intloopReadConsole} +reads the next line and calls one of three kinds of processors +\begin{enumerate} +\item \bfref{intnplisp} to handle )lisp input +\item \bfref{ncloopCommand} to handle )command input +\item \bfref{intloopProcessString} to handle everything else +\end{enumerate} + +There are only two ways out of the REPL, either using the command +"{\bf )fin}" which drops into lisp or closing the *standard-input* stream. +If dropped into lisp, the top level loop can be restarted by calling +{\bf (restart)}. + +{\bf intloopReadConsole} takes 2 arguments. The first is a String {\bf +prefix} which is usually an empty string but might contain prior lines +that ended with an underscore, the Axiom continuation character. The +second is an Integer which will be the step number printed at the +prompt. + +\section{An Overview of a Simple Input} +Here we walk through details of Axiom's default behavior when handling +a simple input, the number 1. Many details are skipped in order to +provide a simple overview of the interpreter operation. Further +details can be found at the specific functions. + +Axiom is in \bfref{intloopReadConsole}, the Read-Eval-Print-Loop (REPL) function and the user types ``1''. +\begin{verbatim} + 1> (|intloopReadConsole| "" 1) + ; serverReadLine : Stream -> String + 2> (|serverReadLine| #) + ; is-console : Stream -> Boolean + 3> (IS-CONSOLE #) + <3 (IS-CONSOLE T) + ; sockSendInt : (Purpose,Command) -> Integer + ; Purpose 1 is SessionManager, Command 3 is EndOfOutput + ; A return of 0 indicates success. + ; see the socket types purpose list in bookvol7, chunk include/com.h + 3> (|sockSendInt| 1 3) + <3 (|sockSendInt| 0) + ; serverSwitch : Void -> Integer + ; see server_switch in sockio.c + ; this multiplexes the socket connection among front ends + ; CallInterp is the constant 4 (see the table in sockio-c) + ; CallInterp simply returns to the interpreter + 3> (|serverSwitch|) +1 + <3 (|serverSwitch| 4) + ; the action for CallInterp is to call read-line + ; read-line is defined in vmlisp.lisp + 3> (|read-line| #) + <3 (|read-line| "1" NIL) + <2 (|serverReadLine| "1") +\end{verbatim} + +Axiom calls \bfref{serverReadLine} +to read the integer from the console. First it calls {\bf is-console} +(bookvol9) to check that the console stream exists. + +{\bf sockSendInt} (see sockio.lisp, sockio-c.c) sends on socket 1 +({\bf SessionManager}) a 3, meaning {\bf EndOfOutput}, i.e. a newline. + +{\bf serverSwitch} (see sockio-c in bookvol7) multitasks among the different +sockets and finds the interpreter socket is available, returning +4 ({\bf CallInterp}) (see sockio-c commands sent table and bookvol8). + +\bfref{serverReadLine} has a cond switch for action {\bf \$CallInterp}. +In that case it calls {\bf read-line} (see vmlisp.lisp) to read the +input line and returns the result, in this case, the string "1". + +\begin{verbatim} + 2> (|intloopPrefix?| ")fi" "1") + <2 (|intloopPrefix?| NIL) + 2> (|intloopPrefix?| ")" "1") + <2 (|intloopPrefix?| NIL) + 2> (CONCAT "" "1") + <2 (CONCAT "1") + 2> (|ncloopEscaped| "1") + <2 (|ncloopEscaped| NIL) +\end{verbatim} + +\bfref{intloopReadConsole} checks for various +possible special kinds of input. Axiom returned a non-zero length +string. Before processing it we need to check for the ``{\bf )fin}'' +command, which fails. We need to check for a leading ``{\bf )}'', +meaning it is some kind of command input, which fails. We might +have an existing string in the {\bf prefix} argument so we +concatentate it to the input. The {\bf prefix} might contain +text from a previous continued line. Next we check whether the input +line has a trailing underscore, meaning an Axiom line is being +continued, and if so, we recurse in order to read the next line. + +\bfref{intloopPrefix?} which will return NIL if there is no +match of the prefix characters, otherwise it returns the string +without any leading blanks. + +None of these special cases occur with the input ``1''. +Axiom calls \bfref{intloopProcessString} +which calls \bfref{setCurrentLine} to add the +input line to the history which is stored in {\bf \$currentLine}. + +\begin{verbatim} + 2> (|intloopProcessString| "1" 1) + 3> (|setCurrentLine| "1") + <3 (|setCurrentLine| ("1")) +\end{verbatim} + +$\cdots$all the magic happens here$\cdots$ + +$\cdots$ and then {\bf intloopProcessString} will eventually +return the new step number 2. Then Axiom puts up a prompt +and waits for further input. + +\begin{verbatim} + <2 (|intloopProcessString| 2) + 2> (MKPROMPT) + 3> (CONCAT "(" "2" ") -> ") + <3 (CONCAT "(2) -> ") + <2 (MKPROMPT "(2) -> ") +(2) -> + 2> (|serverReadLine| #) + 3> (IS-CONSOLE #) + <3 (IS-CONSOLE T) + 3> (|sockSendInt| 1 3) + <3 (|sockSendInt| 0) + 3> (|serverSwitch|) + +\end{verbatim} +Now Axiom is ready for the next input. + +\section{Parsing the input} +We now examine the magic portion above which has several phases. +The first phase constructs a data structure called a Delay. This +data structure is the core data structure of the ``zipper'' parser. + +The ``zipper'' parser is unique to Axiom. It was invented by Bill +Burge who did research in recursive techniques, including parsing. +For insight, see his article on Stream Procesing Functions \cite{Burg74}. + +\subsection{Creating a Delay -- incString} +The \bfref{intloopProcessString} has the nested function call +\begin{verbatim} + (|intloopProcess| n t + (|next| #'|ncloopParse| + (|next| #'|lineoftoks| (|incString| s)))) +\end{verbatim} +which according to lisp semantics is processed inside out. First we +examine the call to \bfref{incString} which is passed the input +string ``1''. + +The \bfref{incString} function gets the string from Axiom's input +line, in this case ``1'' and constructs a set of nested function calls +to process the input line. + +\begin{verbatim} + 3> (|incString| "1") +\end{verbatim} + +The \bfref{incString} function calls \bfref{Delay} which changes the +function call into a simple list object prefixed by the symbol tag +{\bf nonnullstream}. + +\begin{verbatim} + 4> (|incLude| 0 ("1") 0 ("strings") (1)) + 5> (|Delay| |incLude1| (0 ("1") 0 ("strings") (1))) + <5 (|Delay| (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1))) + <4 (|incLude| (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1))) +\end{verbatim} +That result is passed to \bfref{incRenumber}, which calls \bfref{incIgen} +which returns a \bfref{Delay}. It then calls \bfref{incZip} to ``zips'' +together the function \bfref{incRenumberLine} and the two delays into +a single delay. This gets put into a delay with \bfref{incZip1} as the +function. +\begin{verbatim} + 4> (|incRenumber| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1))) + 5> (|incIgen| 0) + 6> (|Delay| |incIgen1| (0)) + <6 (|Delay| (|nonnullstream| |incIgen1| 0)) + <5 (|incIgen| (|nonnullstream| |incIgen1| 0)) + + 5> (|incZip| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0)) + 6> (|Delay| |incZip1| |incRenumberLine|) + <6 (|Delay| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))) + <5 (|incZip| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))) + + <4 (|incRenumber| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))) + + <3 (|incString| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))) +\end{verbatim} + +We are building a stream of functions and arguments stored in a delay +structure which will eventually be evaluated. We continue this process +with the call to \bfref{next} which builds a delay with the function +\bfref{next1} and the current delay. + +\subsection{Creating a Delay -- next} +\begin{verbatim} + 3> (|next| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))) + 4> (|Delay| |next1| + (|lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0)))) + <4 (|Delay| (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0)))) + <3 (|next| + (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0)))) +\end{verbatim} + +\subsection{Creating a Delay -- ncloopParse} +`We continue building a larger delay, this time with a call to +\bfref{next} with the function argument \bfref{ncloopParse} and the +existing delay. + +\begin{verbatim} + 3> (|next| |ncloopParse| + (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0)))) + 4> (|Delay| #0=|next1| + (|ncloopParse| + (|nonnullstream| #0# |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))))) + <4 (|Delay| + (|nonnullstream| #0=|next1| |ncloopParse| + (|nonnullstream| #0# |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))))) + <3 (|next| + (|nonnullstream| #0=|next1| |ncloopParse| + (|nonnullstream| #0# |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))))) +\end{verbatim} + +Finally we call \bfref{intloopProcess} with the step number {\bf stepno}, +whether we are talking to the console {\bf interactive} and the delay +we just constructed {\bf delay} + +\subsection{Evaluating a Delay -- intloopProcess} + +At this point we have created a large delay. Now we begin to evaluate it. + +\begin{verbatim} + 3> (|intloopProcess| 1 T + (|nonnullstream| #0=|next1| |ncloopParse| + (|nonnullstream| #0# |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))))) +\end{verbatim} + +\bfref{intloopProcess} calls \bfref{StreamNull} which walks the +delay applying the second value, which is a function, to the rest +of the delay. Thus, all of the functions we packaged into the +delay will be evaluated. + +The result of each function call, e.g the result of calling \bfref{next1} +will be a pair, which we call a ParsePair \index{ParsePair}. +The car of the ParsePair is rplaca'd into the delay and +the cdr of the ParsePair is rplacd'd into the delay. +So the delay is gradually reduced by each function call. + +\begin{verbatim} + 4> (|StreamNull| + (|nonnullstream| #0=|next1| |ncloopParse| + (|nonnullstream| #0# |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))))) +\end{verbatim} + +Here we see the \bfref{next1} function being called from the delay. +It immediately calls \bfref{StreamNull} to process the rest of the delay. + +\begin{verbatim} + 5> (|next1| |ncloopParse| + (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0)))) + 6> (|StreamNull| + (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0)))) +\end{verbatim} + +\bfref{StreamNull}, now working on the inner portion of the delay, +finds the function \bfref{next1} and calls it, which results in an +immediate inner call to \bfref{StreamNull}. + +\begin{verbatim} + 7> (|next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))) + 8> (|StreamNull| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))) +\end{verbatim} + +Descending even further, the \bfref{StreamNull} finds \bfref{incZip1}, +which finds the function \bfref{incRenumberLine} and two delays. +\begin{verbatim} + 9> (|incZip1| + |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0)) +\end{verbatim} +\bfref{incZip1} invokes \bfref{StreamNull} on the first delay, which +invokes \bfref{incLude1} on the rest of the delay. +\begin{verbatim} + 10> (|StreamNull| + (|nonnullstream| |incLude1| 0 ("1") 0 + ("strings") (1))) +\end{verbatim} +\bfref{incLude1} unpacks the argument list and invokes \bfref{StreamNull} +on the second argument \verb|("1")| which is not the expected symbol +{\bf nonnullstream} so \bfref{StreamNull} immediately returns NIL. +\begin{verbatim} + 11> (|incLude1| 0 ("1") 0 ("strings") (1)) + 12> (|StreamNull| ("1")) + <12 (|StreamNull| NIL) +\end{verbatim} +Next, \bfref{incLude1} calls \bfref{incClassify} to which calls +\bfref{incCommand?} which checks for a leading ``)''. Since there +isn't one \bfref{incClassify} immediately returns a list of NIL, 0, +and the empty string. +\begin{verbatim} + 12> (|incClassify| "1") + 13> (|incCommand?| "1") + <13 (|incCommand?| NIL) + <12 (|incClassify| (NIL 0 "")) + + 12> (|Skipping?| 1) + 13> (|KeepPart?| 1) + <13 (|KeepPart?| T) + <12 (|Skipping?| NIL) + + 12> (|xlOK| 0 "1" 1 "strings") + 13> (|xlOK1| 0 "1" "1" 1 "strings") + 14> (INCLINE1 0 "1" "1" -1 1 "strings") + 15> (|lnCreate| 0 "1" -1 1 "strings") + <15 (|lnCreate| (0 "1" -1 1 "strings")) + <14 (INCLINE1 (((0 "1" -1 1 "strings") . 1) . "1")) + <13 (|xlOK1| ((((0 "1" -1 1 "strings") . 1) . "1") + (NIL |none|))) + <12 (|xlOK| ((((0 "1" -1 1 "strings") . 1) . "1") + (NIL |none|))) + + 12> (|incLude| 0 NIL 1 ("strings") (1)) + 13> (|Delay| |incLude1| (0 NIL 1 ("strings") (1))) + <13 (|Delay| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1))) + <12 (|incLude| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1))) + + <11 (|incLude1| + (((((0 "1" -1 1 "strings") . 1) . "1") (NIL |none|)) + |nonnullstream| |incLude1| 0 NIL 1 ("strings") (1))) + <10 (|StreamNull| NIL) +\end{verbatim} + +\begin{verbatim} + 10> (|StreamNull| (|nonnullstream| |incIgen1| 0)) + 11> (|incIgen1| 0) + 12> (|incIgen| 1) + 13> (|Delay| |incIgen1| (1)) + <13 (|Delay| (|nonnullstream| |incIgen1| 1)) + <12 (|incIgen| (|nonnullstream| |incIgen1| 1)) + <11 (|incIgen1| (1 |nonnullstream| |incIgen1| 1)) + <10 (|StreamNull| NIL) + 10> (|incRenumberLine| + ((((0 "1" -1 1 "strings") . 1) . "1") (NIL |none|)) 1) + 11> (|incRenumberItem| + (((0 "1" -1 1 "strings") . 1) . "1") 1) + 12> (|lnSetGlobalNum| (0 "1" -1 1 "strings") 1) + <12 (|lnSetGlobalNum| 1) + <11 (|incRenumberItem| (((0 "1" 1 1 "strings") . 1) . "1")) + 11> (|incHandleMessage| + ((((0 "1" 1 1 "strings") . 1) . "1") (NIL |none|))) + <11 (|incHandleMessage| 0) + <10 (|incRenumberLine| + (((0 "1" 1 1 "strings") . 1) . "1")) +\end{verbatim} + +\begin{verbatim} + 10> (|incZip| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1)) + 11> (|Delay| |incZip1| + (|incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + <11 (|Delay| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + <10 (|incZip| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) +\end{verbatim} + +\begin{verbatim} + <9 (|incZip1| + ((((0 "1" 1 1 "strings") . 1) . "1") + |nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + <8 (|StreamNull| NIL) +\end{verbatim} + +\begin{verbatim} + 8> (|lineoftoks| + ((((0 "1" 1 1 "strings") . 1) . "1") + |nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + 9> (|nextline| + ((((0 "1" 1 1 "strings") . 1) . "1") + |nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + 10> (|npNull| + ((((0 "1" 1 1 "strings") . 1) . "1") + |nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + 11> (|StreamNull| + ((((0 "1" 1 1 "strings") . 1) . "1") + |nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + <11 (|StreamNull| NIL) + <10 (|npNull| NIL) + 10> (STRPOSL " " "1" 0 T) + <10 (STRPOSL 0) + <9 (|nextline| T) + 9> (|scanIgnoreLine| "1" 0) + <9 (|scanIgnoreLine| 0) + 9> (|incPrefix?| "command" 1 "1") + <9 (|incPrefix?| NIL) + 9> (|scanToken|) + 10> (|startsComment?|) + <10 (|startsComment?| NIL) + 10> (|startsNegComment?|) + <10 (|startsNegComment?| NIL) + 10> (|punctuation?| 49) + <10 (|punctuation?| NIL) + 10> (|digit?| #\1) + 11> (DIGITP #\1) + <11 (DIGITP 1) + <10 (|digit?| 1) + 10> (|scanNumber|) + 11> (|spleI| |digit?|) + 12> (|spleI1| |digit?| NIL) + 13> (|digit?| #\1) + 14> (DIGITP #\1) + <14 (DIGITP 1) + <13 (|digit?| 1) + <12 (|spleI1| "1") + <11 (|spleI| "1") + 11> (|lfinteger| "1") + <11 (|lfinteger| (|integer| "1")) + <10 (|scanNumber| (|integer| "1")) + 10> (|lnExtraBlanks| (0 "1" 1 1 "strings")) + <10 (|lnExtraBlanks| 0) + 10> (|constoken| + "1" (0 "1" 1 1 "strings") (|integer| "1") 0) + 11> (|ncPutQ| + (|integer| . "1") |posn| ((0 "1" 1 1 "strings") . 0)) + 12> (|ncAlist| (|integer| . "1")) + <12 (|ncAlist| NIL) + 12> (|ncAlist| (|integer| . "1")) + <12 (|ncAlist| NIL) + 12> (|ncTag| (|integer| . "1")) + <12 (|ncTag| |integer|) + <11 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <10 (|constoken| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . + "1")) + 10> (|dqUnit| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . + "1")) + <10 (|dqUnit| + (#0=(((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . + "1")) . #0#)) + <9 (|scanToken| + (#0=(((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . + "1")) . #0#)) + 9> (|dqAppend| NIL + (#0=(((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . + "1")) . #0#)) + <9 (|dqAppend| + (#0=(((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . + "1")) . #0#)) + <8 (|lineoftoks| + ((((#0=( + ((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) . "1")) + . #0#) + (((#1# . 1) . "1") . + #2=(|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) + . #2#)) +\end{verbatim} + +\begin{verbatim} + 8> (|next| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + 9> (|Delay| |next1| + (|lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1)))) + <9 (|Delay| + (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1)))) + <8 (|next| + (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1)))) +\end{verbatim} + +\begin{verbatim} + 8> (|incAppend| + (((#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) . "1")) . #0#) + (((#1# . 1) . "1") . + #2=(|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) + (|nonnullstream| |next1| |lineoftoks| #2#)) + 9> (|Delay| |incAppend1| + ((((#1=(( + (|integer| (|posn| #2=(0 "1" 1 1 "strings") . 0)) . + "1")) . #1#) + (((#2# . 1) . "1") . + #3=(|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) + (|nonnullstream| |next1| |lineoftoks| #3#))) + <9 (|Delay| + (|nonnullstream| |incAppend1| + (((#1= + (((|integer| (|posn| #2=(0 "1" 1 1 "strings") . 0)) + . "1")) + . #1#) + (((#2# . 1) . "1") . + #3=(|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) + (|nonnullstream| |next1| |lineoftoks| #3#))) + <8 (|incAppend| + (|nonnullstream| |incAppend1| + (((#1=(((|integer| (|posn| #2=(0 "1" 1 1 "strings") . 0)) . "1")) . #1#) + (((#2# . 1) . "1") . + #3=(|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) + (|nonnullstream| |next1| |lineoftoks| #3#))) +\end{verbatim} + +\begin{verbatim} + <7 (|next1| + (|nonnullstream| |incAppend1| + (((#1=(((|integer| (|posn| #2=(0 "1" 1 1 "strings") . 0)) + . "1")) + . #1#) (((#2# . 1) . "1") . + #3=(|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) + (|nonnullstream| |next1| |lineoftoks| #3#))) + 7> (|incAppend1| + (((#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) . + "1")) + . #0#) (((#1# . 1) . "1") . + #2=(|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) + (|nonnullstream| |next1| |lineoftoks| #2#)) +\end{verbatim} + +\begin{verbatim} + 8> (|StreamNull| + (((#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + . #0#) (((#1# . 1) . "1") + |nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) + <8 (|StreamNull| NIL) +\end{verbatim} + +\begin{verbatim} + 8> (|incAppend| NIL + (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1)))) + 9> (|Delay| |incAppend1| + (NIL + (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) + <9 (|Delay| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) + <8 (|incAppend| (|nonnullstream| |incAppend1| NIL + (|nonnullstream| |next1| |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))))) +\end{verbatim} + +\begin{verbatim} + <7 (|incAppend1| + (((#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) . #0#) (((#1# . 1) . "1") + . #2=(|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1)))) + |nonnullstream| |incAppend1| NIL + (|nonnullstream| |next1| |lineoftoks| #2#))) + <6 (|StreamNull| NIL) +\end{verbatim} + +\begin{verbatim} + 6> (|ncloopParse| + (((#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) . #0#) (((#1# . 1) . "1") + . #2=(|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1)))) + |nonnullstream| |incAppend1| NIL + (|nonnullstream| |next1| |lineoftoks| #2#))) + 7> (|ncloopDQlines| + (#0=(((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) . #0#) (((#1# . 1) . "1") + |nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + 8> (|StreamNull| + ((((0 "1" 1 1 "strings") . 1) . "1") + |nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + <8 (|StreamNull| NIL) + 8> (|tokPosn| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 9> (|ncAlist| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + <9 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <8 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 8> (|poGlobalLinePosn| ((0 "1" 1 1 "strings") . 0)) + 9> (|poGetLineObject| ((0 "1" 1 1 "strings") . 0)) + <9 (|poGetLineObject| (0 "1" 1 1 "strings")) + 9> (|lnGlobalNum| (0 "1" 1 1 "strings")) + <9 (|lnGlobalNum| 1) + <8 (|poGlobalLinePosn| 1) + 8> (|poGlobalLinePosn| ((0 "1" 1 1 "strings") . 1)) + 9> (|poGetLineObject| ((0 "1" 1 1 "strings") . 1)) + <9 (|poGetLineObject| (0 "1" 1 1 "strings")) + 9> (|lnGlobalNum| (0 "1" 1 1 "strings")) + <9 (|lnGlobalNum| 1) + <8 (|poGlobalLinePosn| 1) + 8> (|streamChop| 1 + ((((0 "1" 1 1 "strings") . 1) . "1") + |nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + 9> (|StreamNull| + ((((0 "1" 1 1 "strings") . 1) . "1") + |nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + <9 (|StreamNull| NIL) + 9> (|streamChop| 0 + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + 10> (|StreamNull| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1))) + 11> (|incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1)) + (|nonnullstream| |incIgen1| 1)) + 12> (|StreamNull| + (|nonnullstream| |incLude1| 0 NIL 1 ("strings") (1))) + 13> (|incLude1| 0 NIL 1 ("strings") (1)) + 14> (|StreamNull| NIL) + <14 (|StreamNull| T) + 14> (|Top?| 1) + <14 (|Top?| T) + <13 (|incLude1| (|nullstream|)) + <12 (|StreamNull| T) + <11 (|incZip1| (|nullstream|)) + <10 (|StreamNull| T) + <9 (|streamChop| (NIL NIL)) + 9> (|ncloopPrefix?| ")command" "1") + <9 (|ncloopPrefix?| NIL) + <8 (|streamChop| (((((0 "1" 1 1 "strings") . 1) . "1")) NIL)) + <7 (|ncloopDQlines| (((((0 "1" 1 1 "strings") . 1) . "1")) NIL)) + 7> (|dqToList| + (#0=(( + (|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) . #0#)) + <7 (|dqToList| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) + 7> (|npParse| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) + 8> (|npFirstTok|) + 9> (|tokPart| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + <9 (|tokPart| "1") + <8 (|npFirstTok| "1") + 8> (|npItem|) + 9> (|npQualDef|) + 10> (|npComma|) + 11> (|npTuple| |npQualifiedDefinition|) + 12> (|npListofFun| + |npQualifiedDefinition| + |npCommaBackSet| + |pfTupleListOf|) + 13> (|npQualifiedDefinition|) + 14> (|npQualified| |npDefinitionOrStatement|) + 15> (|npDefinitionOrStatement|) + 16> (|npBackTrack| |npGives| DEF |npDef|) + 17> (|npState|) + <17 (|npState| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 17> (|npGives|) + 18> (|npBackTrack| |npExit| GIVES |npLambda|) + 19> (|npState|) + <19 (|npState| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 19> (|npExit|) + 20> (|npBackTrack| |npAssign| EXIT |npPileExit|) + 21> (|npState|) + <21 (|npState| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 21> (|npAssign|) + 22> (|npBackTrack| |npMDEF| BECOMES |npAssignment|) + 23> (|npState|) + <23 (|npState| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 23> (|npMDEF|) + 24> (|npBackTrack| |npStatement| MDEF |npMDEFinition|) + 25> (|npState|) + <25 (|npState| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 25> (|npStatement|) + 26> (|npExpress|) + 27> (|npExpress1|) + 28> (|npConditionalStatement|) + 29> (|npConditional| |npQualifiedDefinition|) + 30> (|npEqKey| IF) + <30 (|npEqKey| NIL) + <29 (|npConditional| NIL) + <28 (|npConditionalStatement| NIL) + 28> (|npADD|) + 29> (|npType|) + 30> (|npMatch|) + 31> (|npLeftAssoc| (IS ISNT) |npSuch|) + 32> (|npSuch|) + 33> (|npLeftAssoc| (BAR) |npLogical|) + 34> (|npLogical|) + 35> (|npLeftAssoc| (OR) |npDisjand|) + 36> (|npDisjand|) + 37> (|npLeftAssoc| (AND) |npDiscrim|) + 38> (|npDiscrim|) + 39> (|npLeftAssoc| (CASE HAS) |npQuiver|) + 40> (|npQuiver|) + 41> (|npRightAssoc| (ARROW LARROW) |npRelation|) + 42> (|npState|) + <42 (|npState| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 42> (|npRelation|) + 43> (|npLeftAssoc| + (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE) + |npSynthetic|) + 44> (|npSynthetic|) + 45> (|npBy|) + 46> (|npLeftAssoc| (BY) |npInterval|) + 47> (|npInterval|) + 48> (|npArith|) + 49> (|npLeftAssoc| (MOD) |npSum|) + 50> (|npSum|) + 51> (|npLeftAssoc| (PLUS MINUS) |npTerm|) + 52> (|npTerm|) + 53> (|npInfGeneric| (MINUS PLUS)) + 54> (|npDDInfKey| (MINUS PLUS)) + 55> (|npInfKey| (MINUS PLUS)) + <55 (|npInfKey| NIL) + 55> (|npState|) + <55 (|npState| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 55> (|npEqKey| |'|) + <55 (|npEqKey| NIL) + 55> (|npRestore| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 56> (|npFirstTok|) + 57> (|tokPart| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <57 (|tokPart| "1") + <56 (|npFirstTok| "1") + <55 (|npRestore| T) + 55> (|npEqKey| BACKQUOTE) + <55 (|npEqKey| NIL) + 55> (|npRestore| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 56> (|npFirstTok|) + 57> (|tokPart| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <57 (|tokPart| "1") + <56 (|npFirstTok| "1") + <55 (|npRestore| T) + <54 (|npDDInfKey| NIL) + <53 (|npInfGeneric| NIL) + 53> (|npRemainder|) + 54> (|npLeftAssoc| (REM QUO) |npProduct|) + 55> (|npProduct|) + 56> (|npLeftAssoc| + (TIMES SLASH BACKSLASH SLASHSLASH BACKSLASHBACKSLASH + SLASHBACKSLASH BACKSLASHSLASH) + |npPower|) + 57> (|npPower|) + 58> (|npRightAssoc| (POWER CARAT) |npColon|) + 59> (|npState|) + <59 (|npState| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 59> (|npColon|) + 60> (|npTypified|) + 61> (|npApplication|) + 62> (|npDotted| |npPrimary|) + 63> (|npPrimary|) + 64> (|npPrimary1|) + 65> (|npEncAp| |npAtom1|) + 66> (|npAtom1|) + 67> (|npPDefinition|) + 68> (|npParenthesized| |npDefinitionlist|) + 69> (|npParenthesize| |(| |)| |npDefinitionlist|) + 70> (|npEqKey| |(|) + <70 (|npEqKey| NIL) + <69 (|npParenthesize| NIL) + 69> (|npParenthesize| |(\|| |\|)| |npDefinitionlist|) + 70> (|npEqKey| |(\||) + <70 (|npEqKey| NIL) + <69 (|npParenthesize| NIL) + <68 (|npParenthesized| NIL) + <67 (|npPDefinition| NIL) + 67> (|npName|) + 68> (|npId|) + <68 (|npId| NIL) + 68> (|npSymbolVariable|) + 69> (|npState|) + <69 (|npState| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 69> (|npEqKey| BACKQUOTE) + <69 (|npEqKey| NIL) + 69> (|npRestore| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 70> (|npFirstTok|) + 71> (|tokPart| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <71 (|tokPart| "1") + <70 (|npFirstTok| "1") + <69 (|npRestore| T) + <68 (|npSymbolVariable| NIL) + <67 (|npName| NIL) + 67> (|npConstTok|) + 68> (|tokType| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 69> (|ncTag| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <69 (|ncTag| |integer|) + <68 (|tokType| |integer|) + 68> (|npPush| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <68 (|npPush| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 68> (|npNext|) + 69> (|npFirstTok|) + 70> (|tokPosn| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 71> (|ncAlist| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <71 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <70 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 70> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 71> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 72> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <72 (|poNoPosition?| NIL) + <71 (|pfNoPosition?| NIL) + 71> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 72> (|ncAlist| (ERROR . NOMORE)) + <72 (|ncAlist| NIL) + 72> (|ncAlist| (ERROR . NOMORE)) + <72 (|ncAlist| NIL) + 72> (|ncTag| (ERROR . NOMORE)) + <72 (|ncTag| ERROR) + <71 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <70 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) + . NOMORE)) + 70> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <70 (|tokPart| NOMORE) + <69 (|npFirstTok| NOMORE) + <68 (|npNext| NOMORE) + <67 (|npConstTok| NOMORE) + 67> (|npFromdom|) + 68> (|npEqKey| $) + <68 (|npEqKey| NIL) + <67 (|npFromdom| T) + <66 (|npAtom1| T) + 66> (|npAnyNo| |npEncl|) + 67> (|npEncl|) + 68> (|npBDefinition|) + 69> (|npPDefinition|) + 70> (|npParenthesized| |npDefinitionlist|) + 71> (|npParenthesize| |(| |)| |npDefinitionlist|) + 72> (|npEqKey| |(|) + <72 (|npEqKey| NIL) + <71 (|npParenthesize| NIL) + 71> (|npParenthesize| |(\|| |\|)| |npDefinitionlist|) + 72> (|npEqKey| |(\||) + <72 (|npEqKey| NIL) + <71 (|npParenthesize| NIL) + <70 (|npParenthesized| NIL) + <69 (|npPDefinition| NIL) + 69> (|npBracketed| |npDefinitionlist|) + 70> (|npParened| |npDefinitionlist|) + 71> (|npEnclosed| |(| |)| |pfParen| |npDefinitionlist|) + 72> (|npEqKey| |(|) + <72 (|npEqKey| NIL) + <71 (|npEnclosed| NIL) + 71> (|npEnclosed| |(\|| |\|)| |pfParen| |npDefinitionlist|) + 72> (|npEqKey| |(\||) + <72 (|npEqKey| NIL) + <71 (|npEnclosed| NIL) + <70 (|npParened| NIL) + 70> (|npBracked| |npDefinitionlist|) + 71> (|npEnclosed| [ ] |pfBracket| |npDefinitionlist|) + 72> (|npEqKey| [) + <72 (|npEqKey| NIL) + <71 (|npEnclosed| NIL) + 71> (|npEnclosed| |[\|| |\|]| + |pfBracketBar| |npDefinitionlist|) + 72> (|npEqKey| |[\||) + <72 (|npEqKey| NIL) + <71 (|npEnclosed| NIL) + <70 (|npBracked| NIL) + 70> (|npBraced| |npDefinitionlist|) + 71> (|npEnclosed| { } |pfBrace| |npDefinitionlist|) + 72> (|npEqKey| {) + <72 (|npEqKey| NIL) + <71 (|npEnclosed| NIL) + 71> (|npEnclosed| |{\|| |\|}| + |pfBraceBar| |npDefinitionlist|) + 72> (|npEqKey| |{\||) + <72 (|npEqKey| NIL) + <71 (|npEnclosed| NIL) + <70 (|npBraced| NIL) + 70> (|npAngleBared| |npDefinitionlist|) + 71> (|npEnclosed| |<\|| |\|>| |pfHide| |npDefinitionlist|) + 72> (|npEqKey| |<\||) + <72 (|npEqKey| NIL) + <71 (|npEnclosed| NIL) + <70 (|npAngleBared| NIL) + <69 (|npBracketed| NIL) + <68 (|npBDefinition| NIL) + <67 (|npEncl| NIL) + <66 (|npAnyNo| T) + 66> (|npFromdom|) + 67> (|npEqKey| $) + <67 (|npEqKey| NIL) + <66 (|npFromdom| T) + <65 (|npEncAp| T) + <64 (|npPrimary1| T) + <63 (|npPrimary| T) + 63> (|npAnyNo| |npSelector|) + 64> (|npSelector|) + 65> (|npEqKey| DOT) + <65 (|npEqKey| NIL) + <64 (|npSelector| NIL) + <63 (|npAnyNo| T) + <62 (|npDotted| T) + 62> (|npApplication2|) + 63> (|npDotted| |npPrimary1|) + 64> (|npPrimary1|) + 65> (|npEncAp| |npAtom1|) + 66> (|npAtom1|) + 67> (|npPDefinition|) + 68> (|npParenthesized| |npDefinitionlist|) + 69> (|npParenthesize| |(| |)| |npDefinitionlist|) + 70> (|npEqKey| |(|) + <70 (|npEqKey| NIL) + <69 (|npParenthesize| NIL) + 69> (|npParenthesize| |(\|| |\|)| |npDefinitionlist|) + 70> (|npEqKey| |(\||) + <70 (|npEqKey| NIL) + <69 (|npParenthesize| NIL) + <68 (|npParenthesized| NIL) + <67 (|npPDefinition| NIL) + 67> (|npName|) + 68> (|npId|) + <68 (|npId| NIL) + 68> (|npSymbolVariable|) + 69> (|npState|) + <69 (|npState| + (NIL ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 69> (|npEqKey| BACKQUOTE) + <69 (|npEqKey| NIL) + 69> (|npRestore| + (NIL ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 70> (|npFirstTok|) + 71> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 72> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <72 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <71 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 71> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 72> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 73> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <73 (|poNoPosition?| NIL) + <72 (|pfNoPosition?| NIL) + 72> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 73> (|ncAlist| (ERROR . NOMORE)) + <73 (|ncAlist| NIL) + 73> (|ncAlist| (ERROR . NOMORE)) + <73 (|ncAlist| NIL) + 73> (|ncTag| (ERROR . NOMORE)) + <73 (|ncTag| ERROR) + <72 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <71 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 71> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <71 (|tokPart| NOMORE) + <70 (|npFirstTok| NOMORE) + <69 (|npRestore| T) + <68 (|npSymbolVariable| NIL) + <67 (|npName| NIL) + 67> (|npConstTok|) + 68> (|tokType| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 69> (|ncTag| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <69 (|ncTag| ERROR) + <68 (|tokType| ERROR) + 68> (|npEqPeek| |'|) + <68 (|npEqPeek| NIL) + <67 (|npConstTok| NIL) + 67> (|npDollar|) + 68> (|npEqPeek| $) + <68 (|npEqPeek| NIL) + <67 (|npDollar| NIL) + 67> (|npBDefinition|) + 68> (|npPDefinition|) + 69> (|npParenthesized| |npDefinitionlist|) + 70> (|npParenthesize| |(| |)| |npDefinitionlist|) + 71> (|npEqKey| |(|) + <71 (|npEqKey| NIL) + <70 (|npParenthesize| NIL) + 70> (|npParenthesize| |(\|| |\|)| |npDefinitionlist|) + 71> (|npEqKey| |(\||) + <71 (|npEqKey| NIL) + <70 (|npParenthesize| NIL) + <69 (|npParenthesized| NIL) + <68 (|npPDefinition| NIL) + 68> (|npBracketed| |npDefinitionlist|) + 69> (|npParened| |npDefinitionlist|) + 70> (|npEnclosed| |(| |)| |pfParen| |npDefinitionlist|) + 71> (|npEqKey| |(|) + <71 (|npEqKey| NIL) + <70 (|npEnclosed| NIL) + 70> (|npEnclosed| |(\|| |\|)| |pfParen| |npDefinitionlist|) + 71> (|npEqKey| |(\||) + <71 (|npEqKey| NIL) + <70 (|npEnclosed| NIL) + <69 (|npParened| NIL) + 69> (|npBracked| |npDefinitionlist|) + 70> (|npEnclosed| [ ] |pfBracket| |npDefinitionlist|) + 71> (|npEqKey| [) + <71 (|npEqKey| NIL) + <70 (|npEnclosed| NIL) + 70> (|npEnclosed| |[\|| |\|]| + |pfBracketBar| |npDefinitionlist|) + 71> (|npEqKey| |[\||) + <71 (|npEqKey| NIL) + <70 (|npEnclosed| NIL) + <69 (|npBracked| NIL) + 69> (|npBraced| |npDefinitionlist|) + 70> (|npEnclosed| { } |pfBrace| |npDefinitionlist|) + 71> (|npEqKey| {) + <71 (|npEqKey| NIL) + <70 (|npEnclosed| NIL) + 70> (|npEnclosed| |{\|| |\|}| + |pfBraceBar| |npDefinitionlist|) + 71> (|npEqKey| |{\||) + <71 (|npEqKey| NIL) + <70 (|npEnclosed| NIL) + <69 (|npBraced| NIL) + 69> (|npAngleBared| |npDefinitionlist|) + 70> (|npEnclosed| |<\|| |\|>| |pfHide| |npDefinitionlist|) + 71> (|npEqKey| |<\||) + <71 (|npEqKey| NIL) + <70 (|npEnclosed| NIL) + <69 (|npAngleBared| NIL) + <68 (|npBracketed| NIL) + <67 (|npBDefinition| NIL) + <66 (|npAtom1| NIL) + <65 (|npEncAp| NIL) + 65> (|npLet|) + 66> (|npLetQualified| |npDefinitionOrStatement|) + 67> (|npEqKey| LET) + <67 (|npEqKey| NIL) + <66 (|npLetQualified| NIL) + <65 (|npLet| NIL) + 65> (|npFix|) + 66> (|npEqKey| FIX) + <66 (|npEqKey| NIL) + <65 (|npFix| NIL) + 65> (|npMacro|) + 66> (|npEqKey| MACRO) + <66 (|npEqKey| NIL) + <65 (|npMacro| NIL) + 65> (|npBPileDefinition|) + 66> (|npPileBracketed| |npPileDefinitionlist|) + 67> (|npEqKey| SETTAB) + <67 (|npEqKey| NIL) + <66 (|npPileBracketed| NIL) + <65 (|npBPileDefinition| NIL) + 65> (|npDefn|) + 66> (|npEqKey| DEFN) + <66 (|npEqKey| NIL) + <65 (|npDefn| NIL) + 65> (|npRule|) + 66> (|npEqKey| RULE) + <66 (|npEqKey| NIL) + <65 (|npRule| NIL) + <64 (|npPrimary1| NIL) + <63 (|npDotted| NIL) + <62 (|npApplication2| NIL) + <61 (|npApplication| T) + 61> (|npAnyNo| |npTypeStyle|) + 62> (|npTypeStyle|) + 63> (|npCoerceTo|) + 64> (|npTypedForm| COERCE |pfCoerceto|) + 65> (|npEqKey| COERCE) + <65 (|npEqKey| NIL) + <64 (|npTypedForm| NIL) + <63 (|npCoerceTo| NIL) + 63> (|npRestrict|) + 64> (|npTypedForm| AT |pfRestrict|) + 65> (|npEqKey| AT) + <65 (|npEqKey| NIL) + <64 (|npTypedForm| NIL) + <63 (|npRestrict| NIL) + 63> (|npPretend|) + 64> (|npTypedForm| PRETEND |pfPretend|) + 65> (|npEqKey| PRETEND) + <65 (|npEqKey| NIL) + <64 (|npTypedForm| NIL) + <63 (|npPretend| NIL) + 63> (|npColonQuery|) + 64> (|npTypedForm| ATAT |pfRetractTo|) + 65> (|npEqKey| ATAT) + <65 (|npEqKey| NIL) + <64 (|npTypedForm| NIL) + <63 (|npColonQuery| NIL) + <62 (|npTypeStyle| NIL) + <61 (|npAnyNo| T) + <60 (|npTypified| T) + 60> (|npAnyNo| |npTagged|) + 61> (|npTagged|) + 62> (|npTypedForm1| COLON |pfTagged|) + 63> (|npEqKey| COLON) + <63 (|npEqKey| NIL) + <62 (|npTypedForm1| NIL) + <61 (|npTagged| NIL) + <60 (|npAnyNo| T) + <59 (|npColon| T) + 59> (|npInfGeneric| (POWER CARAT)) + 60> (|npDDInfKey| (POWER CARAT)) + 61> (|npInfKey| (POWER CARAT)) + <61 (|npInfKey| NIL) + 61> (|npState|) + <61 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 61> (|npEqKey| |'|) + <61 (|npEqKey| NIL) + 61> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 62> (|npFirstTok|) + 63> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 64> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <64 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <63 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 63> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 64> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 65> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <65 (|poNoPosition?| NIL) + <64 (|pfNoPosition?| NIL) + 64> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 65> (|ncAlist| (ERROR . NOMORE)) + <65 (|ncAlist| NIL) + 65> (|ncAlist| (ERROR . NOMORE)) + <65 (|ncAlist| NIL) + 65> (|ncTag| (ERROR . NOMORE)) + <65 (|ncTag| ERROR) + <64 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <63 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 63> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <63 (|tokPart| NOMORE) + <62 (|npFirstTok| NOMORE) + <61 (|npRestore| T) + 61> (|npEqKey| BACKQUOTE) + <61 (|npEqKey| NIL) + 61> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 62> (|npFirstTok|) + 63> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 64> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <64 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <63 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 63> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 64> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 65> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <65 (|poNoPosition?| NIL) + <64 (|pfNoPosition?| NIL) + 64> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 65> (|ncAlist| (ERROR . NOMORE)) + <65 (|ncAlist| NIL) + 65> (|ncAlist| (ERROR . NOMORE)) + <65 (|ncAlist| NIL) + 65> (|ncTag| (ERROR . NOMORE)) + <65 (|ncTag| ERROR) + <64 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <63 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 63> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <63 (|tokPart| NOMORE) + <62 (|npFirstTok| NOMORE) + <61 (|npRestore| T) + <60 (|npDDInfKey| NIL) + <59 (|npInfGeneric| NIL) + <58 (|npRightAssoc| T) + <57 (|npPower| T) + 57> (|npInfGeneric| + (TIMES SLASH BACKSLASH SLASHSLASH BACKSLASHBACKSLASH + SLASHBACKSLASH BACKSLASHSLASH)) + 58> (|npDDInfKey| + (TIMES SLASH BACKSLASH SLASHSLASH BACKSLASHBACKSLASH + SLASHBACKSLASH BACKSLASHSLASH)) + 59> (|npInfKey| + (TIMES SLASH BACKSLASH SLASHSLASH BACKSLASHBACKSLASH + SLASHBACKSLASH BACKSLASHSLASH)) + <59 (|npInfKey| NIL) + 59> (|npState|) + <59 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 59> (|npEqKey| |'|) + <59 (|npEqKey| NIL) + 59> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 60> (|npFirstTok|) + 61> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 62> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <62 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <61 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 61> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 62> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 63> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <63 (|poNoPosition?| NIL) + <62 (|pfNoPosition?| NIL) + 62> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 63> (|ncAlist| (ERROR . NOMORE)) + <63 (|ncAlist| NIL) + 63> (|ncAlist| (ERROR . NOMORE)) + <63 (|ncAlist| NIL) + 63> (|ncTag| (ERROR . NOMORE)) + <63 (|ncTag| ERROR) + <62 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <61 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 61> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <61 (|tokPart| NOMORE) + <60 (|npFirstTok| NOMORE) + <59 (|npRestore| T) + 59> (|npEqKey| BACKQUOTE) + <59 (|npEqKey| NIL) + 59> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 60> (|npFirstTok|) + 61> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 62> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <62 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <61 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 61> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 62> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 63> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <63 (|poNoPosition?| NIL) + <62 (|pfNoPosition?| NIL) + 62> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 63> (|ncAlist| (ERROR . NOMORE)) + <63 (|ncAlist| NIL) + 63> (|ncAlist| (ERROR . NOMORE)) + <63 (|ncAlist| NIL) + 63> (|ncTag| (ERROR . NOMORE)) + <63 (|ncTag| ERROR) + <62 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <61 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 61> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <61 (|tokPart| NOMORE) + <60 (|npFirstTok| NOMORE) + <59 (|npRestore| T) + <58 (|npDDInfKey| NIL) + <57 (|npInfGeneric| NIL) + <56 (|npLeftAssoc| T) + <55 (|npProduct| T) + 55> (|npInfGeneric| (REM QUO)) + 56> (|npDDInfKey| (REM QUO)) + 57> (|npInfKey| (REM QUO)) + <57 (|npInfKey| NIL) + 57> (|npState|) + <57 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 57> (|npEqKey| |'|) + <57 (|npEqKey| NIL) + 57> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 58> (|npFirstTok|) + 59> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 60> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <60 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <59 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 59> (|tokConstruct| ERROR NOMORE ( + (0 "1" 1 1 "strings") . 0)) + 60> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 61> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <61 (|poNoPosition?| NIL) + <60 (|pfNoPosition?| NIL) + 60> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 61> (|ncAlist| (ERROR . NOMORE)) + <61 (|ncAlist| NIL) + 61> (|ncAlist| (ERROR . NOMORE)) + <61 (|ncAlist| NIL) + 61> (|ncTag| (ERROR . NOMORE)) + <61 (|ncTag| ERROR) + <60 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <59 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 59> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <59 (|tokPart| NOMORE) + <58 (|npFirstTok| NOMORE) + <57 (|npRestore| T) + 57> (|npEqKey| BACKQUOTE) + <57 (|npEqKey| NIL) + 57> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 58> (|npFirstTok|) + 59> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 60> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <60 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <59 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 59> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 60> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 61> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <61 (|poNoPosition?| NIL) + <60 (|pfNoPosition?| NIL) + 60> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 61> (|ncAlist| (ERROR . NOMORE)) + <61 (|ncAlist| NIL) + 61> (|ncAlist| (ERROR . NOMORE)) + <61 (|ncAlist| NIL) + 61> (|ncTag| (ERROR . NOMORE)) + <61 (|ncTag| ERROR) + <60 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <59 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 59> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <59 (|tokPart| NOMORE) + <58 (|npFirstTok| NOMORE) + <57 (|npRestore| T) + <56 (|npDDInfKey| NIL) + <55 (|npInfGeneric| NIL) + <54 (|npLeftAssoc| T) + <53 (|npRemainder| T) + <52 (|npTerm| T) + 52> (|npInfGeneric| (PLUS MINUS)) + 53> (|npDDInfKey| (PLUS MINUS)) + 54> (|npInfKey| (PLUS MINUS)) + <54 (|npInfKey| NIL) + 54> (|npState|) + <54 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 54> (|npEqKey| |'|) + <54 (|npEqKey| NIL) + 54> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 55> (|npFirstTok|) + 56> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 57> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <57 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <56 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 56> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 57> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 58> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <58 (|poNoPosition?| NIL) + <57 (|pfNoPosition?| NIL) + 57> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 58> (|ncAlist| (ERROR . NOMORE)) + <58 (|ncAlist| NIL) + 58> (|ncAlist| (ERROR . NOMORE)) + <58 (|ncAlist| NIL) + 58> (|ncTag| (ERROR . NOMORE)) + <58 (|ncTag| ERROR) + <57 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <56 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 56> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <56 (|tokPart| NOMORE) + <55 (|npFirstTok| NOMORE) + <54 (|npRestore| T) + 54> (|npEqKey| BACKQUOTE) + <54 (|npEqKey| NIL) + 54> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 55> (|npFirstTok|) + 56> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 57> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <57 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <56 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 56> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 57> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 58> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <58 (|poNoPosition?| NIL) + <57 (|pfNoPosition?| NIL) + 57> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 58> (|ncAlist| (ERROR . NOMORE)) + <58 (|ncAlist| NIL) + 58> (|ncAlist| (ERROR . NOMORE)) + <58 (|ncAlist| NIL) + 58> (|ncTag| (ERROR . NOMORE)) + <58 (|ncTag| ERROR) + <57 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <56 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 56> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <56 (|tokPart| NOMORE) + <55 (|npFirstTok| NOMORE) + <54 (|npRestore| T) + <53 (|npDDInfKey| NIL) + <52 (|npInfGeneric| NIL) + <51 (|npLeftAssoc| T) + <50 (|npSum| T) + 50> (|npInfGeneric| (MOD)) + 51> (|npDDInfKey| (MOD)) + 52> (|npInfKey| (MOD)) + <52 (|npInfKey| NIL) + 52> (|npState|) + <52 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 52> (|npEqKey| |'|) + <52 (|npEqKey| NIL) + 52> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 53> (|npFirstTok|) + 54> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 55> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <55 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <54 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 54> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 55> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 56> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <56 (|poNoPosition?| NIL) + <55 (|pfNoPosition?| NIL) + 55> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 56> (|ncAlist| (ERROR . NOMORE)) + <56 (|ncAlist| NIL) + 56> (|ncAlist| (ERROR . NOMORE)) + <56 (|ncAlist| NIL) + 56> (|ncTag| (ERROR . NOMORE)) + <56 (|ncTag| ERROR) + <55 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <54 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 54> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <54 (|tokPart| NOMORE) + <53 (|npFirstTok| NOMORE) + <52 (|npRestore| T) + 52> (|npEqKey| BACKQUOTE) + <52 (|npEqKey| NIL) + 52> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 53> (|npFirstTok|) + 54> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 55> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <55 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <54 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 54> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 55> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 56> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <56 (|poNoPosition?| NIL) + <55 (|pfNoPosition?| NIL) + 55> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 56> (|ncAlist| (ERROR . NOMORE)) + <56 (|ncAlist| NIL) + 56> (|ncAlist| (ERROR . NOMORE)) + <56 (|ncAlist| NIL) + 56> (|ncTag| (ERROR . NOMORE)) + <56 (|ncTag| ERROR) + <55 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <54 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 54> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <54 (|tokPart| NOMORE) + <53 (|npFirstTok| NOMORE) + <52 (|npRestore| T) + <51 (|npDDInfKey| NIL) + <50 (|npInfGeneric| NIL) + <49 (|npLeftAssoc| T) + <48 (|npArith| T) + 48> (|npSegment|) + 49> (|npEqPeek| SEG) + <49 (|npEqPeek| NIL) + <48 (|npSegment| NIL) + <47 (|npInterval| T) + 47> (|npInfGeneric| (BY)) + 48> (|npDDInfKey| (BY)) + 49> (|npInfKey| (BY)) + <49 (|npInfKey| NIL) + 49> (|npState|) + <49 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 49> (|npEqKey| |'|) + <49 (|npEqKey| NIL) + 49> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 50> (|npFirstTok|) + 51> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 52> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <52 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <51 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 51> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 52> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 53> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <53 (|poNoPosition?| NIL) + <52 (|pfNoPosition?| NIL) + 52> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 53> (|ncAlist| (ERROR . NOMORE)) + <53 (|ncAlist| NIL) + 53> (|ncAlist| (ERROR . NOMORE)) + <53 (|ncAlist| NIL) + 53> (|ncTag| (ERROR . NOMORE)) + <53 (|ncTag| ERROR) + <52 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <51 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 51> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <51 (|tokPart| NOMORE) + <50 (|npFirstTok| NOMORE) + <49 (|npRestore| T) + 49> (|npEqKey| BACKQUOTE) + <49 (|npEqKey| NIL) + 49> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 50> (|npFirstTok|) + 51> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 52> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <52 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <51 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 51> (|tokConstruct| ERROR NOMORE ((0 "1" 1 1 "strings") . + 0)) + 52> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 53> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <53 (|poNoPosition?| NIL) + <52 (|pfNoPosition?| NIL) + 52> (|ncPutQ| + (ERROR . NOMORE) |posn| ((0 "1" 1 1 "strings") . 0)) + 53> (|ncAlist| (ERROR . NOMORE)) + <53 (|ncAlist| NIL) + 53> (|ncAlist| (ERROR . NOMORE)) + <53 (|ncAlist| NIL) + 53> (|ncTag| (ERROR . NOMORE)) + <53 (|ncTag| ERROR) + <52 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <51 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 51> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <51 (|tokPart| NOMORE) + <50 (|npFirstTok| NOMORE) + <49 (|npRestore| T) + <48 (|npDDInfKey| NIL) + <47 (|npInfGeneric| NIL) + <46 (|npLeftAssoc| T) + <45 (|npBy| T) + 45> (|npAmpersandFrom|) + 46> (|npAmpersand|) + 47> (|npEqKey| AMPERSAND) + <47 (|npEqKey| NIL) + <46 (|npAmpersand| NIL) + <45 (|npAmpersandFrom| NIL) + <44 (|npSynthetic| T) + 44> (|npInfGeneric| + (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE)) + 45> (|npDDInfKey| + (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE)) + 46> (|npInfKey| (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE)) + <46 (|npInfKey| NIL) + 46> (|npState|) + <46 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 46> (|npEqKey| |'|) + <46 (|npEqKey| NIL) + 46> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 47> (|npFirstTok|) + 48> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 49> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <49 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <48 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 48> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 49> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 50> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <50 (|poNoPosition?| NIL) + <49 (|pfNoPosition?| NIL) + 49> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 50> (|ncAlist| (ERROR . NOMORE)) + <50 (|ncAlist| NIL) + 50> (|ncAlist| (ERROR . NOMORE)) + <50 (|ncAlist| NIL) + 50> (|ncTag| (ERROR . NOMORE)) + <50 (|ncTag| ERROR) + <49 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <48 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 48> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <48 (|tokPart| NOMORE) + <47 (|npFirstTok| NOMORE) + <46 (|npRestore| T) + 46> (|npEqKey| BACKQUOTE) + <46 (|npEqKey| NIL) + 46> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 47> (|npFirstTok|) + 48> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 49> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <49 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <48 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 48> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 49> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 50> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <50 (|poNoPosition?| NIL) + <49 (|pfNoPosition?| NIL) + 49> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 50> (|ncAlist| (ERROR . NOMORE)) + <50 (|ncAlist| NIL) + 50> (|ncAlist| (ERROR . NOMORE)) + <50 (|ncAlist| NIL) + 50> (|ncTag| (ERROR . NOMORE)) + <50 (|ncTag| ERROR) + <49 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <48 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 48> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <48 (|tokPart| NOMORE) + <47 (|npFirstTok| NOMORE) + <46 (|npRestore| T) + <45 (|npDDInfKey| NIL) + <44 (|npInfGeneric| NIL) + <43 (|npLeftAssoc| T) + <42 (|npRelation| T) + 42> (|npInfGeneric| (ARROW LARROW)) + 43> (|npDDInfKey| (ARROW LARROW)) + 44> (|npInfKey| (ARROW LARROW)) + <44 (|npInfKey| NIL) + 44> (|npState|) + <44 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 44> (|npEqKey| |'|) + <44 (|npEqKey| NIL) + 44> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 45> (|npFirstTok|) + 46> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 47> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <47 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <46 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 46> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 47> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 48> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <48 (|poNoPosition?| NIL) + <47 (|pfNoPosition?| NIL) + 47> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 48> (|ncAlist| (ERROR . NOMORE)) + <48 (|ncAlist| NIL) + 48> (|ncAlist| (ERROR . NOMORE)) + <48 (|ncAlist| NIL) + 48> (|ncTag| (ERROR . NOMORE)) + <48 (|ncTag| ERROR) + <47 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <46 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 46> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <46 (|tokPart| NOMORE) + <45 (|npFirstTok| NOMORE) + <44 (|npRestore| T) + 44> (|npEqKey| BACKQUOTE) + <44 (|npEqKey| NIL) + 44> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 45> (|npFirstTok|) + 46> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 47> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <47 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <46 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 46> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 47> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 48> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <48 (|poNoPosition?| NIL) + <47 (|pfNoPosition?| NIL) + 47> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 48> (|ncAlist| (ERROR . NOMORE)) + <48 (|ncAlist| NIL) + 48> (|ncAlist| (ERROR . NOMORE)) + <48 (|ncAlist| NIL) + 48> (|ncTag| (ERROR . NOMORE)) + <48 (|ncTag| ERROR) + <47 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <46 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 46> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <46 (|tokPart| NOMORE) + <45 (|npFirstTok| NOMORE) + <44 (|npRestore| T) + <43 (|npDDInfKey| NIL) + <42 (|npInfGeneric| NIL) + <41 (|npRightAssoc| T) + <40 (|npQuiver| T) + 40> (|npInfGeneric| (CASE HAS)) + 41> (|npDDInfKey| (CASE HAS)) + 42> (|npInfKey| (CASE HAS)) + <42 (|npInfKey| NIL) + 42> (|npState|) + <42 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 42> (|npEqKey| |'|) + <42 (|npEqKey| NIL) + 42> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 43> (|npFirstTok|) + 44> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 45> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <45 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <44 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 44> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 45> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 46> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <46 (|poNoPosition?| NIL) + <45 (|pfNoPosition?| NIL) + 45> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 46> (|ncAlist| (ERROR . NOMORE)) + <46 (|ncAlist| NIL) + 46> (|ncAlist| (ERROR . NOMORE)) + <46 (|ncAlist| NIL) + 46> (|ncTag| (ERROR . NOMORE)) + <46 (|ncTag| ERROR) + <45 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <44 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 44> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <44 (|tokPart| NOMORE) + <43 (|npFirstTok| NOMORE) + <42 (|npRestore| T) + 42> (|npEqKey| BACKQUOTE) + <42 (|npEqKey| NIL) + 42> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 43> (|npFirstTok|) + 44> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 45> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <45 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <44 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 44> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 45> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 46> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <46 (|poNoPosition?| NIL) + <45 (|pfNoPosition?| NIL) + 45> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 46> (|ncAlist| (ERROR . NOMORE)) + <46 (|ncAlist| NIL) + 46> (|ncAlist| (ERROR . NOMORE)) + <46 (|ncAlist| NIL) + 46> (|ncTag| (ERROR . NOMORE)) + <46 (|ncTag| ERROR) + <45 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <44 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 44> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <44 (|tokPart| NOMORE) + <43 (|npFirstTok| NOMORE) + <42 (|npRestore| T) + <41 (|npDDInfKey| NIL) + <40 (|npInfGeneric| NIL) + <39 (|npLeftAssoc| T) + <38 (|npDiscrim| T) + 38> (|npInfGeneric| (AND)) + 39> (|npDDInfKey| (AND)) + 40> (|npInfKey| (AND)) + <40 (|npInfKey| NIL) + 40> (|npState|) + <40 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 40> (|npEqKey| |'|) + <40 (|npEqKey| NIL) + 40> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 41> (|npFirstTok|) + 42> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 43> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <43 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <42 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 42> (|tokConstruct| ERROR NOMORE ((0 "1" 1 1 "strings") . 0)) + 43> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 44> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <44 (|poNoPosition?| NIL) + <43 (|pfNoPosition?| NIL) + 43> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 44> (|ncAlist| (ERROR . NOMORE)) + <44 (|ncAlist| NIL) + 44> (|ncAlist| (ERROR . NOMORE)) + <44 (|ncAlist| NIL) + 44> (|ncTag| (ERROR . NOMORE)) + <44 (|ncTag| ERROR) + <43 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <42 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 42> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <42 (|tokPart| NOMORE) + <41 (|npFirstTok| NOMORE) + <40 (|npRestore| T) + 40> (|npEqKey| BACKQUOTE) + <40 (|npEqKey| NIL) + 40> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 41> (|npFirstTok|) + 42> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 43> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <43 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <42 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 42> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 43> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 44> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <44 (|poNoPosition?| NIL) + <43 (|pfNoPosition?| NIL) + 43> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 44> (|ncAlist| (ERROR . NOMORE)) + <44 (|ncAlist| NIL) + 44> (|ncAlist| (ERROR . NOMORE)) + <44 (|ncAlist| NIL) + 44> (|ncTag| (ERROR . NOMORE)) + <44 (|ncTag| ERROR) + <43 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <42 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 42> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <42 (|tokPart| NOMORE) + <41 (|npFirstTok| NOMORE) + <40 (|npRestore| T) + <39 (|npDDInfKey| NIL) + <38 (|npInfGeneric| NIL) + <37 (|npLeftAssoc| T) + <36 (|npDisjand| T) + 36> (|npInfGeneric| (OR)) + 37> (|npDDInfKey| (OR)) + 38> (|npInfKey| (OR)) + <38 (|npInfKey| NIL) + 38> (|npState|) + <38 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 38> (|npEqKey| |'|) + <38 (|npEqKey| NIL) + 38> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 39> (|npFirstTok|) + 40> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 41> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <41 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <40 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 40> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 41> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 42> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <42 (|poNoPosition?| NIL) + <41 (|pfNoPosition?| NIL) + 41> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 42> (|ncAlist| (ERROR . NOMORE)) + <42 (|ncAlist| NIL) + 42> (|ncAlist| (ERROR . NOMORE)) + <42 (|ncAlist| NIL) + 42> (|ncTag| (ERROR . NOMORE)) + <42 (|ncTag| ERROR) + <41 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <40 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 40> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <40 (|tokPart| NOMORE) + <39 (|npFirstTok| NOMORE) + <38 (|npRestore| T) + 38> (|npEqKey| BACKQUOTE) + <38 (|npEqKey| NIL) + 38> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 39> (|npFirstTok|) + 40> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 41> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <41 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <40 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 40> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 41> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 42> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <42 (|poNoPosition?| NIL) + <41 (|pfNoPosition?| NIL) + 41> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 42> (|ncAlist| (ERROR . NOMORE)) + <42 (|ncAlist| NIL) + 42> (|ncAlist| (ERROR . NOMORE)) + <42 (|ncAlist| NIL) + 42> (|ncTag| (ERROR . NOMORE)) + <42 (|ncTag| ERROR) + <41 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <40 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 40> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <40 (|tokPart| NOMORE) + <39 (|npFirstTok| NOMORE) + <38 (|npRestore| T) + <37 (|npDDInfKey| NIL) + <36 (|npInfGeneric| NIL) + <35 (|npLeftAssoc| T) + <34 (|npLogical| T) + 34> (|npInfGeneric| (BAR)) + 35> (|npDDInfKey| (BAR)) + 36> (|npInfKey| (BAR)) + <36 (|npInfKey| NIL) + 36> (|npState|) + <36 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 36> (|npEqKey| |'|) + <36 (|npEqKey| NIL) + 36> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 37> (|npFirstTok|) + 38> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 39> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <39 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <38 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 38> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 39> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 40> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <40 (|poNoPosition?| NIL) + <39 (|pfNoPosition?| NIL) + 39> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 40> (|ncAlist| (ERROR . NOMORE)) + <40 (|ncAlist| NIL) + 40> (|ncAlist| (ERROR . NOMORE)) + <40 (|ncAlist| NIL) + 40> (|ncTag| (ERROR . NOMORE)) + <40 (|ncTag| ERROR) + <39 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <38 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 38> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <38 (|tokPart| NOMORE) + <37 (|npFirstTok| NOMORE) + <36 (|npRestore| T) + 36> (|npEqKey| BACKQUOTE) + <36 (|npEqKey| NIL) + 36> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 37> (|npFirstTok|) + 38> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 39> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <39 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <38 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 38> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 39> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 40> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <40 (|poNoPosition?| NIL) + <39 (|pfNoPosition?| NIL) + 39> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 40> (|ncAlist| (ERROR . NOMORE)) + <40 (|ncAlist| NIL) + 40> (|ncAlist| (ERROR . NOMORE)) + <40 (|ncAlist| NIL) + 40> (|ncTag| (ERROR . NOMORE)) + <40 (|ncTag| ERROR) + <39 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <38 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 38> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <38 (|tokPart| NOMORE) + <37 (|npFirstTok| NOMORE) + <36 (|npRestore| T) + <35 (|npDDInfKey| NIL) + <34 (|npInfGeneric| NIL) + <33 (|npLeftAssoc| T) + <32 (|npSuch| T) + 32> (|npInfGeneric| (IS ISNT)) + 33> (|npDDInfKey| (IS ISNT)) + 34> (|npInfKey| (IS ISNT)) + <34 (|npInfKey| NIL) + 34> (|npState|) + <34 (|npState| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 34> (|npEqKey| |'|) + <34 (|npEqKey| NIL) + 34> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 35> (|npFirstTok|) + 36> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 37> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <37 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <36 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 36> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 37> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 38> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <38 (|poNoPosition?| NIL) + <37 (|pfNoPosition?| NIL) + 37> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 38> (|ncAlist| (ERROR . NOMORE)) + <38 (|ncAlist| NIL) + 38> (|ncAlist| (ERROR . NOMORE)) + <38 (|ncAlist| NIL) + 38> (|ncTag| (ERROR . NOMORE)) + <38 (|ncTag| ERROR) + <37 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <36 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 36> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <36 (|tokPart| NOMORE) + <35 (|npFirstTok| NOMORE) + <34 (|npRestore| T) + 34> (|npEqKey| BACKQUOTE) + <34 (|npEqKey| NIL) + 34> (|npRestore| + (NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 35> (|npFirstTok|) + 36> (|tokPosn| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 37> (|ncAlist| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <37 (|ncAlist| ((|posn| (0 "1" 1 1 "strings") . 0))) + <36 (|tokPosn| ((0 "1" 1 1 "strings") . 0)) + 36> (|tokConstruct| ERROR NOMORE + ((0 "1" 1 1 "strings") . 0)) + 37> (|pfNoPosition?| ((0 "1" 1 1 "strings") . 0)) + 38> (|poNoPosition?| ((0 "1" 1 1 "strings") . 0)) + <38 (|poNoPosition?| NIL) + <37 (|pfNoPosition?| NIL) + 37> (|ncPutQ| (ERROR . NOMORE) |posn| + ((0 "1" 1 1 "strings") . 0)) + 38> (|ncAlist| (ERROR . NOMORE)) + <38 (|ncAlist| NIL) + 38> (|ncAlist| (ERROR . NOMORE)) + <38 (|ncAlist| NIL) + 38> (|ncTag| (ERROR . NOMORE)) + <38 (|ncTag| ERROR) + <37 (|ncPutQ| ((0 "1" 1 1 "strings") . 0)) + <36 (|tokConstruct| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + 36> (|tokPart| + ((ERROR (|posn| (0 "1" 1 1 "strings") . 0)) . NOMORE)) + <36 (|tokPart| NOMORE) + <35 (|npFirstTok| NOMORE) + <34 (|npRestore| T) + <33 (|npDDInfKey| NIL) + <32 (|npInfGeneric| NIL) + <31 (|npLeftAssoc| T) + <30 (|npMatch| T) + 30> (|npPop1|) + <30 (|npPop1| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 30> (|npWith| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 31> (|npEqKey| WITH) + <31 (|npEqKey| NIL) + <30 (|npWith| NIL) + 30> (|npPush| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <30 (|npPush| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + <29 (|npType| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 29> (|npPop1|) + <29 (|npPop1| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 29> (|npAdd| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 30> (|npEqKey| ADD) + <30 (|npEqKey| NIL) + <29 (|npAdd| NIL) + 29> (|npPush| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <29 (|npPush| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + <28 (|npADD| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + <27 (|npExpress1| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + 27> (|npIterators|) + 28> (|npForIn|) + 29> (|npEqKey| FOR) + <29 (|npEqKey| NIL) + <28 (|npForIn| NIL) + 28> (|npWhile|) + 29> (|npAndOr| WHILE |npLogical| |pfWhile|) + 30> (|npEqKey| WHILE) + <30 (|npEqKey| NIL) + <29 (|npAndOr| NIL) + <28 (|npWhile| NIL) + <27 (|npIterators| NIL) + <26 (|npExpress| T) + <25 (|npStatement| T) + 25> (|npEqPeek| MDEF) + <25 (|npEqPeek| NIL) + <24 (|npBackTrack| T) + <23 (|npMDEF| T) + 23> (|npEqPeek| BECOMES) + <23 (|npEqPeek| NIL) + <22 (|npBackTrack| T) + <21 (|npAssign| T) + 21> (|npEqPeek| EXIT) + <21 (|npEqPeek| NIL) + <20 (|npBackTrack| T) + <19 (|npExit| T) + 19> (|npEqPeek| GIVES) + <19 (|npEqPeek| NIL) + <18 (|npBackTrack| T) + <17 (|npGives| T) + 17> (|npEqPeek| DEF) + <17 (|npEqPeek| NIL) + <16 (|npBackTrack| T) + <15 (|npDefinitionOrStatement| T) + 15> (|npEqKey| WHERE) + <15 (|npEqKey| NIL) + <14 (|npQualified| T) + <13 (|npQualifiedDefinition| T) + 13> (|npCommaBackSet|) + 14> (|npEqKey| COMMA) + <14 (|npEqKey| NIL) + <13 (|npCommaBackSet| NIL) + <12 (|npListofFun| T) + <11 (|npTuple| T) + <10 (|npComma| T) + 10> (|npPop1|) + <10 (|npPop1| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 10> (|npPush| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1"))) + <10 (|npPush| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + <9 (|npQualDef| + ((((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")))) + 9> (|npEqKey| SEMICOLON) + <9 (|npEqKey| NIL) + 9> (|npPop1|) + <9 (|npPop1| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) + 9> (|pfEnSequence| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) + <9 (|pfEnSequence| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 9> (|npPush| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + <9 (|npPush| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) + <8 (|npItem| + (((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1"))) + <7 (|npParse| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + <6 (|ncloopParse| + ((((((#0=(0 "1" 1 1 "strings") . 1) . "1")) + ((|integer| (|posn| #0# . 0)) . "1"))) + |nonnullstream| |incAppend1| NIL + (|nonnullstream| |next1| |lineoftoks| (|nullstream|)))) +\end{verbatim} + +\begin{verbatim} + 6> (|next| |ncloopParse| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| |next1| |lineoftoks| (|nullstream|)))) + 7> (|Delay| #0=|next1| + (|ncloopParse| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) + <7 (|Delay| + (|nonnullstream| #0=|next1| |ncloopParse| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) + <6 (|next| + (|nonnullstream| #0=|next1| |ncloopParse| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) +\end{verbatim} + +\begin{verbatim} + 6> (|incAppend| + (((((#0=(0 "1" 1 1 "strings") . 1) . "1")) + ((|integer| (|posn| #0# . 0)) . "1"))) + (|nonnullstream| #1=|next1| |ncloopParse| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| #1# |lineoftoks| (|nullstream|))))) + 7> (|Delay| #0=|incAppend1| + ((((((#2=(0 "1" 1 1 "strings") . 1) . "1")) + ((|integer| (|posn| #2# . 0)) . "1"))) + (|nonnullstream| #3=|next1| |ncloopParse| + (|nonnullstream| #0# NIL + (|nonnullstream| #3# |lineoftoks| (|nullstream|)))))) + <7 (|Delay| + (|nonnullstream| #0=|incAppend1| + (((((#2=(0 "1" 1 1 "strings") . 1) . "1")) + ((|integer| (|posn| #2# . 0)) . "1"))) + (|nonnullstream| #3=|next1| |ncloopParse| + (|nonnullstream| #0# NIL + (|nonnullstream| #3# |lineoftoks| (|nullstream|)))))) + <6 (|incAppend| + (|nonnullstream| #0=|incAppend1| + (((((#2=(0 "1" 1 1 "strings") . 1) . "1")) + ((|integer| (|posn| #2# . 0)) . "1"))) + (|nonnullstream| #3=|next1| |ncloopParse| + (|nonnullstream| #0# NIL + (|nonnullstream| #3# |lineoftoks| (|nullstream|)))))) + <5 (|next1| + (|nonnullstream| #0=|incAppend1| + (((((#2=(0 "1" 1 1 "strings") . 1) . "1")) + ((|integer| (|posn| #2# . 0)) . "1"))) + (|nonnullstream| #3=|next1| |ncloopParse| + (|nonnullstream| #0# NIL + (|nonnullstream| #3# |lineoftoks| (|nullstream|)))))) +\end{verbatim} + +\begin{verbatim} + 5> (|incAppend1| + (((((#0=(0 "1" 1 1 "strings") . 1) . "1")) + ((|integer| (|posn| #0# . 0)) . "1"))) + (|nonnullstream| #1=|next1| |ncloopParse| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| #1# |lineoftoks| (|nullstream|))))) + 6> (|StreamNull| + (((((#0=(0 "1" 1 1 "strings") . 1) . "1")) + ((|integer| (|posn| #0# . 0)) . "1")))) + <6 (|StreamNull| NIL) + 6> (|incAppend| NIL + (|nonnullstream| #0=|next1| |ncloopParse| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) + 7> (|Delay| #0=|incAppend1| + (NIL + (|nonnullstream| #2=|next1| |ncloopParse| + (|nonnullstream| #0# NIL + (|nonnullstream| #2# |lineoftoks| (|nullstream|)))))) + <7 (|Delay| + (|nonnullstream| #0=|incAppend1| NIL + (|nonnullstream| #2=|next1| |ncloopParse| + (|nonnullstream| #0# NIL + (|nonnullstream| #2# |lineoftoks| (|nullstream|)))))) + <6 (|incAppend| + (|nonnullstream| #0=|incAppend1| NIL + (|nonnullstream| #2=|next1| |ncloopParse| + (|nonnullstream| #0# NIL + (|nonnullstream| #2# |lineoftoks| (|nullstream|)))))) + <5 (|incAppend1| + (((((#0=(0 "1" 1 1 "strings") . 1) . "1")) + ((|integer| (|posn| #0# . 0)) . "1")) + |nonnullstream| #1=|incAppend1| NIL + (|nonnullstream| #3=|next1| |ncloopParse| + (|nonnullstream| #1# NIL + (|nonnullstream| #3# |lineoftoks| (|nullstream|)))))) + <4 (|StreamNull| NIL) +\end{verbatim} + +\begin{verbatim} + 4> (|pfAbSynOp?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1") |command|) + <4 (|pfAbSynOp?| NIL) +\end{verbatim} + +\begin{verbatim} + 4> (|intloopSpadProcess| 1 + (((#0=(0 "1" 1 1 "strings") . 1) . "1")) + ((|integer| (|posn| #0# . 0)) . "1") T) + 5> (|ncPutQ| (|carrier|) |stepNumber| 1) + 6> (|ncAlist| (|carrier|)) + <6 (|ncAlist| NIL) + 6> (|ncAlist| (|carrier|)) + <6 (|ncAlist| NIL) + 6> (|ncTag| (|carrier|)) + <6 (|ncTag| |carrier|) + <5 (|ncPutQ| 1) + 5> (|ncPutQ| ((|carrier| (|stepNumber| . 1))) |messages| NIL) + 6> (|ncAlist| ((|carrier| (|stepNumber| . 1)))) + <6 (|ncAlist| ((|stepNumber| . 1))) + 6> (|ncAlist| ((|carrier| (|stepNumber| . 1)))) + <6 (|ncAlist| ((|stepNumber| . 1))) + 6> (|ncTag| ((|carrier| (|stepNumber| . 1)))) + <6 (|ncTag| |carrier|) + <5 (|ncPutQ| NIL) + 5> (|ncPutQ| + ((|carrier| (|messages|) (|stepNumber| . 1))) + |lines| ((((0 "1" 1 1 "strings") . 1) . "1"))) + 6> (|ncAlist| ((|carrier| (|messages|) (|stepNumber| . 1)))) + <6 (|ncAlist| ((|messages|) (|stepNumber| . 1))) + 6> (|ncAlist| ((|carrier| (|messages|) (|stepNumber| . 1)))) + <6 (|ncAlist| ((|messages|) (|stepNumber| . 1))) + 6> (|ncTag| ((|carrier| (|messages|) (|stepNumber| . 1)))) + <6 (|ncTag| |carrier|) + <5 (|ncPutQ| ((((0 "1" 1 1 "strings") . 1) . "1"))) + 5> (|intloopSpadProcess,interp| + ((|carrier| (|lines| ((#0=(0 "1" 1 1 "strings") . 1) . "1")) + (|messages|) (|stepNumber| . 1))) + ((|integer| (|posn| #0# . 0)) . "1") T) + 6> (|ncConversationPhase| |phParse| + (((|carrier| (|lines| ((#0=(0 "1" 1 1 "strings") . 1) . "1")) + (|messages|) (|stepNumber| . 1))) + ((|integer| (|posn| #0# . 0)) . "1"))) + 7> (|phParse| + ((|carrier| (|lines| ((#0=(0 "1" 1 1 "strings") . 1) . "1")) + (|messages|) (|stepNumber| . 1))) + ((|integer| (|posn| #0# . 0)) . "1")) + 8> (|ncPutQ| + ((|carrier| (|lines| ((#0=(0 "1" 1 1 "strings") . 1) . "1") + ) (|messages|) (|stepNumber| . 1))) + |ptree| ((|integer| (|posn| #0# . 0)) . "1")) + 9> (|ncAlist| + ((|carrier| (|lines| (((0 "1" 1 1 "strings") . 1) . "1")) + (|messages|) (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|lines| (((0 "1" 1 1 "strings") . 1) . "1")) + (|messages|) (|stepNumber| . 1))) + 9> (|ncAlist| + ((|carrier| (|lines| (((0 "1" 1 1 "strings") . 1) . "1")) + (|messages|) (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|lines| (((0 "1" 1 1 "strings") . 1) . "1")) + (|messages|) (|stepNumber| . 1))) + 9> (|ncTag| + ((|carrier| (|lines| (((0 "1" 1 1 "strings") . 1) . "1")) + (|messages|) (|stepNumber| . 1)))) + <9 (|ncTag| |carrier|) + <8 (|ncPutQ| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + <7 (|phParse| OK) + 7> (|ncConversationPhase,wrapup| + ((|carrier| + (|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) + . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <7 (|ncConversationPhase,wrapup| NIL) + <6 (|ncConversationPhase| OK) + 6> (|ncConversationPhase| |phMacro| + (((|carrier| + (|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))))) + 7> (|phMacro| + ((|carrier| + (|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + 8> (|ncEltQ| + ((|carrier| + (|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) |ptree|) + 9> (|ncAlist| + ((|carrier| + (|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) + . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) + . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + <8 (|ncEltQ| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 8> (|ncPutQ| + ((|carrier| + (|ptree| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + |ptreePremacro| #0#) + 9> (|ncAlist| + ((|carrier| + (|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) + . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) + . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + 9> (|ncAlist| + ((|carrier| + (|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) + . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + 9> (|ncTag| + ((|carrier| + (|ptree| + (|integer| (|posn| #0=(0 "1" 1 1 "strings") . 0)) + . "1") + (|lines| ((#0# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncTag| |carrier|) + <8 (|ncPutQ| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 8> (|macroExpanded| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 9> (|macExpand| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 10> (|pfWhere?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 11> (|pfAbSynOp?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1") |Where|) + <11 (|pfAbSynOp?| NIL) + <10 (|pfWhere?| NIL) + 10> (|pfLambda?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 11> (|pfAbSynOp?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1") |Lambda|) + <11 (|pfAbSynOp?| NIL) + <10 (|pfLambda?| NIL) + 10> (|pfMacro?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 11> (|pfAbSynOp?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1") |Macro|) + <11 (|pfAbSynOp?| NIL) + <10 (|pfMacro?| NIL) + 10> (|pfId?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 11> (|pfAbSynOp?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1") |id|) + <11 (|pfAbSynOp?| NIL) + 11> (|pfAbSynOp?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1") |idsy|) + <11 (|pfAbSynOp?| NIL) + <10 (|pfId?| NIL) + 10> (|pfApplication?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 11> (|pfAbSynOp?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1") |Application|) + <11 (|pfAbSynOp?| NIL) + <10 (|pfApplication?| NIL) + 10> (|pfMapParts| |macExpand| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 11> (|pfLeaf?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 12> (|pfAbSynOp| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <12 (|pfAbSynOp| |integer|) + <11 (|pfLeaf?| (|integer| |Document| |error|)) + <10 (|pfMapParts| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <9 (|macExpand| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + <8 (|macroExpanded| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 8> (|ncPutQ| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) |ptree| #0#) + 9> (|ncAlist| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + <8 (|ncPutQ| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + <7 (|phMacro| OK) + 7> (|ncConversationPhase,wrapup| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <7 (|ncConversationPhase,wrapup| NIL) + <6 (|ncConversationPhase| OK) + 6> (|ncConversationPhase| |phIntReportMsgs| + (((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) T)) + 7> (|phIntReportMsgs| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) T) + 8> (|ncEltQ| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) |lines|) + 9> (|ncAlist| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + <8 (|ncEltQ| ((((0 "1" 1 1 "strings") . 1) . "1"))) + 8> (|ncEltQ| + ((|carrier| (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) . + "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + |messages|) + 9> (|ncAlist| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + <8 (|ncEltQ| NIL) + 8> (|ncPutQ| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) |ok?| T) + 9> (|ncAlist| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + 9> (|ncAlist| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + 9> (|ncTag| + ((|carrier| + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncTag| |carrier|) + <8 (|ncPutQ| T) + <7 (|phIntReportMsgs| OK) + 7> (|ncConversationPhase,wrapup| + ((|carrier| + (|ok?| . T) + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <7 (|ncConversationPhase,wrapup| NIL) + <6 (|ncConversationPhase| OK) + 6> (|ncConversationPhase| |phInterpret| + (((|carrier| + (|ok?| . T) + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))))) + 7> (|phInterpret| + ((|carrier| + (|ok?| . T) + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + 8> (|ncEltQ| + ((|carrier| + (|ok?| . T) + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + |ptree|) + 9> (|ncAlist| + ((|carrier| + (|ok?| . T) + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|ok?| . T) + (|ptreePremacro| . + #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + <8 (|ncEltQ| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 8> (|intInterpretPform| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 9> (|pf2Sex| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 10> (|pf2Sex1| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 11> (|pfNothing?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 12> (|pfAbSynOp?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1") |nothing|) + <12 (|pfAbSynOp?| NIL) + <11 (|pfNothing?| NIL) + 11> (|pfSymbol?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 12> (|pfAbSynOp?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1") |symbol|) + <12 (|pfAbSynOp?| NIL) + <11 (|pfSymbol?| NIL) + 11> (|pfLiteral?| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 12> (|pfAbSynOp| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <12 (|pfAbSynOp| |integer|) + <11 (|pfLiteral?| + (|integer| |symbol| |expression| |one| |zero| + |char| |string| |float|)) + 11> (|pfLiteral2Sex| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 12> (|pfLiteralClass| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 13> (|pfAbSynOp| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <13 (|pfAbSynOp| |integer|) + <12 (|pfLiteralClass| |integer|) + 12> (|pfLiteralString| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + 13> (|tokPart| + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <13 (|tokPart| "1") + <12 (|pfLiteralString| "1") + <11 (|pfLiteral2Sex| 1) + <10 (|pf2Sex1| 1) + <9 (|pf2Sex| 1) + 9> (|zeroOneTran| 1) + <9 (|zeroOneTran| 1) + 9> (|processInteractive| 1 + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 10> (PUT |algebra| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |algebra| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |analysis| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |analysis| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |coercion| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |coercion| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |compilation| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |compilation| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |debug| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |debug| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |evaluation| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |evaluation| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |gc| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |gc| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |history| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |history| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |instantiation| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |instantiation| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |load| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |load| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |modemaps| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |modemaps| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |optimization| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |optimization| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |querycoerce| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |querycoerce| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |other| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |other| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |diskread| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |diskread| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |print| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |print| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |resolve| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |resolve| |SpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |interpreter| |ClassTimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |interpreter| |ClassSpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |evaluation| |ClassTimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |evaluation| |ClassSpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |other| |ClassTimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |other| |ClassSpaceTotal| 0) + <10 (PUT 0) + 10> (PUT |reclaim| |ClassTimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |reclaim| |ClassSpaceTotal| 0) + <10 (PUT 0) + 10> (GETL |gc| |TimeTotal|) + <10 (GETL 0.0) + 10> (PUT |gc| |TimeTotal| 0.050000000000000003) + <10 (PUT 0.050000000000000003) + 10> (PUT |gc| |TimeTotal| 0.0) + <10 (PUT 0.0) + 10> (PUT |gc| |SpaceTotal| 0) + <10 (PUT 0) + 10> (|processInteractive1| 1 + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 11> (|recordFrame| |system|) + 12> (|diffAlist| NIL NIL) + <12 (|diffAlist| NIL) + <11 (|recordFrame| NIL) + 11> (GETL |other| |TimeTotal|) + <11 (GETL 0.0) + 11> (GETL |gc| |TimeTotal|) + <11 (GETL 0.0) + 11> (PUT |gc| |TimeTotal| 0.0) + <11 (PUT 0.0) + 11> (PUT |other| |TimeTotal| 0.0) + <11 (PUT 0.0) + 11> (|interpretTopLevel| 1 + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 12> (|interpret| 1 + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 13> (|interpret1| 1 NIL + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) . "1")) + 14> (|member| 1 (|noBranch| |noMapVal|)) + <14 (|member| NIL) + 14> (|member| 1 (|nil| |true| |false|)) + <14 (|member| NIL) + 14> (|member| |--immediateData--| NIL) + <14 (|member| NIL) + 14> (|isDomainValuedVariable| |--immediateData--|) + <14 (|isDomainValuedVariable| NIL) + 14> (GETDATABASE |--immediateData--| CONSTRUCTOR) + <14 (GETDATABASE NIL) + 14> (GETDATABASE |--immediateData--| ABBREVIATION) + <14 (GETDATABASE NIL) + 14> (|member| |--immediateData--| + (|Record| |Union| |Enumeration|)) + <14 (|member| NIL) + 14> (|getProplist| |--immediateData--| ((NIL))) + 15> (|search| |--immediateData--| ((NIL))) + 16> (|searchCurrentEnv| |--immediateData--| (NIL)) + <16 (|searchCurrentEnv| NIL) + 16> (|searchTailEnv| |--immediateData--| NIL) + <16 (|searchTailEnv| NIL) + <15 (|search| NIL) + 15> (|search| |--immediateData--| + ((((|Category| + (|modemap| (((|Category|) (|Category|)) (T *)))) + (|Join| + (|modemap| + (((|Category|) + (|Category|) + (|Category|) + (|Category|)) + (T *)) + (((|Category|) + (|Category|) + (|List| (|Category|)) + (|Category|)) + (T *)))))))) + 16> (|searchCurrentEnv| |--immediateData--| + (((|Category| + (|modemap| (((|Category|) (|Category|)) (T *)))) + (|Join| + (|modemap| + (((|Category|) + (|Category|) + (|Category|) + (|Category|)) + (T *)) + (((|Category|) + (|Category|) + (|List| (|Category|)) + (|Category|)) + (T *))))))) + <16 (|searchCurrentEnv| NIL) + 16> (|searchTailEnv| |--immediateData--| NIL) + <16 (|searchTailEnv| NIL) + <15 (|search| NIL) + <14 (|getProplist| NIL) + 14> (|member| |--immediateData--| NIL) + <14 (|member| NIL) + 14> (|member| |--immediateData--| NIL) + <14 (|member| NIL) + 14> (|member| |--immediateData--| NIL) + <14 (|member| NIL) + 14> (|member| |--immediateData--| NIL) + <14 (|member| NIL) + 14> (|member| |--immediateData--| NIL) + <14 (|member| NIL) + 14> (|interpret2| + (#0=(|PositiveInteger|) . 1) #0# + ((|integer| (|posn| (0 "1" 1 1 "strings") . 0)) + . "1")) + <14 (|interpret2| ((|PositiveInteger|) . 1)) + <13 (|interpret1| ((|PositiveInteger|) . 1)) + <12 (|interpret| ((|PositiveInteger|) . 1)) + <11 (|interpretTopLevel| ((|PositiveInteger|) . 1)) + 11> (GETL |analysis| |TimeTotal|) + <11 (GETL 0.0) + 11> (GETL |gc| |TimeTotal|) + <11 (GETL 0.0) + 11> (PUT |gc| |TimeTotal| 0.0) + <11 (PUT 0.0) + 11> (PUT |analysis| |TimeTotal| 0.0) + <11 (PUT 0.0) + 11> (GETL |other| |TimeTotal|) + <11 (GETL 0.0) + 11> (GETL |gc| |TimeTotal|) + <11 (GETL 0.0) + 11> (PUT |gc| |TimeTotal| 0.0) + <11 (PUT 0.0) + 11> (PUT |other| |TimeTotal| 0.0) + <11 (PUT 0.0) + 11> (|recordAndPrint| 1 (|PositiveInteger|)) + + 12> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (|member| (|PositiveInteger|) + ((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))) + <12 (|member| NIL) + 12> (|member| (|PositiveInteger|) + ((|Category|) (|Mode|) (|Domain|) + (|SubDomain| (|Domain|)))) + <12 (|member| NIL) + 12> (GETL |print| |TimeTotal|) + <12 (GETL 0.0) + 12> (GETL |gc| |TimeTotal|) + <12 (GETL 0.0) + 12> (PUT |gc| |TimeTotal| 0.0) + <12 (PUT 0.0) + 12> (PUT |print| |TimeTotal| 0.0) + <12 (PUT 0.0) + 12> (|isEqualOrSubDomain| (|PositiveInteger|) + (|OutputForm|)) + <12 (|isEqualOrSubDomain| NIL) + 12> (GETDATABASE |OutputForm| ABBREVIATION) + <12 (GETDATABASE OUTFORM) + 12> (HPUT # + (|OutputForm|) (1)) + <12 (HPUT (1)) + 12> (HPUT # + (NIL NIL NIL) (1 . T)) + <12 (HPUT (1 . T)) + 12> (HPUT # + (#0=(|OutputForm|) NIL NIL) (1 . #0#)) + <12 (HPUT (1 |OutputForm|)) + 12> (HPUT # + (|PositiveInteger|) (1)) + <12 (HPUT (1)) + 12> (|member| (|OutputForm|) ((|Integer|) (|OutputForm|))) + <12 (|member| ((|OutputForm|))) + 12> (|member| (|OutputForm|) + ((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))) + <12 (|member| NIL) + 12> (GETDATABASE |OutputForm| ABBREVIATION) + <12 (GETDATABASE OUTFORM) + 12> (GETDATABASE |OutputForm| COSIG) + <12 (GETDATABASE (NIL)) + 12> (HPUT # + (|OutputForm|) (1 . T)) + <12 (HPUT (1 . T)) + 12> (|isPartialMode| (|OutputForm|)) + <12 (|isPartialMode| NIL) + 12> (|member| |coerce| (= + * -)) + <12 (|member| NIL) + 12> (|isPartialMode| (|OutputForm|)) + <12 (|isPartialMode| NIL) + 12> (|member| |PositiveInteger| + (|List| |Vector| |Stream| |FiniteSet| |Array|)) + <12 (|member| NIL) + 12> (|member| |PositiveInteger| + (|Union| |Record| |Mapping| |Enumeration|)) + <12 (|member| NIL) + 12> (GETDATABASE |PositiveInteger| OPERATIONALIST) + <12 (GETDATABASE + ((~= (((|Boolean|) $ $) NIL)) + (|sample| (($) NIL T CONST)) + (|recip| (((|Union| $ "failed") $) NIL)) + (|one?| (((|Boolean|) $) NIL)) + (|min| (($ $ $) NIL)) + (|max| (($ $ $) NIL)) + (|latex| (((|String|) $) NIL)) + (|hash| (((|SingleInteger|) $) NIL)) + (|gcd| (($ $ $) NIL)) + (|coerce| (((|OutputForm|) $) NIL)) + (^ (($ $ (|NonNegativeInteger|)) NIL) + (($ $ (|PositiveInteger|)) NIL)) + (|One| (($) NIL T CONST)) + (>= (((|Boolean|) $ $) NIL)) + (> (((|Boolean|) $ $) NIL)) + (= (((|Boolean|) $ $) NIL)) + (<= (((|Boolean|) $ $) NIL)) + (< (((|Boolean|) $ $) NIL)) + (+ (($ $ $) NIL)) + (** (($ $ (|NonNegativeInteger|)) NIL) + (($ $ (|PositiveInteger|)) NIL)) + (* (($ (|PositiveInteger|) $) NIL) (($ $ $) NIL)))) + 12> (|constructSubst| (|PositiveInteger|)) + <12 (|constructSubst| (($ |PositiveInteger|))) + 12> (|isEqualOrSubDomain| #0=(|PositiveInteger|) #0#) + <12 (|isEqualOrSubDomain| T) + 12> (|isEqualOrSubDomain| (|OutputForm|) (|OutputForm|)) + <12 (|isEqualOrSubDomain| T) + 12> (|member| |OutputForm| (|Union| |Record| |Mapping| |Enumeration|)) + <12 (|member| NIL) + 12> (GETDATABASE |OutputForm| OPERATIONALIST) + <12 (GETDATABASE + ((~= (((|Boolean|) $ $) NIL)) + (|zag| (($ $ $) 120)) + (|width| (((|Integer|) $) 30) (((|Integer|)) 35)) + (|vspace| (($ (|Integer|)) 47)) + (|vconcat| (($ $ $) 48) (($ (|List| $)) 80)) + (|supersub| (($ $ (|List| $)) 78)) + (|superHeight| (((|Integer|) $) 33)) + (|super| (($ $ $) 66)) + (|sum| (($ $) 135) (($ $ $) 136) (($ $ $ $) 137)) + (|subHeight| (((|Integer|) $) 32)) + (|sub| (($ $ $) 65)) + (|string| (($ $) 109)) + (|slash| (($ $ $) 124)) + (|semicolonSeparate| (($ (|List| $)) 55)) + (|scripts| (($ $ (|List| $)) 72)) + (|rspace| (($ (|Integer|) (|Integer|)) 49)) + (|root| (($ $) 121) (($ $ $) 122)) + (|right| (($ $ (|Integer|)) 42) (($ $) 45)) + (|rem| (($ $ $) 93)) + (|rarrow| (($ $ $) 127)) + (|quote| (($ $) 110)) + (|quo| (($ $ $) 94)) + (|prod| (($ $) 138) (($ $ $) 139) (($ $ $ $) 140)) + (|print| (((|Void|) $) 8)) + (|prime| (($ $) 113) (($ $ (|NonNegativeInteger|)) 117)) + (|presuper| (($ $ $) 68)) + (|presub| (($ $ $) 67)) + (|prefix| (($ $ (|List| $)) 104)) + (|postfix| (($ $ $) 108)) + (|pile| (($ (|List| $)) 53)) + (|paren| (($ $) 63) (($ (|List| $)) 64)) + (|overlabel| (($ $ $) 118)) + (|overbar| (($ $) 111)) + (|over| (($ $ $) 123)) + (|outputForm| (($ (|Integer|)) 20) + (($ (|Symbol|)) 22) + (($ (|String|)) 29) + (($ (|DoubleFloat|)) 24)) + (|or| (($ $ $) 97)) + (|not| (($ $) 98)) + (|messagePrint| (((|Void|) (|String|)) 14)) + (|message| (($ (|String|)) 13)) + (|matrix| (($ (|List| (|List| $))) 51)) + (|left| (($ $ (|Integer|)) 41) (($ $) 44)) + (|latex| (((|String|) $) NIL)) + (|label| (($ $ $) 126)) + (|int| (($ $) 141) (($ $ $) 142) (($ $ $ $) 143)) + (|infix?| (((|Boolean|) $) 102)) + (|infix| (($ $ (|List| $)) 106) (($ $ $ $) 107)) + (|hspace| (($ (|Integer|)) 38)) + (|height| (((|Integer|) $) 31) (((|Integer|)) 34)) + (|hconcat| (($ $ $) 39) (($ (|List| $)) 79)) + (|hash| (((|SingleInteger|) $) NIL)) + (|exquo| (($ $ $) 95)) + (|empty| (($) 12)) + (|elt| (($ $ (|List| $)) 103)) + (|dot| (($ $) 112) + (($ $ (|NonNegativeInteger|)) 116)) + (|div| (($ $ $) 92)) + (|differentiate| (($ $ (|NonNegativeInteger|)) 134)) + (|commaSeparate| (($ (|List| $)) 54)) + (|coerce| (((|OutputForm|) $) 18)) + (|center| (($ $ (|Integer|)) 40) (($ $) 43)) + (|bracket| (($ $) 61) (($ (|List| $)) 62)) + (|brace| (($ $) 59) (($ (|List| $)) 60)) + (|box| (($ $) 119)) + (|blankSeparate| (($ (|List| $)) 58)) + (|binomial| (($ $ $) 101)) + (|assign| (($ $ $) 125)) + (|and| (($ $ $) 96)) + (^= (($ $ $) 81)) + (SEGMENT (($ $ $) 99) (($ $) 100)) + (>= (($ $ $) 85)) + (> (($ $ $) 83)) + (= (((|Boolean|) $ $) 15) (($ $ $) 16)) + (<= (($ $ $) 84)) + (< (($ $ $) 82)) + (/ (($ $ $) 90)) + (- (($ $ $) 87) (($ $) 88)) + (+ (($ $ $) 86)) + (** (($ $ $) 91)) + (* (($ $ $) 89)))) + 12> (|constructSubst| (|OutputForm|)) + <12 (|constructSubst| (($ |OutputForm|))) + 12> (|isEqualOrSubDomain| + (|PositiveInteger|) (|OutputForm|)) + <12 (|isEqualOrSubDomain| NIL) + 12> (HPUT # + (|coerce| (|OutputForm|) (#0=(|PositiveInteger|)) + (#0#) NIL) (1 ((#0# #1=(|OutputForm|) #0#) + (#1# $) (NIL)))) + <12 (HPUT (1 ((#0=(|PositiveInteger|) + #1=(|OutputForm|) #0#) (#1# $) (NIL)))) + 12> (HPUT # + (|coerce| #0=(|PositiveInteger|) (|OutputForm|)) + (1 (#0# #1=(|OutputForm|) #0#) (#1# $) (NIL))) + <12 (HPUT (1 (#0=(|PositiveInteger|) + #1=(|OutputForm|) #0#) (#1# $) (NIL))) + 12> (|evalDomain| (|PositiveInteger|)) + 13> (GETL |print| |TimeTotal|) + <13 (GETL 0.0) + 13> (GETL |gc| |TimeTotal|) + <13 (GETL 0.0) + 13> (PUT |gc| |TimeTotal| 0.0) + <13 (PUT 0.0) + 13> (PUT |print| |TimeTotal| 0.0) + <13 (PUT 0.0) + 13> (|mkEvalable| (|PositiveInteger|)) + 14> (CANFUNCALL? |PositiveInteger|) + <14 (CANFUNCALL? T) + 14> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) + <14 (GETDATABASE |domain|) + 14> (GETDATABASE |PositiveInteger| COSIG) + <14 (GETDATABASE (NIL)) + <13 (|mkEvalable| (|PositiveInteger|)) + 13> (GETL |PositiveInteger| LOADED) + <13 (GETL NIL) + 13> (|loadLib| |PositiveInteger|) + 14> (GETL |instantiation| |TimeTotal|) + <14 (GETL 0.0) + 14> (GETL |gc| |TimeTotal|) + <14 (GETL 0.0) + 14> (PUT |gc| |TimeTotal| 0.0) + <14 (PUT 0.0) + 14> (PUT |instantiation| |TimeTotal| 0.0) + <14 (PUT 0.0) + 14> (GETDATABASE |PositiveInteger| OBJECT) + <14 (GETDATABASE + "/home/daly/noise/mnt/ubuntu/algebra/PI.o") + 14> (|pathnameDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/PI.o") + 15> (|pathname| + "/home/daly/noise/mnt/ubuntu/algebra/PI.o") + <15 (|pathname| + #p"/home/daly/noise/mnt/ubuntu/algebra/PI.o") + <14 (|pathnameDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/") + 14> (|isSystemDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/") + <14 (|isSystemDirectory| T) + 14> (|loadLibNoUpdate| |PositiveInteger| |PositiveInteger| + "/home/daly/noise/mnt/ubuntu/algebra/PI.o") + 15> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) + <15 (GETDATABASE |domain|) + 15> (|getProplist| |NonNegativeInteger| + ((((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) + (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 16> (|search| |NonNegativeInteger| + ((((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) + (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 17> (|searchCurrentEnv| |NonNegativeInteger| + (((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) + (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *))))))) + <17 (|searchCurrentEnv| NIL) + 17> (|searchTailEnv| |NonNegativeInteger| NIL) + <17 (|searchTailEnv| NIL) + <16 (|search| NIL) + 16> (|search| |NonNegativeInteger| + ((((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) + (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 17> (|searchCurrentEnv| |NonNegativeInteger| + (((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *))))))) + <17 (|searchCurrentEnv| NIL) + 17> (|searchTailEnv| |NonNegativeInteger| NIL) + <17 (|searchTailEnv| NIL) + <16 (|search| NIL) + <15 (|getProplist| NIL) + 15> (|addBinding| |NonNegativeInteger| + ((|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + ((((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 16> (|getProplist| |NonNegativeInteger| + ((((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 17> (|search| |NonNegativeInteger| + ((((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 18> (|searchCurrentEnv| |NonNegativeInteger| + (((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *))))))) + <18 (|searchCurrentEnv| NIL) + 18> (|searchTailEnv| |NonNegativeInteger| NIL) + <18 (|searchTailEnv| NIL) + <17 (|search| NIL) + 17> (|search| |NonNegativeInteger| + ((((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 18> (|searchCurrentEnv| |NonNegativeInteger| + (((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *))))))) + <18 (|searchCurrentEnv| NIL) + 18> (|searchTailEnv| |NonNegativeInteger| NIL) + <18 (|searchTailEnv| NIL) + <17 (|search| NIL) + <16 (|getProplist| NIL) + 16> (|addBindingInteractive| |NonNegativeInteger| + ((|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + ((((|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + <16 (|addBindingInteractive| + ((((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + <15 (|addBinding| + ((((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 15> (|getProplist| |PositiveInteger| + ((((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 16> (|search| |PositiveInteger| + ((((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 17> (|searchCurrentEnv| |PositiveInteger| + (((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *))))))) + <17 (|searchCurrentEnv| NIL) + 17> (|searchTailEnv| |PositiveInteger| NIL) + <17 (|searchTailEnv| NIL) + <16 (|search| NIL) + 16> (|search| |PositiveInteger| + ((((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 17> (|searchCurrentEnv| |PositiveInteger| + (((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *))))))) + <17 (|searchCurrentEnv| NIL) + 17> (|searchTailEnv| |PositiveInteger| NIL) + <17 (|searchTailEnv| NIL) + <16 (|search| NIL) + <15 (|getProplist| NIL) + 15> (|addBinding| |PositiveInteger| + ((|SuperDomain| |NonNegativeInteger|)) + ((((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 16> (|getProplist| |PositiveInteger| + ((((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 17> (|search| |PositiveInteger| + ((((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 18> (|searchCurrentEnv| |PositiveInteger| + (((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *))))))) + <18 (|searchCurrentEnv| NIL) + 18> (|searchTailEnv| |PositiveInteger| NIL) + <18 (|searchTailEnv| NIL) + <17 (|search| NIL) + 17> (|search| |PositiveInteger| + ((((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 18> (|searchCurrentEnv| |PositiveInteger| + (((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *))))))) + <18 (|searchCurrentEnv| NIL) + 18> (|searchTailEnv| |PositiveInteger| NIL) + <18 (|searchTailEnv| NIL) + <17 (|search| NIL) + <16 (|getProplist| NIL) + 16> (|addBindingInteractive| |PositiveInteger| + ((|SuperDomain| |NonNegativeInteger|)) + ((((|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + <16 (|addBindingInteractive| + ((((|PositiveInteger| + (|SuperDomain| |NonNegativeInteger|)) + (|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + <15 (|addBinding| + ((((|PositiveInteger| + (|SuperDomain| |NonNegativeInteger|)) + (|NonNegativeInteger| + (|SubDomain| + (|PositiveInteger| SPADCALL 0 |#1| (QREFELT $ 7)))) + (|Category| (|modemap| + (((|Category|) (|Category|)) (T *)))) + (|Join| (|modemap| + (((|Category|) (|Category|) (|Category|) + (|Category|)) (T *)) + (((|Category|) (|Category|) (|List| (|Category|)) + (|Category|)) (T *)))))))) + 15> (|makeByteWordVec2| 1 (0 0 0 0 0 0 0)) + <15 (|makeByteWordVec2| #) + 15> (|makeByteWordVec2| 12 (2 5 6 0 0 7 2 0 6 0 0 1 0 0 0 + 1 1 0 9 0 1 1 0 6 0 1 2 0 0 0 0 1 2 0 0 0 0 1 1 0 11 + 0 1 1 0 10 0 1 2 0 0 0 0 1 1 0 12 0 1 2 0 0 0 8 1 2 + 0 0 0 5 1 0 0 0 1 2 0 6 0 0 1 2 0 6 0 0 1 2 0 6 0 0 + 1 2 0 6 0 0 1 2 0 6 0 0 1 2 0 0 0 0 1 2 0 0 0 8 1 2 + 0 0 0 5 1 2 0 0 0 0 1 2 0 0 8 0 1)) + <15 (|makeByteWordVec2| #) + 15> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) + <15 (GETDATABASE |domain|) + 15> (GETL |load| |TimeTotal|) + <15 (GETL 0.0) + 15> (GETL |gc| |TimeTotal|) + <15 (GETL 0.0) + 15> (PUT |gc| |TimeTotal| 0.0) + <15 (PUT 0.0) + 15> (PUT |load| |TimeTotal| 0.0) + <15 (PUT 0.0) + <14 (|loadLibNoUpdate| T) + <13 (|loadLib| T) + 13> (HPUT # |PositiveInteger| + ((NIL 1 . #))) + <13 (HPUT ((NIL 1 . #))) + 13> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) + <13 (GETDATABASE |domain|) + 13> (GETL |PositiveInteger| |infovec|) + <13 (GETL (# + # + (((|commutative| "*") . 0)) + (# + # + # + . #) |lookupComplete|)) + 13> (HPUT # |PositiveInteger| + ((NIL 1 . #))) + <13 (HPUT ((NIL 1 . #))) + 13> (GETL |instantiation| |TimeTotal|) + <13 (GETL 0.0) + 13> (GETL |gc| |TimeTotal|) + <13 (GETL 0.0) + 13> (PUT |gc| |TimeTotal| 0.0) + <13 (PUT 0.0) + 13> (PUT |instantiation| |TimeTotal| 0.0) + <13 (PUT 0.0) + <12 (|evalDomain| #) + 12> (|compiledLookup| |coerce| ((|OutputForm|) $) + #) + 13> (|NRTevalDomain| #) + 14> (|evalDomain| #) + 15> (GETL |print| |TimeTotal|) + <15 (GETL 0.0) + 15> (GETL |gc| |TimeTotal|) + <15 (GETL 0.0) + 15> (PUT |gc| |TimeTotal| 0.0) + <15 (PUT 0.0) + 15> (PUT |print| |TimeTotal| 0.0) + <15 (PUT 0.0) + 15> (|mkEvalable| #) + <15 (|mkEvalable| #) + 15> (GETL |instantiation| |TimeTotal|) + <15 (GETL 0.0) + 15> (GETL |gc| |TimeTotal|) + <15 (GETL 0.0) + 15> (PUT |gc| |TimeTotal| 0.0) + <15 (PUT 0.0) + 15> (PUT |instantiation| |TimeTotal| 0.0) + <15 (PUT 0.0) + <14 (|evalDomain| #) + <13 (|NRTevalDomain| #) + 13> (|basicLookup| |coerce| ((|OutputForm|) $) + # #) + 14> (|oldCompLookup| |coerce| ((|OutputForm|) $) + # #) + 15> (|lookupInDomainVector| |coerce| ((|OutputForm|) $) + # #) + 16> (GETDATABASE |OutputForm| COSIG) + <16 (GETDATABASE (NIL)) + 16> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) + <16 (GETDATABASE |domain|) + 16> (GETL |NonNegativeInteger| LOADED) + <16 (GETL NIL) + 16> (|loadLib| |NonNegativeInteger|) + 17> (GETL |print| |TimeTotal|) + <17 (GETL 0.0) + 17> (GETL |gc| |TimeTotal|) + <17 (GETL 0.0) + 17> (PUT |gc| |TimeTotal| 0.0) + <17 (PUT 0.0) + 17> (PUT |print| |TimeTotal| 0.0) + <17 (PUT 0.0) + 17> (GETDATABASE |NonNegativeInteger| OBJECT) + <17 (GETDATABASE + "/home/daly/noise/mnt/ubuntu/algebra/NNI.o") + 17> (|pathnameDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/NNI.o") + 18> (|pathname| + "/home/daly/noise/mnt/ubuntu/algebra/NNI.o") + <18 (|pathname| + #p"/home/daly/noise/mnt/ubuntu/algebra/NNI.o") + <17 (|pathnameDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/") + 17> (|isSystemDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/") + <17 (|isSystemDirectory| T) + 17> (|loadLibNoUpdate| |NonNegativeInteger| + |NonNegativeInteger| + "/home/daly/noise/mnt/ubuntu/algebra/NNI.o") + 18> (GETDATABASE |NonNegativeInteger| CONSTRUCTORKIND) + <18 (GETDATABASE |domain|) + 18> (|getProplist| |Integer| ((NIL))) + 19> (|search| |Integer| ((NIL))) + 20> (|searchCurrentEnv| |Integer| (NIL)) + <20 (|searchCurrentEnv| NIL) + 20> (|searchTailEnv| |Integer| NIL) + <20 (|searchTailEnv| NIL) + <19 (|search| NIL) + 19> (|search| |Integer| ((NIL))) + 20> (|searchCurrentEnv| |Integer| (NIL)) + <20 (|searchCurrentEnv| NIL) + 20> (|searchTailEnv| |Integer| NIL) + <20 (|searchTailEnv| NIL) + <19 (|search| NIL) + <18 (|getProplist| NIL) + 18> (|addBinding| |Integer| + ((|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))) ((NIL))) + 19> (|getProplist| |Integer| ((NIL))) + 20> (|search| |Integer| ((NIL))) + 21> (|searchCurrentEnv| |Integer| (NIL)) + <21 (|searchCurrentEnv| NIL) + 21> (|searchTailEnv| |Integer| NIL) + <21 (|searchTailEnv| NIL) + <20 (|search| NIL) + 20> (|search| |Integer| ((NIL))) + 21> (|searchCurrentEnv| |Integer| (NIL)) + <21 (|searchCurrentEnv| NIL) + 21> (|searchTailEnv| |Integer| NIL) + <21 (|searchTailEnv| NIL) + <20 (|search| NIL) + <19 (|getProplist| NIL) + 19> (|addBindingInteractive| |Integer| + ((|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))) ((NIL))) + <19 (|addBindingInteractive| + ((((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + <18 (|addBinding| + ((((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + 18> (|getProplist| |NonNegativeInteger| + ((((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + 19> (|search| |NonNegativeInteger| + ((((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + 20> (|searchCurrentEnv| |NonNegativeInteger| + (((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T)))))))) + <20 (|searchCurrentEnv| NIL) + 20> (|searchTailEnv| |NonNegativeInteger| NIL) + <20 (|searchTailEnv| NIL) + <19 (|search| NIL) + 19> (|search| |NonNegativeInteger| + ((((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + 20> (|searchCurrentEnv| |NonNegativeInteger| + (((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T)))))))) + <20 (|searchCurrentEnv| NIL) + 20> (|searchTailEnv| |NonNegativeInteger| NIL) + <20 (|searchTailEnv| NIL) + <19 (|search| NIL) + <18 (|getProplist| NIL) + 18> (|addBinding| |NonNegativeInteger| + ((|SuperDomain| |Integer|)) + ((((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + 19> (|getProplist| |NonNegativeInteger| + ((((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + 20> (|search| |NonNegativeInteger| + ((((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + 21> (|searchCurrentEnv| |NonNegativeInteger| + (((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T)))))))) + <21 (|searchCurrentEnv| NIL) + 21> (|searchTailEnv| |NonNegativeInteger| NIL) + <21 (|searchTailEnv| NIL) + <20 (|search| NIL) + 20> (|search| |NonNegativeInteger| + ((((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + 21> (|searchCurrentEnv| |NonNegativeInteger| + (((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T)))))))) + <21 (|searchCurrentEnv| NIL) + 21> (|searchTailEnv| |NonNegativeInteger| NIL) + <21 (|searchTailEnv| NIL) + <20 (|search| NIL) + <19 (|getProplist| NIL) + 19> (|addBindingInteractive| |NonNegativeInteger| + ((|SuperDomain| |Integer|)) + ((((|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + <19 (|addBindingInteractive| + ((((|NonNegativeInteger| (|SuperDomain| |Integer|)) + (|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + <18 (|addBinding| + ((((|NonNegativeInteger| (|SuperDomain| |Integer|)) + (|Integer| + (|SubDomain| + (|NonNegativeInteger| + COND + ((SPADCALL |#1| 0 (QREFELT $ 7)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T))))))))) + 18> (|makeByteWordVec2| 1 (0 0 0 0 0 0 0 0 0 0 0 0 0)) + <18 (|makeByteWordVec2| #) + 18> (|makeByteWordVec2| 18 (2 5 6 0 0 7 2 5 0 0 0 10 2 0 6 + 0 0 1 1 0 6 0 1 2 0 0 0 0 8 2 0 11 0 0 12 2 0 0 0 5 + 9 0 0 0 1 2 0 0 0 0 1 1 0 11 0 1 1 0 0 0 1 2 0 0 0 + 0 1 1 0 6 0 1 2 0 0 0 0 1 2 0 0 0 0 1 1 0 17 0 1 1 + 0 16 0 1 2 0 0 0 0 1 2 0 11 0 0 1 2 0 13 0 0 1 1 0 + 18 0 1 2 0 0 0 14 1 2 0 0 0 15 1 0 0 0 1 0 0 0 1 2 + 0 6 0 0 1 2 0 6 0 0 1 2 0 6 0 0 1 2 0 6 0 0 1 2 0 + 6 0 0 1 2 0 0 0 0 1 2 0 0 0 14 1 2 0 0 0 15 1 2 0 + 0 0 0 1 2 0 0 14 0 1 2 0 0 15 0 1)) + <18 (|makeByteWordVec2| #) + 18> (GETDATABASE |NonNegativeInteger| CONSTRUCTORKIND) + <18 (GETDATABASE |domain|) + 18> (GETL |load| |TimeTotal|) + <18 (GETL 0.0) + 18> (GETL |gc| |TimeTotal|) + <18 (GETL 0.0) + 18> (PUT |gc| |TimeTotal| 0.0) + <18 (PUT 0.0) + 18> (PUT |load| |TimeTotal| 0.0) + <18 (PUT 0.0) + <17 (|loadLibNoUpdate| T) + <16 (|loadLib| T) + 16> (HPUT # + |NonNegativeInteger| + ((NIL 1 . #))) + <16 (HPUT ((NIL 1 . #))) + 16> (GETDATABASE |NonNegativeInteger| CONSTRUCTORKIND) + <16 (GETDATABASE |domain|) + 16> (GETL |NonNegativeInteger| |infovec|) + <16 (GETL (# + # + (((|commutative| "*") . 0)) + (# + # + # + . #) + |lookupComplete|)) + 16> (HPUT # + |NonNegativeInteger| + ((NIL 1 . #))) + <16 (HPUT ((NIL 1 . #))) + 16> (|lookupInDomainVector| |coerce| ((|OutputForm|) $) + # #) + 17> (GETDATABASE |NonNegativeInteger| CONSTRUCTORKIND) + <17 (GETDATABASE |domain|) + 17> (PNAME |NonNegativeInteger|) + <17 (PNAME "NonNegativeInteger") + 17> (PNAME |NonNegativeInteger|) + <17 (PNAME "NonNegativeInteger") + 17> (GETDATABASE |OutputForm| COSIG) + <17 (GETDATABASE (NIL)) + 17> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) + <17 (GETDATABASE |domain|) + 17> (GETL |Integer| LOADED) + <17 (GETL NIL) + 17> (|loadLib| |Integer|) + 18> (GETL |print| |TimeTotal|) + <18 (GETL 0.0) + 18> (GETL |gc| |TimeTotal|) + <18 (GETL 0.0) + 18> (PUT |gc| |TimeTotal| 0.0) + <18 (PUT 0.0) + 18> (PUT |print| |TimeTotal| 0.0) + <18 (PUT 0.0) + 18> (GETDATABASE |Integer| OBJECT) + <18 (GETDATABASE + "/home/daly/noise/mnt/ubuntu/algebra/INT.o") + 18> (|pathnameDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/INT.o") + 19> (|pathname| + "/home/daly/noise/mnt/ubuntu/algebra/INT.o") + <19 (|pathname| + #p"/home/daly/noise/mnt/ubuntu/algebra/INT.o") + <18 (|pathnameDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/") + 18> (|isSystemDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/") + <18 (|isSystemDirectory| T) + 18> (|loadLibNoUpdate| |Integer| |Integer| + "/home/daly/noise/mnt/ubuntu/algebra/INT.o") + 19> (GETDATABASE |Integer| CONSTRUCTORKIND) + <19 (GETDATABASE |domain|) + 19> (|makeByteWordVec2| 1 + (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) + <19 (|makeByteWordVec2| #) + 19> (|makeByteWordVec2| 133 + (1 7 6 0 8 3 7 6 0 9 9 10 2 7 6 0 11 12 1 7 6 0 13 0 + 14 0 15 2 7 0 9 14 16 1 7 6 0 17 1 7 6 0 18 1 7 6 0 + 19 1 35 0 11 36 1 44 0 11 45 1 47 0 11 48 1 50 0 11 + 51 1 9 0 11 53 2 93 90 91 92 94 1 97 95 96 98 1 96 + 0 0 99 1 96 2 0 100 1 101 95 96 102 1 96 0 2 103 1 + 0 104 0 105 2 108 95 106 107 109 2 110 95 95 95 111 + 1 101 95 96 112 1 96 21 0 113 1 96 0 0 114 1 116 96 + 115 117 2 0 21 0 0 1 1 0 21 0 25 1 0 87 0 88 1 0 0 + 0 89 1 0 21 0 1 2 0 0 0 0 1 2 0 83 0 0 1 3 0 0 0 0 + 0 42 1 0 0 0 1 1 0 104 0 1 2 0 21 0 0 1 1 0 11 0 1 + 2 0 0 0 0 82 0 0 0 1 1 0 124 0 1 1 0 11 0 1 2 0 0 0 + 0 81 2 0 60 58 61 62 1 0 57 58 59 1 0 83 0 85 1 0 + 120 0 1 1 0 21 0 1 1 0 121 0 1 1 0 0 0 65 0 0 0 64 + 2 0 0 0 0 80 1 0 127 126 1 1 0 21 0 1 3 0 0 0 0 0 1 + 2 0 0 0 0 56 1 0 21 0 1 2 0 0 0 0 1 3 0 122 0 123 + 122 1 1 0 21 0 26 1 0 21 0 75 1 0 83 0 1 1 0 21 0 + 34 2 0 125 126 0 1 3 0 0 0 0 0 43 2 0 0 0 0 77 2 0 + 0 0 0 76 1 0 0 0 1 1 0 0 0 40 2 0 131 0 0 1 1 0 0 + 126 1 2 0 0 0 0 1 1 0 9 0 55 2 0 0 0 0 1 0 0 0 1 1 + 0 0 0 31 1 0 0 0 33 1 0 133 0 1 2 0 118 118 118 119 + 2 0 0 0 0 86 1 0 0 126 1 1 0 0 0 1 1 0 104 0 105 3 + 0 129 0 0 0 1 2 0 130 0 0 1 2 0 83 0 0 84 2 0 125 + 126 0 1 1 0 21 0 1 1 0 73 0 1 2 0 78 0 0 79 1 0 0 0 + 1 2 0 0 0 73 1 1 0 0 0 32 1 0 0 0 30 1 0 9 0 54 1 0 + 47 0 49 1 0 44 0 46 1 0 50 0 52 1 0 123 0 1 1 0 11 + 0 39 1 0 0 11 38 1 0 0 0 1 1 0 0 11 38 1 0 35 0 37 + 0 0 73 1 2 0 21 0 0 1 2 0 0 0 0 1 0 0 0 29 2 0 21 0 + 0 1 3 0 0 0 0 0 41 1 0 0 0 63 2 0 0 0 73 1 2 0 0 0 + 132 1 0 0 0 27 0 0 0 28 3 0 6 7 0 21 24 2 0 9 0 21 + 22 2 0 6 7 0 23 1 0 9 0 20 1 0 0 0 1 2 0 0 0 73 1 2 + 0 21 0 0 1 2 0 21 0 0 1 2 0 21 0 0 66 2 0 21 0 0 1 + 2 0 21 0 0 67 2 0 0 0 0 70 1 0 0 0 68 2 0 0 0 0 69 + 2 0 0 0 73 74 2 0 0 0 132 1 2 0 0 0 0 71 2 0 0 11 0 + 72 2 0 0 73 0 1 2 0 0 132 0 1)) + <19 (|makeByteWordVec2| #) + 19> (GETDATABASE |Integer| CONSTRUCTORKIND) + <19 (GETDATABASE |domain|) + 19> (GETL |load| |TimeTotal|) + <19 (GETL 0.0) + 19> (GETL |gc| |TimeTotal|) + <19 (GETL 0.0) + 19> (PUT |gc| |TimeTotal| 0.0) + <19 (PUT 0.0) + 19> (PUT |load| |TimeTotal| 0.0) + <19 (PUT 0.0) + <18 (|loadLibNoUpdate| T) + <17 (|loadLib| T) + 17> (HPUT # |Integer| + ((NIL 1 . #))) + <17 (HPUT ((NIL 1 . #))) + 17> (GETDATABASE |Integer| CONSTRUCTORKIND) + <17 (GETDATABASE |domain|) + 17> (GETL |Integer| |infovec|) + <17 (GETL (# + # ((|infinite| . 0) + (|noetherian| . 0) (|canonicalsClosed| . 0) + (|canonical| . 0) (|canonicalUnitNormal| . 0) + (|multiplicativeValuation| . 0) + (|noZeroDivisors| . 0) + ((|commutative| "*") . 0) (|rightUnitary| . 0) + (|leftUnitary| . 0) (|unitsKnown| . 0)) + (# + # + # + . #) + |lookupComplete|)) + 17> (HPUT # |Integer| + ((NIL 1 . #))) + <17 (HPUT ((NIL 1 . #))) + 17> (|lookupInDomainVector| |coerce| ((|OutputForm|) $) + # #) + 18> (GETDATABASE |Integer| CONSTRUCTORKIND) + <18 (GETDATABASE |domain|) + 18> (PNAME |Integer|) + <18 (PNAME "Integer") + 18> (PNAME |Integer|) + <18 (PNAME "Integer") + 18> (GETDATABASE |OutputForm| COSIG) + <18 (GETDATABASE (NIL)) + 18> (GETDATABASE |PositiveInteger| CONSTRUCTORKIND) + <18 (GETDATABASE |domain|) + <17 (|lookupInDomainVector| + (# + . #)) + <16 (|lookupInDomainVector| + (# + . #)) + <15 (|lookupInDomainVector| + (# + . #)) + <14 (|oldCompLookup| + (# + . #)) + <13 (|basicLookup| + (# + . #)) + <12 (|compiledLookup| + (# + . #)) + +"TPD:INT:coerce(x):OutputForm" +\end{verbatim} + +\begin{verbatim} + 12> (GETDATABASE |Integer| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (GETL |OutputForm| LOADED) + <12 (GETL NIL) + 12> (|loadLib| |OutputForm|) + 13> (GETL |print| |TimeTotal|) + <13 (GETL 0.0) + 13> (GETL |gc| |TimeTotal|) + <13 (GETL 0.0) + 13> (PUT |gc| |TimeTotal| 0.0) + <13 (PUT 0.0) + 13> (PUT |print| |TimeTotal| 0.0) + <13 (PUT 0.0) + 13> (GETDATABASE |OutputForm| OBJECT) + <13 (GETDATABASE + "/home/daly/noise/mnt/ubuntu/algebra/OUTFORM.o") + 13> (|pathnameDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/OUTFORM.o") + 14> (|pathname| + "/home/daly/noise/mnt/ubuntu/algebra/OUTFORM.o") + <14 (|pathname| + #p"/home/daly/noise/mnt/ubuntu/algebra/OUTFORM.o") + <13 (|pathnameDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/") + 13> (|isSystemDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/") + <13 (|isSystemDirectory| T) + 13> (|loadLibNoUpdate| |OutputForm| |OutputForm| + "/home/daly/noise/mnt/ubuntu/algebra/OUTFORM.o") + 14> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <14 (GETDATABASE |domain|) + 14> (|makeByteWordVec2| 1 (0 0 0)) + <14 (|makeByteWordVec2| #) + 14> (|makeByteWordVec2| 144 + (1 10 9 0 11 0 25 0 26 2 10 0 0 25 27 2 10 0 25 0 28 + 2 19 0 0 0 36 2 19 0 0 0 37 2 19 9 0 0 46 1 6 0 0 56 + 2 6 0 0 0 57 1 6 9 0 69 1 6 0 0 70 1 6 2 0 71 1 6 73 + 0 74 1 19 9 0 75 2 76 0 0 0 77 1 76 0 0 105 1 25 0 + 10 114 2 10 0 73 25 115 1 73 9 0 128 2 73 9 0 0 129 + 1 131 10 130 132 1 10 0 0 133 2 0 9 0 0 1 2 0 0 0 0 + 120 0 0 19 35 1 0 19 0 30 1 0 0 19 47 1 0 0 52 80 2 + 0 0 0 0 48 2 0 0 0 52 78 1 0 19 0 33 2 0 0 0 0 66 2 + 0 0 0 0 136 3 0 0 0 0 0 137 1 0 0 0 135 1 0 19 0 32 + 2 0 0 0 0 65 1 0 0 0 109 2 0 0 0 0 124 1 0 0 52 55 + 2 0 0 0 52 72 2 0 0 19 19 49 1 0 0 0 121 2 0 0 0 0 + 122 1 0 0 0 45 2 0 0 0 19 42 2 0 0 0 0 93 2 0 0 0 0 + 127 1 0 0 0 110 2 0 0 0 0 94 3 0 0 0 0 0 140 1 0 0 + 0 138 2 0 0 0 0 139 1 0 7 0 8 2 0 0 0 73 117 1 0 0 + 0 113 2 0 0 0 0 68 2 0 0 0 0 67 2 0 0 0 52 104 2 0 + 0 0 0 108 1 0 0 52 53 1 0 0 52 64 1 0 0 0 63 2 0 0 + 0 0 118 1 0 0 0 111 2 0 0 0 0 123 1 0 0 10 29 1 0 0 + 23 24 1 0 0 21 22 1 0 0 19 20 2 0 0 0 0 97 1 0 0 0 + 98 1 0 7 10 14 1 0 0 10 13 1 0 0 50 51 1 0 0 0 44 2 + 0 0 0 19 41 1 0 10 0 1 2 0 0 0 0 126 3 0 0 0 0 0 + 143 2 0 0 0 0 142 1 0 0 0 141 1 0 9 0 102 2 0 0 0 + 52 106 3 0 0 0 0 0 107 1 0 0 19 38 0 0 19 34 1 0 19 + 0 31 1 0 0 52 79 2 0 0 0 0 39 1 0 144 0 1 2 0 0 0 0 + 95 0 0 0 12 2 0 0 0 52 103 2 0 0 0 73 116 1 0 0 0 + 112 2 0 0 0 0 92 2 0 0 0 73 134 1 0 0 52 54 1 0 17 + 0 18 1 0 0 0 43 2 0 0 0 19 40 1 0 0 0 61 1 0 0 52 + 62 1 0 0 52 60 1 0 0 0 59 1 0 0 0 119 1 0 0 52 58 2 + 0 0 0 0 101 2 0 0 0 0 125 2 0 0 0 0 96 2 0 0 0 0 81 + 1 0 0 0 100 2 0 0 0 0 99 2 0 0 0 0 85 2 0 0 0 0 83 + 2 0 0 0 0 16 2 0 9 0 0 15 2 0 0 0 0 84 2 0 0 0 0 82 + 2 0 0 0 0 90 1 0 0 0 88 2 0 0 0 0 87 2 0 0 0 0 86 2 + 0 0 0 0 91 2 0 0 0 0 89)) + <14 (|makeByteWordVec2| #) + 14> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <14 (GETDATABASE |domain|) + 14> (GETL |load| |TimeTotal|) + <14 (GETL 0.0) + 14> (GETL |gc| |TimeTotal|) + <14 (GETL 0.0) + 14> (PUT |gc| |TimeTotal| 0.0) + <14 (PUT 0.0) + 14> (PUT |load| |TimeTotal| 0.0) + <14 (PUT 0.0) + <13 (|loadLibNoUpdate| T) + <12 (|loadLib| T) + 12> (HPUT # |OutputForm| + ((NIL 1 . #))) + <12 (HPUT ((NIL 1 . #))) + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (GETL |OutputForm| |infovec|) + <12 (GETL (# + # NIL + (# + # + # + . #) + |lookupComplete|)) + 12> (GETL |List| LOADED) + <12 (GETL NIL) + 12> (|loadLib| |List|) + 13> (GETL |print| |TimeTotal|) + <13 (GETL 0.0) + 13> (GETL |gc| |TimeTotal|) + <13 (GETL 0.0) + 13> (PUT |gc| |TimeTotal| 0.0) + <13 (PUT 0.0) + 13> (PUT |print| |TimeTotal| 0.0) + <13 (PUT 0.0) + 13> (GETDATABASE |List| OBJECT) + <13 (GETDATABASE + "/home/daly/noise/mnt/ubuntu/algebra/LIST.o") + 13> (|pathnameDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/LIST.o") + 14> (|pathname| + "/home/daly/noise/mnt/ubuntu/algebra/LIST.o") + <14 (|pathname| + #p"/home/daly/noise/mnt/ubuntu/algebra/LIST.o") + <13 (|pathnameDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/") + 13> (|isSystemDirectory| + "/home/daly/noise/mnt/ubuntu/algebra/") + <13 (|isSystemDirectory| T) + 13> (|loadLibNoUpdate| |List| |List| + "/home/daly/noise/mnt/ubuntu/algebra/LIST.o") + 14> (GETDATABASE |List| CONSTRUCTORKIND) + <14 (GETDATABASE |domain|) + 14> (|makeByteWordVec2| 8 + (0 0 0 0 0 0 0 0 0 0 3 0 0 8 4 0 0 8 1 2 4 5)) + <14 (|makeByteWordVec2| #) + 14> (|makeByteWordVec2| 51 + (1 13 12 0 14 3 13 12 0 15 15 16 1 0 6 0 17 3 6 12 + 13 0 8 18 1 0 0 0 19 1 13 12 0 20 0 21 0 22 2 13 0 + 15 21 23 1 13 12 0 24 1 13 12 0 25 1 13 12 0 26 1 + 0 15 0 27 2 0 15 0 8 28 2 0 12 13 0 29 3 0 12 13 0 + 8 30 2 0 0 0 0 31 1 0 0 0 32 2 0 0 0 0 33 0 0 0 34 + 1 0 8 0 35 2 0 8 6 0 36 2 0 0 0 0 37 2 0 6 0 38 39 + 2 0 0 6 0 40 2 0 0 0 0 41 1 42 0 15 43 1 44 0 42 45 + 1 6 44 0 46 2 47 0 44 0 48 1 44 0 49 50 1 0 44 0 51 + 2 1 0 0 0 33 2 1 0 0 0 37 2 1 0 0 0 41 1 0 0 0 19 1 + 1 0 0 32 1 0 8 0 9 0 0 0 7 2 1 8 6 0 36 1 0 6 0 17 + 1 0 8 0 35 0 0 0 34 2 0 6 0 38 39 1 2 44 0 51 2 0 0 + 6 0 10 2 0 0 6 0 40 2 0 0 0 0 31 2 0 0 0 0 11 3 5 12 + 13 0 8 30 2 5 12 13 0 29 1 5 15 0 27 2 5 15 0 8 28)) + <14 (|makeByteWordVec2| #) + 14> (GETDATABASE |List| CONSTRUCTORKIND) + <14 (GETDATABASE |domain|) + 14> (GETL |load| |TimeTotal|) + <14 (GETL 0.0) + 14> (GETL |gc| |TimeTotal|) + <14 (GETL 0.0) + 14> (PUT |gc| |TimeTotal| 0.0) + <14 (PUT 0.0) + 14> (PUT |load| |TimeTotal| 0.0) + <14 (PUT 0.0) + <13 (|loadLibNoUpdate| T) + <12 (|loadLib| T) + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (GETDATABASE |SetCategory| COSIG) + <12 (GETDATABASE (NIL)) + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (GETDATABASE |SetCategory| COSIG) + <12 (GETDATABASE (NIL)) + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (GETDATABASE |Integer| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (PNAME |Integer|) + <12 (PNAME "Integer") + 12> (PNAME |Integer|) + <12 (PNAME "Integer") + 12> (GETDATABASE |OrderedSet| COSIG) + <12 (GETDATABASE (NIL)) + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (PNAME |OutputForm|) + <12 (PNAME "OutputForm") + 12> (HPUT # |List| + ((((|OutputForm|)) 1 . #))) + <12 (HPUT ((((|OutputForm|)) 1 + . #))) + 12> (GETDATABASE |List| CONSTRUCTORKIND) + <12 (GETDATABASE |domain|) + 12> (GETL |List| |infovec|) + <12 (GETL (# + # + ((|shallowlyMutable| . 0) + (|finiteAggregate| . 0)) + (# + # + # + . #) + |lookupIncomplete|)) + 12> (HPUT # |OutputForm| + ((NIL 1 . #))) + <12 (HPUT ((NIL 1 . #))) + 12> (GETDATABASE |Integer| COSIG) + <12 (GETDATABASE (NIL)) + 12> (|basicLookup| |outputForm| ($ (|Integer|)) + # #) + 13> (|oldCompLookup| |outputForm| ($ (|Integer|)) + # #) + 14> (|lookupInDomainVector| |outputForm| ($ (|Integer|)) + # #) + 15> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <15 (GETDATABASE |domain|) + 15> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <15 (GETDATABASE |domain|) + 15> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <15 (GETDATABASE |domain|) + 15> (GETDATABASE |OutputForm| CONSTRUCTORKIND) + <15 (GETDATABASE |domain|) + 15> (GETDATABASE |Integer| COSIG) + <15 (GETDATABASE (NIL)) + <14 (|lookupInDomainVector| + (# + . #)) + <13 (|oldCompLookup| + (# + . #)) + <12 (|basicLookup| + (# + . #)) + +"TPD:OUTFORM:outputForm n" +\end{verbatim} + +\begin{verbatim} + 12> (GETL |print| |TimeTotal|) + <12 (GETL 0.0) + 12> (GETL |gc| |TimeTotal|) + <12 (GETL 0.0) + 12> (PUT |gc| |TimeTotal| 0.0) + <12 (PUT 0.0) + 12> (PUT |print| |TimeTotal| 0.0) + <12 (PUT 0.0) + 12> (|member| 1 ("failed" "nil" "prime" "sqfr" "irred")) + <12 (|member| NIL) + 12> (|member| EQUATNUM (SLASH OVER)) + <12 (|member| NIL) + 12> (GETL EQUATNUM |Led|) + <12 (GETL (|dummy| |dummy| 10000 0)) + 12> (|member| EQUATNUM (SLASH OVER)) + <12 (|member| NIL) + 12> (GETL EQUATNUM |Led|) + <12 (GETL (|dummy| |dummy| 10000 0)) + 12> (GETL EQUATNUM INFIXOP) + <12 (GETL " ") + 12> (GETL EQUATNUM WIDTH) + <12 (GETL NIL) + 12> (GETL EQUATNUM APP) + <12 (GETL NIL) + 12> (|member| EQUATNUM (SLASH OVER)) + <12 (|member| NIL) + 12> (GETL EQUATNUM |Led|) + <12 (GETL (|dummy| |dummy| 10000 0)) + 12> (|member| EQUATNUM (SLASH OVER)) + <12 (|member| NIL) + 12> (GETL EQUATNUM |Led|) + <12 (GETL (|dummy| |dummy| 10000 0)) + 12> (GETL EQUATNUM INFIXOP) + <12 (GETL " ") + 12> (GETL EQUATNUM SUPERSPAN) + <12 (GETL NIL) + 12> (GETL EQUATNUM SUBSPAN) + <12 (GETL NIL) + (1) 1 +\end{verbatim} + +\begin{verbatim} + 12> (|putHist| % |value| ((|PositiveInteger|) . 1) ((NIL))) + 13> (|recordNewValue| % |value| ((|PositiveInteger|) . 1)) + 14> (GETL |print| |TimeTotal|) + <14 (GETL 0.0) + 14> (GETL |gc| |TimeTotal|) + <14 (GETL 0.0) + 14> (PUT |gc| |TimeTotal| 0.0) + <14 (PUT 0.0) + 14> (PUT |print| |TimeTotal| 0.0) + <14 (PUT 0.0) + 14> (|recordNewValue0| % |value| ((|PositiveInteger|) . 1)) + <14 (|recordNewValue0| + ((% (|value| (|PositiveInteger|) . 1)))) + 14> (GETL |history| |TimeTotal|) + <14 (GETL 0.0) + 14> (GETL |gc| |TimeTotal|) + <14 (GETL 0.0) + 14> (PUT |gc| |TimeTotal| 0.0) + <14 (PUT 0.0) + 14> (PUT |history| |TimeTotal| 0.0) + <14 (PUT 0.0) + <13 (|recordNewValue| |history|) + 13> (|search| % ((NIL))) + 14> (|searchCurrentEnv| % (NIL)) + <14 (|searchCurrentEnv| NIL) + 14> (|searchTailEnv| % NIL) + <14 (|searchTailEnv| NIL) + <13 (|search| NIL) + <12 (|putHist| ((((% (|value| (|PositiveInteger|) . 1)))))) + 12> (|printTypeAndTime| 1 (|PositiveInteger|)) + 13> (|printTypeAndTimeNormal| 1 (|PositiveInteger|)) + 14> (|sayKeyedMsg| S2GL0012 ((|PositiveInteger|))) + 15> (|sayKeyedMsgLocal| S2GL0012 ((|PositiveInteger|))) + 16> (|getKeyedMsg| S2GL0012) + 17> (|fetchKeyedMsg| S2GL0012 NIL) + <17 (|fetchKeyedMsg| " %rjon Type: %1p %rjoff" T) + <16 (|getKeyedMsg| " %rjon Type: %1p %rjoff" T) + 16> (|segmentKeyedMsg| " %rjon Type: %1p %rjoff") + <16 (|segmentKeyedMsg| ("%rjon" "Type:" "%1p" "%rjoff")) + 16> (|member| "%rjon" (|%ceon| "%ceon")) + <16 (|member| NIL) + 16> (|member| "%rjon" (|%rjon| "%rjon")) + <16 (|member| ("%rjon")) + 16> (|member| "Type:" + (|%ceoff| "%ceoff" |%rjoff| "%rjoff")) + <16 (|member| NIL) + 16> (|member| "%1p" (|%ceoff| "%ceoff" |%rjoff| "%rjoff")) + <16 (|member| NIL) + 16> (|member| "%rjoff" + (|%ceoff| "%ceoff" |%rjoff| "%rjoff")) + <16 (|member| ("%rjoff")) + 16> (|member| "%rj" (|%ceon| "%ceon")) + <16 (|member| NIL) + 16> (|member| "%rj" (|%rjon| "%rjon")) + <16 (|member| NIL) + 16> (|member| "Type:" (|%ceon| "%ceon")) + <16 (|member| NIL) + 16> (|member| "Type:" (|%rjon| "%rjon")) + <16 (|member| NIL) + 16> (|member| "%1p" (|%ceon| "%ceon")) + <16 (|member| NIL) + 16> (|member| "%1p" (|%rjon| "%rjon")) + <16 (|member| NIL) + 16> (DIGITP #\r) + <16 (DIGITP NIL) + 16> (DIGITP #\1) + <16 (DIGITP 1) + 16> (GETDATABASE |PositiveInteger| ABBREVIATION) + <16 (GETDATABASE PI) + 16> (|member| "Type:" ("%n" |%n|)) + <16 (|member| NIL) + 16> (|member| "Type:" ("%y" |%y|)) + <16 (|member| NIL) + 16> (|member| "%rj" + (" " | | "%" % |%b| |%d| |%l| |%i| |%u| %U |%n| |%x| + |%ce| |%rj| "%U" "%b" "%d" "%l" "%i" "%u" "%U" "%n" + "%x" "%ce" "%rj" [ |(| "[" "(")) + <16 (|member| ("%rj" [ |(| "[" "(")) + 16> (|member| |PositiveInteger| ("%n" |%n|)) + <16 (|member| NIL) + 16> (|member| |PositiveInteger| ("%y" |%y|)) + <16 (|member| NIL) + 16> (|member| "Type:" + (" " | | "%" % |%b| |%d| |%l| |%i| |%u| %U |%n| |%x| + |%ce| |%rj| "%U" "%b" "%d" "%l" "%i" "%u" "%U" "%n" + "%x" "%ce" "%rj" [ |(| "[" "(")) + <16 (|member| NIL) + 16> (SIZE "Type:") + <16 (SIZE 5) + 16> (|member| |PositiveInteger| + (" " | | "%" % |%b| |%d| |%l| |%i| |%u| %U |%n| |%x| + |%ce| |%rj| "%U" "%b" "%d" "%l" "%i" "%u" "%U" "%n" + "%x" "%ce" "%rj" |.| |,| ! |:| |;| ? ] |)| "." "," + "!" ":" ";" "?" "]" ")")) + <16 (|member| NIL) + 16> (|member| "%rj" (|%ce| "%ce" |%rj| "%rj")) + <16 (|member| ("%rj")) + 16> (|sayMSG| (("%rj" "Type:" " " |PositiveInteger|))) + 17> (SAYBRIGHTLY1 (("%rj" "Type:" " " |PositiveInteger|)) + #) + 18> (BRIGHTPRINT (("%rj" "Type:" " " |PositiveInteger|))) + 19> (|member| "%rj" ("%p" "%s")) + <19 (|member| NIL) + 19> (|member| "Type:" (|%l| "%l")) + <19 (|member| NIL) + 19> (|member| " " (|%l| "%l")) + <19 (|member| NIL) + 19> (|member| |PositiveInteger| (|%l| "%l")) + <19 (|member| NIL) + 19> (|member| "Type:" ("%b" "%d" |%b| |%d|)) + <19 (|member| NIL) + 19> (|member| "Type:" ("%l" |%l|)) + <19 (|member| NIL) + 19> (|member| " " ("%b" "%d" |%b| |%d|)) + <19 (|member| NIL) + 19> (|member| " " ("%l" |%l|)) + <19 (|member| NIL) + 19> (|member| |PositiveInteger| ("%b" "%d" |%b| |%d|)) + <19 (|member| NIL) + 19> (|member| |PositiveInteger| ("%l" |%l|)) + <19 (|member| NIL) + 19> (PNAME |PositiveInteger|) + <19 (PNAME "PositiveInteger") + 19> (|fillerSpaces| 56 " ") + <19 (|fillerSpaces| + " ") + Type: + 19> (PNAME |PositiveInteger|) + <19 (PNAME "PositiveInteger") +PositiveInteger +\end{verbatim} + +\begin{verbatim} + <18 (BRIGHTPRINT NIL) + <17 (SAYBRIGHTLY1 NIL) + <16 (|sayMSG| NIL) + <15 (|sayKeyedMsgLocal| NIL) + <14 (|sayKeyedMsg| NIL) + <13 (|printTypeAndTimeNormal| NIL) + <12 (|printTypeAndTime| NIL) + <11 (|recordAndPrint| |done|) + 11> (|recordFrame| |normal|) + 12> (|diffAlist| + ((% (|value| (|PositiveInteger|) . 1))) NIL) + <12 (|diffAlist| ((% (|value|)))) + <11 (|recordFrame| ((% (|value|)))) + 11> (GETL |print| |TimeTotal|) + <11 (GETL 0.0) + 11> (GETL |gc| |TimeTotal|) + <11 (GETL 0.0) + 11> (PUT |gc| |TimeTotal| 0.0) + <11 (PUT 0.0) + 11> (PUT |print| |TimeTotal| 0.0) + <11 (PUT 0.0) + <10 (|processInteractive1| ((|PositiveInteger|) . 1)) + 10> (|writeHistModesAndValues|) + 11> (|putHist| % |value| + #0=((|PositiveInteger|) . 1) ((((% (|value| . #0#)))))) + 12> (|recordNewValue| % |value| ((|PositiveInteger|) . 1)) + 13> (GETL |other| |TimeTotal|) + <13 (GETL 0.0) + 13> (GETL |gc| |TimeTotal|) + <13 (GETL 0.0) + 13> (PUT |gc| |TimeTotal| 0.0) + <13 (PUT 0.0) + 13> (PUT |other| |TimeTotal| 0.0) + <13 (PUT 0.0) + 13> (|recordNewValue0| % |value| ((|PositiveInteger|) . 1)) + <13 (|recordNewValue0| (|value| (|PositiveInteger|) . 1)) + 13> (GETL |history| |TimeTotal|) + <13 (GETL 0.0) + 13> (GETL |gc| |TimeTotal|) + <13 (GETL 0.0) + 13> (PUT |gc| |TimeTotal| 0.0) + <13 (PUT 0.0) + 13> (PUT |history| |TimeTotal| 0.0) + <13 (PUT 0.0) + <12 (|recordNewValue| |history|) + 12> (|search| % + ((((% (|value| (|PositiveInteger|) . 1)))))) + 13> (|searchCurrentEnv| % + (((% (|value| (|PositiveInteger|) . 1))))) + <13 (|searchCurrentEnv| + ((|value| (|PositiveInteger|) . 1))) + <12 (|search| ((|value| (|PositiveInteger|) . 1))) + <11 (|putHist| ((((% (|value| (|PositiveInteger|) . 1)))))) + <10 (|writeHistModesAndValues| NIL) + 10> (|updateHist|) + 11> (GETL |other| |TimeTotal|) + <11 (GETL 0.0) + 11> (GETL |gc| |TimeTotal|) + <11 (GETL 0.0) + 11> (PUT |gc| |TimeTotal| 0.0) + <11 (PUT 0.0) + 11> (PUT |other| |TimeTotal| 0.0) + <11 (PUT 0.0) + 11> (|updateInCoreHist|) + <11 (|updateInCoreHist| 1) + 11> (|writeHiFi|) + <11 (|writeHiFi| + ((1 (% (|value| (|PositiveInteger|) . 1))))) + 11> (|disableHist|) + <11 (|disableHist| NIL) + 11> (|updateCurrentInterpreterFrame|) + 12> (|createCurrentInterpreterFrame|) + <12 (|createCurrentInterpreterFrame| + (|frame0| + ((((% (|value| . #0=((|PositiveInteger|) . 1)))))) + 2 T + #1=(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL + NIL NIL NIL NIL NIL NIL NIL NIL NIL . #1#) + 20 1 NIL ((1 (% (|value| . #0#)))) + #)) + 12> (|updateFromCurrentInterpreterFrame|) + <12 (|updateFromCurrentInterpreterFrame| NIL) + <11 (|updateCurrentInterpreterFrame| NIL) + 11> (GETL |history| |TimeTotal|) + <11 (GETL 0.0) + 11> (GETL |gc| |TimeTotal|) + <11 (GETL 0.0) + 11> (PUT |gc| |TimeTotal| 0.0) + <11 (PUT 0.0) + 11> (PUT |history| |TimeTotal| 0.0) + <11 (PUT 0.0) + <10 (|updateHist| |history|) + <9 (|processInteractive| ((|PositiveInteger|) . 1)) + <8 (|intInterpretPform| ((|PositiveInteger|) . 1)) + 8> (|ncPutQ| + ((|carrier| (|ok?| . T) + (|ptreePremacro| + . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) |value| + ((|PositiveInteger|) . 1)) + 9> (|ncAlist| + ((|carrier| (|ok?| . T) + (|ptreePremacro| + . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| ((|ok?| . T) + (|ptreePremacro| + . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + 9> (|ncAlist| + ((|carrier| (|ok?| . T) + (|ptreePremacro| + . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncAlist| + ((|ok?| . T) + (|ptreePremacro| + . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + 9> (|ncTag| + ((|carrier| (|ok?| . T) + (|ptreePremacro| + . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <9 (|ncTag| |carrier|) + <8 (|ncPutQ| ((|PositiveInteger|) . 1)) + <7 (|phInterpret| ((|PositiveInteger|) . 1)) + 7> (|ncConversationPhase,wrapup| + ((|carrier| (|value| (|PositiveInteger|) . 1) (|ok?| . T) + (|ptreePremacro| + . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <7 (|ncConversationPhase,wrapup| NIL) + <6 (|ncConversationPhase| ((|PositiveInteger|) . 1)) + 6> (|ncEltQ| + ((|carrier| (|value| (|PositiveInteger|) . 1) (|ok?| . T) + (|ptreePremacro| + . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + |messages|) + 7> (|ncAlist| + ((|carrier| (|value| (|PositiveInteger|) . 1) (|ok?| . T) + (|ptreePremacro| + . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1)))) + <7 (|ncAlist| + ((|value| (|PositiveInteger|) . 1) (|ok?| . T) + (|ptreePremacro| + . #0=((|integer| (|posn| #1=(0 "1" 1 1 "strings") . 0)) + . "1")) + (|ptree| . #0#) + (|lines| ((#1# . 1) . "1")) + (|messages|) + (|stepNumber| . 1))) + <6 (|ncEltQ| NIL) + <5 (|intloopSpadProcess,interp| NIL) + <4 (|intloopSpadProcess| 2) +\end{verbatim} +\begin{verbatim} + 4> (|StreamNull| + (|nonnullstream| #0=|incAppend1| NIL + (|nonnullstream| #2=|next1| |ncloopParse| + (|nonnullstream| #0# NIL + (|nonnullstream| #2# |lineoftoks| (|nullstream|)))))) + 5> (|incAppend1| NIL + (|nonnullstream| #0=|next1| |ncloopParse| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) + 6> (|StreamNull| NIL) + <6 (|StreamNull| T) + 6> (|StreamNull| + (|nonnullstream| #0=|next1| |ncloopParse| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| #0# |lineoftoks| (|nullstream|))))) + 7> (|next1| |ncloopParse| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| |next1| |lineoftoks| (|nullstream|)))) + 8> (|StreamNull| + (|nonnullstream| |incAppend1| NIL + (|nonnullstream| |next1| |lineoftoks| (|nullstream|)))) + 9> (|incAppend1| NIL + (|nonnullstream| |next1| |lineoftoks| (|nullstream|))) + 10> (|StreamNull| NIL) + <10 (|StreamNull| T) + 10> (|StreamNull| + (|nonnullstream| |next1| |lineoftoks| (|nullstream|))) + 11> (|next1| |lineoftoks| (|nullstream|)) + 12> (|StreamNull| (|nullstream|)) + <12 (|StreamNull| T) + <11 (|next1| (|nullstream|)) + <10 (|StreamNull| T) + <9 (|incAppend1| (|nullstream|)) + <8 (|StreamNull| T) + <7 (|next1| (|nullstream|)) + <6 (|StreamNull| T) + <5 (|incAppend1| (|nullstream|)) + <4 (|StreamNull| T) + <3 (|intloopProcess| 2) +\end{verbatim} + +\chapter{Axiom Details} +\section{Variables Used} +\section{Data Structures} +\section{Functions} +\defunsec{set-restart-hook}{Set the restart hook} +When a lisp image containing code is reloaded there is a hook to +allow a function to be called. In our case it is the restart +function which is the entry to the Axiom interpreter. +\sig{set-restart-hook}{Void}{'restart} +\begin{chunk}{defun set-restart-hook 0} +(defun set-restart-hook () + "Set the restart hook" + #+KCL (setq system::*top-level-hook* 'restart) + #+Lucid (setq boot::restart-hook 'restart) + 'restart + ) + +\end{chunk} + +\pagehead{restart function}{The restart function} +\pagepic{ps/v5restart.ps}{Restart}{1.00} +The restart function is the real root of the world. It sets up memory +if we are working in a GCL/akcl version of the system. + +The \verb|compiler::*compile-verbose*| flag has been set to nil globally. +We do not want to know about the microsteps of GCL's compile facility. + +The \verb|compiler::*suppress-compiler-warnings*| flag has been set to t. +We do not care that certain generated variables are not used. + +The \verb|compiler::*suppress-compiler-notes*| flag has been set to t. +We do not care that tail recursion occurs. + +It sets the +current package to be the ``BOOT'' package which is the standard +package in which the interpreter runs. + +The \fnref{initroot} function sets global variables that depend on the +AXIOM shell variable. These are needed to find basic files like s2-us.msgs, +which contains the error message text. + +The \fnref{openserver} function tried to set up the socket connection +used for things like hyperdoc. The \verb|$openServerIfTrue| variable +starts true, which implies trying to start a server. + +Axiom has multiple frames that contain independent information about a +computation. There can be several frames at any one time and you can +shift back and forth between the frames. By default, the system starts +in ``frame0'' (try the \verb|)frame names| command). See the Frame +Mechanism chapter (\ref{TheFrameMechanism} page~\pageref{TheFrameMechanism}). + +The \varref{printLoadMsgs} variable controls whether load messages will +be output as library routines are loaded. We disnable this by default. +It can be changed by using \verb|)set message autoload|. + +The \varref{current-directory} variable is set to the current directory. +This is used by the \verb|)cd| function and some of the compile routines. + +The \fnref{statisticsInitialization} function initializes variables +used to collect statistics. Currently, only the garbage collector +information is initialized. + +\calls{restart}{init-memory-config} +\calls{restart}{initroot} +\calls{restart}{openserver} +\calls{restart}{makeInitialModemapFrame} +\calls{restart}{get-current-directory} +\calls{restart}{statisticsInitialization} +\calls{restart}{initHist} +\calls{restart}{initializeInterpreterFrameRing} +\calls{restart}{spadStartUpMsgs} +\calls{restart}{restart0} +\calls{restart}{readSpadProfileIfThere} +\calls{restart}{spad} +\usesdollar{restart}{openServerIfTrue} +\usesdollar{restart}{SpadServerName} +\usesdollar{restart}{SpadServer} +\usesdollar{restart}{IOindex} +\usesdollar{restart}{InteractiveFrame} +\usesdollar{restart}{printLoadMsgs} +\usesdollar{restart}{current-directory} +\usesdollar{restart}{displayStartMsgs} +\usesdollar{restart}{currentLine} +\begin{chunk}{defun restart} +(defun restart () + (declare (special $openServerIfTrue $SpadServerName |$SpadServer| + |$IOindex| |$InteractiveFrame| |$printLoadMsgs| $current-directory + |$displayStartMsgs| |$currentLine|)) +#+:akcl + (init-memory-config :cons 1024 :fixnum 200 :symbol 500 :package 8 + :array 800 :string 1024 :cfun 200 :cpages 6000 :rpages 2000 :hole 4000) +#+:akcl (setq compiler::*compile-verbose* nil) +#+:akcl (setq compiler::*suppress-compiler-warnings* t) +#+:akcl (setq compiler::*suppress-compiler-notes* t) +#+:akcl (setq si::*system-directory* "") + (in-package "BOOT") + (initroot) +#+:akcl + (when (and $openServerIfTrue (zerop (openserver $SpadServerName))) + (setq $openServerIfTrue nil) + (setq |$SpadServer| t)) + (setq |$IOindex| 1) + (setq |$InteractiveFrame| (|makeInitialModemapFrame|)) + (setq |$printLoadMsgs| nil) + (setq $current-directory (get-current-directory)) + (setq *default-pathname-defaults* (pathname $current-directory)) + (|statisticsInitialization|) + (|initHist|) + (|initializeInterpreterFrameRing|) + (when |$displayStartMsgs| (|spadStartUpMsgs|)) + (setq |$currentLine| nil) + (restart0) + (|readSpadProfileIfThere|) + (|spad|)) + +\end{chunk} + +\defvar{localVars} +\begin{chunk}{initvars} +(defvar |$localVars| ()) ;checked by isType + +\end{chunk} + +\defun{restart0}{Non-interactive restarts} +\calls{restart0}{interpopen} +\calls{restart0}{operationopen} +\calls{restart0}{categoryopen} +\calls{restart0}{browseopen} +\begin{chunk}{defun restart0} +(defun restart0 () + (interpopen) ;; open up the interpreter database + (operationopen) ;; all of the operations known to the system + (categoryopen) ;; answer hasCategory question + (browseopen)) + +\end{chunk} + +\defun{spadStartUpMsgs}{The startup banner messages} +\calls{spadStartUpMsgs}{fillerSpaces} +\calls{spadStartUpMsgs}{specialChar} +\calls{spadStartUpMsgs}{sayKeyedMsg} +\calls{spadStartUpMsgs}{sayMSG} +\usesdollar{spadStartUpMsgs}{msgAlist} +\usesdollar{spadStartUpMsgs}{opSysName} +\usesdollar{spadStartUpMsgs}{linelength} +\uses{spadStartUpMsgs}{*yearweek*} +\uses{spadStartUpMsgs}{*build-version*} +\begin{chunk}{defun spadStartUpMsgs} +(defun |spadStartUpMsgs| () + (let (bar) + (declare (special |$msgAlist| |$opSysName| $linelength *yearweek* + *build-version*)) + (when (> $linelength 60) + (setq bar (|fillerSpaces| $linelength (|specialChar| '|hbar|))) + (|sayKeyedMsg| 'S2GL0001 (list *build-version* *yearweek*)) + (|sayMSG| bar) + (|sayKeyedMsg| 'S2GL0018C nil) + (|sayKeyedMsg| 'S2GL0018D nil) + (|sayKeyedMsg| 'S2GL0003B (list |$opSysName|)) + (say " Visit http://axiom-developer.org for more information") + (|sayMSG| bar) + (setq |$msgAlist| nil) + (|sayMSG| '| |)))) + +\end{chunk} + +\defun{fillerSpaces}{Make a vector of filler characters} +\calls{fillerSpaces}{ifcar} +\begin{chunk}{defun fillerSpaces} +(defun |fillerSpaces| (&rest arglist &aux charPart n) + (setq n (car arglist)) + (setq charPart (cdr arglist)) + (if (<= n 0) + "" + (make-string n :initial-element (character (or (ifcar charPart) " "))))) + +\end{chunk} + +\defdollar{PrintCompilerMessageIfTrue} +The \verb|$PrintCompilerMessageIfTrue| variable is set to NIL in spad. +\begin{chunk}{initvars} +(defvar |$PrintCompilerMessageIfTrue| nil) + +\end{chunk} + +\defunsec{spad}{Starts the interpreter but do not read in profiles} +\calls{spad}{setOutputAlgebra} +\calls{spad}{runspad} +\usesdollar{spad}{PrintCompilerMessageIfTrue} +\begin{chunk}{defun spad} +(defun |spad| () + "Starts the interpreter but do not read in profiles" + (let (|$PrintCompilerMessageIfTrue|) + (declare (special |$PrintCompilerMessageIfTrue|)) + (setq |$PrintCompilerMessageIfTrue| nil) + (|setOutputAlgebra| '|%initialize%|) + (|runspad|) + '|EndOfSpad|)) + +\end{chunk} + +\defdollar{quitTag} +\begin{chunk}{initvars} +(defvar |$quitTag| system::*quit-tag*) + +\end{chunk} + +\defun{runspad}{runspad} +\catches{runspad}{quitTag} +\catches{runspad}{coerceFailure} +\catches{runspad}{top-level} +\calls{runspad}{seq} +\calls{runspad}{exit} +\calls{runspad}{resetStackLimits} +\calls{runspad}{ncTopLevel} +\usesdollar{runspad}{quitTag} +\begin{chunk}{defun runspad} +(defun |runspad| () + (prog (mode) + (declare (special |$quitTag|)) + (return + (seq + (progn + (setq mode '|restart|) + (do () + ((null (eq mode '|restart|)) nil) + (seq + (exit + (progn + (|resetStackLimits|) + (catch |$quitTag| + (catch '|coerceFailure| + (setq mode (catch '|top_level| (|ncTopLevel|)))))))))))))) + +\end{chunk} + +\defun{resetStackLimits}{Reset the stack limits} +\calls{resetStackLimits}{reset-stack-limits} +\begin{chunk}{defun resetStackLimits 0} +(defun |resetStackLimits| () + "Reset the stack limits" + (system:reset-stack-limits)) + +\end{chunk} + +\chapter{Handling Terminal Input} +\section{Streams} +\defvar{curinstream} +The curinstream variable is set to the value of the +\verb|*standard-input*| common lisp +variable in ncIntLoop. While not using the +``dollar'' convention this variable is still ``global''. +\begin{chunk}{initvars} +(defvar curinstream (make-synonym-stream '*standard-input*)) + +\end{chunk} + +\defvar{curoutstream} +The curoutstream variable is set to the value of the +\verb|*standard-output*| common lisp variable in ncIntLoop. +While not using the ``dollar'' convention this variable is still ``global''. +\begin{chunk}{initvars} +(defvar curoutstream (make-synonym-stream '*standard-output*)) + +\end{chunk} + +\defvar{errorinstream} +\begin{chunk}{initvars} +(defvar errorinstream (make-synonym-stream '*terminal-io*)) + +\end{chunk} + +\defvar{erroroutstream} +\begin{chunk}{initvars} +(defvar erroroutstream (make-synonym-stream '*terminal-io*)) + +\end{chunk} + +\defvar{*eof*} +\begin{chunk}{initvars} +(defvar *eof* nil) + +\end{chunk} + +\defvar{*whitespace*} +\begin{chunk}{initvars} +(defvar *whitespace* + '(#\Space #\Newline #\Tab #\Page #\Linefeed #\Return #\Backspace) + "A list of characters used by string-trim considered as whitespace") + +\end{chunk} + +There are several different environments used in the interpreter: + +{\bf \verb|$InteractiveFrame|} is the environment where the user +values are stored. Any side effects of evaluation of a top-level +expression are stored in this environment. It is always used as +the starting environment for interpretation. + +{\bf \$e} is the name used for \verb|$InteractiveFrame| while interpreting. + +{\bf \verb|$env|} is local environment used by the interpreter. +Only temporary information (such as types of local variables is +stored in \verb|$env|. It is thrown away after evaluation of each expression. + +\defdollar{InteractiveMode} +\begin{chunk}{initvars} +(defvar |$InteractiveMode| (list (list nil)) "top level environment") + +\end{chunk} + +\defdollar{env} +\begin{chunk}{initvars} +(defvar |$env| nil "checked in isDomainValuedVariable") + +\end{chunk} + +\defdollar{e} +The \verb|$e| variable is set to the value of \verb|$InteractiveFrame| +which is set in restart to the value of the call to the +makeInitialModemapFrame function. This function simply returns a copy +of the variable \verb|$InitialModemapFrame|. + +Prints out the value x which is of type m, and records the changes +in environment \verb|$e| into \verb|$InteractiveFrame| +Thus \verb|$e| is a copy of the variable \verb|$InitialModemapFrame|. + +This variable is used in the undo mechanism. +\begin{chunk}{initvars} +(defvar |$e| nil "the environment?") + +\end{chunk} + +\defdollar{InteractiveMode} +\begin{chunk}{initvars} +(defvar |$InteractiveMode| t) + +\end{chunk} + +\defdollar{boot} +\begin{chunk}{initvars} +(defvar $boot nil) + +\end{chunk} + +\subsection{\$newspad} +The \verb|$newspad| is set to T in ncTopLevel. +\defdollar{newspad} +\begin{chunk}{initvars} +(defvar $newspad nil) + +\end{chunk} + +\defunsec{ncTopLevel}{Top-level read-parse-eval-print loop} +Top-level read-parse-eval-print loop for the interpreter. Uses +the Bill Burge's parser. +\calls{ncTopLevel}{ncIntLoop} +\usesdollar{ncTopLevel}{e} +\usesdollar{ncTopLevel}{spad} +\usesdollar{ncTopLevel}{newspad} +\usesdollar{ncTopLevel}{boot} +\usesdollar{ncTopLevel}{InteractiveMode} +\usesdollar{ncTopLevel}{InteractiveFrame} +\uses{ncTopLevel}{*eof*} +\uses{ncTopLevel}{in-stream} +\begin{chunk}{defun ncTopLevel} +(defun |ncTopLevel| () + "Top-level read-parse-eval-print loop" + (let (|$e| $spad $newspad $boot |$InteractiveMode| *eof* in-stream) + (declare (special |$e| $spad $newspad $boot |$InteractiveMode| *eof* + in-stream |$InteractiveFrame|)) + (setq in-stream curinstream) + (setq *eof* nil) + (setq |$InteractiveMode| t) + (setq $boot nil) + (setq $newspad t) + (setq $spad t) + (setq |$e| |$InteractiveFrame|) + (|ncIntLoop|))) + +\end{chunk} +\defun{ncIntLoop}{ncIntLoop} +\calls{ncIntLoop}{intloop} +\uses{ncIntLoop}{curinstream} +\uses{ncIntLoop}{curoutstream} +\begin{chunk}{defun ncIntLoop} +(defun |ncIntLoop| () + (let ((curinstream *standard-output*) + (curoutstream *standard-input*)) + (declare (special curinstream curoutstream)) + (|intloop|))) + +\end{chunk} + +\defdollar{intTopLevel} +\begin{chunk}{initvars} +(defvar |$intTopLevel| '|top_level|) + +\end{chunk} + +\defdollar{intRestart} +\begin{chunk}{initvars} +(defvar |$intRestart| '|restart|) + +\end{chunk} + +\defun{intloop}{intloop} +Note that the SpadInterpretStream function uses a list of +three strings as an argument. The values in the list seem to have +no use and can eventually be removed. +\catches{intloop}{intTopLevel} +\calls{intloop}{SpadInterpretStream} +\calls{intloop}{resetStackLimits} +\usesdollar{intloop}{intTopLevel} +\usesdollar{intloop}{intRestart} +\begin{chunk}{defun intloop} +(defun |intloop| () + (prog (mode) + (declare (special |$intTopLevel| |$intRestart|)) + (return + (progn + (setq mode |$intRestart|) + ((lambda () + (loop + (cond + ((not (equal mode |$intRestart|)) + (return nil)) + (t + (progn + (|resetStackLimits|) + (setq mode + (catch |$intTopLevel| + (|SpadInterpretStream| 1 + (list 'tim 'daly '?) t))))))))))))) + +\end{chunk} +\defdollar{ncMsgList} +\begin{chunk}{initvars} +(defvar |$ncMsgList| nil) + +\end{chunk} + +\defun{SpadInterpretStream}{SpadInterpretStream} +The SpadInterpretStream function takes three arguments +\begin{list}{} +\item str This is passed as an argument to intloopReadConsole +\item source This is the name of a source file but appears not +to be used. It is set to the list \verb|(tim daly ?)|. +\item \verb|interactive?| If this is false then various messages are +suppressed and input does not use piles. If this is true then the +library loading routines might output messages and piles are expected +on input (as from a file). +\end{list} +System commands are handled by the function in the ``hook'' +variable \verb|$systemCommandFunction| which +has the default function \verb|InterpExecuteSpadSystemCommand|. +Thus, when a system command is entered this function is called. + +The \verb|$promptMsg| variable is set to the constant S2CTP023. This +constant points to a message in src/doc/msgs/s2-us.msgs. This message +does nothing but print the argument value. +\defdollar{promptMsg} +\begin{chunk}{initvars} +(defvar |$promptMsg| 'S2CTP023) + +\end{chunk} + +\defun{cmpnote}{GCL cmpnote function} +GCL keeps noting the fact that the compiler is performing tail-recursion. +Bill Schelter added this as a debugging tool for Axiom and it was never +removed. Patching the lisp code in the GCL build fails as the system +is actually built from the pre-compiled C code. Thus, we can only step +on this message after the fact. The cmpnote function is used nowhere +else in GCL so stepping on the function call seems best. We're unhappy +with this hack and will try to convince the GCL crowd to fix this. +\begin{chunk}{defun cmpnote} +#+:gcl (defun compiler::cmpnote (&rest x) (declare (ignore x))) + +\end{chunk} + +\defdollar{newcompErrorCount} +\begin{chunk}{initvars} +(defvar |$newcompErrorCount| 0) + +\end{chunk} + +\defdollar{nopos} +\begin{chunk}{initvars} +(defvar |$nopos| (list '|noposition|)) + +\end{chunk} +\calls{SpadInterpretStream}{mkprompt} +\calls{SpadInterpretStream}{intloopReadConsole} +\calls{SpadInterpretStream}{intloopInclude} +\usesdollar{SpadInterpretStream}{promptMsg} +\usesdollar{SpadInterpretStream}{systemCommandFunction} +\usesdollar{SpadInterpretStream}{ncMsgList} +\usesdollar{SpadInterpretStream}{erMsgToss} +\usesdollar{SpadInterpretStream}{lastPos} +\usesdollar{SpadInterpretStream}{inclAssertions} +\usesdollar{SpadInterpretStream}{okToExecuteMachineCode} +\usesdollar{SpadInterpretStream}{newcompErrorCount} +\usesdollar{SpadInterpretStream}{libQuiet} +\usesdollar{SpadInterpretStream}{fn} +\usesdollar{SpadInterpretStream}{nopos} +\label{SpadInterpretStream} +\begin{chunk}{defun SpadInterpretStream} +(defun |SpadInterpretStream| (str source interactive?) + (let (|$promptMsg| |$systemCommandFunction| + |$ncMsgList| |$erMsgToss| |$lastPos| |$inclAssertions| + |$okToExecuteMachineCode| |$newcompErrorCount| + |$libQuiet|) + (declare (special |$promptMsg| + |$systemCommandFunction| |$ncMsgList| |$erMsgToss| |$lastPos| + |$inclAssertions| |$okToExecuteMachineCode| |$newcompErrorCount| + |$libQuiet| |$nopos|)) + (setq |$libQuiet| (null interactive?)) + (setq |$newcompErrorCount| 0) + (setq |$okToExecuteMachineCode| t) + (setq |$inclAssertions| (list 'aix '|CommonLisp|)) + (setq |$lastPos| |$nopos|) + (setq |$erMsgToss| nil) + (setq |$ncMsgList| nil) + (setq |$systemCommandFunction| #'|InterpExecuteSpadSystemCommand|) + (setq |$promptMsg| 's2ctp023) + (if interactive? + (progn + (princ (mkprompt)) + (|intloopReadConsole| "" str)) + (|intloopInclude| source 0)))) + +\end{chunk} + +\section{The Read-Eval-Print Loop} +\defun{intloopReadConsole}{intloopReadConsole} +Note that this function relies on the fact that lisp can do tail-recursion. +The function recursively invokes itself. + +The serverReadLine function is a special readline function that handles +communication with the session manager code, which is a separate process +running in parallel. + +We read a line from standard input. +\begin{itemize} +\item If it is a null line then we exit Axiom. +\item If it is a zero length line we prompt and recurse +\item If \$dalymode and open-paren we execute lisp code, prompt and recurse +The \$dalymode will interpret any input that begins with an open-paren +as a lisp expression rather than Axiom input. This is useful for debugging +purposes when most of the input lines will be lisp. Setting \$dalymode +non-nil will certainly break user expectations and is to be used with +caution. +\item If it is ``)fi'' or ``)fin'' we drop into lisp. Use the (restart) + function to return to the interpreter loop. +\item If it starts with ``)'' we process the command, prompt, and recurse +\item If it is a command then we remember the current line, process the + command, prompt, and recurse. +\item If the input has a trailing underscore (Axiom line-continuation) + then we cut off the continuation character and pass the truncated + string to ourselves, prompt, and recurse +\item otherwise we process the input, prompt, and recurse. +\end{itemize} +Notice that all but two paths (a null input or a ``)fi'' or a ``)fin'') +will end up as a recursive call to ourselves. + +\throws{intloopReadConsole}{top-level} +\calls{intloopReadConsole}{serverReadLine} +\calls{intloopReadConsole}{leaveScratchpad} +\calls{intloopReadConsole}{mkprompt} +\calls{intloopReadConsole}{intloopReadConsole} +\calls{intloopReadConsole}{intloopPrefix?} +\calls{intloopReadConsole}{intnplisp} +\calls{intloopReadConsole}{setCurrentLine} +\calls{intloopReadConsole}{ncloopCommand} +\calls{intloopReadConsole}{concat} +\calls{intloopReadConsole}{ncloopEscaped} +\calls{intloopReadConsole}{intloopProcessString} +\usesdollar{intloopReadConsole}{dalymode} +\label{intloopReadConsole} +\sig{intloopReadConsole}{(String Integer)}{Throw} +\begin{chunk}{defun intloopReadConsole} +(defun |intloopReadConsole| (prefix stepNumber) + (declare (special $dalymode)) + (let (newStepNo cmd pfx input) + ; read the next line + (setq input (|serverReadLine| *standard-input*)) + ; if we have lost *standard-input* then exit Axiom + (when (null (stringp input)) (|leaveScratchpad|)) + ; if the input is a zero-length input, recurse + (when (eql (length input) 0) + (princ (mkprompt)) + (|intloopReadConsole| "" stepNumber)) + ; if $dalymode is nonnil anything starting with '(' is a lisp expression + ; evaluate the expression in lisp and recurse + (when (and $dalymode (|intloopPrefix?| "(" input)) + (|intnplisp| input) + (princ (mkprompt)) + (|intloopReadConsole| "" stepNumber)) + ; if the input starts with ")fi" or ")fin" throw into lisp + (setq pfx (|intloopPrefix?| ")fi" input)) + (when (and pfx (or (string= pfx ")fi") (string= pfx ")fin"))) + (throw '|top_level| nil)) + ; if the input starts with ')' it is a command; execute and recurse + (when (and (equal prefix "") (setq cmd (|intloopPrefix?| ")" input))) + (|setCurrentLine| cmd) + (setq newStepNo (|ncloopCommand| cmd stepNumber)) + (princ (mkprompt)) + (|intloopReadConsole| "" newStepNo)) + ; if the last non-blank character on the line is an underscore + ; we use the current accumulated input as a prefix and recurse. + ; this has the effect of concatenating the next line (minus the underscore) + (setq input (concat prefix input)) + (when (|ncloopEscaped| input) + (|intloopReadConsole| (subseq input 0 (- (length input) 1)) stepNumber)) + ; if there are no special cases, process the current line and recurse + (setq newStepNo (|intloopProcessString| input stepNumber)) + (princ (mkprompt)) + (|intloopReadConsole| "" newStepNo))) + +\end{chunk} + +\section{Helper Functions} +\defunsec{getenviron}{Get the value of an evironment variable} +\calls{getenviron}{getenv} +\begin{chunk}{defun getenviron 0} +(defun getenviron (var) + "Get the value of an evironment variable" + #+allegro (sys::getenv (string var)) + #+clisp (ext:getenv (string var)) + #+(or cmu scl) + (cdr + (assoc (string var) ext:*environment-list* :test #'equalp :key #'string)) + #+(or kcl akcl gcl) (si::getenv (string var)) + #+lispworks (lw:environment-variable (string var)) + #+lucid (lcl:environment-variable (string var)) + #+mcl (ccl::getenv var) + #+sbcl (sb-ext:posix-getenv var) + ) + +\end{chunk} + +\defdollar{intCoerceFailure} +\begin{chunk}{initvars} +(defvar |$intCoerceFailure| '|coerceFailure|) + +\end{chunk} + +\defdollar{intSpadReader} +\begin{chunk}{initvars} +(defvar |$intSpadReader| 'SPAD_READER) + +\end{chunk} + +\defun{InterpExecuteSpadSystemCommand}{InterpExecuteSpadSystemCommand} +\catches{InterpExecuteSpadSystemCommand}{intCoerceFailure} +\catches{InterpExecuteSpadSystemCommand}{intSpadReader} +\calls{InterpExecuteSpadSystemCommand}{ExecuteInterpSystemCommand} +\usesdollar{InterpExecuteSpadSystemCommand}{intSpadReader} +\usesdollar{InterpExecuteSpadSystemCommand}{intCoerceFailure} +\begin{chunk}{defun InterpExecuteSpadSystemCommand} +(defun |InterpExecuteSpadSystemCommand| (string) + (declare (special |$intSpadReader| |$intCoerceFailure|)) + (catch |$intCoerceFailure| + (catch |$intSpadReader| + (|ExecuteInterpSystemCommand| string)))) + +\end{chunk} + +\defun{ExecuteInterpSystemCommand}{ExecuteInterpSystemCommand} +\calls{ExecuteInterpSystemCommand}{intProcessSynonyms} +\calls{ExecuteInterpSystemCommand}{substring} +\calls{ExecuteInterpSystemCommand}{doSystemCommand} +\usesdollar{ExecuteInterpSystemCommand}{currentLine} +\begin{chunk}{defun ExecuteInterpSystemCommand} +(defun |ExecuteInterpSystemCommand| (string) + (let (|$currentLine|) + (declare (special |$currentLine|)) + (setq string (|intProcessSynonyms| string)) + (setq |$currentLine| string) + (setq string (substring string 1 nil)) + (unless (equal string "") (|doSystemCommand| string)))) + +\end{chunk} + +\defun{substring}{substring} +\begin{chunk}{defun substring 0} +(defun substring (cvec start length) + (if length + (subseq (string cvec) start (+ start length)) + (subseq (string cvec) start))) + +\end{chunk} + +\defun{intProcessSynonyms}{Handle Synonyms} +\calls{intProcessSynonyms}{processSynonyms} +\uses{intProcessSynonyms}{line} +\begin{chunk}{defun intProcessSynonyms} +(defun |intProcessSynonyms| (str) + (let ((line str)) + (declare (special line)) + (|processSynonyms|) + line)) + +\end{chunk} + +\defun{processSynonyms}{Synonym File Reader} +\calls{processSynonyms}{strpos} +\calls{processSynonyms}{substring} +\calls{processSynonyms}{string2id-n} +\calls{processSynonyms}{lassoc} +\calls{processSynonyms}{strconc} +\calls{processSynonyms}{size} +\calls{processSynonyms}{concat} +\calls{processSynonyms}{rplacstr} +\calls{processSynonyms}{processSynonyms} +\usesdollar{processSynonyms}{CommandSynonymAlist} +\uses{processSynonyms}{line} +\begin{chunk}{defun processSynonyms} +(defun |processSynonyms| () + (let (fill p aline synstr syn to opt fun cl chr) + (declare (special |$CommandSynonymAlist| line)) + (setq p (strpos ")" line 0 nil)) + (setq fill "") + (cond + (p + (setq aline (substring line p nil)) + (when (> p 0) (setq fill (substring line 0 p)))) + (t + (setq p 0) + (setq aline line))) + (setq to (strpos " " aline 1 nil)) + (cond (to (setq to (1- to)))) + (setq synstr (substring aline 1 to)) + (setq syn (string2id-n synstr 1)) + (when (setq fun (lassoc syn |$CommandSynonymAlist|)) + (setq to (strpos ")" fun 1 nil)) + (cond + ((and to (not (eql to (1- (size fun))))) + (setq opt (strconc " " (substring fun to nil))) + (setq fun (substring fun 0 (1- to )))) + (t (setq opt " "))) + (when (> (size synstr) (size fun)) + (do ((G167173 (size synstr)) (i (size fun) (1+ i))) + ((> i G167173) nil) + (setq fun (concat fun " ")))) + (setq cl (strconc fill (rplacstr aline 1 (size synstr) fun) opt)) + (setq line cl) + (setq chr (elt line (1+ p))) + (|processSynonyms|)))) + +\end{chunk} + +\defun{init-memory-config}{init-memory-config} +Austin-Kyoto Common Lisp (AKCL), now known as Gnu Common Lisp (GCL) +requires some changes to the default memory setup to run Axiom efficently. +This function performs those setup commands. + +\calls{init-memory-config}{allocate} +\calls{init-memory-config}{allocate-contiguous-pages} +\calls{init-memory-config}{allocate-relocatable-pages} +\calls{init-memory-config}{set-hole-size} +\begin{chunk}{defun init-memory-config 0} +(defun init-memory-config (&key + (cons 500) + (fixnum 200) + (symbol 500) + (package 8) + (array 400) + (string 500) + (cfun 100) + (cpages 3000) + (rpages 1000) + (hole 2000) ) + ;; initialize AKCL memory allocation parameters + #+:AKCL + (progn + (system:allocate 'cons cons) + (system:allocate 'fixnum fixnum) + (system:allocate 'symbol symbol) + (system:allocate 'package package) + (system:allocate 'array array) + (system:allocate 'string string) + (system:allocate 'cfun cfun) + (system:allocate-contiguous-pages cpages) + (system:allocate-relocatable-pages rpages) + (system:set-hole-size hole)) + #-:AKCL + nil) + +\end{chunk} + +\defunsec{initroot}{Set spadroot to be the AXIOM shell variable} +Sets up the system to use the {\bf AXIOM} shell variable if we can +and default to the {\bf \$spadroot} variable (which was the value +of the {\bf AXIOM} shell variable at build time) if we can't. + +\calls{initroot}{reroot} +\calls{initroot}{getenviron} +\usesdollar{initroot}{spadroot} +\begin{chunk}{defun initroot} +(defun initroot (&optional (newroot (getenviron "AXIOM"))) + "Set spadroot to be the AXIOM shell variable" + (declare (special $spadroot)) + (reroot (or newroot $spadroot (error "setenv AXIOM or (setq $spadroot)")))) + +\end{chunk} + +\defunsec{intloopPrefix?}{Does the string start with this prefix?} +If the prefix string is the same as the whole string initial characters +--R(ignoring spaces in the whole string) then we return the whole string +minus any leading spaces. +\label{intloopPrefix?} +\sig{intloopPrefix?}{String}{Union(String,NIL)} +\begin{chunk}{defun intloopPrefix? 0} +(defun |intloopPrefix?| (prefix whole) + "Does the string start with this prefix?" + (let ((newprefix (string-left-trim '(#\space) prefix)) + (newwhole (string-left-trim '(#\space) whole))) + (when (<= (length newprefix) (length newwhole)) + (when (string= newprefix newwhole :end2 (length prefix)) + newwhole)))) + +\end{chunk} + +\defun{intnplisp}{Interpret a line of lisp code} +This is used to hande {\tt )lisp} top level commands +\calls{intnplisp}{nplisp} +\usesdollar{intnplisp}{currentLine} +\label{intnplisp} +\begin{chunk}{defun intnplisp} +(defun |intnplisp| (s) + (declare (special |$currentLine|)) + (setq |$currentLine| s) + (|nplisp| |$currentLine|)) + +\end{chunk} + +\defunsec{get-current-directory}{Get the current directory} +\begin{chunk}{defun get-current-directory 0} +(defun get-current-directory () + "Get the current directory" + (namestring (truename ""))) + +\end{chunk} + +\defunsec{make-absolute-filename}{Prepend the absolute path to a filename} +Prefix a filename with the {\bf AXIOM} shell variable. + +\usesdollar{make-absolute-filename}{spadroot} +\begin{chunk}{defun make-absolute-filename 0} +(defun make-absolute-filename (name) + "Prepend the absolute path to a filename" + (declare (special $spadroot)) + (concatenate 'string $spadroot name)) + +\end{chunk} + +\defunsec{makeInitialModemapFrame}{Make the initial modemap frame} +\calls{makeInitialModemapFrame}{copy} +\usesdollar{makeInitialModemapFrame}{InitialModemapFrame} +\begin{chunk}{defun makeInitialModemapFrame 0} +(defun |makeInitialModemapFrame| () + "Make the initial modemap frame" + (declare (special |$InitialModemapFrame|)) + (copy |$InitialModemapFrame|)) + +\end{chunk} + +\defun{ncloopEscaped}{ncloopEscaped} +The ncloopEscaped function will return true if the last non-blank +character of a line is an underscore, the Axiom line-continuation +character. Otherwise, it returns nil. +\begin{chunk}{defun ncloopEscaped 0} +(defun |ncloopEscaped| (x) + (let ((l (length x))) + (dotimes (i l) + (when (char= (char x (- l i 1)) #\_) (return t)) + (unless (char= (char x (- l i 1)) #\space) (return nil))))) + +\end{chunk} + +\defun{intloopProcessString}{intloopProcessString} +\calls{intloopProcessString}{setCurrentLine} +\calls{intloopProcessString}{intloopProcess} +\calls{intloopProcessString}{next} +\calls{intloopProcessString}{incString} +\label{intloopProcessString} +\sig{intloopProcessString}{(String,StepNo)}{StepNo} +\begin{chunk}{defun intloopProcessString} +(defun |intloopProcessString| (currentline stepno) + (|setCurrentLine| currentline) + (|intloopProcess| stepno t + (|next| #'|ncloopParse| + (|next| #'|lineoftoks| (|incString| currentline))))) + +\end{chunk} + +\defun{ncloopParse}{ncloopParse} +\calls{ncloopParse}{ncloopDQlines} +\calls{ncloopParse}{npParse} +\calls{ncloopParse}{dqToList} +\begin{chunk}{defun ncloopParse} +(defun |ncloopParse| (s) + (let (cudr lines stream dq t1) + (setq t1 (car s)) + (setq dq (car t1)) + (setq stream (cadr t1)) + (setq t1 (|ncloopDQlines| dq stream)) + (setq lines (car t1)) + (setq cudr (cadr t1)) + (cons (list (list lines (|npParse| (|dqToList| dq)))) (cdr s)))) + +\end{chunk} + +\defun{next}{next} +\calls{next}{Delay} +\calls{next}{next1} +\label{next} +\sig{next}{(Function,Delay)}{Delay} +\begin{chunk}{defun next} +(defun |next| (function delay) + (|Delay| #'|next1| (list function delay))) + +\end{chunk} + +\defun{next1}{next1} +\calls{next1}{StreamNull} +\calls{next1}{incAppend} +\calls{next1}{next} +\label{next1} +\sig{next1}{Delay}{ParsePair} +\begin{chunk}{defun next1} +(defun |next1| (&rest delayArg) + (let (h delay function) + (setq function (car delayArg)) + (setq delay (cadr delayArg)) + (cond + ((|StreamNull| delay) |StreamNil|) + (t + (setq h (apply function (list delay))) + (|incAppend| (car h) (|next| function (cdr h))))))) + +\end{chunk} + +\defun{incString}{incString} +The {\bf incString} function gets a string, usually from Axiom's input, +and constructs a set of nested function calls to process the input line. +\calls{incString}{incRenumber} +\calls{incString}{incLude} +\uses{incString}{Top} +\label{incString} +\sig{incString}{String}{Function} +\begin{chunk}{defun incString} +(defun |incString| (s) + (declare (special |Top|)) + (|incRenumber| (|incLude| 0 (list s) 0 (list "strings") (list |Top|)))) + +\end{chunk} + +\defunsec{reclaim}{Call the garbage collector} +Call the garbage collector on various platforms. +\begin{chunk}{defun reclaim 0} +#+abcl +(defun reclaim () "Call the garbage collector" (ext::gc)) +#+:allegro +(defun reclaim () "Call the garbage collector" (excl::gc t)) +#+:CCL +(defun reclaim () "Call the garbage collector" (gc)) +#+clisp +(defun reclaim () + "Call the garbage collector" + (#+lisp=cl ext::gc #-lisp=cl lisp::gc)) +#+(or :cmulisp :cmu) +(defun reclaim () "Call the garbage collector" (ext:gc)) +#+cormanlisp +(defun reclaim () "Call the garbage collector" (cl::gc)) +#+(OR IBCL KCL GCL) +(defun reclaim () "Call the garbage collector" (si::gbc t)) +#+lispworks +(defun reclaim () "Call the garbage collector" (hcl::normal-gc)) +#+Lucid +(defun reclaim () "Call the garbage collector" (lcl::gc)) +#+sbcl +(defun reclaim () "Call the garbage collector" (sb-ext::gc)) + +\end{chunk} + +\defun{reroot}{reroot} +The reroot function is used to reset the important variables used by +the system. In particular, these variables are sensitive to the +{\bf AXIOM} shell variable. That variable is renamed internally to +be {\bf \$spadroot}. The {\bf reroot} function will change the +system to use a new root directory and will have the same effect +as changing the {\bf AXIOM} shell variable and rerunning the system +from scratch. Note that we have changed from the +NAG distribution back to the original form. If you need the NAG +version you can push {\bf :tpd} on the {\bf *features*} variable +before compiling this file. A correct call looks like: +\begin{verbatim} + (in-package "BOOT") + (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} +\usesdollar{reroot}{relative-directory-list} +\usesdollar{reroot}{library-directory-list} +\usesdollar{reroot}{relative-library-directory-list} +\usesdollar{reroot}{defaultMsgDatabaseName} +\usesdollar{reroot}{msgDatabaseName} +\usesdollar{reroot}{current-directory} +\begin{chunk}{defun reroot} +(defun reroot (dir) + (declare (special $spadroot $directory-list $relative-directory-list + $library-directory-list $relative-library-directory-list + |$defaultMsgDatabaseName| |$msgDatabaseName| $current-directory)) + (setq $spadroot dir) + (setq $directory-list + (mapcar #'make-absolute-filename $relative-directory-list)) + (setq $library-directory-list + (mapcar #'make-absolute-filename $relative-library-directory-list)) + (setq |$defaultMsgDatabaseName| + (pathname (make-absolute-filename "/doc/msgs/s2-us.msgs"))) + (setq |$msgDatabaseName| ()) + (setq $current-directory $spadroot)) + +\end{chunk} + +\defdollar{current-directory} +\begin{chunk}{initvars} +(defvar |$currentLine| "" "A list of the input line history") + +\end{chunk} + +\defun{setCurrentLine}{setCurrentLine} +Remember the current line. The cases are: +\begin{itemize} +\item If there is no \$currentLine set it to the input +\item Is the current line a string and the input a string? + Make them into a list +\item Is \$currentLine not a cons cell? Make it one. +\item Is the input a string? Cons it on the end of the list. +\item Otherwise stick it on the end of the list +\end{itemize} +\usesdollar{setCurrentLine}{currentLine} +\label{setCurrentLine} +\sig{setCurrentLine}{String}{List(String)} +\begin{chunk}{defun setCurrentLine 0} +(defun |setCurrentLine| (s) + (declare (special |$currentLine|)) + (cond + ((null |$currentLine|) (setq |$currentLine| s)) + ((and (stringp |$currentLine|) (stringp s)) + (setq |$currentLine| (list |$currentLine| s))) + ((not (consp |$currentLine|)) (setq |$currentLine| (cons |$currentLine| s))) + ((stringp s) (rplacd (last |$currentLine|) (cons s nil))) + (t (rplacd (last |$currentLine|) s))) + |$currentLine|) + +\end{chunk} + +\defunsec{mkprompt}{Show the Axiom prompt} +\calls{mkprompt}{concat} +\calls{mkprompt}{substring} +\calls{mkprompt}{currenttime} +\usesdollar{mkprompt}{inputPromptType} +\usesdollar{mkprompt}{IOindex} +\usesdollar{mkprompt}{interpreterFrameName} +\label{mkprompt} +\sig{mkprompt}{Void}{String} +\begin{chunk}{defun mkprompt} +(defun mkprompt () + "Show the Axiom prompt" + (declare (special |$inputPromptType| |$IOindex| |$interpreterFrameName|)) + (case |$inputPromptType| + (|none| "") + (|plain| "-> ") + (|step| (concat "(" (princ-to-string |$IOindex|) ") -> ")) + (|frame| + (concat (princ-to-string |$interpreterFrameName|) " (" + (princ-to-string |$IOindex|) ") -> ")) + (t (concat (princ-to-string |$interpreterFrameName|) " [" + (substring (currenttime) 8 nil) "] [" + (princ-to-string |$IOindex|) "] -> ")))) + +\end{chunk} + +\defdollar{frameAlist} +\begin{chunk}{initvars} +(defvar |$frameAlist| nil) + +\end{chunk} +\defdollar{frameNumber} +\begin{chunk}{initvars} +(defvar |$frameNumber| 0) + +\end{chunk} +\defdollar{currentFrameNum} +\begin{chunk}{initvars} +(defvar |$currentFrameNum| 0) + +\end{chunk} + +\defdollar{EndServerSession} +\begin{chunk}{initvars} +(defvar |$EndServerSession| nil) + +\end{chunk} + +\defdollar{NeedToSignalSessionManager} +\begin{chunk}{initvars} +(defvar |$NeedToSignalSessionManager| nil) + +\end{chunk} + +\defdollar{sockBufferLength} +\begin{chunk}{initvars} +(defvar |$sockBufferLength| 9217) + +\end{chunk} + +\defunsec{serverReadLine}{READ-LINE in an Axiom server system} +\catches{serverReadLine}{coerceFailure} +\catches{serverReadLine}{top-level} +\catches{serverReadLine}{spad-reader} +\calls{serverReadLine}{read-line} +\calls{serverReadLine}{addNewInterpreterFrame} +\calls{serverReadLine}{sockSendInt} +\calls{serverReadLine}{sockSendString} +\calls{serverReadLine}{mkprompt} +\calls{serverReadLine}{sockGetInt} +\calls{serverReadLine}{lassoc} +\calls{serverReadLine}{changeToNamedInterpreterFrame} +\calls{serverReadLine}{sockGetString} +\calls{serverReadLine}{unescapeStringsInForm} +\calls{serverReadLine}{protectedEVAL} +\calls{serverReadLine}{executeQuietCommand} +\calls{serverReadLine}{parseAndInterpret} +\seebook{serverReadLine}{is-console}{9} +\calls{serverReadLine}{serverSwitch} +\usesdollar{serverReadLine}{KillLispSystem} +\usesdollar{serverReadLine}{NonSmanSession} +\usesdollar{serverReadLine}{SpadCommand} +\usesdollar{serverReadLine}{QuietSpadCommand} +\usesdollar{serverReadLine}{MenuServer} +\usesdollar{serverReadLine}{sockBufferLength} +\usesdollar{serverReadLine}{LispCommand} +\usesdollar{serverReadLine}{EndServerSession} +\usesdollar{serverReadLine}{EndSession} +\usesdollar{serverReadLine}{SwitchFrames} +\usesdollar{serverReadLine}{CreateFrameAnswer} +\usesdollar{serverReadLine}{currentFrameNum} +\usesdollar{serverReadLine}{frameNumber} +\usesdollar{serverReadLine}{frameAlist} +\usesdollar{serverReadLine}{CreateFrame} +\usesdollar{serverReadLine}{CallInterp} +\usesdollar{serverReadLine}{EndOfOutput} +\usesdollar{serverReadLine}{SessionManager} +\usesdollar{serverReadLine}{NeedToSignalSessionManager} +\usesdollar{serverReadLine}{EndServerSession} +\usesdollar{serverReadLine}{SpadServer} +\uses{serverReadLine}{*eof*} +\uses{serverReadLine}{in-stream} +\label{serverReadLine} +\sig{serverReadLine}{Stream}{String} +\begin{chunk}{defun serverReadLine} +(defun |serverReadLine| (stream) + "used in place of READ-LINE in a Axiom server system." + (let (in-stream *eof* l framename currentframe form stringbuf line action) + (declare (special in-stream *eof* |$SpadServer| |$EndServerSession| + |$NeedToSignalSessionManager| |$SessionManager| |$EndOfOutput| + |$CallInterp| |$CreateFrame| |$frameAlist| |$frameNumber| + |$currentFrameNum| |$CreateFrameAnswer| |$SwitchFrames| |$EndSession| + |$EndServerSession| |$LispCommand| |$sockBufferLength| |$MenuServer| + |$QuietSpadCommand| |$SpadCommand| |$NonSmanSession| |$KillLispSystem|)) + (force-output) + (if (or (null |$SpadServer|) (null (is-console stream))) + (|read-line| stream) + (progn + (setq in-stream stream) + (setq *eof* nil) + (setq line + (do () + ((null (and (null |$EndServerSession|) (null *eof*))) nil) + (when |$NeedToSignalSessionManager| + (|sockSendInt| |$SessionManager| |$EndOfOutput|)) + (setq |$NeedToSignalSessionManager| nil) + ; see bookvol8 for the constants that serverSwitch returns + (setq action (|serverSwitch|)) + (cond + ((= action |$CallInterp|) + (setq l (|read-line| stream)) + (setq |$NeedToSignalSessionManager| t) + (return l)) + ((= action |$CreateFrame|) + (setq framename (gentemp "frame")) + (|addNewInterpreterFrame| framename) + (setq |$frameAlist| + (cons (cons |$frameNumber| framename) |$frameAlist|)) + (setq |$currentFrameNum| |$frameNumber|) + (|sockSendInt| |$SessionManager| |$CreateFrameAnswer|) + (|sockSendInt| |$SessionManager| |$frameNumber|) + (setq |$frameNumber| (1+ |$frameNumber|)) + (|sockSendString| |$SessionManager| (mkprompt))) + ((= action |$SwitchFrames|) + (setq |$currentFrameNum| (|sockGetInt| |$SessionManager|)) + (setq currentframe (lassoc |$currentFrameNum| |$frameAlist|)) + (|changeToNamedInterpreterFrame| currentframe)) + ((= action |$EndSession|) + (setq |$EndServerSession| t)) + ((= action |$LispCommand|) + (setq |$NeedToSignalSessionManager| t) + (setq stringbuf (make-string |$sockBufferLength|)) + (|sockGetString| |$MenuServer| stringbuf |$sockBufferLength|) + (setq form (|unescapeStringsInForm| (read-from-string stringbuf))) + (|protectedEVAL| form)) + ((= action |$QuietSpadCommand|) + (setq |$NeedToSignalSessionManager| t) + (|executeQuietCommand|)) + ((= action |$SpadCommand|) + (setq |$NeedToSignalSessionManager| t) + (setq stringbuf (make-string 512)) + (|sockGetString| |$MenuServer| stringbuf 512) + (catch '|coerceFailure| + (catch '|top_level| + (catch 'spad_reader + (|parseAndInterpret| stringbuf)))) + (princ (mkprompt)) + (finish-output)) + ((= action |$NonSmanSession|) (setq |$SpadServer| nil)) + ((= action |$KillLispSystem|) (bye)) + (t nil)))) + (cond + (line line) + (t '||)))))) + +\end{chunk} + +\defun{protectedEVAL}{protectedEVAL} +\calls{protectedEVAL}{resetStackLimits} +\calls{protectedEVAL}{sendHTErrorSignal} +\begin{chunk}{defun protectedEVAL} +(defun |protectedEVAL| (x) + (let (val (error t)) + (unwind-protect + (progn + (setq val (eval x)) + (setq error nil)) + (when error + (|resetStackLimits|) + (|sendHTErrorSignal|))) + (unless error val))) + +\end{chunk} + +\defdollar{QuietCommand} +\begin{chunk}{initvars} +(defvar |$QuietCommand| nil "If true, produce no top level output") + +\end{chunk} + +\defun{executeQuietCommand}{executeQuietCommand} +When \verb|$QuiteCommand| is true Spad will not produce any output from +a top level command + +\catches{executeQuietCommand}{spad-reader} +\catches{executeQuietCommand}{coerceFailure} +\catches{executeQuietCommand}{toplevel} +\catches{executeQuietCommand}{spadreader} +\calls{executeQuietCommand}{make-string} +\calls{executeQuietCommand}{sockGetString} +\calls{executeQuietCommand}{parseAndInterpret} +\usesdollar{executeQuietCommand}{MenuServer} +\usesdollar{executeQuietCommand}{QuietCommand} +\begin{chunk}{defun executeQuietCommand} +(defun |executeQuietCommand| () + (let (|$QuietCommand| stringBuf) + (declare (special |$QuietCommand| |$MenuServer|)) + (setq |$QuietCommand| t) + (setq stringBuf (make-string 512)) + (|sockGetString| |$MenuServer| stringBuf 512) + (catch '|coerceFailure| + (catch '|top_level| + (catch 'spad_reader (|parseAndInterpret| stringBuf)))))) + +\end{chunk} + +\defun{parseAndInterpret}{parseAndInterpret} +\usesdollar{parseAndInterpret}{InteractiveMode} +\usesdollar{parseAndInterpret}{boot} +\usesdollar{parseAndInterpret}{spad} +\usesdollar{parseAndInterpret}{e} +\usesdollar{parseAndInterpret}{InteractiveFrame} +\begin{chunk}{defun parseAndInterpret} +(defun |parseAndInterpret| (str) + (let (|$InteractiveMode| $boot $spad |$e|) + (declare (special |$InteractiveMode| $boot $spad |$e| + |$InteractiveFrame|)) + (setq |$InteractiveMode| t) + (setq $boot nil) + (setq $spad t) + (setq |$e| |$InteractiveFrame|) + (|processInteractive| (|parseFromString| str) nil))) + +\end{chunk} + +\defun{parseFromString}{parseFromString} +\calls{parseFromString}{next} +\calls{parseFromString}{ncloopParse} +\calls{parseFromString}{lineoftoks} +\calls{parseFromString}{incString} +\calls{parseFromString}{StreamNull} +\calls{parseFromString}{pf2Sex} +\calls{parseFromString}{macroExpanded} +\begin{chunk}{defun parseFromString} +(defun |parseFromString| (s) + (setq s (|next| #'|ncloopParse| (|next| #'|lineoftoks| (|incString| s)))) + (unless (|StreamNull| s) (|pf2Sex| (|macroExpanded| (cadar s))))) + +\end{chunk} + +\defdollar{interpOnly} +\begin{chunk}{initvars} +(defvar |$interpOnly| nil) + +\end{chunk} + +\defdollar{minivectorNames} +\begin{chunk}{initvars} +(defvar |$minivectorNames| nil) + +\end{chunk} + +\defdollar{domPvar} +\begin{chunk}{initvars} +(defvar |$domPvar| nil) + +\end{chunk} + +\defdollar{compilingMap} +{\bf \verb|$compilingMap|}: true when compiling a map, used to +detect where to THROW when interpret-only is invoked +\begin{chunk}{initvars} +(defvar |$compilingMap| ()) + +\end{chunk} + +\defdollar{instantRecord} +\begin{chunk}{initvars} +(setq |$instantRecord| (make-hash-table :test #'eq)) + +\end{chunk} + +\defun{processInteractive}{processInteractive} +Parser Output {\tt -->} Interpreter + +Top-level dispatcher for the interpreter. It sets local variables +and then calls processInteractive1 to do most of the work. +This function receives the output from the parser. + +\calls{processInteractive}{initializeTimedNames} +\calls{processInteractive}{qcar} +\calls{processInteractive}{processInteractive1} +\calls{processInteractive}{reportInstantiations} +\calls{processInteractive}{clrhash} +\calls{processInteractive}{writeHistModesAndValues} +\calls{processInteractive}{updateHist} +\usesdollar{processInteractive}{op} +\usesdollar{processInteractive}{Coerce} +\usesdollar{processInteractive}{compErrorMessageStack} +\usesdollar{processInteractive}{freeVars} +\usesdollar{processInteractive}{mapList} +\usesdollar{processInteractive}{compilingMap} +\usesdollar{processInteractive}{compilingLoop} +\usesdollar{processInteractive}{interpOnly} +\usesdollar{processInteractive}{whereCacheList} +\usesdollar{processInteractive}{timeGlobalName} +\usesdollar{processInteractive}{StreamFrame} +\usesdollar{processInteractive}{declaredMode} +\usesdollar{processInteractive}{localVars} +\usesdollar{processInteractive}{analyzingMapList} +\usesdollar{processInteractive}{lastLineInSEQ} +\usesdollar{processInteractive}{instantCoerceCount} +\usesdollar{processInteractive}{instantCanCoerceCount} +\usesdollar{processInteractive}{instantMmCondCount} +\usesdollar{processInteractive}{fortVar} +\usesdollar{processInteractive}{minivector} +\usesdollar{processInteractive}{minivectorCode} +\usesdollar{processInteractive}{minivectorNames} +\usesdollar{processInteractive}{domPvar} +\usesdollar{processInteractive}{inRetract} +\usesdollar{processInteractive}{instantRecord} +\usesdollar{processInteractive}{reportInstantiations} +\usesdollar{processInteractive}{ProcessInteractiveValue} +\usesdollar{processInteractive}{defaultFortVar} +\usesdollar{processInteractive}{interpreterTimedNames} +\usesdollar{processInteractive}{interpreterTimedClasses} +\begin{chunk}{defun processInteractive} +(defun |processInteractive| (form posnForm) + (let (|$op| |$Coerce| |$compErrorMessageStack| |$freeVars| + |$mapList| |$compilingMap| |$compilingLoop| + |$interpOnly| |$whereCacheList| |$timeGlobalName| + |$StreamFrame| |$declaredMode| |$localVars| + |$analyzingMapList| |$lastLineInSEQ| + |$instantCoerceCount| |$instantCanCoerceCount| + |$instantMmCondCount| |$fortVar| |$minivector| + |$minivectorCode| |$minivectorNames| |$domPvar| + |$inRetract| object) + (declare (special |$op| |$Coerce| |$compErrorMessageStack| + |$freeVars| |$mapList| |$compilingMap| + |$compilingLoop| |$interpOnly| |$whereCacheList| + |$timeGlobalName| |$StreamFrame| |$declaredMode| + |$localVars| |$analyzingMapList| |$lastLineInSEQ| + |$instantCoerceCount| |$instantCanCoerceCount| + |$instantMmCondCount| |$fortVar| |$minivector| + |$minivectorCode| |$minivectorNames| |$domPvar| + |$inRetract| |$instantRecord| |$reportInstantiations| + |$ProcessInteractiveValue| |$defaultFortVar| + |$interpreterTimedNames| |$interpreterTimedClasses|)) + (|initializeTimedNames| |$interpreterTimedNames| |$interpreterTimedClasses|) + (if (consp form) ; compute name of operator + (setq |$op| (qcar form)) + (setq |$op| form)) + (setq |$Coerce| nil) + (setq |$compErrorMessageStack| nil) + (setq |$freeVars| nil) + (setq |$mapList| nil) ; list of maps being type analyzed + (setq |$compilingMap| nil) ; true when compiling a map + (setq |$compilingLoop| nil) ; true when compiling a loop body + (setq |$interpOnly| nil) ; true when in interp only mode + (setq |$whereCacheList| nil) ; maps compiled because of where + (setq |$timeGlobalName| '|$compTimeSum|); see incrementTimeSum + (setq |$StreamFrame| nil) ; used in printing streams + (setq |$declaredMode| nil) ; weak type propagation for symbols + (setq |$localVars| nil) ; list of local variables in function + (setq |$analyzingMapList| nil) ; names of maps currently being analyzed + (setq |$lastLineInSEQ| t) ; see evalIF and friends + (setq |$instantCoerceCount| 0) + (setq |$instantCanCoerceCount| 0) + (setq |$instantMmCondCount| 0) + (setq |$defaultFortVar| 'x) ; default FORTRAN variable name + (setq |$fortVar| |$defaultFortVar|) ; variable name for FORTRAN output + (setq |$minivector| nil) + (setq |$minivectorCode| nil) + (setq |$minivectorNames| nil) + (setq |$domPvar| nil) + (setq |$inRetract| nil) + (setq object (|processInteractive1| form posnForm)) + (unless |$ProcessInteractiveValue| + (when |$reportInstantiations| + (|reportInstantiations|) + (clrhash |$instantRecord|)) + (|writeHistModesAndValues|) + (|updateHist|)) + object)) + +\end{chunk} + +\defdollar{ProcessInteractiveValue} +\begin{chunk}{initvars} +(defvar |$ProcessInteractiveValue| nil "If true, no output or record") + +\end{chunk} + +\defdollar{HTCompanionWindowID} +\begin{chunk}{initvars} +(defvar |$HTCompanionWindowID| nil) + +\end{chunk} + +\defun{processInteractive1}{processInteractive1} +This calls the analysis and output printing routines +\calls{processInteractive1}{recordFrame} +\calls{processInteractive1}{startTimingProcess} +\calls{processInteractive1}{interpretTopLevel} +\calls{processInteractive1}{stopTimingProcess} +\calls{processInteractive1}{recordAndPrint} +\calls{processInteractive1}{objValUnwrap} +\calls{processInteractive1}{objMode} +\usesdollar{processInteractive1}{e} +\usesdollar{processInteractive1}{ProcessInteractiveValue} +\usesdollar{processInteractive1}{InteractiveFrame} +\begin{chunk}{defun processInteractive1} +(defun |processInteractive1| (form posnForm) + (let (|$e| object) + (declare (special |$e| |$ProcessInteractiveValue| |$InteractiveFrame|)) + (setq |$e| |$InteractiveFrame|) + (|recordFrame| '|system|) + (|startTimingProcess| '|analysis|) + (setq object (|interpretTopLevel| form posnForm)) + (|stopTimingProcess| '|analysis|) + (|startTimingProcess| '|print|) + (unless |$ProcessInteractiveValue| + (|recordAndPrint| (|objValUnwrap| object) (|objMode| object))) + (|recordFrame| '|normal|) + (|stopTimingProcess| '|print|) + object)) + +\end{chunk} + +\defun{interpretTopLevel}{interpretTopLevel} +\catches{interpretTopLevel}{interpreter} +\calls{interpretTopLevel}{interpret} +\calls{interpretTopLevel}{stopTimingProcess} +\calls{interpretTopLevel}{peekTimedName} +\calls{interpretTopLevel}{interpretTopLevel} +\usesdollar{interpretTopLevel}{timedNameStack} +\begin{chunk}{defun interpretTopLevel} +(defun |interpretTopLevel| (x posnForm) + (let (savedTimerStack c) + (declare (special |$timedNameStack|)) + (setq savedTimerStack (copy |$timedNameStack|)) + (setq c (catch '|interpreter| (|interpret| x posnForm))) + (do () + ((equal savedTimerStack |$timedNameStack|) nil) + (|stopTimingProcess| (|peekTimedName|))) + (if (eq c '|tryAgain|) + (|interpretTopLevel| x posnForm) + c))) + +\end{chunk} + +\defdollar{genValue} +If the \verb|$genValue| variable is true then evaluate generated code, +otherwise leave code unevaluated. If \verb|$genValue| is false then we +are compiling. This variable is only defined and used locally. +\begin{chunk}{initvars} +(defvar |$genValue| nil "evaluate generated code if true") + +\end{chunk} + +\defun{interpret}{Type analyzes and evaluates expression x, returns object} +\calls{interpret}{interpret1} +\usesdollar{interpret}{env} +\usesdollar{interpret}{eval} +\usesdollar{interpret}{genValue} +\begin{chunk}{defun interpret} +(defun |interpret| (&rest arg &aux restargs x) + (let (|$env| |$eval| |$genValue| posnForm) + (declare (special |$env| |$eval| |$genValue|)) + (setq x (car arg)) + (setq restargs (cdr arg)) + (if (consp restargs) + (setq posnForm (car restargs)) + (setq posnForm restargs)) + (setq |$env| (list (list nil))) + (setq |$eval| t) ; generate code -- don't just type analyze + (setq |$genValue| t) ; evaluate all generated code + (|interpret1| x nil posnForm))) + +\end{chunk} + +\defun{interpret1}{Dispatcher for the type analysis routines} +This is the dispatcher for the type analysis routines. It type analyzes and +evaluates the expression x in the rootMode (if non-nil) +which may be \verb|$EmptyMode|. It returns an object if evaluating, and a +modeset otherwise. It creates the attributed tree. + +\calls{interpret1}{mkAtreeWithSrcPos} +\calls{interpret1}{putTarget} +\calls{interpret1}{bottomUp} +\calls{interpret1}{getArgValue} +\calls{interpret1}{mkObj} +\calls{interpret1}{getValue} +\calls{interpret1}{interpret2} +\calls{interpret1}{keyedSystemError} +\usesdollar{interpret1}{genValue} +\usesdollar{interpret1}{eval} +\begin{chunk}{defun interpret1} +(defun |interpret1| (x rootMode posnForm) + (let (node modeSet newRootMode argVal val) + (declare (special |$genValue| |$eval|)) + (setq node (|mkAtreeWithSrcPos| x posnForm)) + (when rootMode (|putTarget| node rootMode)) + (setq modeSet (|bottomUp| node)) + (if (null |$eval|) + modeSet + (progn + (if (null rootMode) + (setq newRootMode (car modeSet)) + (setq newRootMode rootMode)) + (setq argVal (|getArgValue| node newRootMode)) + (cond + ((and argVal (null |$genValue|)) + (mkObj argVal newRootMode)) + ((and argVal (setq val (|getValue| node))) + (|interpret2| val newRootMode posnForm)) + (t + (|keyedSystemError| 'S2IS0053 (list x)))))))) + +\end{chunk} + +\defdollar{ThrowAwayMode} +\begin{chunk}{initvars} +(defvar |$ThrowAwayMode| '|$ThrowAwayMode| "interp constant") + +\end{chunk} + +\defun{interpret2}{interpret2} +This is the late interpretCoerce. I removed the call to +coerceInteractive, so it only does the JENKS cases. + +\calls{interpret2}{objVal} +\calls{interpret2}{objMode} +\calls{interpret2}{member} +\calls{interpret2}{mkObj} +\calls{interpret2}{systemErrorHere} +\calls{interpret2}{coerceInteractive} +\calls{interpret2}{throwKeyedMsgCannotCoerceWithValue} +\usesdollar{interpret2}{EmptyMode} +\usesdollar{interpret2}{ThrowAwayMode} +\begin{chunk}{defun interpret2} +(defun |interpret2| (object m1 posnForm) + (declare (ignore posnForm)) + (let (x m op ans) + (declare (special |$EmptyMode| |$ThrowAwayMode|)) + (cond + ((equal m1 |$ThrowAwayMode|) object) + (t + (setq x (|objVal| object)) + (setq m (|objMode| object)) + (cond + ((equal m |$EmptyMode|) + (cond + ((and (consp x) + (progn (setq op (qcar x)) t) + (|member| op '(map stream))) + (mkObj x m1)) + ((equal m1 |$EmptyMode|) + (mkObj x m)) + (t + (|systemErrorHere| "interpret2")))) + (m1 + (if (setq ans (|coerceInteractive| object m1)) + ans + (|throwKeyedMsgCannotCoerceWithValue| x m m1))) + (t object)))))) + +\end{chunk} + +\defdollar{runTestFlag} +This is referenced by maPrin to stash output by recordAndPrint to not +print type/time +\begin{chunk}{initvars} +(defvar |$runTestFlag| nil) + +\end{chunk} + +\defdollar{mkTestFlag} +This referenced by READLN to stash input by maPrin to stash output +by recordAndPrint to write i/o onto \verb|$testStream| +\begin{chunk}{initvars} +(defvar |$mkTestFlag| nil) + +\end{chunk} + +\defun{recordAndPrint}{Result Output Printing} +Prints out the value x which is of type m, and records the changes +in environment \verb|$e| into \verb|$InteractiveFrame| +\verb|$printAnyIfTrue| is documented in setvart.boot. +It is controlled with the {\tt )se me any} command. + +\calls{recordAndPrint}{output} +\calls{recordAndPrint}{putHist} +\calls{recordAndPrint}{mkObjWrap} +\calls{recordAndPrint}{printTypeAndTime} +\calls{recordAndPrint}{printStorage} +\calls{recordAndPrint}{printStatisticsSummary} +\calls{recordAndPrint}{mkCompanionPage} +\calls{recordAndPrint}{recordAndPrintTest} +\usesdollar{recordAndPrint}{outputMode} +\usesdollar{recordAndPrint}{mkTestOutputType} +\usesdollar{recordAndPrint}{runTestFlag} +\usesdollar{recordAndPrint}{e} +\usesdollar{recordAndPrint}{mkTestFlag} +\usesdollar{recordAndPrint}{HTCompanionWindowID} +\usesdollar{recordAndPrint}{QuietCommand} +\usesdollar{recordAndPrint}{printStatisticsSummaryIfTrue} +\usesdollar{recordAndPrint}{printTypeIfTrue} +\usesdollar{recordAndPrint}{printStorageIfTrue} +\usesdollar{recordAndPrint}{printTimeIfTrue} +\usesdollar{recordAndPrint}{Void} +\usesdollar{recordAndPrint}{algebraOutputStream} +\usesdollar{recordAndPrint}{collectOutput} +\usesdollar{recordAndPrint}{EmptyMode} +\usesdollar{recordAndPrint}{printVoidIfTrue} +\usesdollar{recordAndPrint}{outputMode} +\usesdollar{recordAndPrint}{printAnyIfTrue} +\begin{chunk}{defun recordAndPrint} +(defun |recordAndPrint| (x md) + (let (|$outputMode| xp mdp mode) + (declare (special |$outputMode| |$mkTestOutputType| |$runTestFlag| |$e| + |$mkTestFlag| |$HTCompanionWindowID| |$QuietCommand| + |$printStatisticsSummaryIfTrue| |$printTypeIfTrue| + |$printStorageIfTrue| |$printTimeIfTrue| |$Void| + |$algebraOutputStream| |$collectOutput| |$EmptyMode| + |$printVoidIfTrue| |$outputMode| |$printAnyIfTrue|)) + (cond + ((and (equal md '(|Any|)) |$printAnyIfTrue|) + (setq mdp (car x)) + (setq xp (cdr x))) + (t + (setq mdp md) + (setq xp x))) + (setq |$outputMode| md) + (if (equal md |$EmptyMode|) + (setq mode (|quadSch|)) + (setq mode md)) + (when (or (not (equal md |$Void|)) |$printVoidIfTrue|) + (unless |$collectOutput| (terpri |$algebraOutputStream|)) + (unless |$QuietCommand| (|output| xp mdp))) + (|putHist| '% '|value| (mkObjWrap x md) |$e|) + (when (or |$printTimeIfTrue| |$printTypeIfTrue|) + (|printTypeAndTime| xp mdp)) + (when |$printStorageIfTrue| (|printStorage|)) + (when |$printStatisticsSummaryIfTrue| (|printStatisticsSummary|)) + (when (integerp |$HTCompanionWindowID|) (|mkCompanionPage| md)) + (cond + (|$mkTestFlag| (|recordAndPrintTest| md)) + (|$runTestFlag| + (setq |$mkTestOutputType| md) + '|done|) + (t '|done|)))) + +\end{chunk} + +\defun{printStatisticsSummary}{printStatisticsSummary} +\calls{printStatisticsSummary}{sayKeyedMsg} +\calls{printStatisticsSummary}{statisticsSummary} +\usesdollar{printStatisticsSummary}{collectOutput} +\begin{chunk}{defun printStatisticsSummary} +(defun |printStatisticsSummary| () + (declare (special |$collectOutput|)) + (unless |$collectOutput| + (|sayKeyedMsg| 'S2GL0017 (list (|statisticsSummary|))))) + +\end{chunk} + +\defun{printStorage}{printStorage} +\calls{printStorage}{makeLongSpaceString} +\usesdollar{printStorage}{interpreterTimedClasses} +\usesdollar{printStorage}{collectOutput} +\usesdollar{printStorage}{interpreterTimedNames} +\begin{chunk}{defun printStorage} +(defun |printStorage| () + (declare (special |$interpreterTimedClasses| |$collectOutput| + |$interpreterTimedNames|)) + (unless |$collectOutput| + (|sayKeyedMsg| 'S2GL0016 + (list + (|makeLongSpaceString| + |$interpreterTimedNames| + |$interpreterTimedClasses|))))) + +\end{chunk} + +\defun{printTypeAndTime}{printTypeAndTime} +\calls{printTypeAndTime}{printTypeAndTimeSaturn} +\calls{printTypeAndTime}{printTypeAndTimeNormal} +\usesdollar{printTypeAndTime}{saturn} +\begin{chunk}{defun printTypeAndTime} +(defun |printTypeAndTime| (x m) + (declare (special |$saturn|)) + (if |$saturn| + (|printTypeAndTimeSaturn| x m) + (|printTypeAndTimeNormal| x m))) + +\end{chunk} + +\defun{printTypeAndTimeNormal}{printTypeAndTimeNormal} +\calls{printTypeAndTimeNormal}{retract} +\calls{printTypeAndTimeNormal}{qcar} +\calls{printTypeAndTimeNormal}{retract} +\calls{printTypeAndTimeNormal}{mkObjWrap} +\calls{printTypeAndTimeNormal}{objMode} +\calls{printTypeAndTimeNormal}{sameUnionBranch} +\calls{printTypeAndTimeNormal}{makeLongTimeString} +\calls{printTypeAndTimeNormal}{msgText} +\calls{printTypeAndTimeNormal}{sayKeyedMsg} +\calls{printTypeAndTimeNormal}{justifyMyType} +\usesdollar{printTypeAndTimeNormal}{collectOutput} +\usesdollar{printTypeAndTimeNormal}{printTypeIfTrue} +\usesdollar{printTypeAndTimeNormal}{printTimeIfTrue} +\usesdollar{printTypeAndTimeNormal}{outputLines} +\usesdollar{printTypeAndTimeNormal}{interpreterTimedNames} +\usesdollar{printTypeAndTimeNormal}{interpreterTimedClasses} +\begin{chunk}{defun printTypeAndTimeNormal} +(defun |printTypeAndTimeNormal| (x m) + (let (xp mp timeString result) + (declare (special |$outputLines| |$collectOutput| |$printTypeIfTrue| + |$printTimeIfTrue| |$outputLines| + |$interpreterTimedNames| |$interpreterTimedClasses|)) + (cond + ((and (consp m) (eq (qcar m) '|Union|)) + (setq xp (|retract| (mkObjWrap x m))) + (setq mp (|objMode| xp)) + (setq m + (cons '|Union| + (append + (dolist (arg (qcdr m) (nreverse result)) + (when (|sameUnionBranch| arg mp) (push arg result))) + (list "...")))))) + (when |$printTimeIfTrue| + (setq timeString + (|makeLongTimeString| + |$interpreterTimedNames| + |$interpreterTimedClasses|))) + (cond + ((and |$printTimeIfTrue| |$printTypeIfTrue|) + (if |$collectOutput| + (push (|msgText| 'S2GL0012 (list m)) |$outputLines|) + (|sayKeyedMsg| 'S2GL0014 (list m timeString )))) + (|$printTimeIfTrue| + (unless |$collectOutput| (|sayKeyedMsg| 'S2GL0013 (list timeString)))) + (|$printTypeIfTrue| + (if |$collectOutput| + (push (|justifyMyType| (|msgText| 'S2GL0012 (list m))) |$outputLines|) + (|sayKeyedMsg| 'S2GL0012 (list m))))))) + +\end{chunk} + +\defun{printTypeAndTimeSaturn}{printTypeAndTimeSaturn} +\calls{printTypeAndTimeSaturn}{makeLongTimeString} +\calls{printTypeAndTimeSaturn}{form2StringAsTeX} +\calls{printTypeAndTimeSaturn}{devaluate} +\calls{printTypeAndTimeSaturn}{printAsTeX} +\usesdollar{printTypeAndTimeSaturn}{printTimeIfTrue} +\usesdollar{printTypeAndTimeSaturn}{printTypeIfTrue} +\usesdollar{printTypeAndTimeSaturn}{interpreterTimedClasses} +\usesdollar{printTypeAndTimeSaturn}{interpreterTimedNames} +\begin{chunk}{defun printTypeAndTimeSaturn} +(defun |printTypeAndTimeSaturn| (x m) + (declare (ignore x)) + (let (timeString typeString) + (declare (special |$printTimeIfTrue| |$printTypeIfTrue| + |$interpreterTimedClasses| |$interpreterTimedNames|)) + (if |$printTimeIfTrue| + (setq timeString + (|makeLongTimeString| + |$interpreterTimedNames| + |$interpreterTimedClasses|)) + (setq timeString "")) + (if |$printTypeIfTrue| + (setq typeString (|form2StringAsTeX| (|devaluate| m))) + (setq typeString "")) + (when |$printTypeIfTrue| + (|printAsTeX| "\\axPrintType{") + (if (consp typeString) + (mapc #'|printAsTeX| typeString) + (|printAsTeX| typeString)) + (|printAsTeX| "}")) + (when |$printTimeIfTrue| + (|printAsTeX| "\\axPrintTime{") + (|printAsTeX| timeString) + (|printAsTeX| "}")))) + +\end{chunk} + +\defun{printAsTeX}{printAsTeX} +\usesdollar{printAsTeX}{texOutputStream} +\begin{chunk}{defun printAsTeX 0} +(defun |printAsTeX| (x) + (declare (special |$texOutputStream|)) + (princ x |$texOutputStream|)) + +\end{chunk} + +\defun{sameUnionBranch}{sameUnionBranch} +\begin{verbatim} +sameUnionBranch(uArg, m) == + uArg is [":", ., t] => t = m + uArg = m +\end{verbatim} +\begin{chunk}{defun sameUnionBranch 0} +(defun |sameUnionBranch| (uArg m) + (let (t1 t2 t3) + (cond + ((and (consp uArg) + (eq (qcar uArg) '|:|) + (progn + (setq t1 (qcdr uArg)) + (and (consp t1) + (progn + (setq t2 (qcdr t1)) + (and (consp t2) + (eq (qcdr t2) nil) + (progn (setq t3 (qcar t2)) t)))))) + (equal t3 m)) + (t (equal uArg m))))) + +\end{chunk} + +\defun{msgText}{msgText} +\calls{msgText}{segmentKeyedMsg} +\calls{msgText}{getKeyedMsg} +\calls{msgText}{substituteSegmentedMsg} +\calls{msgText}{flowSegmentedMsg} +\usesdollar{msgText}{linelength} +\usesdollar{msgText}{margin} +\begin{chunk}{defun msgText} +(defun |msgText| (key args) + (let (msg) + (declare (special $linelength $margin)) + (setq msg (|segmentKeyedMsg| (|getKeyedMsg| key))) + (setq msg (|substituteSegmentedMsg| msg args)) + (setq msg (|flowSegmentedMsg| msg $linelength $margin)) + (apply #'concat (mapcar #'princ-to-string (cdar msg))))) + +\end{chunk} + +\defun{justifyMyType}{Right-justify the Type output} +\calls{justifyMyType}{fillerSpaces} +\usesdollar{justifyMyType}{linelength} +\begin{chunk}{defun justifyMyType} +(defun |justifyMyType| (arg) + (let (len) + (declare (special $linelength)) + (setq len (|#| arg)) + (if (> len $linelength) + arg + (concat (|fillerSpaces| (- $linelength len)) arg)))) + +\end{chunk} + +\defun{unescapeStringsInForm}{Destructively fix quotes in strings} +\calls{unescapeStringsInForm}{unescapeStringsInForm} +\usesdollar{unescapeStringsInForm}{funnyBacks} +\usesdollar{unescapeStringsInForm}{funnyQuote} +\begin{chunk}{defun unescapeStringsInForm} +(defun |unescapeStringsInForm| (form) + (let (str) + (declare (special |$funnyBacks| |$funnyQuote|)) + (cond + ((stringp form) + (setq str (nsubstitute #\" |$funnyQuote| form)) + (nsubstitute #\\ |$funnyBacks| str)) + ((consp form) + (|unescapeStringsInForm| (car form)) + (|unescapeStringsInForm| (cdr form)) + form) + (t form)))) + +\end{chunk} + +\defunsec{intloopInclude}{Include a file into the stream} +\calls{intloopInclude}{intloopInclude0} +\begin{chunk}{defun intloopInclude} +(defun |intloopInclude| (name n) + "Include a file into the stream" + (with-open-file (st name) (|intloopInclude0| st name n))) + +\end{chunk} + +\defun{intloopInclude0}{intloopInclude0} +\calls{intloopInclude0}{incStream} +\calls{intloopInclude0}{intloopProcess} +\calls{intloopInclude0}{next} +\calls{intloopInclude0}{intloopEchoParse} +\calls{intloopInclude0}{insertpile} +\calls{intloopInclude0}{lineoftoks} +\usesdollar{intloopInclude0}{lines} +\begin{chunk}{defun intloopInclude0} +(defun |intloopInclude0| (|st| |name| |n|) + (let (|$lines|) + (declare (special |$lines|)) + (setq |$lines| (|incStream| |st| |name|)) + (|intloopProcess| |n| NIL + (|next| #'|intloopEchoParse| + (|next| #'|insertpile| + (|next| #'|lineoftoks| + |$lines|)))))) + +\end{chunk} + +\defun{intloopProcess}{intloopProcess} +An example call looks like: +\begin{verbatim} + 3> (|intloopProcess| 1 T + (|nonnullstream| #0=|next1| |ncloopParse| + (|nonnullstream| #0# |lineoftoks| + (|nonnullstream| |incZip1| |incRenumberLine| + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) + (|nonnullstream| |incIgen1| 0))))) +\end{verbatim} +which was constructed \bfref{intloopProcessString}. This call +says we are processing the first input, in this case ``1''. +It is interactive. The third argument, the delay, contains the +information to drive the rest of the process. +\calls{intloopProcess}{StreamNull} +\calls{intloopProcess}{pfAbSynOp?} +\calls{intloopProcess}{setCurrentLine} +\calls{intloopProcess}{tokPart} +\calls{intloopProcess}{intloopProcess} +\calls{intloopProcess}{intloopSpadProcess} +\callsdollar{intloopProcess}{systemCommandFunction} +\usesdollar{intloopProcess}{systemCommandFunction} +\label{intloopProcess} +\sig{intloopProcess}{(StepNo,Boolean,Delay)}{StepNo} +\begin{chunk}{defun intloopProcess} +(defun |intloopProcess| (stepno interactive delay) + (let (ptree lines t1) + (declare (special |$systemCommandFunction|)) + (cond + ((|StreamNull| delay) stepno) + (t + (setq t1 (car delay)) + (setq lines (car t1)) + (setq ptree (cadr t1)) + (cond + ((|pfAbSynOp?| ptree '|command|) + (when interactive (|setCurrentLine| (|tokPart| ptree))) + (funcall |$systemCommandFunction| (|tokPart| ptree)) + (|intloopProcess| stepno interactive (cdr delay))) + (t + (|intloopProcess| + (|intloopSpadProcess| stepno lines ptree interactive) + interactive (cdr delay)))))))) + +\end{chunk} + +\defun{intloopSpadProcess}{intloopSpadProcess} +\catches{intloopSpadProcess}{flung} +\catches{intloopSpadProcess}{SpadCompileItem} +\catches{intloopSpadProcess}{intCoerceFailure} +\catches{intloopSpadProcess}{intSpadReader} +\calls{intloopSpadProcess}{ncPutQ} +\calls{intloopSpadProcess}{CatchAsCan} +\calls{intloopSpadProcess}{Catch} +\calls{intloopSpadProcess}{intloopSpadProcess,interp} +\usesdollar{intloopSpadProcess}{currentCarrier} +\usesdollar{intloopSpadProcess}{ncMsgList} +\usesdollar{intloopSpadProcess}{intCoerceFailure} +\usesdollar{intloopSpadProcess}{intSpadReader} +\usesdollar{intloopSpadProcess}{prevCarrier} +\usesdollar{intloopSpadProcess}{stepNo} +\usesdollar{intloopSpadProcess}{NeedToSignalSessionManager} +\uses{intloopSpadProcess}{flung} +\begin{chunk}{defun intloopSpadProcess} +(defun |intloopSpadProcess| (stepNo lines ptree interactive?) + (let (|$stepNo| result cc) + (declare (special |$stepNo| |$prevCarrier| |$intSpadReader| |flung| + |$intCoerceFailure| |$ncMsgList| |$currentCarrier| + |$NeedToSignalSessionManager|)) + (setq |$stepNo| stepNo) + (setq |$currentCarrier| (setq cc (list '|carrier|))) + (|ncPutQ| cc '|stepNumber| stepNo) + (|ncPutQ| cc '|messages| |$ncMsgList|) + (|ncPutQ| cc '|lines| lines) + (setq |$ncMsgList| nil) + (setq result + (catch '|SpadCompileItem| + (catch |$intCoerceFailure| + (catch |$intSpadReader| + (|intloopSpadProcess,interp| cc ptree interactive?))))) + (setq |$NeedToSignalSessionManager| t) + (setq |$prevCarrier| |$currentCarrier|) + (cond + ((eq result '|ncEnd|) stepNo) + ((eq result '|ncError|) stepNo) + ((eq result '|ncEndItem|) stepNo) + (t (1+ stepNo))))) + +\end{chunk} + +\defun{intloopSpadProcess,interp}{intloopSpadProcess,interp} +\calls{intloopSpadProcess,interp}{ncConversationPhase} +\calls{intloopSpadProcess,interp}{ncEltQ} +\calls{intloopSpadProcess,interp}{ncError} +\begin{chunk}{defun intloopSpadProcess,interp} +(defun |intloopSpadProcess,interp| (cc ptree interactive?) + (|ncConversationPhase| #'|phParse| (list cc ptree)) + (|ncConversationPhase| #'|phMacro| (list cc)) + (|ncConversationPhase| #'|phIntReportMsgs| (list cc interactive?)) + (|ncConversationPhase| #'|phInterpret| (list cc)) + (unless (eql (length (|ncEltQ| cc '|messages|)) 0) (|ncError|))) + +\end{chunk} + +\defun{phParse}{phParse} +\tpdhere{The pform function has a leading percent sign} +\begin{verbatim} +phParse: carrier[tokens,...] -> carrier[ptree, tokens,...] +\end{verbatim} +\calls{phParse}{ncPutQ} +\begin{chunk}{defun phParse} +(defun |phParse| (carrier ptree) + (|ncPutQ| carrier '|ptree| ptree) + 'ok) + +\end{chunk} + +\defun{phIntReportMsgs}{phIntReportMsgs} +\begin{verbatim} +carrier[lines,messages,..]-> carrier[lines,messages,..] +\end{verbatim} +\calls{phIntReportMsgs}{ncEltQ} +\calls{phIntReportMsgs}{ncPutQ} +\calls{phIntReportMsgs}{processMsgList} +\usesdollar{phIntReportMsgs}{erMsgToss} +\begin{chunk}{defun phIntReportMsgs} +(defun |phIntReportMsgs| (carrier interactive?) + (declare (ignore interactive?)) + (let (nerr msgs lines) + (declare (special |$erMsgToss|)) + (cond + (|$erMsgToss| 'ok) + (t + (setq lines (|ncEltQ| carrier '|lines|)) + (setq msgs (|ncEltQ| carrier '|messages|)) + (setq nerr (length msgs)) + (|ncPutQ| carrier '|ok?| (eql nerr 0)) + (cond + ((eql nerr 0) 'ok) + (t + (|processMsgList| msgs lines) + (|sayKeyedMsg| 'S2CTP010 (list nerr)) + 'ok)))))) + +\end{chunk} + +\defun{phInterpret}{phInterpret} +\calls{phInterpret}{ncEltQ} +\calls{phInterpret}{intInterpretPform} +\calls{phInterpret}{ncPutQ} +\begin{chunk}{defun phInterpret} +(defun |phInterpret| (carrier) + (let (val ptree) + (setq ptree (|ncEltQ| carrier '|ptree|)) + (setq val (|intInterpretPform| ptree)) + (|ncPutQ| carrier '|value| val))) + +\end{chunk} + +\defun{intInterpretPform}{intInterpretPform} +\calls{intInterpretPform}{processInteractive} +\calls{intInterpretPform}{zeroOneTran} +\calls{intInterpretPform}{pf2Sex} +\begin{chunk}{defun intInterpretPform} +(defun |intInterpretPform| (pf) + (|processInteractive| (|zeroOneTran| (|pf2Sex| pf)) pf)) + +\end{chunk} + +\defun{zeroOneTran}{zeroOneTran} +\calls{zeroOneTran}{nsubst} +\begin{chunk}{defun zeroOneTran 0} +(defun |zeroOneTran| (sex) + (nsubst '|$EmptyMode| '? sex)) + +\end{chunk} + +\defun{ncConversationPhase}{ncConversationPhase} +\calls{ncConversationPhase}{ncConversationPhase,wrapup} +\usesdollar{ncConversationPhase}{ncMsgList} +\begin{chunk}{defun ncConversationPhase} +(defun |ncConversationPhase| (fn args) + (let (|$ncMsgList| carrier) + (declare (special |$ncMsgList|)) + (setq carrier (car args)) + (setq |$ncMsgList| nil) + (unwind-protect + (apply fn args) + (|ncConversationPhase,wrapup| carrier)))) + +\end{chunk} + +\defun{ncConversationPhase,wrapup}{ncConversationPhase,wrapup} +\usesdollar{ncConversationPhase,wrapup}{ncMsgList} +\begin{chunk}{defun ncConversationPhase,wrapup} +(defun |ncConversationPhase,wrapup| (carrier) + (declare (special |$ncMsgList|)) + ((lambda (Var5 m) + (loop + (cond + ((or (atom Var5) (progn (setq m (car Var5)) nil)) + (return nil)) + (t + (|ncPutQ| carrier '|messages| (cons m (|ncEltQ| carrier '|messages|))))) + (setq Var5 (cdr Var5)))) + |$ncMsgList| nil)) + +\end{chunk} + +\defun{ncError}{ncError} +\throws{ncError}{SpadCompileItem} +\begin{chunk}{defun ncError 0} +(defun |ncError| () + (throw '|SpadCompileItem| '|ncError|)) + +\end{chunk} + +\defun{intloopEchoParse}{intloopEchoParse} +\calls{intloopEchoParse}{ncloopDQlines} +\calls{intloopEchoParse}{setCurrentLine} +\calls{intloopEchoParse}{mkLineList} +\calls{intloopEchoParse}{ncloopPrintLines} +\calls{intloopEchoParse}{npParse} +\calls{intloopEchoParse}{dqToList} +\usesdollar{intloopEchoParse}{EchoLines} +\usesdollar{intloopEchoParse}{lines} +\begin{chunk}{defun intloopEchoParse} +(defun |intloopEchoParse| (s) + (let (cudr lines stream dq t1) + (declare (special |$EchoLines| |$lines|)) + (setq t1 (car s)) + (setq dq (car t1)) + (setq stream (cadr t1)) + (setq t1 (|ncloopDQlines| dq |$lines|)) + (setq lines (car t1)) + (setq cudr (cadr t1)) + (|setCurrentLine| (|mkLineList| lines)) + (when |$EchoLines| (|ncloopPrintLines| lines)) + (setq |$lines| cudr) + (cons (list (list lines (|npParse| (|dqToList| dq)))) (cdr s)))) + +\end{chunk} + +\defun{ncloopPrintLines}{ncloopPrintLines} +\begin{verbatim} +;ncloopPrintLines lines == +; for line in lines repeat WRITE_-LINE CDR line +; WRITE_-LINE '" " +\end{verbatim} +\begin{chunk}{defun ncloopPrintLines 0} +(defun |ncloopPrintLines| (lines) + ((lambda (Var4 line) + (loop + (cond + ((or (atom Var4) (progn (setq line (car Var4)) nil)) + (return nil)) + (t (write-line (cdr line)))) + (setq Var4 (cdr Var4)))) + lines nil) + (write-line " ")) + +\end{chunk} + +\defun{mkLineList}{mkLineList} +\begin{verbatim} +;mkLineList lines == +; l := [CDR line for line in lines | nonBlank CDR line] +; #l = 1 => CAR l +; l +\end{verbatim} +\begin{chunk}{defun mkLineList} +(defun |mkLineList| (lines) + (let (l) + (setq l + ((lambda (Var2 Var1 line) + (loop + (cond + ((or (atom Var1) (progn (setq line (car Var1)) nil)) + (return (nreverse Var2))) + (t + (and (|nonBlank| (cdr line)) + (setq Var2 (cons (cdr line) Var2))))) + (setq Var1 (cdr Var1)))) + nil lines nil)) + (cond + ((eql (length l) 1) (car l)) + (t l)))) + +\end{chunk} + +\defun{nonBlank}{nonBlank} +\begin{verbatim} +;nonBlank str == +; value := false +; for i in 0..MAXINDEX str repeat +; str.i ^= char " " => +; value := true +; return value +; value +\end{verbatim} +\begin{chunk}{defun nonBlank 0} +(defun |nonBlank| (str) + (let (value) + ((lambda (Var3 i) + (loop + (cond + ((> i Var3) (return nil)) + (t + (cond + ((not (equal (elt str i) #\Space)) + (identity (progn (setq value t) (return value))))))) + (setq i (+ i 1)))) + (maxindex str) 0) + value)) + +\end{chunk} + +\defun{ncloopDQlines}{ncloopDQlines} +\calls{ncloopDQlines}{StreamNull} +\calls{ncloopDQlines}{poGlobalLinePosn} +\calls{ncloopDQlines}{tokPosn} +\calls{ncloopDQlines}{streamChop} +\begin{chunk}{defun ncloopDQlines} +(defun |ncloopDQlines| (dq stream) + (let (b a) + (|StreamNull| stream) + (setq a (|poGlobalLinePosn| (|tokPosn| (cadr dq)))) + (setq b (|poGlobalLinePosn| (caar stream))) + (|streamChop| (+ (- a b) 1) stream))) + +\end{chunk} + +\defun{poGlobalLinePosn}{poGlobalLinePosn} +\calls{poGlobalLinePosn}{lnGlobalNum} +\calls{poGlobalLinePosn}{poGetLineObject} +\calls{poGlobalLinePosn}{ncBug} +\begin{chunk}{defun poGlobalLinePosn} +(defun |poGlobalLinePosn| (posn) + (if posn + (|lnGlobalNum| (|poGetLineObject| posn)) + (|ncBug| "old style pos objects have no global positions" nil))) + +\end{chunk} + +\defun{streamChop}{streamChop} +Note that changing the name ``lyne'' to ``line'' will break the system. +I do not know why. The symptom shows up when there is a file with a large +contiguous comment spanning enough lines to overflow the stack. + +\calls{streamChop}{StreamNull} +\calls{streamChop}{streamChop} +\calls{streamChop}{ncloopPrefix?} +\begin{chunk}{defun streamChop} +(defun |streamChop| (n s) + (let (d c lyne b a tmp1) + (cond + ((|StreamNull| s) (list nil nil)) + ((eql n 0) (list nil s)) + (t + (setq tmp1 (|streamChop| (- n 1) (cdr s))) + (setq a (car tmp1)) + (setq b (cadr tmp1)) + (setq lyne (car s)) + (setq c (|ncloopPrefix?| ")command" (cdr lyne))) + (setq d (cons (car lyne) (cond (c c) (t (cdr lyne))))) + (list (cons d a) b))))) + +\end{chunk} + +\defun{ncloopInclude0}{ncloopInclude0} +\calls{ncloopInclude0}{incStream} +\calls{ncloopInclude0}{ncloopProcess} +\calls{ncloopInclude0}{next} +\calls{ncloopInclude0}{ncloopEchoParse} +\calls{ncloopInclude0}{insertpile} +\calls{ncloopInclude0}{lineoftoks} +\usesdollar{ncloopInclude0}{lines} +\begin{chunk}{defun ncloopInclude0} +(defun |ncloopInclude0| (st name n) + (let (|$lines|) + (declare (special |$lines|)) + (setq |$lines| (|incStream| st name)) + (|ncloopProcess| n nil + (|next| #'|ncloopEchoParse| + (|next| #'|insertpile| + (|next| #'|lineoftoks| + |$lines|)))))) + +\end{chunk} + +\defun{incStream}{incStream} +\calls{incStream}{incRenumber} +\calls{incStream}{incLude} +\calls{incStream}{incRgen} +\uses{incStream}{Top} +\begin{chunk}{defun incStream} +(defun |incStream| (st fn) + (declare (special |Top|)) + (|incRenumber| (|incLude| 0 (|incRgen| st) 0 (list fn) (list |Top|)))) + +\end{chunk} + +\defun{incRenumber}{incRenumber} +\calls{incRenumber}{incZip} +\calls{incRenumber}{incIgen} +\label{incRenumber} +\sig{incRenumber}{Delay}{Delay} +\begin{chunk}{defun incRenumber} +(defun |incRenumber| (ssx) + (|incZip| #'|incRenumberLine| ssx (|incIgen| 0))) + +\end{chunk} + +\defun{incZip}{incZip} +Axiom ``zips'' a function together with two delays into a delay. + +\calls{incZip}{Delay} +\calls{incZip}{incZip1} +\label{incZip} +\sig{incZip}{(Function,Delay,Delay)}{Delay} +\begin{chunk}{defun incZip} +(defun |incZip| (function delay1 delay2) + (|Delay| #'|incZip1| (list function delay1 delay2))) + +\end{chunk} + +\defun{incZip1}{incZip1} +\calls{incZip1}{StreamNull} +\calls{incZip1}{incZip} +\label{incZip1} +\sig{incZip1}{Delay}{ParsePair} +\begin{chunk}{defun incZip1} +(defun |incZip1| (&rest delayArg) + (let (function delay1 delay2) + (setq function (car delayArg)) + (setq delay1 (cadr delayArg)) + (setq delay2 (caddr delayArg)) + (cond + ((|StreamNull| delay1) |StreamNil|) + ((|StreamNull| delay2) |StreamNil|) + (t + (cons + (funcall function (car delay1) (car delay2)) + (|incZip| function (cdr delay1) (cdr delay2))))))) + +\end{chunk} + +\defun{incIgen}{incIgen} +\calls{incIgen}{Delay} +\calls{incIgen}{incIgen1} +\label{incIgen} +\sig{incIgen}{Integer}{Delay} +\begin{chunk}{defun incIgen} +(defun |incIgen| (int) + (|Delay| #'|incIgen1| (list int))) + +\end{chunk} + +\defun{incIgen1}{incIgen1} +\calls{incIgen1}{incIgen} +\begin{chunk}{defun incIgen1} +(defun |incIgen1| (&rest z) + (let (n) + (setq n (car z)) + (setq n (+ n 1)) + (cons n (|incIgen| n)))) + +\end{chunk} + +\defun{incRenumberLine}{incRenumberLine} +\calls{incRenumberLine}{incRenumberItem} +\calls{incRenumberLine}{incHandleMessage} +\label{incRenumberLine} +\begin{chunk}{defun incRenumberLine} +(defun |incRenumberLine| (xl gno) + (let (l) + (setq l (|incRenumberItem| (elt xl 0) gno)) + (|incHandleMessage| xl) + l)) + +\end{chunk} +\defun{incRenumberItem}{incRenumberItem} +\calls{incRenumberItem}{lnSetGlobalNum} +\begin{chunk}{defun incRenumberItem} +(defun |incRenumberItem| (f i) + (let (l) + (setq l (caar f)) + (|lnSetGlobalNum| l i) f)) + +\end{chunk} + +\defun{incHandleMessage}{incHandleMessage} +\calls{incHandleMessage}{ncSoftError} +\calls{incHandleMessage}{ncBug} +\begin{chunk}{defun incHandleMessage 0} +(defun |incHandleMessage| (x) + "Message handling for the source includer" + (let ((msgtype (elt (elt x 1) 1)) + (pos (car (elt x 0))) + (key (car (elt (elt x 1) 0))) + (args (cadr (elt (elt x 1) 0)))) + + (cond + ((eq msgtype '|none|) 0) + ((eq msgtype '|error|) (|ncSoftError| pos key args)) + ((eq msgtype '|warning|) (|ncSoftError| pos key args)) + ((eq msgtype '|say|) (|ncSoftError| pos key args)) + (t (|ncBug| key args))))) + +\end{chunk} + +\defun{incLude}{incLude} +This function takes +\begin{enumerate} +\item {\bf eb} -- in Integer +\item {\bf ss} -- a list of strings +\item {\bf ln} -- an Integer +\item {\bf ufos} -- a list of strings +\item {\bf states} -- a list of integers +\end{enumerate} +and constructs a call to \bfref{Delay}. + +\calls{incLude}{Delay} +\calls{include}{incLude1} +\label{incLude} +\sig{incLude}{(Int,List(String),Int,List(String),List(Int))}{Delay} +\begin{chunk}{defun incLude} +(defun |incLude| (eb ss ln ufos states) + (|Delay| #'|incLude1| (list eb ss ln ufos states))) + +\end{chunk} + +\defmacro{Rest} +\begin{chunk}{defmacro Rest} +(defmacro |Rest| () + "used in incLude1 for parsing; s is not used." + '(|incLude| eb (cdr ss) lno ufos states)) + +\end{chunk} + +\defvar{Top} +\begin{chunk}{initvars} +(defvar |Top| 1 "used in incLude1 for parsing") + +\end{chunk} + +\defvar{IfSkipToEnd} +\begin{chunk}{initvars} +(defvar |IfSkipToEnd| 10 "used in incLude1 for parsing") + +\end{chunk} + +\defvar{IfKeepPart} +\begin{chunk}{initvars} +(defvar |IfKeepPart| 11 "used in incLude1 for parsing") + +\end{chunk} + +\defvar{IfSkipPart} +\begin{chunk}{initvars} +(defvar |IfSkipPart| 12 "used in incLude1 for parsing") + +\end{chunk} + +\defvar{ElseifSkipToEnd} +\begin{chunk}{initvars} +(defvar |ElseifSkipToEnd| 20 "used in incLude1 for parsing") + +\end{chunk} + +\defvar{ElseifKeepPart} +\begin{chunk}{initvars} +(defvar |ElseifKeepPart| 21 "used in incLude1 for parsing") + +\end{chunk} + +\defvar{ElseifSkipPart} +\begin{chunk}{initvars} +(defvar |ElseifSkipPart| 22 "used in incLude1 for parsing") + +\end{chunk} + +\defvar{ElseSkipToEnd} +\begin{chunk}{initvars} +(defvar |ElseSkipToEnd| 30 "used in incLude1 for parsing") + +\end{chunk} + +\defvar{ElseKeepPart} +\begin{chunk}{initvars} +(defvar |ElseKeepPart| 31 "used in incLude1 for parsing") + +\end{chunk} + +\defun{Top?}{Top?} +\calls{Top?}{quotient} +\begin{chunk}{defun Top? 0} +(defun |Top?| (|st|) + "used in incLude1 for parsing" + (eql (quotient |st| 10) 0)) + +\end{chunk} + +\defun{If?}{If?} +\calls{If?}{quotient} +\begin{chunk}{defun If?} +(defun |If?| (|st|) + "used in incLude1 for parsing" + (eql (quotient |st| 10) 1)) + +\end{chunk} + +\defun{Elseif?}{Elseif?} +\calls{Elseif?}{quotient} +\begin{chunk}{defun Elseif?} +(defun |Elseif?| (|st|) + "used in incLude1 for parsing" + (eql (quotient |st| 10) 2)) + +\end{chunk} + +\defun{Else?}{Else?} +\calls{Else?}{quotient} +\begin{chunk}{defun Else?} +(defun |Else?| (|st|) + "used in incLude1 for parsing" + (eql (quotient |st| 10) 3)) + +\end{chunk} + +\defun{SkipEnd?}{SkipEnd?} +\calls{SkipEnd?}{remainder} +\begin{chunk}{defun SkipEnd?} +(defun |SkipEnd?| (|st|) + "used in incLude1 for parsing" + (eql (remainder |st| 10) 0)) + +\end{chunk} + +\defun{KeepPart?}{KeepPart?} +\calls{KeepPart?}{remainder} +\begin{chunk}{defun KeepPart?} +(defun |KeepPart?| (|st|) + "used in incLude1 for parsing" + (eql (remainder |st| 10) 1)) + +\end{chunk} + +\defun{SkipPart?}{SkipPart?} +\calls{SkipPart?}{remainder} +\begin{chunk}{defun SkipPart?} +(defun |SkipPart?| (|st|) + "used in incLude1 for parsing" + (eql (remainder |st| 10) 2)) + +\end{chunk} + +\defun{Skipping?}{Skipping?} +\calls{Skipping?}{KeepPart?} +\begin{chunk}{defun Skipping?} +(defun |Skipping?| (|st|) + "used in incLude1 for parsing" + (null (|KeepPart?| |st|))) + +\end{chunk} + +\defun{incLude1}{incLude1} +\calls{incLude1}{StreamNull} +\calls{incLude1}{Top?} +\calls{incLude1}{xlPrematureEOF} +\calls{incLude1}{Skipping?} +\calls{incLude1}{xlSkip} +\calls{incLude1}{Rest} +\calls{incLude1}{xlOK} +\calls{incLude1}{xlOK1} +\calls{incLude1}{concat} +\calls{incLude1}{incCommandTail} +\calls{incLude1}{xlSay} +\calls{incLude1}{xlNoSuchFile} +\calls{incLude1}{xlCannotRead} +\calls{incLude1}{incActive?} +\calls{incLude1}{xlFileCycle} +\calls{incLude1}{incLude} +\calls{incLude1}{incFileInput} +\calls{incLude1}{incAppend} +\calls{incLude1}{inclFname} +\calls{incLude1}{xlConActive} +\calls{incLude1}{xlConStill} +\calls{incLude1}{incConsoleInput} +\calls{incLude1}{incNConsoles} +\calls{incLude1}{xlConsole} +\calls{incLude1}{xlSkippingFin} +\calls{incLude1}{xlPrematureFin} +\calls{incLude1}{assertCond} +\calls{incLude1}{ifCond} +\calls{incLude1}{If?} +\calls{incLude1}{Elseif?} +\calls{incLude1}{xlIfSyntax} +\calls{incLude1}{SkipEnd?} +\calls{incLude1}{KeepPart?} +\calls{incLude1}{SkipPart?} +\calls{incLude1}{xlIfBug} +\calls{incLude1}{xlCmdBug} +\calls{incLude1}{expand-tabs} +\calls{incLude1}{incClassify} +\begin{chunk}{defun incLude1} +(defun |incLude1| (&rest z) + (let (pred s1 n tail head includee fn1 info str state lno states + ufos ln ss eb) + (setq eb (car z)) + (setq ss (cadr . (z))) + (setq ln (caddr . (z))) + (setq ufos (cadddr . (z))) + (setq states (car (cddddr . (z)))) + (setq lno (+ ln 1)) + (setq state (elt states 0)) + (cond + ((|StreamNull| ss) + (cond + ((null (|Top?| state)) + (cons (|xlPrematureEOF| eb ")--premature end" lno ufos) + |StreamNil|)) + (t |StreamNil|))) + (t + (progn + (setq str (expand-tabs (car ss))) + (setq info (|incClassify| str)) + (cond + ((null (elt info 0)) + (cond + ((|Skipping?| state) + (cons (|xlSkip| eb str lno (elt ufos 0)) (|Rest|))) + (t + (cons (|xlOK| eb str lno (elt ufos 0)) (|Rest|))))) + ((equal (elt info 2) "other") + (cond + ((|Skipping?| state) + (cons (|xlSkip| eb str lno (elt ufos 0)) (|Rest|))) + (t + (cons + (|xlOK1| eb str (concat ")command" str) lno (elt ufos 0)) + (|Rest|))))) + ((equal (elt info 2) "say") + (cond + ((|Skipping?| state) + (cons (|xlSkip| eb str lno (elt ufos 0)) (|Rest|))) + (t + (progn + (setq str (|incCommandTail| str info)) + (cons (|xlSay| eb str lno ufos str) + (cons (|xlOK| eb str lno (ELT ufos 0)) (|Rest|))))))) + ((equal (elt info 2) "include") + (cond + ((|Skipping?| state) + (cons (|xlSkip| eb str lno (elt ufos 0)) (|Rest|))) + (t + (progn + (setq fn1 (|inclFname| str info)) + (cond + ((null fn1) + (cons (|xlNoSuchFile| eb str lno ufos fn1) (|Rest|))) + ((null (probe-file fn1)) + (cons (|xlCannotRead| eb str lno ufos fn1) (|Rest|))) + ((|incActive?| fn1 ufos) + (cons (|xlFileCycle| eb str lno ufos fn1) (|Rest|))) + (t + (progn + (setq includee + (|incLude| (+ eb (elt info 1)) + (|incFileInput| fn1) + 0 + (cons fn1 ufos) + (cons |Top| states))) + (cons (|xlOK| eb str lno (elt ufos 0)) + (|incAppend| includee (|Rest|)))))))))) + ((equal (elt info 2) "console") + (cond + ((|Skipping?| state) + (cons (|xlSkip| eb str lno (elt ufos 0)) (|Rest|))) + (t + (progn + (setq head + (|incLude| (+ eb (elt info 1)) + (|incConsoleInput|) + 0 + (cons "console" ufos) + (cons |Top| states))) + (setq tail (|Rest|)) + (setq n (|incNConsoles| ufos)) + (cond + ((< 0 n) + (setq head + (cons (|xlConActive| eb str lno ufos n) head)) + (setq tail + (cons (|xlConStill| eb str lno ufos n) tail)))) + (setq head (cons (|xlConsole| eb str lno ufos) head)) + (cons (|xlOK| eb str lno (elt ufos 0)) + (|incAppend| head tail)))))) + ((equal (elt info 2) "fin") + (cond + ((|Skipping?| state) + (cons (|xlSkippingFin| eb str lno ufos) (|Rest|))) + ((null (|Top?| state)) + (cons (|xlPrematureFin| eb str lno ufos) |StreamNil|)) + (t + (cons (|xlOK| eb str lno (elt ufos 0)) |StreamNil|)))) + ((equal (elt info 2) "assert") + (cond + ((|Skipping?| state) + (cons (|xlSkippingFin| eb str lno ufos) (|Rest|))) + (t + (progn + (|assertCond| str info) + (cons (|xlOK| eb str lno (elt ufos 0)) + (|incAppend| includee (|Rest|))))))) + ((equal (elt info 2) "if") + (progn + (setq s1 + (cond + ((|Skipping?| state) |IfSkipToEnd|) + (t + (cond + ((|ifCond| str info) |IfKeepPart|) + (t |IfSkipPart|))))) + (cons (|xlOK| eb str lno (elt ufos 0)) + (|incLude| eb (cdr ss) lno ufos (cons s1 states))))) + ((equal (elt info 2) "elseif") + (cond + ((and (null (|If?| state)) (null (|Elseif?| state))) + (cons (|xlIfSyntax| eb str lno ufos info states) + |StreamNil|)) + (t + (cond + ((or (|SkipEnd?| state) + (|KeepPart?| state) + (|SkipPart?| state)) + (setq s1 + (cond + ((|SkipPart?| state) + (setq pred (|ifCond| str info)) + (cond + (pred |ElseifKeepPart|) + (t |ElseifSkipPart|))) + (t |ElseifSkipToEnd|))) + (cons (|xlOK| eb str lno (elt ufos 0)) + (|incLude| eb (cdr ss) lno ufos (cons s1 (cdr states))))) + (t + (cons (|xlIfBug| eb str lno ufos) |StreamNil|)))))) + ((equal (elt info 2) "else") + (cond + ((and (null (|If?| state)) (null (|Elseif?| state))) + (cons (|xlIfSyntax| eb str lno ufos info states) + |StreamNil|)) + (t + (cond + ((or (|SkipEnd?| state) + (|KeepPart?| state) + (|SkipPart?| state)) + (setq s1 + (cond ((|SkipPart?| state) |ElseKeepPart|) (t |ElseSkipToEnd|))) + (cons (|xlOK| eb str lno (elt ufos 0)) + (|incLude| eb (cdr ss) lno ufos (cons s1 (cdr states))))) + (t + (cons (|xlIfBug| eb str lno ufos) |StreamNil|)))))) + ((equal (elt info 2) "endif") + (cond + ((|Top?| state) + (cons (|xlIfSyntax| eb str lno ufos info states) + |StreamNil|)) + (t + (cons (|xlOK| eb str lno (elt ufos 0)) + (|incLude| eb (cdr ss) lno ufos (cdr states)))))) + (t (cons (|xlCmdBug| eb str lno ufos) |StreamNil|)))))))) + +\end{chunk} + +\defun{xlPrematureEOF}{xlPrematureEOF} +\calls{xlPrematureEOF}{xlMsg} +\calls{xlPrematureEOF}{inclmsgPrematureEOF} +\begin{chunk}{defun xlPrematureEOF} +(defun |xlPrematureEOF| (eb str lno ufos) + (|xlMsg| eb str lno (elt ufos 0) + (list (|inclmsgPrematureEOF| (elt ufos 0)) '|error|))) + +\end{chunk} + +\defun{xlMsg}{xlMsg} +\calls{xlMsg}{incLine} +\begin{chunk}{defun xlMsg} +(defun |xlMsg| (extrablanks string localnum fileobj mess) + (let ((globalnum -1)) + (list (incLine extrablanks string globalnum localnum fileobj) mess))) + +\end{chunk} + +\defun{xlOK}{xlOK} +\calls{xlOK}{xlOK1} +\begin{chunk}{defun xlOK} +(defun |xlOK| (extrablanks string localnum fileobj) + (|xlOK1| extrablanks string string localnum fileobj)) + +\end{chunk} + +\defun{xlOK1}{xlOK1} +\calls{xlOK1}{incLine1} +\begin{chunk}{defun xlOK1} +(defun |xlOK1| (extrablanks string string1 localnum fileobj) + (let ((globalnum -1)) + (list (incLine1 extrablanks string string1 globalnum localnum fileobj) + (list nil '|none|)))) + +\end{chunk} + +\defun{incAppend}{incAppend} +\calls{incAppend}{Delay} +\calls{incAppend}{incAppend1} +\begin{chunk}{defun incAppend} +(defun |incAppend| (x y) + (|Delay| #'|incAppend1| (list x y))) + +\end{chunk} + +\defun{incAppend1}{incAppend1} +\calls{incAppend1}{StreamNull} +\calls{incAppend1}{incAppend} +\begin{chunk}{defun incAppend1} +(defun |incAppend1| (&rest z) + (let (y x) + (setq x (car z)) + (setq y (cadr z)) + (cond + ((|StreamNull| x) + (cond ((|StreamNull| y) |StreamNil|) (t y))) + (t + (cons (car x) (|incAppend| (cdr x) y)))))) + +\end{chunk} + +\defun{incLine}{incLine} +\calls{incLine}{incLine1} +\begin{chunk}{defun incLine} +(defun incLine (extrablanks string globalnum localnum fileobj) + (incLine1 extrablanks string string globalnum localnum fileobj)) + +\end{chunk} + +\defun{incLine1}{incLine1} +\calls{incLine1}{lnCreate} +\begin{chunk}{defun incLine1} +(defun incLine1 (extrablanks string string1 globalnum localnum fileobj) + (cons + (cons (|lnCreate| extrablanks string globalnum localnum fileobj) 1) string1)) + +\end{chunk} + +\defun{inclmsgPrematureEOF}{inclmsgPrematureEOF} +\calls{inclmsgPrematureEOF}{theorigin} +\begin{chunk}{defun inclmsgPrematureEOF 0} +(defun |inclmsgPrematureEOF| (ufo) + (list 'S2CI0002 (list (|theorigin| ufo)))) + +\end{chunk} + +\defun{theorigin}{theorigin} +\begin{chunk}{defun theorigin 0} +(defun |theorigin| (x) (list #'|porigin| x)) + +\end{chunk} + +\defun{porigin}{porigin} +\calls{porigin}{pfname} +\begin{chunk}{defun porigin} +(defun |porigin| (x) + (if (stringp x) + x + (|pfname| x))) + +\end{chunk} + +\defun{ifCond}{ifCond} +\calls{ifCond}{MakeSymbol} +\calls{ifCond}{incCommandTail} +\usesdollar{ifCond}{inclAssertions} +\begin{chunk}{defun ifCond} +(defun |ifCond| (s info) + (let (word) + (declare (special |$inclAssertions|)) + (setq word + (|MakeSymbol| (string-trim *whitespace* (|incCommandTail| s info)))) + (member word |$inclAssertions|))) + +\end{chunk} + +\defun{xlSkip}{xlSkip} +\calls{xlSkip}{incLine} +\calls{xlSkip}{concat} +\begin{chunk}{defun xlSkip} +(defun |xlSkip| (extrablanks str localnum fileobj) + (let ((string (concat "-- Omitting:" str)) (globalnum -1)) + (list + (incLine extrablanks string globalnum localnum fileobj) + (list nil '|none|)))) + +\end{chunk} + +\defun{xlSay}{xlSay} +\calls{xlSay}{xlMsg} +\calls{xlSay}{inclmsgSay} +\begin{chunk}{defun xlSay} +(defun |xlSay| (eb str lno ufos x) + (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgSay| x) '|say|))) + +\end{chunk} + +\defun{inclmsgSay}{inclmsgSay} +\calls{inclmsgSay}{theid} +\begin{chunk}{defun inclmsgSay} +(defun |inclmsgSay| (str) + (list 'S2CI0001 (list (|theid| str)))) + +\end{chunk} + +\defun{theid}{theid} +\begin{chunk}{defun theid 0} +(defun |theid| (a) (list #'identity a)) + +\end{chunk} + +\defun{xlNoSuchFile}{xlNoSuchFile} +\calls{xlNoSuchFile}{xlMsg} +\calls{xlNoSuchFile}{inclmsgNoSuchFile} +\begin{chunk}{defun xlNoSuchFile} +(defun |xlNoSuchFile| (eb str lno ufos fn) + (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgNoSuchFile| fn) '|error|))) + +\end{chunk} + +\defun{inclmsgNoSuchFile}{inclmsgNoSuchFile} +\calls{inclmsgNoSuchFile}{thefname} +\begin{chunk}{defun inclmsgNoSuchFile} +(defun |inclmsgNoSuchFile| (fn) + (list 'S2CI0010 (list (|thefname| fn)))) + +\end{chunk} + +\defun{thefname}{thefname} +\calls{thefname}{pfname} +\begin{chunk}{defun thefname 0} +(defun |thefname| (x) (list #'|pfname| x)) + +\end{chunk} + +\defun{pfname}{pfname} +\calls{pfname}{PathnameString} +\begin{chunk}{defun pfname} +(defun |pfname| (x) (|PathnameString| x)) + +\end{chunk} + +\defun{xlCannotRead}{xlCannotRead} +\calls{xlCannotRead}{xlMsg} +\calls{xlCannotRead}{inclmsgCannotRead} +\begin{chunk}{defun xlCannotRead} +(defun |xlCannotRead| (eb str lno ufos fn) + (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgCannotRead| fn) '|error|))) + +\end{chunk} + +\defun{inclmsgCannotRead}{inclmsgCannotRead} +\calls{inclmsgCannotRead}{thefname} +\begin{chunk}{defun inclmsgCannotRead} +(defun |inclmsgCannotRead| (fn) + (list 'S2CI0011 (list (|thefname| fn)))) + +\end{chunk} + +\defun{xlFileCycle}{xlFileCycle} +\calls{xlFileCycle}{xlMsg} +\calls{xlFileCycle}{inclmsgFileCycle} +\begin{chunk}{defun xlFileCycle} +(defun |xlFileCycle| (eb str lno ufos fn) + (|xlMsg| eb str lno (elt ufos 0) + (list (|inclmsgFileCycle| ufos fn) '|error|))) + +\end{chunk} + +\defun{inclmsgFileCycle}{inclmsgFileCycle} +\begin{verbatim} +;inclmsgFileCycle(ufos,fn) == +; flist := [porigin n for n in reverse ufos] +; f1 := porigin fn +; cycle := [:[:[n,'"==>"] for n in flist], f1] +; ['S2CI0004, [%id cycle, %id f1] ] + +\end{verbatim} +\calls{inclmsgFileCycle}{porigin} +\calls{inclmsgFileCycle}{theid} +\begin{chunk}{defun inclmsgFileCycle} +(defun |inclmsgFileCycle| (ufos fn) + (let (cycle f1 flist) + (setq flist + ((lambda (Var8 Var7 n) + (loop + (cond + ((or (atom Var7) (progn (setq n (car Var7)) nil)) + (return (nreverse Var8))) + (t + (setq Var8 (cons (|porigin| n) Var8)))) + (setq Var7 (cdr Var7)))) + nil (reverse ufos) nil)) + (setq f1 (|porigin| fn)) + (setq cycle + (append + ((lambda (Var10 Var9 n) + (loop + (cond + ((or (atom Var9) (progn (setq n (car Var9)) nil)) + (return (nreverse Var10))) + (t + (setq Var10 (append (reverse (list n "==>")) Var10)))) + (setq Var9 (cdr Var9)))) + nil flist nil) + (cons f1 nil))) + (list 'S2CI0004 (list (|theid| cycle) (|theid| f1))))) + +\end{chunk} + +\defun{xlConActive}{xlConActive} +\calls{xlConActive}{xlMsg} +\calls{xlConActive}{inclmsgConActive} +\begin{chunk}{defun xlConActive} +(defun |xlConActive| (eb str lno ufos n) + (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgConActive| n) '|warning|))) + +\end{chunk} + +\defun{inclmsgConActive}{inclmsgConActive} +\calls{inclmsgConActive}{theid} +\begin{chunk}{defun inclmsgConActive} +(defun |inclmsgConActive| (n) + (list 'S2CI0006 (list (|theid| n)))) + +\end{chunk} + +\defun{xlConStill}{xlConStill} +\calls{xlConStill}{xlMsg} +\calls{xlConStill}{inclmsgConStill} +\begin{chunk}{defun xlConStill} +(defun |xlConStill| (eb str lno ufos n) + (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgConStill| n) '|say|))) + +\end{chunk} + +\defun{inclmsgConStill}{inclmsgConStill} +\calls{inclmsgConStill}{theid} +\begin{chunk}{defun inclmsgConStill} +(defun |inclmsgConStill| (n) + (list 'S2CI0007 (list (|theid| n)))) + +\end{chunk} + +\defun{xlConsole}{xlConsole} +\calls{xlConsole}{xlMsg} +\calls{xlConsole}{inclmsgConsole} +\begin{chunk}{defun xlConsole} +(defun |xlConsole| (eb str lno ufos) + (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgConsole|) '|say|))) + +\end{chunk} + +\defun{inclmsgConsole}{inclmsgConsole} +\begin{chunk}{defun inclmsgConsole 0} +(defun |inclmsgConsole| () + (list 'S2CI0005 nil)) + +\end{chunk} + +\defun{xlSkippingFin}{xlSkippingFin} +\calls{xlSkippingFin}{xlMsg} +\calls{xlSkippingFin}{inclmsgFinSkipped} +\begin{chunk}{defun xlSkippingFin} +(defun |xlSkippingFin| (eb str lno ufos) + (|xlMsg| eb str lno (elt ufos 0) + (list (|inclmsgFinSkipped|) '|warning|))) + +\end{chunk} + +\defun{inclmsgFinSkipped}{inclmsgFinSkipped} +\begin{chunk}{defun inclmsgFinSkipped 0} +(defun |inclmsgFinSkipped| () + (list 'S2CI0008 nil)) + +\end{chunk} + +\defun{xlPrematureFin}{xlPrematureFin} +\calls{xlPrematureFin}{xlMsg} +\calls{xlPrematureFin}{inclmsgPrematureFin} +\begin{chunk}{defun xlPrematureFin} +(defun |xlPrematureFin| (eb str lno ufos) + (|xlMsg| eb str lno (elt ufos 0) + (list (|inclmsgPrematureFin| (elt ufos 0)) '|error|))) + +\end{chunk} + +\defun{inclmsgPrematureFin}{inclmsgPrematureFin} +\calls{inclmsgPrematureFin}{theorigin} +\begin{chunk}{defun inclmsgPrematureFin} +(defun |inclmsgPrematureFin| (ufo) + (list 'S2CI0003 (list (|theorigin| ufo)))) + +\end{chunk} + +\defun{assertCond}{assertCond} +\calls{assertCond}{MakeSymbol} +\calls{assertCond}{incCommandTail} +\usesdollar{assertCond}{inclAssertions} +\uses{assertCond}{*whitespace*} +\begin{chunk}{defun assertCond} +(defun |assertCond| (s info) + (let (word) + (declare (special |$inclAssertions| *whitespace*)) + (setq word + (|MakeSymbol| (string-trim *whitespace* (|incCommandTail| s info)))) + (unless (member word |$inclAssertions|) + (setq |$inclAssertions| (cons word |$inclAssertions|))))) + +\end{chunk} + +\defun{xlIfSyntax}{xlIfSyntax} +\calls{xlIfSyntax}{Top?} +\calls{xlIfSyntax}{Else?} +\calls{xlIfSyntax}{xlMsg} +\calls{xlIfSyntax}{inclmsgIfSyntax} +\begin{chunk}{defun xlIfSyntax} +(defun |xlIfSyntax| (eb str lno ufos info sts) + (let (context found st) + (setq st (elt sts 0)) + (setq found (elt info 2)) + (setq context + (cond + ((|Top?| st) '|not in an )if...)endif|) + ((|Else?| st) '|after an )else|) + (t '|but can't figure out where|))) + (|xlMsg| eb str lno (elt ufos 0) + (list (|inclmsgIfSyntax| (elt ufos 0) found context) '|error|)))) + +\end{chunk} + +\defun{inclmsgIfSyntax}{inclmsgIfSyntax} +\calls{inclmsgIfSyntax}{concat} +\calls{inclmsgIfSyntax}{theid} +\calls{inclmsgIfSyntax}{theorigin} +\begin{chunk}{defun inclmsgIfSyntax} +(defun |inclmsgIfSyntax| (ufo found context) + (setq found (concat ")" found)) + (list 'S2CI0009 (list (|theid| found) + (|theid| context) + (|theorigin| ufo)))) + +\end{chunk} + +\defun{xlIfBug}{xlIfBug} +\calls{xlIfBug}{xlMsg} +\calls{xlIfBug}{inclmsgIfBug} +\begin{chunk}{defun xlIfBug} +(defun |xlIfBug| (eb str lno ufos) + (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgIfBug|) '|bug|))) + +\end{chunk} + +\defun{inclmsgIfBug}{inclmsgIfBug} +\begin{chunk}{defun inclmsgIfBug 0} +(defun |inclmsgIfBug| () + (list 'S2CB0002 nil)) + +\end{chunk} + +\defun{xlCmdBug}{xlCmdBug} +\calls{xlCmdBug}{xlMsg} +\calls{xlCmdBug}{inclmsgCmdBug} +\begin{chunk}{defun xlCmdBug} +(defun |xlCmdBug| (eb str lno ufos) + (|xlMsg| eb str lno (elt ufos 0) (list (|inclmsgCmdBug|) '|bug|))) + +\end{chunk} + +\defun{inclmsgCmdBug}{inclmsgCmdBug} +\begin{chunk}{defun inclmsgCmdBug 0} +(defun |inclmsgCmdBug| () + (list 'S2CB0003 nil)) + +\end{chunk} + +\defvar{incCommands} +This is a list of commands that can be in an include file +\begin{chunk}{postvars} +(eval-when (eval load) +(setq |incCommands| + (list "say" "include" "console" "fin" "assert" "if" "elseif" "else" "endif"))) + +\end{chunk} + +\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} +a ==> 3 +a ==> 4 +b ==> 7 +( + (|b| |mbody| ((|integer| (|posn| (0 "b ==> 7" 1 1 "strings") . 6)) . "7")) + (|a| |mbody| ((|integer| (|posn| (0 "a ==> 4" 1 1 "strings") . 6)) . "4")) + (|a| |mbody| ((|integer| (|posn| (0 "a ==> 3" 1 1 "strings") . 6)) . "3")) +) +\end{verbatim} +\begin{chunk}{initvars} +(defvar |$pfMacros| nil) + +\end{chunk} + + +\defun{incClassify}{incClassify} +\begin{verbatim} +;incClassify(s) == +; not incCommand? s => [false,0, '""] +; i := 1; n := #s +; while i < n and s.i = char " " repeat i := i + 1 +; i >= n => [true,0,'"other"] +; eb := (i = 1 => 0; i) +; bad:=true +; for p in incCommands while bad repeat +; incPrefix?(p, i, s) => +; bad:=false +; p1 :=p +; if bad then [true,0,'"other"] else [true,eb,p1] +\end{verbatim} +\calls{incClassify}{incCommand?} +\uses{incClassify}{incCommands} +\label{incClassify} +\begin{chunk}{defun incClassify} +(defun |incClassify| (s) + (let (p1 bad eb n i) + (declare (special |incCommands|)) + (if (null (|incCommand?| s)) + (list nil 0 "") + (progn + (setq i 1) + (setq n (length s)) + ((lambda () + (loop + (cond + ((not (and (< i n) (char= (elt s i) #\space))) + (return nil)) + (t (setq i (1+ i))))))) + (cond + ((not (< i n)) (list t 0 "other")) + (t + (if (= i 1) + (setq eb 0) + (setq eb i)) + (setq bad t) + ((lambda (tmp1 p) + (loop + (cond + ((or (atom tmp1) + (progn (setq p (car tmp1)) nil) + (not bad)) + (return nil)) + (t + (cond + ((|incPrefix?| p i s) + (identity + (progn + (setq bad nil) + (setq p1 p))))))) + (setq tmp1 (cdr tmp1)))) + |incCommands| nil) + (if bad + (list t 0 "other") + (list t eb p1)))))))) + +\end{chunk} + +\defun{incCommand?}{incCommand?} +\sig{incCommand?}{String}{Boolean} +\begin{chunk}{defun incCommand? 0} +(defun |incCommand?| (s) + "does this start with a close paren?" + (and (< 0 (length s)) (equal (elt s 0) #\) ))) + +\end{chunk} + +\defun{incPrefix?}{incPrefix?} +\begin{verbatim} +;incPrefix?(prefix, start, whole) == +; #prefix > #whole-start => false +; good:=true +; for i in 0..#prefix-1 for j in start.. while good repeat +; good:= prefix.i = whole.j +; good +\end{verbatim} +\begin{chunk}{defun incPrefix? 0} +(defun |incPrefix?| (prefix start whole) + (let (good) + (cond + ((< (- (length whole) start) (length prefix)) nil) + (t + (setq good t) + ((lambda (Var i j) + (loop + (cond + ((or (> i Var) (not good)) (return nil)) + (t (setq good (equal (elt prefix i) (elt whole j))))) + (setq i (+ i 1)) + (setq j (+ j 1)))) + (- (length prefix) 1) 0 start) + good)))) + +\end{chunk} + +\defun{incCommandTail}{incCommandTail} +\calls{incCommandTail}{incDrop} +\begin{chunk}{defun incCommandTail} +(defun |incCommandTail| (s info) + (let ((start (elt info 1))) + (when (= start 0) (setq start 1)) + (|incDrop| (+ start (length (elt info 2)) 1) s))) + +\end{chunk} + +\defun{incDrop}{incDrop} +\calls{incDrop}{substring} +\begin{chunk}{defun incDrop 0} +(defun |incDrop| (n b) + (if (>= n (length b)) + '|| + (substring b n nil))) + +\end{chunk} + +\defun{inclFname}{inclFname} +\calls{inclFname}{incFileName} +\calls{inclFname}{incCommandTail} +\begin{chunk}{defun inclFname} +(defun |inclFname| (s info) + (|incFileName| (|incCommandTail| s info))) + +\end{chunk} + +\defun{incFileInput}{incFileInput} +\calls{incFileInput}{incRgen} +\calls{incFileInput}{make-instream} +\begin{chunk}{defun incFileInput} +(defun |incFileInput| (fn) + (|incRgen| (make-instream fn))) + +\end{chunk} + +\defun{incConsoleInput}{incConsoleInput} +\calls{incConsoleInput}{incRgen} +\calls{incConsoleInput}{make-instream} +\begin{chunk}{defun incConsoleInput} +(defun |incConsoleInput| () + (|incRgen| (make-instream 0))) + +\end{chunk} + +\defun{incNConsoles}{incNConsoles} +\calls{incNConsoles}{incNConsoles} +\begin{chunk}{defun incNConsoles} +(defun |incNConsoles| (ufos) + (let ((a (member "console" ufos))) + (if a + (+ 1 (|incNConsoles| (cdr a))) + 0))) + +\end{chunk} + +\defun{incActive?}{incActive?} +\begin{chunk}{defun incActive? 0} +(defun |incActive?| (fn ufos) + (member fn ufos)) + +\end{chunk} + +\defun{incRgen}{incRgen} +Note that incRgen1 recursively calls this function. + +\calls{incRgen}{Delay} +\calls{incRgen}{incRgen1} +\begin{chunk}{defun incRgen} +(defun |incRgen| (s) + (|Delay| #'|incRgen1| (list s))) + +\end{chunk} + +\defun{Delay}{Delay} +{\bf Delay} prepends a label {\bf nonnullstream}, returning a list +of the label, the given function name in {\bf function} +and {\bf arguments}. That is, given +\begin{verbatim} + (|Delay| |incLude1| (0 ("1") 0 ("strings") (1))) +\end{verbatim} +construct +\begin{verbatim} + (|nonnullstream| |incLude1| 0 ("1") 0 ("strings") (1)) +\end{verbatim} +Note that {\bf nonnullstream} is NOT a function so the inputs +have been changed from a function call to a simple list. +\label{Delay} +\sig{Delay}{(Function,List(Any))}{Delay} +\begin{chunk}{defun Delay 0} +(defun |Delay| (function arguments) + (cons '|nonnullstream| (cons function arguments))) + +\end{chunk} + +\defvar{StreamNil} +\begin{chunk}{initvars} +(defvar |StreamNil| (list '|nullstream|)) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) + (setq |StreamNil| (list '|nullstream|))) + +\end{chunk} + +\defun{incRgen1}{incRgen1} +This function reads a line from the stream and then conses it up +with a recursive call to incRgen. +Note that incRgen recursively wraps this function in a delay list. + +\calls{incRgen1}{incRgen} +\uses{incRgen1}{StreamNil} +\begin{chunk}{defun incRgen1} +(defun |incRgen1| (&rest z) + (let (a s) + (declare (special |StreamNil|)) + (setq s (car z)) + (setq a (read-line s nil nil)) + (if (null a) + (progn + (close s) + |StreamNil|) + (cons a (|incRgen| s))))) + +\end{chunk} + +\chapter{The Token Scanner} + +\defvar{scanKeyWords} +\begin{chunk}{postvars} +(eval-when (eval load) +(defvar |scanKeyWords| + (list + (list "add" 'add) + (list "and" 'and) + (list "break" 'break) + (list "by" 'by) + (list "case" 'case) + (list "default" 'default) + (list "define" 'defn) + (list "do" 'do) + (list "else" 'else) + (list "exit" 'exit) + (list "export" 'export) + (list "for" 'for) + (list "free" 'free) + (list "from" 'from) + (list "has" 'has) + (list "if" 'if) + (list "import" 'import) + (list "in" 'in) + (list "inline" 'inline) + (list "is" 'is) + (list "isnt" 'isnt) + (list "iterate" 'iterate) + (list "local" '|local|) + (list "macro" 'macro) + (list "mod" 'mod) + (list "or" 'or) + (list "pretend" 'pretend) + (list "quo" 'quo) + (list "rem" 'rem) + (list "repeat" 'repeat) + (list "return" 'return) + (list "rule" 'rule) + (list "then" 'then) + (list "where" 'where) + (list "while" 'while) + (list "with" 'with) + (list "|" 'bar) + (list "." 'dot) + (list "::" 'coerce) + (list ":" 'colon) + (list ":-" 'colondash) + (list "@" 'at) + (list "@@" 'atat) + (list "," 'comma) + (list ";" 'semicolon) + (list "**" 'power) + (list "*" 'times) + (list "+" 'plus) + (list "-" 'minus) + (list "<" 'lt) + (list ">" 'gt) + (list "<=" 'le) + (list ">=" 'ge) + (list "=" 'equal) + (list "~=" 'notequal) + (list "~" '~) + (list "^" 'carat) + (list ".." 'seg) + (list "#" '|#|) + (list "&" 'ampersand) + (list "$" '$) + (list "/" 'slash) + (list "\\" 'backslash) + (list "//" 'slashslash) + (list "\\\\" 'backslashbackslash) + (list "/\\" 'slashbackslash) + (list "\\/" 'backslashslash) + (list "=>" 'exit) + (list ":=" 'becomes) + (list "==" 'def) + (list "==>" 'mdef) + (list "->" 'arrow) + (list "<-" 'larrow) + (list "+->" 'gives) + (list "(" '|(|) + (list ")" '|)|) + (list "(|" '|(\||) + (list "|)" '|\|)|) + (list "[" '[) + (list "]" ']) + (list "[_]" '[]) + (list "{" '{) + (list "}" '}) + (list "{_}" '{}) + (list "[|" '|[\||) + (list "|]" '|\|]|) + (list "[|_|]" '|[\|\|]|) + (list "{|" '|{\||) + (list "|}" '|\|}|) + (list "{|_|}" '|{\|\|}|) + (list "<<" 'oangle) + (list ">>" 'cangle) + (list "'" '|'|) + (list "`" 'backquote)))) + +\end{chunk} + +\defvar{infgeneric} +\begin{chunk}{postvars} +(eval-when (eval load) +(prog () + (return + ((lambda (var value) + (loop + (cond + ((or (atom var) (progn (setq value (car var)) nil)) + (return nil)) + (t + (setf (get (car value) 'infgeneric) (cadr value)))) + (setq var (cdr var)))) + (list + (list 'equal '=) + (list 'times '*) + (list 'has '|has|) + (list 'case '|case|) + (list 'rem '|rem|) + (list 'mod '|mod|) + (list 'quo '|quo|) + (list 'slash '/) + (list 'backslash '|\\|) + (list 'slashslash '//) + (list 'backslashbackslash '|\\\\|) + (list 'slashbackslash '|/\\|) + (list 'backslashslash '|\\/|) + (list 'power '**) + (list 'carat '^) + (list 'plus '+) + (list 'minus '-) + (list 'lt '<) + (list 'gt '>) + (list 'oangle '<<) + (list 'cangle '>>) + (list 'le '<=) + (list 'ge '>=) + (list 'notequal '~=) + (list 'by '|by|) + (list 'arrow '->) + (list 'larrow '<-) + (list 'bar '|\||) + (list 'seg '|..|)) + nil)))) + +\end{chunk} + +\defun{lineoftoks}{lineoftoks} +lineoftoks bites off a token-dq from a line-stream +returning the token-dq and the rest of the line-stream +\begin{verbatim} +;lineoftoks(s)== +; $f: local:=nil +; $r:local :=nil +; $ln:local :=nil +; $linepos:local:=nil +; $n:local:=nil +; $sz:local := nil +; $floatok:local:=true +; if not nextline s +; then CONS(nil,nil) +; else +; if null scanIgnoreLine($ln,$n) -- line of spaces or starts ) or > +; then cons(nil,$r) +; else +; toks:=[] +; a:= incPrefix?('"command",1,$ln) +; a => +; $ln:=SUBSTRING($ln,8,nil) +; b:= dqUnit constoken($ln,$linepos,["command",$ln],0) +; cons([ [b,s] ],$r) +; +; while $n<$sz repeat toks:=dqAppend(toks,scanToken()) +; if null toks +; then cons([],$r) +; else cons([ [toks,s] ],$r) +\end{verbatim} +\calls{lineoftoks}{nextline} +\calls{lineoftoks}{scanIgnoreLine} +\calls{lineoftoks}{incPrefix?} +\calls{lineoftoks}{substring} +\calls{lineoftoks}{dqUnit} +\calls{lineoftoks}{constoken} +\usesdollar{lineoftoks}{floatok} +\usesdollar{lineoftoks}{f} +\usesdollar{lineoftoks}{sz} +\usesdollar{lineoftoks}{linepos} +\usesdollar{lineoftoks}{r} +\usesdollar{lineoftoks}{n} +\usesdollar{lineoftoks}{ln} +\label{lineoftoks} +\begin{chunk}{defun lineoftoks} +(defun |lineoftoks| (s) + (let (|$floatok| |$sz| |$n| |$linepos| |$ln| |$r| |$f| |b| |a| |toks|) + (declare (special |$floatok| |$f| |$sz| |$linepos| |$r| |$n| |$ln|)) + (setq |$f| nil) + (setq |$r| nil) + (setq |$ln| nil) + (setq |$linepos| nil) + (setq |$n| nil) + (setq |$sz| nil) + (setq |$floatok| t) + (cond + ((null (|nextline| s)) (cons nil nil)) + ((null (|scanIgnoreLine| |$ln| |$n|)) (cons nil |$r|)) + (t + (setq |toks| nil) + (setq |a| (|incPrefix?| "command" 1 |$ln|)) + (cond + (|a| + (setq |$ln| (substring |$ln| 8 nil)) + (setq |b| + (|dqUnit| (|constoken| |$ln| |$linepos| (list '|command| |$ln|) 0))) + (cons (list (list |b| s)) |$r|)) + (t + ((lambda () + (loop + (cond + ((not (< |$n| |$sz|)) (return nil)) + (t (setq |toks| (|dqAppend| |toks| (|scanToken|)))))))) + (cond + ((null |toks|) (cons nil |$r|)) + (t (cons (list (list |toks| s)) |$r|))))))))) + +\end{chunk} + +\defun{nextline}{nextline} +\calls{nextline}{npNull} +\calls{nextline}{strposl} +\usesdollar{nextline}{sz} +\usesdollar{nextline}{n} +\usesdollar{nextline}{linepos} +\usesdollar{nextline}{ln} +\usesdollar{nextline}{r} +\usesdollar{nextline}{f} +\begin{chunk}{defun nextline} +(defun |nextline| (s) + (declare (special |$sz| |$n| |$linepos| |$ln| |$r| |$f|)) + (cond + ((|npNull| s) nil) + (t + (setq |$f| (car s)) + (setq |$r| (cdr s)) + (setq |$ln| (cdr |$f|)) + (setq |$linepos| (caar |$f|)) + (setq |$n| (strposl " " |$ln| 0 t)) ; spaces at beginning + (setq |$sz| (length |$ln|)) + t))) + +\end{chunk} + +\defun{scanIgnoreLine}{scanIgnoreLine} +\calls{scanIgnoreLine}{incPrefix?} +\begin{chunk}{defun scanIgnoreLine} +(defun |scanIgnoreLine| (ln n) + (cond + ((null n) n) + (t + (cond + ((= (char-code (char ln 0)) (char-code #\))) + (cond + ((|incPrefix?| "command" 1 ln) t) + (t nil))) + (t n))))) + +\end{chunk} + +\defun{constoken}{constoken} +\calls{constoken}{ncPutQ} +\begin{chunk}{defun constoken} +(defun |constoken| (ln lp b n) + (declare (ignore ln)) + (let (a) + (setq a (cons (elt b 0) (elt b 1))) + (|ncPutQ| a '|posn| (cons lp n)) + a)) + +\end{chunk} + +\defun{scanToken}{scanToken} +\calls{scanToken}{startsComment?} +\calls{scanToken}{scanComment} +\calls{scanToken}{startsNegComment?} +\calls{scanToken}{scanNegComment} +\calls{scanToken}{lfid} +\calls{scanToken}{punctuation?} +\calls{scanToken}{scanPunct} +\calls{scanToken}{startsId?} +\calls{scanToken}{scanWord} +\calls{scanToken}{scanSpace} +\calls{scanToken}{scanString} +\calls{scanToken}{scanNumber} +\calls{scanToken}{scanEscape} +\calls{scanToken}{scanError} +\calls{scanToken}{dqUnit} +\calls{scanToken}{constoken} +\calls{scanToken}{lnExtraBlanks} +\usesdollar{scanToken}{linepos} +\usesdollar{scanToken}{n} +\usesdollar{scanToken}{ln} +\begin{chunk}{defun scanToken} +(defun |scanToken| () + (let (b ch n linepos c ln) + (declare (special |$linepos| |$n| |$ln|)) + (setq ln |$ln|) + (setq c (char-code (char |$ln| |$n|))) + (setq linepos |$linepos|) + (setq n |$n|) + (setq ch (elt |$ln| |$n|)) + (setq b + (cond + ((|startsComment?|) (|scanComment|) nil) + ((|startsNegComment?|) (|scanNegComment|) nil) + ((= c (char-code #\?)) + (setq |$n| (+ |$n| 1)) + (|lfid| "?")) + ((|punctuation?| c) (|scanPunct|)) + ((|startsId?| ch) (|scanWord| nil)) + ((= c (char-code #\space)) (|scanSpace|) nil) + ((= c (char-code #\")) (|scanString|)) + ((digitp ch) (|scanNumber|)) + ((= c (char-code #\_)) (|scanEscape|)) + (t (|scanError|)))) + (cond + ((null b) nil) + (t + (|dqUnit| + (|constoken| ln linepos b (+ n (|lnExtraBlanks| linepos)))))))) + +\end{chunk} + +\defun{lfid}{lfid} +To pair badge and badgee +\begin{chunk}{defun lfid 0} +(defun |lfid| (x) + (list '|id| (intern x "BOOT"))) + +\end{chunk} + +\defun{startsComment?}{Is it a ++ comment?} +\usesdollar{startsComment?}{ln} +\usesdollar{startsComment?}{sz} +\usesdollar{startsComment?}{n} +\begin{chunk}{defun startsComment? 0} +(defun |startsComment?| () + (let (www) + (declare (special |$ln| |$sz| |$n|)) + (cond + ((< |$n| |$sz|) + (cond + ((= (char-code (char |$ln| |$n|)) (char-code #\+)) + (setq www (+ |$n| 1)) + (cond + ((not (< www |$sz|)) nil) + (t (= (char-code (char |$ln| www)) (char-code #\+))))) + (t nil))) + (t nil)))) + +\end{chunk} + +\defun{scanComment}{scanComment} +\calls{scanComment}{lfcomment} +\calls{scanComment}{substring} +\usesdollar{scanComment}{ln} +\usesdollar{scanComment}{sz} +\usesdollar{scanComment}{n} +\begin{chunk}{defun scanComment} +(defun |scanComment| () + (let (n) + (declare (special |$ln| |$sz| |$n|)) + (setq n |$n|) + (setq |$n| |$sz|) + (|lfcomment| (substring |$ln| n nil)))) + +\end{chunk} + +\defun{lfcomment}{lfcomment} +\begin{chunk}{defun lfcomment 0} +(defun |lfcomment| (x) + (list '|comment| x)) + +\end{chunk} + +\defun{startsNegComment?}{Is it a -- comment?} +\usesdollar{startsNegComment?}{ln} +\usesdollar{startsNegComment?}{sz} +\usesdollar{startsNegComment?}{n} +\begin{chunk}{defun startsNegComment?} +(defun |startsNegComment?| () + (let (www) + (declare (special |$ln| |$sz| |$n|)) + (cond + ((< |$n| |$sz|) + (cond + ((= (char-code (char |$ln| |$n|)) (char-code #\-)) + (setq www (+ |$n| 1)) + (cond + ((not (< www |$sz|)) nil) + (t (= (char-code (char |$ln| www)) (char-code #\-))))) + (t nil))) + (t nil)))) + +\end{chunk} + +\defun{scanNegComment}{scanNegComment} +\calls{scanNegComment}{lfnegcomment} +\calls{scanNegComment}{substring} +\usesdollar{scanNegComment}{ln} +\usesdollar{scanNegComment}{sz} +\usesdollar{scanNegComment}{n} +\begin{chunk}{defun scanNegComment} +(defun |scanNegComment| () + (let (n) + (declare (special |$ln| |$sz| |$n|)) + (setq n |$n|) + (setq |$n| |$sz|) + (|lfnegcomment| (substring |$ln| n nil)))) + +\end{chunk} + +\defun{lfnegcomment}{lfnegcomment} +\begin{chunk}{defun lfnegcomment 0} +(defun |lfnegcomment| (x) + (list '|negcomment| x)) + +\end{chunk} + +\defun{punctuation?}{punctuation?} +\begin{chunk}{defun punctuation?} +(defun |punctuation?| (c) + (eql (elt |scanPun| c) 1)) + +\end{chunk} + +\defun{scanPunct}{scanPunct} +\calls{scanPunct}{subMatch} +\calls{scanPunct}{scanError} +\calls{scanPunct}{scanKeyTr} +\usesdollar{scanPunct}{n} +\usesdollar{scanPunct}{ln} +\begin{chunk}{defun scanPunct} +(defun |scanPunct| () + (let (a sss) + (declare (special |$n| |$ln|)) + (setq sss (|subMatch| |$ln| |$n|)) + (setq a (length sss)) + (cond + ((eql a 0) (|scanError|)) + (t (setq |$n| (+ |$n| a)) (|scanKeyTr| sss))))) + +\end{chunk} + +\defun{subMatch}{subMatch} +\calls{subMatch}{substringMatch} +\begin{chunk}{defun subMatch} +(defun |subMatch| (a b) + (|substringMatch| a |scanDict| b)) + +\end{chunk} + +\defun{substringMatch}{substringMatch} +\begin{verbatim} +;substringMatch (l,d,i)== +; h:= QENUM(l, i) +; u:=ELT(d,h) +; ll:=SIZE l +; done:=false +; s1:='"" +; for j in 0.. SIZE u - 1 while not done repeat +; s:=ELT(u,j) +; ls:=SIZE s +; done:=if ls+i > ll +; then false +; else +; eql:= true +; for k in 1..ls-1 while eql repeat +; eql:= EQL(QENUM(s,k),QENUM(l,k+i)) +; if eql +; then +; s1:=s +; true +; else false +; s1 +\end{verbatim} +\calls{substringMatch}{size} +\begin{chunk}{defun substringMatch} +(defun |substringMatch| (l dict i) + (let (equl ls s s1 done ll u h) + (setq h (char-code (char l i))) + (setq u (elt dict h)) + (setq ll (size l)) + (setq s1 "") + ((lambda (Var4 j) + (loop + (cond + ((or (> j Var4) done) (return nil)) + (t + (setq s (elt u j)) + (setq ls (size s)) + (setq done + (cond + ((< ll (+ ls i)) nil) + (t + (setq equl t) + ((lambda (Var5 k) + (loop + (cond + ((or (> k Var5) (not equl)) (return nil)) + (t + (setq equl (= (char-code (char s k)) + (char-code (char l (+ k i))))))) + (setq k (+ k 1)))) + (- ls 1) 1) + (cond (equl (setq s1 s) t) (t nil))))))) + (setq j (+ j 1)))) + (- (size u) 1) 0) + s1)) + +\end{chunk} + +\defun{scanKeyTr}{scanKeyTr} +\calls{scanKeyTr}{keyword} +\calls{scanKeyTr}{scanPossFloat} +\calls{scanKeyTr}{lfkey} +\calls{scanKeyTr}{scanCloser?} +\usesdollar{scanKeyTr}{floatok} +\begin{chunk}{defun scanKeyTr} +(defun |scanKeyTr| (w) + (declare (special |$floatok|)) + (cond + ((eq (|keyword| w) 'dot) + (cond + (|$floatok| (|scanPossFloat| w)) + (t (|lfkey| w)))) + (t (setq |$floatok| (null (|scanCloser?| w))) (|lfkey| w)))) + +\end{chunk} + +\defun{keyword}{keyword} +\calls{keyword}{hget} +\begin{chunk}{defun keyword 0} +(defun |keyword| (st) + (hget |scanKeyTable| st)) + +\end{chunk} + +\defun{keyword?}{keyword?} +\calls{keyword?}{hget} +\begin{chunk}{defun keyword? 0} +(defun |keyword?| (st) + (null (null (hget |scanKeyTable| st)))) + +\end{chunk} + +\defun{scanPossFloat}{scanPossFloat} +\calls{scanPossFloat}{lfkey} +\calls{scanPossFloat}{spleI} +\calls{scanPossFloat}{scanExponent} +\usesdollar{scanPossFloat}{ln} +\usesdollar{scanPossFloat}{sz} +\usesdollar{scanPossFloat}{n} +\begin{chunk}{defun scanPossFloat} +(defun |scanPossFloat| (w) + (declare (special |$ln| |$sz| |$n|)) + (cond + ((or (not (< |$n| |$sz|)) (null (digitp (elt |$ln| |$n|)))) + (|lfkey| w)) + (t + (setq w (|spleI| #'digitp)) (|scanExponent| "0" w)))) + +\end{chunk} + +\defun{digit?}{digit?} +\calls{digit?}{digitp} +\begin{chunk}{defun digit?} +(defun |digit?| (x) + (digitp x)) + +\end{chunk} + +\defun{lfkey}{lfkey} +\calls{lfkey}{keyword} +\begin{chunk}{defun lfkey} +(defun |lfkey| (x) + (list '|key| (|keyword| x))) + +\end{chunk} + +\defun{spleI}{spleI} +\calls{spleI}{spleI1} +\begin{chunk}{defun spleI} +(defun |spleI| (dig) + (|spleI1| dig nil)) + +\end{chunk} + +\defun{spleI1}{spleI1} +\calls{spleI1}{substring} +\calls{spleI1}{scanEsc} +\calls{spleI1}{spleI1} +\calls{spleI1}{concat} +\usesdollar{spleI1}{ln} +\usesdollar{spleI1}{sz} +\usesdollar{spleI1}{n} +\begin{chunk}{defun spleI1} +(defun |spleI1| (dig zro) + (let (bb a str l n) + (declare (special |$ln| |$sz| |$n|)) + (setq n |$n|) + (setq l |$sz|) + ; while $n=$sz +; then if nextline($r) +; then +; while null $n repeat nextline($r) +; scanEsc() +; false +; else false +; else +; n1:=STRPOSL('" ",$ln,$n,true) +; if null n1 +; then if nextline($r) +; then +; while null $n repeat nextline($r) +; scanEsc() +; false +; else false +; else +; if $n=n1 +; then true +; else if QENUM($ln,n1)=ESCAPE +; then +; $n:=n1+1 +; scanEsc() +; false +; else +; $n:=n1 +; startsNegComment?() or startsComment?() => +; nextline($r) +; scanEsc() +; false +; false +\end{verbatim} +\calls{scanEsc}{nextline} +\calls{scanEsc}{scanEsc} +\calls{scanEsc}{strposl} +\calls{scanEsc}{startsNegComment?} +\calls{scanEsc}{startsComment?} +\usesdollar{scanEsc}{ln} +\usesdollar{scanEsc}{r} +\usesdollar{scanEsc}{sz} +\usesdollar{scanEsc}{n} +\begin{chunk}{defun scanEsc} +(defun |scanEsc| () + (let (n1) + (declare (special |$ln| |$r| |$sz| |$n|)) + (cond + ((not (< |$n| |$sz|)) + (cond + ((|nextline| |$r|) + ((lambda () + (loop + (cond + (|$n| (return nil)) + (t (|nextline| |$r|)))))) + (|scanEsc|) + nil) + (t nil))) + (t + (setq n1 (strposl " " |$ln| |$n| t)) + (cond + ((null n1) + (cond + ((|nextline| |$r|) + ((lambda () + (loop + (cond + (|$n| (return nil)) + (t (|nextline| |$r|)))))) + (|scanEsc|) + nil) + (t nil))) + ((equal |$n| n1) t) + ((= (char-code (char |$ln| n1)) (char-code #\_)) + (setq |$n| (+ n1 1)) + (|scanEsc|) + nil) + (t (setq |$n| n1) + (cond + ((or (|startsNegComment?|) (|startsComment?|)) + (progn + (|nextline| |$r|) + (|scanEsc|) + nil)) + (t nil)))))))) + +\end{chunk} + +\defvar{scanCloser} +\begin{chunk}{postvars} +(eval-when (eval load) + (defvar |scanCloser| (list '|)| '} '] '|\|)| '|\|}| '|\|]|))) + +\end{chunk} + +\defun{scanCloser?}{scanCloser?} +\calls{scanCloser?}{keyword} +\uses{scanCloser?}{scanCloser} +\begin{chunk}{defun scanCloser? 0} +(defun |scanCloser?| (w) + (declare (special |scanCloser|)) + (member (|keyword| w) |scanCloser|)) + +\end{chunk} + +\defun{scanWord}{scanWord} +\calls{scanWord}{scanW} +\calls{scanWord}{lfid} +\calls{scanWord}{keyword?} +\calls{scanWord}{lfkey} +\usesdollar{scanWord}{floatok} +\begin{chunk}{defun scanWord} +(defun |scanWord| (esp) + (let (w aaa) + (declare (special |$floatok|)) + (setq aaa (|scanW| nil)) + (setq w (elt aaa 1)) + (setq |$floatok| nil) + (cond + ((or esp (elt aaa 0)) + (|lfid| w)) + ((|keyword?| w) + (setq |$floatok| t) + (|lfkey| w)) + (t + (|lfid| w))))) + +\end{chunk} + +\defun{scanExponent}{scanExponent} +\calls{scanExponent}{lffloat} +\calls{scanExponent}{digit?} +\calls{scanExponent}{spleI} +\calls{scanExponent}{concat} +\usesdollar{scanExponent}{ln} +\usesdollar{scanExponent}{sz} +\usesdollar{scanExponent}{n} +\begin{chunk}{defun scanExponent} +(defun |scanExponent| (a w) + (let (c1 e c n) + (declare (special |$ln| |$sz| |$n|)) + (cond + ((not (< |$n| |$sz|)) (|lffloat| a w "0")) + (t + (setq n |$n|) + (setq c (char-code (char |$ln| |$n|))) + (cond + ((or (= c (char-code #\E)) (= c (char-code #\e))) + (setq |$n| (+ |$n| 1)) + (cond + ((not (< |$n| |$sz|)) + (setq |$n| n) + (|lffloat| a w "0")) + ((digitp (elt |$ln| |$n|)) + (setq e (|spleI| #'digitp)) + (|lffloat| a w e)) + (t + (setq c1 (char-code (char |$ln| |$n|))) + (cond + ((or (= c1 (char-code #\+)) (= c1 (char-code #\-))) + (setq |$n| (+ |$n| 1)) + (cond + ((not (< |$n| |$sz|)) + (setq |$n| n) + (|lffloat| a w "0")) + ((digitp (elt |$ln| |$n|)) + (setq e (|spleI| #'digitp)) + (|lffloat| a w + (cond + ((= c1 (char-code #\-)) + (concat "-" e)) + (t e)))) + (t + (setq |$n| n) + (|lffloat| a w "0")))))))) + (t (|lffloat| a w "0"))))))) + +\end{chunk} + +\defun{lffloat}{lffloat} +\calls{lffloat}{concat} +\begin{chunk}{defun lffloat 0} +(defun |lffloat| (a w e) + (list '|float| (concat a "." w "e" e))) + +\end{chunk} + +\defmacro{idChar?} +\begin{chunk}{defmacro idChar? 0} +(defmacro |idChar?| (x) + `(or (alphanumericp ,x) (member ,x '(#\? #\% #\' #\!) :test #'char=))) + +\end{chunk} + +\defun{scanW}{scanW} +\calls{scanW}{posend} +\calls{scanW}{substring} +\calls{scanW}{scanEsc} +\calls{scanW}{scanW} +\calls{scanW}{idChar?} +\calls{scanW}{concat} +\usesdollar{scanW}{ln} +\usesdollar{scanW}{sz} +\usesdollar{scanW}{n} +\begin{chunk}{defun scanW} +(defun |scanW| (b) + (let (bb a str endid l n1) + (declare (special |$ln| |$sz| |$n|)) + (setq n1 |$n|) + (setq |$n| (+ |$n| 1)) + (setq l |$sz|) + (setq endid (|posend| |$ln| |$n|)) + (cond + ((or (equal endid l) + (not (= (char-code (char |$ln| endid)) (char-code #\_)))) + (setq |$n| endid) + (list b (substring |$ln| n1 (- endid n1)))) + (t + (setq str (substring |$ln| n1 (- endid n1))) + (setq |$n| (+ endid 1)) + (setq a (|scanEsc|)) + (setq bb + (cond + (a (|scanW| t)) + ((not (< |$n| |$sz|)) (list b "")) + ((|idChar?| (elt |$ln| |$n|)) (|scanW| b)) + (t (list b "")))) + (list (or (elt bb 0) b) (concat str (elt bb 1))))))) + +\end{chunk} + +\defun{posend}{posend} +\begin{verbatim} +;posend(line,n)== +; while n<#line and idChar? line.n repeat n:=n+1 +; n +\end{verbatim} +NOTE: do not replace ``lyne'' with ``line'' +\begin{chunk}{defun posend} +(defun |posend| (lyne n) + ((lambda () + (loop + (cond + ((not (and (< n (length lyne)) (|idChar?| (elt lyne n)))) + (return nil)) + (t (setq n (+ n 1))))))) + n) + +\end{chunk} + +\defun{scanSpace}{scanSpace} +\calls{scanSpace}{strposl} +\calls{scanSpace}{lfspaces} +\usesdollar{scanSpace}{floatok} +\usesdollar{scanSpace}{ln} +\usesdollar{scanSpace}{n} +\begin{chunk}{defun scanSpace} +(defun |scanSpace| () + (let (n) + (declare (special |$floatok| |$ln| |$n|)) + (setq n |$n|) + (setq |$n| (strposl " " |$ln| |$n| t)) + (when (null |$n|) (setq |$n| (length |$ln|))) + (setq |$floatok| t) + (|lfspaces| (- |$n| n)))) + +\end{chunk} + +\defun{lfspaces}{lfspaces} +\begin{chunk}{defun lfspaces 0} +(defun |lfspaces| (x) + (list '|spaces| x)) + +\end{chunk} + +\defun{scanString}{scanString} +\calls{scanString}{lfstring} +\calls{scanString}{scanS} +\usesdollar{scanString}{floatok} +\usesdollar{scanString}{n} +\begin{chunk}{defun scanString} +(defun |scanString| () + (declare (special |$floatok| |$n|)) + (setq |$n| (+ |$n| 1)) + (setq |$floatok| nil) + (|lfstring| (|scanS|))) + +\end{chunk} + +\defun{lfstring}{lfstring} +\begin{chunk}{defun lfstring 0} +(defun |lfstring| (x) + (if (eql (length x) 1) + (list '|char| x) + (list '|string| x))) + +\end{chunk} + +\defun{scanS}{scanS} +\calls{scanS}{ncSoftError} +\calls{scanS}{lnExtraBlanks} +\calls{scanS}{strpos} +\calls{scanS}{substring} +\calls{scanS}{scanEsc} +\calls{scanS}{concat} +\calls{scanS}{scanTransform} +\calls{scanS}{scanS} +\usesdollar{scanS}{ln} +\usesdollar{scanS}{linepos} +\usesdollar{scanS}{sz} +\usesdollar{scanS}{n} +\begin{chunk}{defun scanS} +(defun |scanS| () + (let (b a str mn escsym strsym n) + (declare (special |$ln| |$linepos| |$sz| |$n|)) + (cond + ((not (< |$n| |$sz|)) + (|ncSoftError| + (cons |$linepos| (+ (|lnExtraBlanks| |$linepos|) |$n|)) 'S2CN0001 nil) "") + (t + (setq n |$n|) + (setq strsym (or (strpos "\"" |$ln| |$n| nil) |$sz|)) + (setq escsym (or (strpos "_" |$ln| |$n| nil) |$sz|)) + (setq mn (min strsym escsym)) + (cond + ((equal mn |$sz|) + (setq |$n| |$sz|) + (|ncSoftError| + (cons |$linepos| (+ (|lnExtraBlanks| |$linepos|) |$n|)) 'S2CN0001 nil) + (substring |$ln| n nil)) + ((equal mn strsym) + (setq |$n| (+ mn 1)) + (substring |$ln| n (- mn n))) + (t + (setq str (substring |$ln| n (- mn n))) + (setq |$n| (+ mn 1)) + (setq a (|scanEsc|)) + (setq b + (cond + (a + (setq str (concat str (|scanTransform| (elt |$ln| |$n|)))) + (setq |$n| (+ |$n| 1)) (|scanS|)) + (t (|scanS|)))) + (concat str b))))))) + +\end{chunk} + +\defun{scanTransform}{scanTransform} +\begin{chunk}{defun scanTransform} +(defun |scanTransform| (x) x) + +\end{chunk} + +\defun{scanNumber}{scanNumber} +\calls{scanNumber}{spleI} +\calls{scanNumber}{lfinteger} +\calls{scanNumber}{spleI1} +\calls{scanNumber}{scanExponent} +\calls{scanNumber}{scanCheckRadix} +\calls{scanNumber}{lfrinteger} +\calls{scanNumber}{concat} +\usesdollar{scanNumber}{floatok} +\usesdollar{scanNumber}{ln} +\usesdollar{scanNumber}{sz} +\usesdollar{scanNumber}{n} +\begin{chunk}{defun scanNumber} +(defun |scanNumber| () + (let (v w n a) + (declare (special |$floatok| |$ln| |$sz| |$n|)) + (setq a (|spleI| #'digitp)) + (cond + ((not (< |$n| |$sz|)) + (|lfinteger| a)) + ((not (= (char-code (char |$ln| |$n|)) (char-code #\r))) + (cond + ((and |$floatok| (= (char-code (char |$ln| |$n|)) (char-code #\.))) + (setq n |$n|) + (setq |$n| (+ |$n| 1)) + (cond + ((and (< |$n| |$sz|) (= (char-code (char |$ln| |$n|)) (char-code #\.))) + (setq |$n| n) + (|lfinteger| a)) + (t + (setq w (|spleI1| #'digitp t)) + (|scanExponent| a w)))) + (t (|lfinteger| a)))) + (t + (setq |$n| (+ |$n| 1)) + (setq w (|spleI1| #'|rdigit?| t)) + (|scanCheckRadix| (parse-integer a) w) + (cond + ((not (< |$n| |$sz|)) + (|lfrinteger| a w)) + ((= (char-code (char |$ln| |$n|)) (char-code #\.)) + (setq n |$n|) + (setq |$n| (+ |$n| 1)) + (cond + ((and (< |$n| |$sz|) (= (char-code (char |$ln| |$n|)) (char-code #\.))) + (setq |$n| n) + (|lfrinteger| a w)) + (t + (setq v (|spleI1| #'|rdigit?| t)) + (|scanCheckRadix| (parse-integer a) v) + (|scanExponent| (concat a "r" w) v)))) + (t (|lfrinteger| a w))))))) + +\end{chunk} + +\defun{rdigit?}{rdigit?} +\calls{rdigit?}{strpos} +\begin{chunk}{defun rdigit? 0} +(defun |rdigit?| (x) + (strpos x "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" 0 nil)) + +\end{chunk} + +\defun{lfinteger}{lfinteger} +\begin{chunk}{defun lfinteger 0} +(defun |lfinteger| (x) + (list '|integer| x)) + +\end{chunk} + +\defun{lfrinteger}{lfrinteger} +\calls{lfrinteger}{concat} +\begin{chunk}{defun lfrinteger 0} +(defun |lfrinteger| (r x) + (list '|integer| (concat r (concat "r" x)))) + +\end{chunk} + +\defun{scanCheckRadix}{scanCheckRadix} +\begin{verbatim} +;scanCheckRadix(r,w)== +; ns:=#w +; done:=false +; for i in 0..ns-1 repeat +; a:=rdigit? w.i +; if null a or a>=r +; then ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n-ns+i), +; "S2CN0002", [w.i]) +\end{verbatim} +\usesdollar{scanCheckRadix}{n} +\usesdollar{scanCheckRadix}{linepos} +\begin{chunk}{defun scanCheckRadix} +(defun |scanCheckRadix| (r w) + (let (a ns) + (declare (special |$n| |$linepos|)) + (setq ns (length w)) + ((lambda (Var1 i) + (loop + (cond + ((> i Var1) (return nil)) + (t + (setq a (|rdigit?| (elt w i))) + (cond + ((or (null a) (not (< a r))) + (|ncSoftError| + (cons |$linepos| (+ (- (+ (|lnExtraBlanks| |$linepos|) |$n|) ns) i)) + 'S2CN0002 (list (elt w i))))))) + (setq i (+ i 1)))) + (- ns 1) 0))) + +\end{chunk} + +\defun{scanEscape}{scanEscape} +\calls{scanEscape}{scanEsc} +\calls{scanEscape}{scanWord} +\usesdollar{scanEscape}{n} +\begin{chunk}{defun scanEscape} +(defun |scanEscape| () + (declare (special |$n|)) + (setq |$n| (+ |$n| 1)) + (when (|scanEsc|) (|scanWord| t))) + +\end{chunk} + +\defun{scanError}{scanError} +\calls{scanError}{ncSoftError} +\calls{scanError}{lnExtraBlanks} +\calls{scanError}{lferror} +\usesdollar{scanError}{ln} +\usesdollar{scanError}{linepos} +\usesdollar{scanError}{n} +\begin{chunk}{defun scanError} +(defun |scanError| () + (let (n) + (declare (special |$ln| |$linepos| |$n|)) + (setq n |$n|) + (setq |$n| (+ |$n| 1)) + (|ncSoftError| + (cons |$linepos| (+ (|lnExtraBlanks| |$linepos|) |$n|)) + 'S2CN0003 (list (elt |$ln| n))) + (|lferror| (elt |$ln| n)))) + +\end{chunk} + +\defun{lferror}{lferror} +\begin{chunk}{defun lferror 0} +(defun |lferror| (x) + (list '|error| x)) + +\end{chunk} + +\defvar{scanKeyTable} +\begin{chunk}{postvars} +(eval-when (eval load) + (defvar |scanKeyTable| (|scanKeyTableCons|))) + +\end{chunk} + +\defun{scanKeyTableCons}{scanKeyTableCons} +This function is used to build the scanKeyTable +\begin{verbatim} +;scanKeyTableCons()== +; KeyTable:=MAKE_-HASHTABLE("CVEC",true) +; for st in scanKeyWords repeat +; HPUT(KeyTable,CAR st,CADR st) +; KeyTable +\end{verbatim} +\begin{chunk}{defun scanKeyTableCons} +(defun |scanKeyTableCons| () + (let (KeyTable) + (setq KeyTable (make-hash-table :test #'equal)) + ((lambda (Var6 st) + (loop + (cond + ((or (atom Var6) (progn (setq st (car Var6)) nil)) + (return nil)) + (t + (hput KeyTable (car st) (cadr st)))) + (setq Var6 (cdr Var6)))) + |scanKeyWords| nil) + KeyTable)) + +\end{chunk} + +\defvar{scanDict} +\begin{chunk}{postvars} +(eval-when (eval load) + (defvar |scanDict| (|scanDictCons|))) + +\end{chunk} + +\defun{scanDictCons}{scanDictCons} +\begin{verbatim} +;scanDictCons()== +; l:= HKEYS scanKeyTable +; d := +; a:=MAKE_-VEC(256) +; b:=MAKE_-VEC(1) +; VEC_-SETELT(b,0,MAKE_-CVEC 0) +; for i in 0..255 repeat VEC_-SETELT(a,i,b) +; a +; for s in l repeat scanInsert(s,d) +; d +\end{verbatim} +\calls{scanDictCons}{hkeys} +\begin{chunk}{defun scanDictCons} +(defun |scanDictCons| () + (let (d b a l) + (setq l (hkeys |scanKeyTable|)) + (setq d + (progn + (setq a (make-array 256)) + (setq b (make-array 1)) + (setf (svref b 0) + (make-array 0 :fill-pointer 0 :element-type 'string-char)) + ((lambda (i) + (loop + (cond + ((> i 255) (return nil)) + (t (setf (svref a i) b))) + (setq i (+ i 1)))) + 0) + a)) + ((lambda (Var7 s) + (loop + (cond + ((or (atom Var7) (progn (setq s (car Var7)) nil)) + (return nil)) + (t (|scanInsert| s d))) + (setq Var7 (cdr Var7)))) + l nil) + d)) + +\end{chunk} + +\defun{scanInsert}{scanInsert} +\begin{verbatim} +;scanInsert(s,d) == +; l := #s +; h := QENUM(s,0) +; u := ELT(d,h) +; n := #u +; k:=0 +; while l <= #(ELT(u,k)) repeat +; k:=k+1 +; v := MAKE_-VEC(n+1) +; for i in 0..k-1 repeat VEC_-SETELT(v,i,ELT(u,i)) +; VEC_-SETELT(v,k,s) +; for i in k..n-1 repeat VEC_-SETELT(v,i+1,ELT(u,i)) +; VEC_-SETELT(d,h,v) +; s +\end{verbatim} +\begin{chunk}{defun scanInsert} +(defun |scanInsert| (s d) + (let (v k n u h l) + (setq l (length s)) + (setq h (char-code (char s 0))) + (setq u (elt d h)) + (setq n (length u)) + (setq k 0) + ((lambda () + (loop + (cond + ((< (length (elt u k)) l) (return nil)) + (t (setq k (+ k 1))))))) + (setq v (make-array (+ n 1))) + ((lambda (Var2 i) + (loop + (cond + ((> i Var2) (return nil)) + (t (setf (svref v i) (elt u i)))) + (setq i (+ i 1)))) + (- k 1) 0) + (setf (svref v k) s) + ((lambda (Var3 i) + (loop + (cond + ((> i Var3) (return nil)) + (t (setf (svref v (+ i 1)) (elt u i)))) + (setq i (+ i 1)))) + (- n 1) k) + (setf (svref d h) v) + s)) + +\end{chunk} + +\defvar{scanPun} +\begin{chunk}{postvars} +(eval-when (eval load) + (defvar |scanPun| (|scanPunCons|))) + +\end{chunk} + +\defun{scanPunCons}{scanPunCons} +\begin{verbatim} +;scanPunCons()== +; listing := HKEYS scanKeyTable +; a:=MAKE_-BVEC 256 +; for i in 0..255 repeat BVEC_-SETELT(a,i,0) +; for k in listing repeat +; if not startsId? k.0 +; then BVEC_-SETELT(a,QENUM(k,0),1) +; a +\end{verbatim} +\calls{scanPunCons}{hkeys} +\begin{chunk}{defun scanPunCons} +(defun |scanPunCons| () + (let (a listing) + (setq listing (hkeys |scanKeyTable|)) + (setq a (make-array (list 256) :element-type 'bit :initial-element 0)) + ((lambda (i) + (loop + (cond + ((> i 255) (return nil)) + (t (setf (sbit a i) 0))) + (setq i (+ i 1)))) + 0) + ((lambda (Var8 k) + (loop + (cond + ((or (atom Var8) (progn (setq k (car Var8)) nil)) + (return nil)) + (t + (cond + ((null (|startsId?| (elt k 0))) + (setf (sbit a (char-code (char k 0))) 1))))) + (setq Var8 (cdr Var8)))) + listing nil) + a)) + +\end{chunk} + +\chapter{Input Stream Parser} + +\defun{npParse}{Input Stream Parser} +\catches{npParse}{trappoint} +\calls{npParse}{npFirstTok} +\calls{npParse}{npItem} +\calls{npParse}{ncSoftError} +\calls{npParse}{tokPosn} +\calls{npParse}{pfWrong} +\calls{npParse}{pfDocument} +\calls{npParse}{pfListOf} +\usesdollar{npParse}{ttok} +\usesdollar{npParse}{stok} +\usesdollar{npParse}{stack} +\usesdollar{npParse}{inputStream} +\begin{chunk}{defun npParse} +(defun |npParse| (stream) + (let (|$ttok| |$stok| |$stack| |$inputStream| found) + (declare (special |$ttok| |$stack| |$inputStream| |$stok|)) + (setq |$inputStream| stream) + (setq |$stack| nil) + (setq |$stok| nil) + (setq |$ttok| nil) + (|npFirstTok|) + (setq found (catch 'trappoint (|npItem|))) + (cond + ((eq found 'trapped) + (|ncSoftError| (|tokPosn| |$stok|) 's2cy0006 nil) + (|pfWrong| (|pfDocument| "top level syntax error") (|pfListOf| nil))) + ((null (null |$inputStream|)) + (|ncSoftError| (|tokPosn| |$stok|) 's2cy0002 nil) + (|pfWrong| + (|pfDocument| (list "input stream not exhausted")) + (|pfListOf| nil))) + ((null |$stack|) + (|ncSoftError| (|tokPosn| |$stok|) 's2cy0009 nil) + (|pfWrong| (|pfDocument| (list "stack empty")) (|pfListOf| nil))) + (t (car |$stack|))))) + +\end{chunk} + +\defun{npItem}{npItem} +\calls{npItem}{npQualDef} +\calls{npItem}{npEqKey} +\calls{npItem}{npItem1} +\calls{npItem}{npPop1} +\calls{npItem}{pfEnSequence} +\calls{npItem}{npPush} +\calls{npItem}{pfNovalue} +\begin{chunk}{defun npItem} +(defun |npItem| () + (let (c b a tmp1) + (when (|npQualDef|) + (if (|npEqKey| 'semicolon) + (progn + (setq tmp1 (|npItem1| (|npPop1|))) + (setq a (car tmp1)) + (setq b (cadr tmp1)) + (setq c (|pfEnSequence| b)) + (if a + (|npPush| c) + (|npPush| (|pfNovalue| c)))) + (|npPush| (|pfEnSequence| (|npPop1|))))))) + +\end{chunk} + +\defun{npItem1}{npItem1} +\calls{npItem1}{npQualDef} +\calls{npItem1}{npEqKey} +\calls{npItem1}{npItem1} +\calls{npItem1}{npPop1} +\begin{chunk}{defun npItem1} +(defun |npItem1| (c) + (let (b a tmp1) + (if (|npQualDef|) + (if (|npEqKey| 'semicolon) + (progn + (setq tmp1 (|npItem1| (|npPop1|))) + (setq a (car tmp1)) + (setq b (cadr tmp1)) + (list a (append c b))) + (list t (append c (|npPop1|)))) + (list nil c)))) + +\end{chunk} + +\defun{npFirstTok}{npFirstTok} +Sets the current leaf (\$stok) to the next leaf in the input stream. +Sets the current token (\$ttok) cdr of the leaf. +A leaf token looks like [head, token, position] +where head is either an id or (id . alist) + +\calls{npFirstTok}{tokConstruct} +\calls{npFirstTok}{tokPosn} +\calls{npFirstTok}{tokPart} +\usesdollar{npFirstTok}{ttok} +\usesdollar{npFirstTok}{stok} +\usesdollar{npFirstTok}{inputStream} +\begin{chunk}{defun npFirstTok} +(defun |npFirstTok| () + (declare (special |$ttok| |$stok| |$inputStream|)) + (if (null |$inputStream|) + (setq |$stok| (|tokConstruct| 'error 'nomore (|tokPosn| |$stok|))) + (setq |$stok| (car |$inputStream|))) + (setq |$ttok| (|tokPart| |$stok|))) + +\end{chunk} + +\defun{npPush}{Push one item onto \$stack} +\usesdollar{npPush}{stack} +\begin{chunk}{defun npPush 0} +(defun |npPush| (x) + (declare (special |$stack|)) + (push x |$stack|)) + +\end{chunk} + +\defun{npPop1}{Pop one item off \$stack} +\usesdollar{npPop1}{stack} +\begin{chunk}{defun npPop1 0} +(defun |npPop1| () + (declare (special |$stack|)) + (pop |$stack|)) + +\end{chunk} + +\defun{npPop2}{Pop the second item off \$stack} +\usesdollar{npPop2}{stack} +\begin{chunk}{defun npPop2 0} +(defun |npPop2| () + (let (a) + (declare (special |$stack|)) + (setq a (cadr |$stack|)) + (rplacd |$stack| (cddr |$stack|)) + a)) + +\end{chunk} + +\defun{npPop3}{Pop the third item off \$stack} +\usesdollar{npPop3}{stack} +\begin{chunk}{defun npPop3 0} +(defun |npPop3| () + (let (a) + (declare (special |$stack|)) + (setq a (caddr |$stack|)) + (rplacd (cdr |$stack|) (cdddr |$stack|)) a)) + +\end{chunk} + +\defun{npQualDef}{npQualDef} +\calls{npQualDef}{npComma} +\calls{npQualDef}{npPush} +\calls{npQualDef}{npPop1} +\begin{chunk}{defun npQualDef} +(defun |npQualDef| () + (and (|npComma|) (|npPush| (list (|npPop1|))))) + +\end{chunk} + +\defun{npEqKey}{Advance over a keyword} +Test for the keyword, if found advance the token stream + +\calls{npEqKey}{npNext} +\usesdollar{npEqKey}{ttok} +\usesdollar{npEqKey}{stok} +\begin{chunk}{defun npEqKey} +(defun |npEqKey| (keyword) + (declare (special |$ttok| |$stok|)) + (and + (eq (caar |$stok|) '|key|) + (eq keyword |$ttok|) + (|npNext|))) + +\end{chunk} + +\defun{npNext}{Advance the input stream} +This advances the input stream. The call to npFirstTok picks off the +next token in the input stream and updates the current leaf (\$stok) +and the current token (\$ttok) + +\calls{npNext}{npFirstTok} +\usesdollar{npNext}{inputStream} +\begin{chunk}{defun npNext} +(defun |npNext| () + (declare (special |$inputStream|)) + (setq |$inputStream| (cdr |$inputStream|)) + (|npFirstTok|)) + +\end{chunk} + +\defun{npComma}{npComma} +\calls{npComma}{npTuple} +\calls{npComma}{npQualifiedDefinition} +\begin{chunk}{defun npComma} +(defun |npComma| () + (|npTuple| #'|npQualifiedDefinition|)) + +\end{chunk} + +\defun{npTuple}{npTuple} +\calls{npTuple}{npListofFun} +\calls{npTuple}{npCommaBackSet} +\calls{npTuple}{pfTupleListOf} +\begin{chunk}{defun npTuple} +(defun |npTuple| (|p|) + (|npListofFun| |p| #'|npCommaBackSet| #'|pfTupleListOf|)) + +\end{chunk} + +\defun{npCommaBackSet}{npCommaBackSet} +\calls{npCommaBackSet}{npEqKey} +\begin{chunk}{defun npCommaBackSet} +(defun |npCommaBackSet| () + (and + (|npEqKey| 'comma) + (or (|npEqKey| 'backset) t))) + +\end{chunk} + +\defun{npQualifiedDefinition}{npQualifiedDefinition} +\calls{npQualifiedDefinition}{npQualified} +\calls{npQualifiedDefinition}{npDefinitionOrStatement} +\begin{chunk}{defun npQualifiedDefinition} +(defun |npQualifiedDefinition| () + (|npQualified| #'|npDefinitionOrStatement|)) + +\end{chunk} + +\defun{npQualified}{npQualified} +\calls{npQualified}{npEqKey} +\calls{npQualified}{npDefinition} +\calls{npQualified}{npTrap} +\calls{npQualified}{npPush} +\calls{npQualified}{pfWhere} +\calls{npQualified}{npPop1} +\calls{npQualified}{npLetQualified} +\begin{chunk}{defun npQualified} +(defun |npQualified| (f) + (if (funcall f) + (progn + (do () ; while ... do + ((not (and (|npEqKey| 'where) (or (|npDefinition|) (|npTrap|))))) + (|npPush| (|pfWhere| (|npPop1|) (|npPop1|)))) + t) + (|npLetQualified| f))) + +\end{chunk} + +\defun{npDefinitionOrStatement}{npDefinitionOrStatement} +\calls{npDefinitionOrStatement}{npBackTrack} +\calls{npDefinitionOrStatement}{npGives} +\calls{npDefinitionOrStatement}{npDef} +\begin{chunk}{defun npDefinitionOrStatement} +(defun |npDefinitionOrStatement| () + (|npBackTrack| #'|npGives| 'def #'|npDef|)) + +\end{chunk} + +\defun{npBackTrack}{npBackTrack} +\calls{npBackTrack}{npState} +\calls{npBackTrack}{npEqPeek} +\calls{npBackTrack}{npRestore} +\calls{npBackTrack}{npTrap} +\begin{chunk}{defun npBackTrack} +(defun |npBackTrack| (p1 p2 p3) + (let (a) + (setq a (|npState|)) + (when (apply p1 nil) + (cond + ((|npEqPeek| p2) + (|npRestore| a) + (or (apply p3 nil) (|npTrap|))) + (t t))))) + +\end{chunk} + +\defun{npGives}{npGives} +\calls{npGives}{npBackTrack} +\calls{npGives}{npExit} +\calls{npGives}{npLambda} +\begin{chunk}{defun npGives} +(defun |npGives| () + (|npBackTrack| #'|npExit| 'gives #'|npLambda|)) + +\end{chunk} + +\defun{npLambda}{npLambda} +\calls{npLambda}{npVariable} +\calls{npLambda}{npLambda} +\calls{npLambda}{npTrap} +\calls{npLambda}{npPush} +\calls{npLambda}{pfLam} +\calls{npLambda}{npPop2} +\calls{npLambda}{npPop1} +\calls{npLambda}{npEqKey} +\calls{npLambda}{npDefinitionOrStatement} +\calls{npLambda}{npType} +\calls{npLambda}{pfReturnTyped} +\begin{chunk}{defun npLambda} +(defun |npLambda| () + (or + (and + (|npVariable|) + (or (|npLambda|) (|npTrap|)) + (|npPush| (|pfLam| (|npPop2|) (|npPop1|)))) + (and + (|npEqKey| 'gives) + (or (|npDefinitionOrStatement|) (|npTrap|))) + (and + (|npEqKey| 'colon) + (or (|npType|) (|npTrap|)) + (|npEqKey| 'gives) + (or (|npDefinitionOrStatement|) (|npTrap|)) + (|npPush| (|pfReturnTyped| (|npPop2|) (|npPop1|)))))) + +\end{chunk} + +\defun{npType}{npType} +\calls{npType}{npMatch} +\calls{npType}{npPop1} +\calls{npType}{npWith} +\calls{npType}{npPush} +\begin{chunk}{defun npType} +(defun |npType| () + (and + (|npMatch|) + (let ((a (|npPop1|))) + (or + (|npWith| a) + (|npPush| a))))) + +\end{chunk} + +\defun{npMatch}{npMatch} +\calls{npMatch}{npLeftAssoc} +\calls{npMatch}{npSuch} +\begin{chunk}{defun npMatch} +(defun |npMatch| () + (|npLeftAssoc| '(is isnt) #'|npSuch|)) + +\end{chunk} + +\defun{npSuch}{npSuch} +\calls{npSuch}{npLeftAssoc} +\calls{npSuch}{npLogical} +\begin{chunk}{defun npSuch} +(defun |npSuch| () + (|npLeftAssoc| '(bar) #'|npLogical|)) + +\end{chunk} + +\defun{npWith}{npWith} +\calls{npWith}{npEqKey} +\calls{npWith}{npState} +\calls{npWith}{npCategoryL} +\calls{npWith}{npTrap} +\calls{npWith}{npEqPeek} +\calls{npWith}{npRestore} +\calls{npWith}{npVariable} +\calls{npWith}{npCompMissing} +\calls{npWith}{npPush} +\calls{npWith}{pfWith} +\calls{npWith}{npPop2} +\calls{npWith}{npPop1} +\calls{npWith}{pfNothing} +\begin{chunk}{defun npWith} +(defun |npWith| (extra) + (let (a) + (and + (|npEqKey| 'with) + (progn + (setq a (|npState|)) + (or (|npCategoryL|) (|npTrap|)) + (if (|npEqPeek| 'in) + (progn + (|npRestore| a) + (and + (or (|npVariable|) (|npTrap|)) + (|npCompMissing| 'in) + (or (|npCategoryL|) (|npTrap|)) + (|npPush| (|pfWith| (|npPop2|) (|npPop1|) extra)))) + (|npPush| (|pfWith| (|pfNothing|) (|npPop1|) extra))))))) + +\end{chunk} + +\defun{npCompMissing}{npCompMissing} +\calls{npCompMissing}{npEqKey} +\calls{npCompMissing}{npMissing} +\begin{chunk}{defun npCompMissing} +(defun |npCompMissing| (s) + (or (|npEqKey| s) (|npMissing| s))) + +\end{chunk} + +\defun{npMissing}{npMissing} +\throws{npMissing}{trappoint} +\calls{npMissing}{ncSoftError} +\calls{npMissing}{tokPosn} +\calls{npMissing}{pname} +\usesdollar{npMissing}{stok} +\begin{chunk}{defun npMissing} +(defun |npMissing| (s) + (declare (special |$stok|)) + (|ncSoftError| (|tokPosn| |$stok|) 'S2CY0007 (list (pname s))) + (throw 'trappoint 'trapped)) + +\end{chunk} + +\defun{npRestore}{npRestore} +\calls{npRestore}{npFirstTok} +\usesdollar{npRestore}{stack} +\usesdollar{npRestore}{inputStream} +\begin{chunk}{defun npRestore} +(defun |npRestore| (x) + (declare (special |$stack| |$inputStream|)) + (setq |$inputStream| (car x)) + (|npFirstTok|) + (setq |$stack| (cdr x)) + t) + +\end{chunk} + +\defun{npEqPeek}{Peek for keyword s, no advance of token stream} +\usesdollar{npEqPeek}{ttok} +\usesdollar{npEqPeek}{stok} +\begin{chunk}{defun npEqPeek 0} +(defun |npEqPeek| (s) + (declare (special |$ttok| |$stok|)) + (and (eq (caar |$stok|) '|key|) (eq s |$ttok|))) + +\end{chunk} + +\defun{npCategoryL}{npCategoryL} +\calls{npCategoryL}{npCategory} +\calls{npCategoryL}{npPush} +\calls{npCategoryL}{pfUnSequence} +\calls{npCategoryL}{npPop1} +\begin{chunk}{defun npCategoryL} +(defun |npCategoryL| () + (and + (|npCategory|) + (|npPush| (|pfUnSequence| (|npPop1|))))) + +\end{chunk} + +\defun{npCategory}{npCategory} +\calls{npCategory}{npPP} +\calls{npCategory}{npSCategory} +\begin{chunk}{defun npCategory} +(defun |npCategory| () + (|npPP| #'|npSCategory|)) + +\end{chunk} + +\defun{npSCategory}{npSCategory} +\calls{npSCategory}{npWConditional} +\calls{npSCategory}{npCategoryL} +\calls{npSCategory}{npPush} +\calls{npSCategory}{npPop1} +\calls{npSCategory}{npDefaultValue} +\calls{npSCategory}{npState} +\calls{npSCategory}{npPrimary} +\calls{npSCategory}{npEqPeek} +\calls{npSCategory}{npRestore} +\calls{npSCategory}{npSignature} +\calls{npSCategory}{npApplication} +\calls{npSCategory}{pfAttribute} +\calls{npSCategory}{npTrap} +\begin{chunk}{defun npSCategory} +(defun |npSCategory| () + (let (a) + (cond + ((|npWConditional| #'|npCategoryL|) (|npPush| (list (|npPop1|)))) + ((|npDefaultValue|) t) + (t + (setq a (|npState|)) + (cond + ((|npPrimary|) + (cond + ((|npEqPeek| 'colon) (|npRestore| a) (|npSignature|)) + (t + (|npRestore| a) + (or + (and (|npApplication|) (|npPush| (list (|pfAttribute| (|npPop1|))))) + (|npTrap|))))) + (t nil)))))) + +\end{chunk} + +\defun{npSignature}{npSignature} +\calls{npSignature}{npSigItemlist} +\calls{npSignature}{npPush} +\calls{npSignature}{pfWDec} +\calls{npSignature}{pfNothing} +\calls{npSignature}{npPop1} +\begin{chunk}{defun npSignature} +(defun |npSignature| () + (and (|npSigItemlist|) (|npPush| (|pfWDec| (|pfNothing|) (|npPop1|))))) + +\end{chunk} + +\defun{npSigItemlist}{npSigItemlist} +\calls{npSigItemlist}{npListing} +\calls{npSigItemlist}{npSigItem} +\calls{npSigItemlist}{npPush} +\calls{npSigItemlist}{pfListOf} +\calls{npSigItemlist}{pfAppend} +\calls{npSigItemlist}{pfParts} +\calls{npSigItemlist}{npPop1} +\begin{chunk}{defun npSigItemlist} +(defun |npSigItemlist| () + (and + (|npListing| #'|npSigItem|) + (|npPush| (|pfListOf| (|pfAppend| (|pfParts| (|npPop1|))))))) + +\end{chunk} + +\defun{npListing}{npListing} +\calls{npListing}{npList} +\calls{npListing}{pfListOf} +\begin{chunk}{defun npListing} +(defun |npListing| (p) + (|npList| p 'comma #'|pfListOf|)) + +\end{chunk} + +\defun{npList}{Always produces a list, fn is applied to it} +\calls{npList}{npEqKey} +\calls{npList}{npTrap} +\calls{npList}{npPush} +\calls{npList}{npPop3} +\calls{npList}{npPop2} +\calls{npList}{npPop1} +\usesdollar{npList}{stack} +\begin{chunk}{defun npList} +(defun |npList| (f str1 fn) + (let (a) + (declare (special |$stack|)) + (cond + ((apply f nil) + (cond + ((and (|npEqKey| str1) + (or (|npEqKey| 'backset) t) + (or (apply f nil) (|npTrap|))) + (setq a |$stack|) + (setq |$stack| nil) + (do () ; while .. do nothing + ((not + (and (|npEqKey| str1) + (or (|npEqKey| 'backset) t) + (or (apply f nil) (|npTrap|)))) + nil)) + (setq |$stack| (cons (nreverse |$stack|) a)) + (|npPush| (funcall fn (cons (|npPop3|) (cons (|npPop2|) (|npPop1|)))))) + (t (|npPush| (funcall fn (list (|npPop1|))))))) + (t (|npPush| (funcall fn nil)))))) + +\end{chunk} + +\defun{npSigItem}{npSigItem} +\calls{npSigItem}{npTypeVariable} +\calls{npSigItem}{npSigDecl} +\calls{npSigItem}{npTrap} +\begin{chunk}{defun npSigItem} +(defun |npSigItem| () + (and (|npTypeVariable|) (or (|npSigDecl|) (|npTrap|)))) + +\end{chunk} + +\defun{npTypeVariable}{npTypeVariable} +\calls{npTypeVariable}{npParenthesized} +\calls{npTypeVariable}{npTypeVariablelist} +\calls{npTypeVariable}{npSignatureDefinee} +\calls{npTypeVariable}{npPush} +\calls{npTypeVariable}{pfListOf} +\calls{npTypeVariable}{npPop1} +\begin{chunk}{defun npTypeVariable} +(defun |npTypeVariable| () + (or + (|npParenthesized| #'|npTypeVariablelist|) + (and (|npSignatureDefinee|) (|npPush| (|pfListOf| (list (|npPop1|))))))) + +\end{chunk} + +\defun{npSignatureDefinee}{npSignatureDefinee} +\calls{npSignatureDefinee}{npName} +\calls{npSignatureDefinee}{npInfixOperator} +\calls{npSignatureDefinee}{npPrefixColon} +\begin{chunk}{defun npSignatureDefinee} +(defun |npSignatureDefinee| () + (or (|npName|) (|npInfixOperator|) (|npPrefixColon|))) + +\end{chunk} + +\defun{npTypeVariablelist}{npTypeVariablelist} +\calls{npTypeVariablelist}{npListing} +\calls{npTypeVariablelist}{npSignatureDefinee} +\begin{chunk}{defun npTypeVariablelist} +(defun |npTypeVariablelist| () + (|npListing| #'|npSignatureDefinee|)) + +\end{chunk} + +\defun{npSigDecl}{npSigDecl} +\calls{npSigDecl}{npEqKey} +\calls{npSigDecl}{npType} +\calls{npSigDecl}{npTrap} +\calls{npSigDecl}{npPush} +\calls{npSigDecl}{pfSpread} +\calls{npSigDecl}{pfParts} +\calls{npSigDecl}{npPop2} +\calls{npSigDecl}{npPop1} +\begin{chunk}{defun npSigDecl} +(defun |npSigDecl| () + (and + (|npEqKey| 'colon) + (or (|npType|) (|npTrap|)) + (|npPush| (|pfSpread| (|pfParts| (|npPop2|)) (|npPop1|))))) + +\end{chunk} + +\defun{npPrimary}{npPrimary} +\calls{npPrimary}{npPrimary1} +\calls{npPrimary}{npPrimary2} +\begin{chunk}{defun npPrimary} +(defun |npPrimary| () + (or (|npPrimary1|) (|npPrimary2|))) + +\end{chunk} + +\defun{npPrimary2}{npPrimary2} +\calls{npPrimary2}{npEncAp} +\calls{npPrimary2}{npAtom2} +\calls{npPrimary2}{npAdd} +\calls{npPrimary2}{pfNothing} +\calls{npPrimary2}{npWith} +\begin{chunk}{defun npPrimary2} +(defun |npPrimary2| () + (or + (|npEncAp| #'|npAtom2|) + (|npAdd| (|pfNothing|)) + (|npWith| (|pfNothing|)))) + +\end{chunk} + +\defun{npADD}{npADD} +\tpdhere{Note that there is also an npAdd function} + +\calls{npADD}{npType} +\calls{npADD}{npPop1} +\calls{npADD}{npAdd} +\calls{npADD}{npPush} +\begin{chunk}{defun npADD} +(defun |npADD| () + (let (a) + (and + (|npType|) + (progn + (setq a (|npPop1|)) + (or + (|npAdd| a) + (|npPush| a)))))) + +\end{chunk} + +\defun{npAdd}{npAdd} +\tpdhere{Note that there is also an npADD function} + +\calls{npAdd}{npEqKey} +\calls{npAdd}{npState} +\calls{npAdd}{npDefinitionOrStatement} +\calls{npAdd}{npTrap} +\calls{npAdd}{npEqPeek} +\calls{npAdd}{npRestore} +\calls{npAdd}{npVariable} +\calls{npAdd}{npCompMissing} +\calls{npAdd}{npDefinitionOrStatement} +\calls{npAdd}{npPush} +\calls{npAdd}{pfAdd} +\calls{npAdd}{npPop2} +\calls{npAdd}{npPop1} +\calls{npAdd}{pfNothing} +\begin{chunk}{defun npAdd} +(defun |npAdd| (extra) + (let (a) + (and + (|npEqKey| 'add) + (progn + (setq a (|npState|)) + (or (|npDefinitionOrStatement|) (|npTrap|)) + (cond + ((|npEqPeek| 'in) + (progn + (|npRestore| a) + (and + (or (|npVariable|) (|npTrap|)) + (|npCompMissing| 'in) + (or (|npDefinitionOrStatement|) (|npTrap|)) + (|npPush| (|pfAdd| (|npPop2|) (|npPop1|) extra))))) + (t + (|npPush| (|pfAdd| (|pfNothing|) (|npPop1|) extra)))))))) + +\end{chunk} + +\defun{npAtom2}{npAtom2} +\calls{npAtom2}{npInfixOperator} +\calls{npAtom2}{npAmpersand} +\calls{npAtom2}{npPrefixColon} +\calls{npAtom2}{npFromdom} +\begin{chunk}{defun npAtom2} +(defun |npAtom2| () + (and + (or (|npInfixOperator|) (|npAmpersand|) (|npPrefixColon|)) + (|npFromdom|))) + +\end{chunk} + +\defun{npInfixOperator}{npInfixOperator} +\calls{npInfixOperator}{npInfixOp} +\calls{npInfixOperator}{npState} +\calls{npInfixOperator}{npEqKey} +\calls{npInfixOperator}{npInfixOp} +\calls{npInfixOperator}{npPush} +\calls{npInfixOperator}{pfSymb} +\calls{npInfixOperator}{npPop1} +\calls{npInfixOperator}{tokPosn} +\calls{npInfixOperator}{npRestore} +\calls{npInfixOperator}{tokConstruct} +\calls{npInfixOperator}{tokPart} +\usesdollar{npInfixOperator}{stok} +\begin{chunk}{defun npInfixOperator} +(defun |npInfixOperator| () + (let (b a) + (declare (special |$stok|)) + (or (|npInfixOp|) + (progn + (setq a (|npState|)) + (setq b |$stok|) + (cond + ((and (|npEqKey| '|'|) (|npInfixOp|)) + (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| b)))) + (t + (|npRestore| a) + (cond + ((and (|npEqKey| 'backquote) (|npInfixOp|)) + (setq a (|npPop1|)) + (|npPush| (|tokConstruct| '|idsy| (|tokPart| a) (|tokPosn| a)))) + (t + (|npRestore| a) + nil)))))))) + +\end{chunk} + +\defun{npInfixOp}{npInfixOp} +\calls{npInfixOp}{npPushId} +\usesdollar{npInfixOp}{ttok} +\usesdollar{npInfixOp}{stok} +\begin{chunk}{defun npInfixOp} +(defun |npInfixOp| () + (declare (special |$ttok| |$stok|)) + (and + (eq (caar |$stok|) '|key|) + (get |$ttok| 'infgeneric) + (|npPushId|))) + +\end{chunk} + +\defun{npPrefixColon}{npPrefixColon} +\calls{npPrefixColon}{npEqPeek} +\calls{npPrefixColon}{npPush} +\calls{npPrefixColon}{tokConstruct} +\calls{npPrefixColon}{tokPosn} +\calls{npPrefixColon}{npNext} +\usesdollar{npPrefixColon}{stok} +\begin{chunk}{defun npPrefixColon} +(defun |npPrefixColon| () + (declare (special |$stok|)) + (and + (|npEqPeek| 'colon) + (progn + (|npPush| (|tokConstruct| '|id| '|:| (|tokPosn| |$stok|))) + (|npNext|)))) + +\end{chunk} + +\defun{npApplication}{npApplication} +\calls{npApplication}{npDotted} +\calls{npApplication}{npPrimary} +\calls{npApplication}{npApplication2} +\calls{npApplication}{npPush} +\calls{npApplication}{pfApplication} +\calls{npApplication}{npPop2} +\calls{npApplication}{npPop1} +\begin{chunk}{defun npApplication} +(defun |npApplication| () + (and + (|npDotted| #'|npPrimary|) + (or + (and + (|npApplication2|) + (|npPush| (|pfApplication| (|npPop2|) (|npPop1|)))) + t))) + +\end{chunk} + +\defun{npDotted}{npDotted} +\begin{chunk}{defun npDotted} +(defun |npDotted| (f) + (and (apply f nil) (|npAnyNo| #'|npSelector|))) + +\end{chunk} + +\defun{npAnyNo}{npAnyNo} +fn must transform the head of the stack +\begin{chunk}{defun npAnyNo 0} +(defun |npAnyNo| (fn) + (do () ((not (apply fn nil)))) ; while apply do... + t) + +\end{chunk} + +\defun{npSelector}{npSelector} +\calls{npSelector}{npEqKey} +\calls{npSelector}{npPrimary} +\calls{npSelector}{npTrap} +\calls{npSelector}{npPush} +\calls{npSelector}{pfApplication} +\calls{npSelector}{npPop2} +\calls{npSelector}{npPop1} +\begin{chunk}{defun npSelector} +(defun |npSelector| () + (and + (|npEqKey| 'dot) + (or (|npPrimary|) (|npTrap|)) + (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))))) + +\end{chunk} + +\defun{npApplication2}{npApplication2} +\calls{npApplication2}{npDotted} +\calls{npApplication2}{npPrimary1} +\calls{npApplication2}{npApplication2} +\calls{npApplication2}{npPush} +\calls{npApplication2}{pfApplication} +\calls{npApplication2}{npPop2} +\calls{npApplication2}{npPop1} +\begin{chunk}{defun npApplication2} +(defun |npApplication2| () + (and + (|npDotted| #'|npPrimary1|) + (or + (and + (|npApplication2|) + (|npPush| (|pfApplication| (|npPop2|) (|npPop1|)))) + t))) + +\end{chunk} + +\defun{npPrimary1}{npPrimary1} +\calls{npPrimary1}{npEncAp} +\calls{npPrimary1}{npAtom1} +\calls{npPrimary1}{npLet} +\calls{npPrimary1}{npFix} +\calls{npPrimary1}{npMacro} +\calls{npPrimary1}{npBPileDefinition} +\calls{npPrimary1}{npDefn} +\calls{npPrimary1}{npRule} +\begin{chunk}{defun npPrimary1} +(defun |npPrimary1| () + (or + (|npEncAp| #'|npAtom1|) + (|npLet|) + (|npFix|) + (|npMacro|) + (|npBPileDefinition|) + (|npDefn|) + (|npRule|))) + +\end{chunk} + +\defun{npMacro}{npMacro} +\calls{npMacro}{npPP} +\calls{npMacro}{npMdef} +\begin{chunk}{defun npMacro} +(defun |npMacro| () + (and + (|npEqKey| 'macro) + (|npPP| #'|npMdef|))) + +\end{chunk} + +\defun{npMdef}{npMdef} +\tpdhere{Beware that this function occurs with uppercase also} + +\calls{npMdef}{npQuiver} +\calls{npMdef}{pfCheckMacroOut} +\calls{npMdef}{npPop1} +\calls{npMdef}{npDefTail} +\calls{npMdef}{npTrap} +\calls{npMdef}{npPop1} +\calls{npMdef}{npPush} +\calls{npMdef}{pfMacro} +\calls{npMdef}{pfPushMacroBody} +\begin{chunk}{defun npMdef} +(defun |npMdef| () + (let (body arg op tmp) + (when (|npQuiver|) ;[op,arg]:= pfCheckMacroOut(npPop1()) + (setq tmp (|pfCheckMacroOut| (|npPop1|))) + (setq op (car tmp)) + (setq arg (cadr tmp)) + (or (|npDefTail|) (|npTrap|)) + (setq body (|npPop1|)) + (if (null arg) + (|npPush| (|pfMacro| op body)) + (|npPush| (|pfMacro| op (|pfPushMacroBody| arg body))))))) + +\end{chunk} + +\defun{npMDEF}{npMDEF} +\tpdhere{Beware that this function occurs with lowercase also} + +\calls{npMDEF}{npBackTrack} +\calls{npMDEF}{npStatement} +\calls{npMDEF}{npMDEFinition} +\begin{chunk}{defun npMDEF} +(defun |npMDEF| () + (|npBackTrack| #'|npStatement| 'mdef #'|npMDEFinition|)) + +\end{chunk} + +\defun{npMDEFinition}{npMDEFinition} +\calls{npMDEFinition}{npPP} +\calls{npMDEFinition}{npMdef} +\begin{chunk}{defun npMDEFinition} +(defun |npMDEFinition| () + (|npPP| #'|npMdef|)) + +\end{chunk} + +\defun{npFix}{npFix} +\calls{npFix}{npEqKey} +\calls{npFix}{npDef} +\calls{npFix}{npPush} +\calls{npFix}{pfFix} +\calls{npFix}{npPop1} +\begin{chunk}{defun npFix} +(defun |npFix| () + (and + (|npEqKey| 'fix) + (|npPP| #'|npDef|) + (|npPush| (|pfFix| (|npPop1|))))) + +\end{chunk} + +\defun{npLet}{npLet} +\calls{npLet}{npLetQualified} +\calls{npLet}{npDefinitionOrStatement} +\begin{chunk}{defun npLet} +(defun |npLet| () + (|npLetQualified| #'|npDefinitionOrStatement|)) + +\end{chunk} + +\defun{npLetQualified}{npLetQualified} +\calls{npLetQualified}{npEqKey} +\calls{npLetQualified}{npDefinition} +\calls{npLetQualified}{npTrap} +\calls{npLetQualified}{npCompMissing} +\calls{npLetQualified}{npPush} +\calls{npLetQualified}{pfWhere} +\calls{npLetQualified}{npPop2} +\calls{npLetQualified}{npPop1} +\begin{chunk}{defun npLetQualified} +(defun |npLetQualified| (f) + (and + (|npEqKey| 'let) + (or (|npDefinition|) (|npTrap|)) + (|npCompMissing| 'in) + (or (funcall f) (|npTrap|)) + (|npPush| (|pfWhere| (|npPop2|) (|npPop1|))))) + +\end{chunk} + +\defun{npDefinition}{npDefinition} +\calls{npDefinition}{npPP} +\calls{npDefinition}{npDefinitionItem} +\calls{npDefinition}{npPush} +\calls{npDefinition}{pfSequenceToList} +\calls{npDefinition}{npPop1} +\begin{chunk}{defun npDefinition} +(defun |npDefinition| () + (and + (|npPP| #'|npDefinitionItem|) + (|npPush| (|pfSequenceToList| (|npPop1|))))) + +\end{chunk} + +\defun{npDefinitionItem}{npDefinitionItem} +\calls{npDefinitionItem}{npTyping} +\calls{npDefinitionItem}{npImport} +\calls{npDefinitionItem}{npState} +\calls{npDefinitionItem}{npStatement} +\calls{npDefinitionItem}{npEqPeek} +\calls{npDefinitionItem}{npRestore} +\calls{npDefinitionItem}{npDef} +\calls{npDefinitionItem}{npMacro} +\calls{npDefinitionItem}{npDefn} +\calls{npDefinitionItem}{npTrap} +\begin{chunk}{defun npDefinitionItem} +(defun |npDefinitionItem| () + (let (a) + (or (|npTyping|) + (|npImport|) + (progn + (setq a (|npState|)) + (cond + ((|npStatement|) + (cond + ((|npEqPeek| 'def) + (|npRestore| a) + (|npDef|)) + (t + (|npRestore| a) + (or (|npMacro|) (|npDefn|))))) + (t (|npTrap|))))))) + +\end{chunk} + +\defun{npTyping}{npTyping} +\calls{npTyping}{npEqKey} +\calls{npTyping}{npDefaultItemlist} +\calls{npTyping}{npTrap} +\calls{npTyping}{npPush} +\calls{npTyping}{pfTyping} +\calls{npTyping}{npPop1} +\begin{chunk}{defun npTyping} +(defun |npTyping| () + (and + (|npEqKey| 'default) + (or (|npDefaultItemlist|) (|npTrap|)) + (|npPush| (|pfTyping| (|npPop1|))))) + +\end{chunk} + +\defun{npDefaultItemlist}{npDefaultItemlist} +\calls{npDefaultItemlist}{npPC} +\calls{npDefaultItemlist}{npSDefaultItem} +\calls{npDefaultItemlist}{npPush} +\calls{npDefaultItemlist}{pfUnSequence} +\calls{npDefaultItemlist}{npPop1} +\begin{chunk}{defun npDefaultItemlist} +(defun |npDefaultItemlist| () + (and + (|npPC| #'|npSDefaultItem|) + (|npPush| (|pfUnSequence| (|npPop1|))))) + +\end{chunk} + +\defun{npSDefaultItem}{npSDefaultItem} +\calls{npSDefaultItem}{npListing} +\calls{npSDefaultItem}{npDefaultItem} +\calls{npSDefaultItem}{npPush} +\calls{npSDefaultItem}{pfAppend} +\calls{npSDefaultItem}{pfParts} +\calls{npSDefaultItem}{npPop1} +\begin{chunk}{defun npSDefaultItem} +(defun |npSDefaultItem| () + (and + (|npListing| #'|npDefaultItem|) + (|npPush| (|pfAppend| (|pfParts| (|npPop1|)))))) + +\end{chunk} + +\defun{npDefaultItem}{npDefaultItem} +\calls{npDefaultItem}{npTypeVariable} +\calls{npDefaultItem}{npDefaultDecl} +\calls{npDefaultItem}{npTrap} +\begin{chunk}{defun npDefaultItem} +(defun |npDefaultItem| () + (and + (|npTypeVariable|) + (or (|npDefaultDecl|) (|npTrap|)))) + +\end{chunk} + +\defun{npDefaultDecl}{npDefaultDecl} +\calls{npDefaultDecl}{npEqKey} +\calls{npDefaultDecl}{npType} +\calls{npDefaultDecl}{npTrap} +\calls{npDefaultDecl}{npPush} +\calls{npDefaultDecl}{pfSpread} +\calls{npDefaultDecl}{pfParts} +\calls{npDefaultDecl}{npPop2} +\calls{npDefaultDecl}{npPop1} +\begin{chunk}{defun npDefaultDecl} +(defun |npDefaultDecl| () + (and + (|npEqKey| 'colon) + (or (|npType|) (|npTrap|)) + (|npPush| (|pfSpread| (|pfParts| (|npPop2|)) (|npPop1|))))) + +\end{chunk} + +\defun{npStatement}{npStatement} +\calls{npStatement}{npExpress} +\calls{npStatement}{npLoop} +\calls{npStatement}{npIterate} +\calls{npStatement}{npReturn} +\calls{npStatement}{npBreak} +\calls{npStatement}{npFree} +\calls{npStatement}{npImport} +\calls{npStatement}{npInline} +\calls{npStatement}{npLocal} +\calls{npStatement}{npExport} +\calls{npStatement}{npTyping} +\calls{npStatement}{npVoid} +\begin{chunk}{defun npStatement} +(defun |npStatement| () + (or + (|npExpress|) + (|npLoop|) + (|npIterate|) + (|npReturn|) + (|npBreak|) + (|npFree|) + (|npImport|) + (|npInline|) + (|npLocal|) + (|npExport|) + (|npTyping|) + (|npVoid|))) + +\end{chunk} + +\defun{npExport}{npExport} +\calls{npExport}{npEqKey} +\calls{npExport}{npLocalItemlist} +\calls{npExport}{npTrap} +\calls{npExport}{npPush} +\calls{npExport}{pfExport} +\calls{npExport}{npPop1} +\begin{chunk}{defun npExport} +(defun |npExport| () + (and + (|npEqKey| 'export) + (or (|npLocalItemlist|) (|npTrap|)) + (|npPush| (|pfExport| (|npPop1|))))) + +\end{chunk} + +\defun{npLocalItemlist}{npLocalItemlist} +\calls{npLocalItemlist}{npPC} +\calls{npLocalItemlist}{npSLocalItem} +\calls{npLocalItemlist}{npPush} +\calls{npLocalItemlist}{pfUnSequence} +\calls{npLocalItemlist}{npPop1} +\begin{chunk}{defun npLocalItemlist} +(defun |npLocalItemlist| () + (and + (|npPC| #'|npSLocalItem|) + (|npPush| (|pfUnSequence| (|npPop1|))))) + +\end{chunk} + +\defun{npSLocalItem}{npSLocalItem} +\calls{npSLocalItem}{npListing} +\calls{npSLocalItem}{npLocalItem} +\calls{npSLocalItem}{npPush} +\calls{npSLocalItem}{pfAppend} +\calls{npSLocalItem}{pfParts} +\calls{npSLocalItem}{npPop1} +\begin{chunk}{defun npSLocalItem} +(defun |npSLocalItem| () + (and + (|npListing| #'|npLocalItem|) + (|npPush| (|pfAppend| (|pfParts| (|npPop1|)))))) + +\end{chunk} + +\defun{npLocalItem}{npLocalItem} +\calls{npLocalItem}{npTypeVariable} +\calls{npLocalItem}{npLocalDecl} +\begin{chunk}{defun npLocalItem} +(defun |npLocalItem| () + (and + (|npTypeVariable|) + (|npLocalDecl|))) + +\end{chunk} + +\defun{npLocalDecl}{npLocalDecl} +\calls{npLocalDecl}{npEqKey} +\calls{npLocalDecl}{npType} +\calls{npLocalDecl}{npTrap} +\calls{npLocalDecl}{npPush} +\calls{npLocalDecl}{pfSpread} +\calls{npLocalDecl}{pfParts} +\calls{npLocalDecl}{npPop2} +\calls{npLocalDecl}{npPop1} +\calls{npLocalDecl}{pfNothing} +\begin{chunk}{defun npLocalDecl} +(defun |npLocalDecl| () + (or + (and + (|npEqKey| 'colon) + (or (|npType|) (|npTrap|)) + (|npPush| (|pfSpread| (|pfParts| (|npPop2|)) (|npPop1|)))) + (|npPush| (|pfSpread| (|pfParts| (|npPop1|)) (|pfNothing|))))) + +\end{chunk} + +\defun{npLocal}{npLocal} +\calls{npLocal}{npEqKey} +\calls{npLocal}{npLocalItemlist} +\calls{npLocal}{npTrap} +\calls{npLocal}{npPush} +\calls{npLocal}{pfLocal} +\calls{npLocal}{npPop1} +\begin{chunk}{defun npLocal} +(defun |npLocal| () + (and + (|npEqKey| '|local|) + (or (|npLocalItemlist|) (|npTrap|)) + (|npPush| (|pfLocal| (|npPop1|))))) + +\end{chunk} + +\defun{npFree}{npFree} +\calls{npFree}{npEqKey} +\calls{npFree}{npLocalItemlist} +\calls{npFree}{npTrap} +\calls{npFree}{npPush} +\calls{npFree}{pfFree} +\calls{npFree}{npPop1} +\begin{chunk}{defun npFree} +(defun |npFree| () + (and + (|npEqKey| 'free) + (or (|npLocalItemlist|) (|npTrap|)) + (|npPush| (|pfFree| (|npPop1|))))) + +\end{chunk} + +\defun{npInline}{npInline} +\calls{npInline}{npAndOr} +\calls{npInline}{npQualTypelist} +\calls{npInline}{pfInline} +\begin{chunk}{defun npInline} +(defun |npInline| () + (|npAndOr| 'inline #'|npQualTypelist| #'|pfInline|)) + +\end{chunk} + +\defun{npIterate}{npIterate} +\calls{npIterate}{npEqKey} +\calls{npIterate}{npPush} +\calls{npIterate}{pfIterate} +\calls{npIterate}{pfNothing} +\begin{chunk}{defun npIterate} +(defun |npIterate| () + (and (|npEqKey| 'iterate) (|npPush| (|pfIterate| (|pfNothing|))))) + +\end{chunk} + +\defun{npBreak}{npBreak} +\calls{npBreak}{npEqKey} +\calls{npBreak}{npPush} +\calls{npBreak}{pfBreak} +\calls{npBreak}{pfNothing} +\begin{chunk}{defun npBreak} +(defun |npBreak| () + (and (|npEqKey| 'break) (|npPush| (|pfBreak| (|pfNothing|))))) + +\end{chunk} + +\defun{npLoop}{npLoop} +\calls{npLoop}{npIterators} +\calls{npLoop}{npCompMissing} +\calls{npLoop}{npAssign} +\calls{npLoop}{npTrap} +\calls{npLoop}{npPush} +\calls{npLoop}{pfLp} +\calls{npLoop}{npPop2} +\calls{npLoop}{npPop1} +\calls{npLoop}{npEqKey} +\calls{npLoop}{pfLoop1} +\begin{chunk}{defun npLoop} +(defun |npLoop| () + (or + (and + (|npIterators|) + (|npCompMissing| 'repeat) + (or (|npAssign|) (|npTrap|)) + (|npPush| (|pfLp| (|npPop2|) (|npPop1|)))) + (and + (|npEqKey| 'repeat) + (or (|npAssign|) (|npTrap|)) + (|npPush| (|pfLoop1| (|npPop1|)))))) + +\end{chunk} + +\defun{npIterators}{npIterators} +\calls{npIterators}{npForIn} +\calls{npIterators}{npZeroOrMore} +\calls{npIterators}{npIterator} +\calls{npIterators}{npPush} +\calls{npIterators}{npPop2} +\calls{npIterators}{npPop1} +\calls{npIterators}{npWhile} +\calls{npIterators}{npIterators} +\begin{chunk}{defun npIterators} +(defun |npIterators| () + (or + (and + (|npForIn|) + (|npZeroOrMore| #'|npIterator|) + (|npPush| (cons (|npPop2|) (|npPop1|)))) + (and + (|npWhile|) + (or + (and (|npIterators|) (|npPush| (cons (|npPop2|) (|npPop1|)))) + (|npPush| (list (|npPop1|))))))) + +\end{chunk} + +\defun{npIterator}{npIterator} +\calls{npIterator}{npForIn} +\calls{npIterator}{npSuchThat} +\calls{npIterator}{npWhile} +\begin{chunk}{defun npIterator} +(defun |npIterator| () + (or + (|npForIn|) + (|npSuchThat|) + (|npWhile|))) + +\end{chunk} + +\defun{npSuchThat}{npSuchThat} +\calls{npSuchThat}{npAndOr} +\calls{npSuchThat}{npLogical} +\calls{npSuchThat}{pfSuchthat} +\begin{chunk}{defun npSuchThat} +(defun |npSuchThat| () + (|npAndOr| 'bar #'|npLogical| #'|pfSuchthat|)) + +\end{chunk} + +\defun{npZeroOrMore}{Apply argument 0 or more times} +\calls{npZeroOrMore}{npPush} +\calls{npZeroOrMore}{npPop2} +\calls{npZeroOrMore}{npPop1} +\usesdollar{npZeroOrMore}{stack} +\begin{chunk}{defun npZeroOrMore} +(defun |npZeroOrMore| (f) + (let (a) + (declare (special |$stack|)) + (cond + ((apply f nil) + (setq a |$stack|) + (setq |$stack| nil) + (do () ((not (apply f nil)))) ; while .. do + (setq |$stack| (cons (nreverse |$stack|) a)) + (|npPush| (cons (|npPop2|) (|npPop1|)))) + (t (progn (|npPush| nil) t))))) + +\end{chunk} + +\defun{npWhile}{npWhile} +\calls{npWhile}{npAndOr} +\calls{npWhile}{npLogical} +\calls{npWhile}{pfWhile} +\begin{chunk}{defun npWhile} +(defun |npWhile| () + (|npAndOr| 'while #'|npLogical| #'|pfWhile|)) + +\end{chunk} + +\defun{npForIn}{npForIn} +\calls{npForIn}{npEqKey} +\calls{npForIn}{npVariable} +\calls{npForIn}{npTrap} +\calls{npForIn}{npCompMissing} +\calls{npForIn}{npBy} +\calls{npForIn}{npPush} +\calls{npForIn}{pfForin} +\calls{npForIn}{npPop2} +\calls{npForIn}{npPop1} +\begin{chunk}{defun npForIn} +(defun |npForIn| () + (and + (|npEqKey| 'for) + (or (|npVariable|) (|npTrap|)) + (|npCompMissing| 'in) + (or (|npBy|) (|npTrap|)) + (|npPush| (|pfForin| (|npPop2|) (|npPop1|))))) + +\end{chunk} + +\defun{npReturn}{npReturn} +\calls{npReturn}{npEqKey} +\calls{npReturn}{npExpress} +\calls{npReturn}{npPush} +\calls{npReturn}{pfNothing} +\calls{npReturn}{npEqKey} +\calls{npReturn}{npName} +\calls{npReturn}{npTrap} +\calls{npReturn}{pfReturn} +\calls{npReturn}{npPop2} +\calls{npReturn}{npPop1} +\calls{npReturn}{pfReturnNoName} +\begin{chunk}{defun npReturn} +(defun |npReturn| () + (and + (|npEqKey| 'return) + (or + (|npExpress|) + (|npPush| (|pfNothing|))) + (or + (and + (|npEqKey| 'from) + (or (|npName|) (|npTrap|)) + (|npPush| (|pfReturn| (|npPop2|) (|npPop1|)))) + (|npPush| (|pfReturnNoName| (|npPop1|)))))) + +\end{chunk} + +\defun{npVoid}{npVoid} +\calls{npVoid}{npAndOr} +\calls{npVoid}{npStatement} +\calls{npVoid}{pfNovalue} +\begin{chunk}{defun npVoid} +(defun |npVoid| () + (|npAndOr| 'do #'|npStatement| #'|pfNovalue|)) + +\end{chunk} + +\defun{npExpress}{npExpress} +\calls{npExpress}{npExpress1} +\calls{npExpress}{npIterators} +\calls{npExpress}{npPush} +\calls{npExpress}{pfCollect} +\calls{npExpress}{npPop2} +\calls{npExpress}{pfListOf} +\calls{npExpress}{npPop1} +\begin{chunk}{defun npExpress} +(defun |npExpress| () + (and + (|npExpress1|) + (or + (and + (|npIterators|) + (|npPush| (|pfCollect| (|npPop2|) (|pfListOf| (|npPop1|))))) + t))) + +\end{chunk} + +\defun{npExpress1}{npExpress1} +\calls{npExpress1}{npConditionalStatement} +\calls{npExpress1}{npADD} +\begin{chunk}{defun npExpress1} +(defun |npExpress1| () + (or (|npConditionalStatement|) (|npADD|))) + +\end{chunk} + +\defun{npConditionalStatement}{npConditionalStatement} +\calls{npConditionalStatement}{npConditional} +\calls{npConditionalStatement}{npQualifiedDefinition} +\begin{chunk}{defun npConditionalStatement} +(defun |npConditionalStatement| () + (|npConditional| #'|npQualifiedDefinition|)) + +\end{chunk} + +\defun{npImport}{npImport} +\calls{npImport}{npAndOr} +\calls{npImport}{npQualTypelist} +\calls{npImport}{pfImport} +\begin{chunk}{defun npImport} +(defun |npImport| () + (|npAndOr| 'import #'|npQualTypelist| #'|pfImport|)) + +\end{chunk} + +\defun{npQualTypelist}{npQualTypelist} +\calls{npQualTypelist}{npPC} +\calls{npQualTypelist}{npSQualTypelist} +\calls{npQualTypelist}{npPush} +\calls{npQualTypelist}{pfUnSequence} +\calls{npQualTypelist}{npPop1} +\begin{chunk}{defun npQualTypelist} +(defun |npQualTypelist| () + (and + (|npPC| #'|npSQualTypelist|) + (|npPush| (|pfUnSequence| (|npPop1|))))) + +\end{chunk} + +\defun{npSQualTypelist}{npSQualTypelist} +\calls{npSQualTypelist}{npListing} +\calls{npSQualTypelist}{npQualType} +\calls{npSQualTypelist}{npPush} +\calls{npSQualTypelist}{pfParts} +\calls{npSQualTypelist}{npPop1} +\begin{chunk}{defun npSQualTypelist} +(defun |npSQualTypelist| () + (and + (|npListing| #'|npQualType|) + (|npPush| (|pfParts| (|npPop1|))))) + +\end{chunk} + +\defun{npQualType}{npQualType} +\calls{npQualType}{npType} +\calls{npQualType}{npPush} +\calls{npQualType}{pfQualType} +\calls{npQualType}{npPop1} +\calls{npQualType}{pfNothing} +\begin{chunk}{defun npQualType} +(defun |npQualType| () + (and + (|npType|) + (|npPush| (|pfQualType| (|npPop1|) (|pfNothing|))))) + +\end{chunk} + +\defun{npAndOr}{npAndOr} +\calls{npAndOr}{npEqKey} +\calls{npAndOr}{npTrap} +\calls{npAndOr}{npPush} +\calls{npAndOr}{npPop1} +\begin{chunk}{defun npAndOr} +(defun |npAndOr| (keyword p f) + (and + (|npEqKey| keyword) + (or (apply p nil) (|npTrap|)) + (|npPush| (funcall f (|npPop1|))))) + +\end{chunk} + +\defun{npEncAp}{npEncAp} +\calls{npEncAp}{npAnyNo} +\calls{npEncAp}{npEncl} +\calls{npEncAp}{npFromdom} +\begin{chunk}{defun npEncAp} +(defun |npEncAp| (f) + (and (apply f nil) (|npAnyNo| #'|npEncl|) (|npFromdom|))) + +\end{chunk} + +\defun{npEncl}{npEncl} +\calls{npEncl}{npBDefinition} +\calls{npEncl}{npPush} +\calls{npEncl}{pfApplication} +\calls{npEncl}{npPop2} +\calls{npEncl}{npPop1} +\begin{chunk}{defun npEncl} +(defun |npEncl| () + (and + (|npBDefinition|) + (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))))) + +\end{chunk} + +\defun{npAtom1}{npAtom1} +\calls{npAtom1}{npPDefinition} +\calls{npAtom1}{npName} +\calls{npAtom1}{npConstTok} +\calls{npAtom1}{npDollar} +\calls{npAtom1}{npBDefinition} +\calls{npAtom1}{npFromdom} +\begin{chunk}{defun npAtom1} +(defun |npAtom1| () + (or + (|npPDefinition|) + (and + (or (|npName|) (|npConstTok|) (|npDollar|) (|npBDefinition|)) + (|npFromdom|)))) + +\end{chunk} + +\defun{npPDefinition}{npPDefinition} +\calls{npPDefinition}{npParenthesized} +\calls{npPDefinition}{npDefinitionlist} +\calls{npPDefinition}{npPush} +\calls{npPDefinition}{pfEnSequence} +\calls{npPDefinition}{npPop1} +\begin{chunk}{defun npPDefinition} +(defun |npPDefinition| () + (and + (|npParenthesized| #'|npDefinitionlist|) + (|npPush| (|pfEnSequence| (|npPop1|))))) + +\end{chunk} + +\defun{npDollar}{npDollar} +\calls{npDollar}{npEqPeek} +\calls{npDollar}{npPush} +\calls{npDollar}{tokConstruct} +\calls{npDollar}{tokPosn} +\calls{npDollar}{npNext} +\usesdollar{npDollar}{stok} +\begin{chunk}{defun npDollar} +(defun |npDollar| () + (declare (special |$stok|)) + (and (|npEqPeek| '$) + (progn + (|npPush| (|tokConstruct| '|id| '$ (|tokPosn| |$stok|))) + (|npNext|)))) + +\end{chunk} + +\defun{npConstTok}{npConstTok} +\calls{npConstTok}{tokType} +\calls{npConstTok}{npPush} +\calls{npConstTok}{npNext} +\calls{npConstTok}{npEqPeek} +\calls{npConstTok}{npState} +\calls{npConstTok}{npPrimary1} +\calls{npConstTok}{pfSymb} +\calls{npConstTok}{npPop1} +\calls{npConstTok}{tokPosn} +\calls{npConstTok}{npRestore} +\usesdollar{npConstTok}{stok} +\begin{chunk}{defun npConstTok} +(defun |npConstTok| () + (let (b a) + (declare (special |$stok|)) + (cond + ((member (|tokType| |$stok|) '(|integer| |string| |char| |float| |command|)) + (|npPush| |$stok|) + (|npNext|)) + ((|npEqPeek| '|'|) + (setq a |$stok|) + (setq b (|npState|)) + (|npNext|) + (cond + ((and (|npPrimary1|) + (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| a)))) + t) + (t (|npRestore| b) nil))) + (t nil)))) + +\end{chunk} + +\defun{npBDefinition}{npBDefinition} +\calls{npBDefinition}{npPDefinition} +\calls{npBDefinition}{npBracketed} +\calls{npBDefinition}{npDefinitionlist} +\begin{chunk}{defun npBDefinition} +(defun |npBDefinition| () + (or + (|npPDefinition|) + (|npBracketed| #'|npDefinitionlist|))) + +\end{chunk} + +\defun{npBracketed}{npBracketed} +\calls{npBracketed}{npParened} +\calls{npBracketed}{npBracked} +\calls{npBracketed}{npBraced} +\calls{npBracketed}{npAngleBared} +\begin{chunk}{defun npBracketed} +(defun |npBracketed| (f) + (or + (|npParened| f) + (|npBracked| f) + (|npBraced| f) + (|npAngleBared| f))) + +\end{chunk} + +\defun{npParened}{npParened} +\calls{npParened}{npEnclosed} +\calls{npParened}{pfParen} +\begin{chunk}{defun npParened} +(defun |npParened| (f) + (or (|npEnclosed| '|(| '|)| #'|pfParen| f) + (|npEnclosed| '|(\|| '|\|)| #'|pfParen| f))) + +\end{chunk} + +\defun{npBracked}{npBracked} +\calls{npBracked}{npEnclosed} +\calls{npBracked}{pfBracket} +\calls{npBracked}{pfBracketBar} +\begin{chunk}{defun npBracked} +(defun |npBracked| (f) + (or (|npEnclosed| '[ '] #'|pfBracket| f) + (|npEnclosed| '|[\|| '|\|]| #'|pfBracketBar| f))) + +\end{chunk} + +\defun{npBraced}{npBraced} +\calls{npBraced}{npEnclosed} +\calls{npBraced}{pfBrace} +\calls{npBraced}{pfBraceBar} +\begin{chunk}{defun npBraced} +(defun |npBraced| (f) + (or (|npEnclosed| '{ '} #'|pfBrace| f) + (|npEnclosed| '|{\|| '|\|}| #'|pfBraceBar| f))) + +\end{chunk} + +\defun{npAngleBared}{npAngleBared} +\calls{npAngleBared}{npEnclosed} +\calls{npAngleBared}{pfHide} +\begin{chunk}{defun npAngleBared} +(defun |npAngleBared| (f) + (|npEnclosed| '|<\|| '|\|>| #'|pfHide| f)) + +\end{chunk} + +\defun{npDefn}{npDefn} +\calls{npDefn}{npEqKey} +\calls{npDefn}{npPP} +\calls{npDefn}{npDef} +\begin{chunk}{defun npDefn} +(defun |npDefn| () + (and + (|npEqKey| 'defn) + (|npPP| #'|npDef|))) + +\end{chunk} + +\defun{npDef}{npDef} +\calls{npDef}{npMatch} +\calls{npDef}{pfCheckItOut} +\calls{npDef}{npPop1} +\calls{npDef}{npDefTail} +\calls{npDef}{npTrap} +\calls{npDef}{npPop1} +\calls{npDef}{npPush} +\calls{npDef}{pfDefinition} +\calls{npDef}{pfPushBody} +\begin{chunk}{defun npDef} +(defun |npDef| () + (let (body rt arg op tmp1) + (when (|npMatch|) + ; [op,arg,rt]:= pfCheckItOut(npPop1()) + (setq tmp1 (|pfCheckItOut| (|npPop1|))) + (setq op (car tmp1)) + (setq arg (cadr tmp1)) + (setq rt (caddr tmp1)) + (or (|npDefTail|) (|npTrap|)) + (setq body (|npPop1|)) + (if (null arg) + (|npPush| (|pfDefinition| op body)) + (|npPush| (|pfDefinition| op (|pfPushBody| rt arg body))))))) + +\end{chunk} + +\defun{npBPileDefinition}{npBPileDefinition} +\calls{npBPileDefinition}{npPileBracketed} +\calls{npBPileDefinition}{npPileDefinitionlist} +\calls{npBPileDefinition}{npPush} +\calls{npBPileDefinition}{pfSequence} +\calls{npBPileDefinition}{pfListOf} +\calls{npBPileDefinition}{npPop1} +\begin{chunk}{defun npBPileDefinition} +(defun |npBPileDefinition| () + (and + (|npPileBracketed| #'|npPileDefinitionlist|) + (|npPush| (|pfSequence| (|pfListOf| (|npPop1|)))))) + +\end{chunk} + +\defun{npPileBracketed}{npPileBracketed} +\calls{npPileBracketed}{npEqKey} +\calls{npPileBracketed}{npPush} +\calls{npPileBracketed}{pfNothing} +\calls{npPileBracketed}{npMissing} +\calls{npPileBracketed}{pfPile} +\calls{npPileBracketed}{npPop1} +\begin{chunk}{defun npPileBracketed} +(defun |npPileBracketed| (f) + (cond + ((|npEqKey| 'settab) + (cond + ((|npEqKey| 'backtab) (|npPush| (|pfNothing|))) ; never happens + ((and (apply f nil) + (or (|npEqKey| 'backtab) (|npMissing| '|backtab|))) + (|npPush| (|pfPile| (|npPop1|)))) + (t nil))) + (t nil))) + +\end{chunk} + +\defun{npPileDefinitionlist}{npPileDefinitionlist} +\calls{npPileDefinitionlist}{npListAndRecover} +\calls{npPileDefinitionlist}{npDefinitionlist} +\calls{npPileDefinitionlist}{npPush} +\calls{npPileDefinitionlist}{pfAppend} +\calls{npPileDefinitionlist}{npPop1} +\begin{chunk}{defun npPileDefinitionlist} +(defun |npPileDefinitionlist| () + (and + (|npListAndRecover| #'|npDefinitionlist|) + (|npPush| (|pfAppend| (|npPop1|))))) + +\end{chunk} + +\defun{npListAndRecover}{npListAndRecover} +\catches{npListAndRecover}{trappoint} +\calls{npListAndRecover}{npRecoverTrap} +\calls{npListAndRecover}{syGeneralErrorHere} +\calls{npListAndRecover}{npEqKey} +\calls{npListAndRecover}{npEqPeek} +\calls{npListAndRecover}{npNext} +\calls{npListAndRecover}{npPop1} +\calls{npListAndRecover}{npPush} +\usesdollar{npListAndRecover}{inputStream} +\usesdollar{npListAndRecover}{stack} +\begin{chunk}{defun npListAndRecover} +(defun |npListAndRecover| (f) + (let (found c done b savestack) + (declare (special |$inputStream| |$stack|)) + (setq savestack |$stack|) + (setq |$stack| nil) + (setq c |$inputStream|) + (do () + (done) + (setq found (catch 'trappoint (apply f nil))) + (cond + ((eq found 'trapped) + (setq |$inputStream| c) + (|npRecoverTrap|)) + ((null found) + (setq |$inputStream| c) + (|syGeneralErrorHere|) (|npRecoverTrap|))) + (cond + ((|npEqKey| 'backset) (setq c |$inputStream|)) + ((|npEqPeek| 'backtab) (setq done t)) + (t + (setq |$inputStream| c) + (|syGeneralErrorHere|) + (|npRecoverTrap|) + (cond + ((|npEqPeek| 'backtab) (setq done t)) + (t + (|npNext|) + (setq c |$inputStream|))))) + (setq b (cons (|npPop1|) b))) + (setq |$stack| savestack) + (|npPush| (nreverse b)))) + +\end{chunk} + +\defun{npRecoverTrap}{npRecoverTrap} +\calls{npRecoverTrap}{npFirstTok} +\calls{npRecoverTrap}{tokPosn} +\calls{npRecoverTrap}{npMoveTo} +\calls{npRecoverTrap}{syIgnoredFromTo} +\calls{npRecoverTrap}{npPush} +\calls{npRecoverTrap}{pfWrong} +\calls{npRecoverTrap}{pfDocument} +\calls{npRecoverTrap}{pfListOf} +\usesdollar{npRecoverTrap}{stok} +\begin{chunk}{defun npRecoverTrap} +(defun |npRecoverTrap| () + (let (pos2 pos1) + (declare (special |$stok|)) + (|npFirstTok|) + (setq pos1 (|tokPosn| |$stok|)) + (|npMoveTo| 0) + (setq pos2 (|tokPosn| |$stok|)) + (|syIgnoredFromTo| pos1 pos2) + (|npPush| + (list (|pfWrong| (|pfDocument| (list "pile syntax error")) + (|pfListOf| nil)))))) + +\end{chunk} + +\defun{npMoveTo}{npMoveTo} +\calls{npMoveTo}{npEqPeek} +\calls{npMoveTo}{npNext} +\calls{npMoveTo}{npMoveTo} +\calls{npMoveTo}{npEqKey} +\usesdollar{npMoveTo}{inputStream} +\begin{chunk}{defun npMoveTo} +(defun |npMoveTo| (|n|) + (declare (special |$inputStream|)) + (cond + ((null |$inputStream|) t) + ((|npEqPeek| 'backtab) + (cond + ((eql |n| 0) t) + (t (|npNext|) (|npMoveTo| (1- |n|))))) + ((|npEqPeek| 'backset) + (cond + ((eql |n| 0) t) + (t (|npNext|) (|npMoveTo| |n|)))) + ((|npEqKey| 'settab) (|npMoveTo| (+ |n| 1))) + (t (|npNext|) (|npMoveTo| |n|)))) + +\end{chunk} + +\defun{syIgnoredFromTo}{syIgnoredFromTo} +\calls{syIgnoredFromTo}{pfGlobalLinePosn} +\calls{syIgnoredFromTo}{ncSoftError} +\calls{syIgnoredFromTo}{FromTo} +\calls{syIgnoredFromTo}{From} +\calls{syIgnoredFromTo}{To} +\begin{chunk}{defun syIgnoredFromTo} +(defun |syIgnoredFromTo| (pos1 pos2) + (cond + ((equal (|pfGlobalLinePosn| pos1) (|pfGlobalLinePosn| pos2)) + (|ncSoftError| (|FromTo| pos1 pos2) 'S2CY0005 nil)) + (t + (|ncSoftError| (|From| pos1) 'S2CY0003 nil) + (|ncSoftError| (|To| pos2) 'S2CY0004 nil)))) + +\end{chunk} + +\defun{syGeneralErrorHere}{syGeneralErrorHere} +\calls{syGeneralErrorHere}{sySpecificErrorHere} +\begin{chunk}{defun syGeneralErrorHere} +(defun |syGeneralErrorHere| () + (|sySpecificErrorHere| 'S2CY0002 nil)) + +\end{chunk} + +\defun{sySpecificErrorHere}{sySpecificErrorHere} +\calls{sySpecificErrorHere}{sySpecificErrorAtToken} +\usesdollar{sySpecificErrorHere}{stok} +\begin{chunk}{defun sySpecificErrorHere} +(defun |sySpecificErrorHere| (key args) + (declare (special |$stok|)) + (|sySpecificErrorAtToken| |$stok| key args)) + +\end{chunk} + +\defun{sySpecificErrorAtToken}{sySpecificErrorAtToken} +\calls{sySpecificErrorAtToken}{ncSoftError} +\calls{sySpecificErrorAtToken}{tokPosn} +\begin{chunk}{defun sySpecificErrorAtToken} +(defun |sySpecificErrorAtToken| (tok key args) + (|ncSoftError| (|tokPosn| tok) key args)) + +\end{chunk} + +\defun{npDefinitionlist}{npDefinitionlist} +\calls{npDefinitionlist}{npSemiListing} +\calls{npDefinitionlist}{npQualDef} +\begin{chunk}{defun npDefinitionlist} +(defun |npDefinitionlist| () + (|npSemiListing| #'|npQualDef|)) + +\end{chunk} + +\defun{npSemiListing}{npSemiListing} +\calls{npSemiListing}{npListofFun} +\calls{npSemiListing}{npSemiBackSet} +\calls{npSemiListing}{pfAppend} +\begin{chunk}{defun npSemiListing} +(defun |npSemiListing| (p) + (|npListofFun| p #'|npSemiBackSet| #'|pfAppend|)) + +\end{chunk} + +\defun{npSemiBackSet}{npSemiBackSet} +\calls{npSemiBackSet}{npEqKey} +\begin{chunk}{defun npSemiBackSet} +(defun |npSemiBackSet| () + (and (|npEqKey| 'semicolon) (or (|npEqKey| 'backset) t))) + +\end{chunk} + +\defun{npRule}{npRule} +\calls{npRule}{npEqKey} +\calls{npRule}{npPP} +\calls{npRule}{npSingleRule} +\begin{chunk}{defun npRule} +(defun |npRule| () + (and + (|npEqKey| 'rule) + (|npPP| #'|npSingleRule|))) + +\end{chunk} + +\defun{npSingleRule}{npSingleRule} +\calls{npSingleRule}{npQuiver} +\calls{npSingleRule}{npDefTail} +\calls{npSingleRule}{npTrap} +\calls{npSingleRule}{npPush} +\calls{npSingleRule}{pfRule} +\calls{npSingleRule}{npPop2} +\calls{npSingleRule}{npPop1} +\begin{chunk}{defun npSingleRule} +(defun |npSingleRule| () + (when (|npQuiver|) + (or (|npDefTail|) (|npTrap|)) + (|npPush| (|pfRule| (|npPop2|) (|npPop1|))))) + +\end{chunk} + +\defun{npDefTail}{npDefTail} +\calls{npDefTail}{npEqKey} +\calls{npDefTail}{npDefinitionOrStatement} +\begin{chunk}{defun npDefTail} +(defun |npDefTail| () + (and + (or (|npEqKey| 'def) (|npEqKey| 'mdef)) + (|npDefinitionOrStatement|))) + +\end{chunk} + +\defun{npDefaultValue}{npDefaultValue} +\calls{npDefaultValue}{npEqKey} +\calls{npDefaultValue}{npDefinitionOrStatement} +\calls{npDefaultValue}{npTrap} +\calls{npDefaultValue}{npPush} +\calls{npDefaultValue}{pfAdd} +\calls{npDefaultValue}{pfNothing} +\calls{npDefaultValue}{npPop1} +\begin{chunk}{defun npDefaultValue} +(defun |npDefaultValue| () + (and + (|npEqKey| 'default) + (or (|npDefinitionOrStatement|) (|npTrap|)) + (|npPush| (list (|pfAdd| (|pfNothing|) (|npPop1|) (|pfNothing|)))))) + +\end{chunk} + +\defun{npWConditional}{npWConditional} +\calls{npWConditional}{npConditional} +\calls{npWConditional}{npPush} +\calls{npWConditional}{pfTweakIf} +\calls{npWConditional}{npPop1} +\begin{chunk}{defun npWConditional} +(defun |npWConditional| (f) + (when (|npConditional| f) (|npPush| (|pfTweakIf| (|npPop1|))))) + +\end{chunk} + +\defun{npConditional}{npConditional} +\calls{npConditional}{npEqKey} +\calls{npConditional}{npLogical} +\calls{npConditional}{npTrap} +\calls{npConditional}{npMissing} +\calls{npConditional}{npElse} +\begin{chunk}{defun npConditional} +(defun |npConditional| (f) + (cond + ((and (|npEqKey| 'IF) + (or (|npLogical|) (|npTrap|)) + (or (|npEqKey| 'backset) t)) + (cond + ((|npEqKey| 'settab) + (cond + ((|npEqKey| 'then) + (and (or (apply f nil) (|npTrap|)) + (|npElse| f) + (|npEqKey| 'backtab))) + (t (|npMissing| '|then|)))) + ((|npEqKey| 'then) + (and (or (apply f nil) (|npTrap|)) (|npElse| f))) + (t (|npMissing| '|then|)))) + (t nil))) + +\end{chunk} + +\defun{npElse}{npElse} +\calls{npElse}{npState} +\calls{npElse}{npBacksetElse} +\calls{npElse}{npTrap} +\calls{npElse}{npPush} +\calls{npElse}{pfIf} +\calls{npElse}{npPop3} +\calls{npElse}{npPop2} +\calls{npElse}{npPop1} +\calls{npElse}{npRestore} +\calls{npElse}{pfIfThenOnly} +\begin{chunk}{defun npElse} +(defun |npElse| (f) + (let (a) + (setq a (|npState|)) + (cond + ((|npBacksetElse|) + (and + (or (apply f nil) (|npTrap|)) + (|npPush| (|pfIf| (|npPop3|) (|npPop2|) (|npPop1|))))) + (t + (|npRestore| a) + (|npPush| (|pfIfThenOnly| (|npPop2|) (|npPop1|))))))) + +\end{chunk} + +\defun{npBacksetElse}{npBacksetElse} +\tpdhere{Well this makes no sense.} + +\calls{npBacksetElse}{npEqKey} +\begin{chunk}{defun npBacksetElse} +(defun |npBacksetElse| () + (if (|npEqKey| 'backset) + (|npEqKey| 'else) + (|npEqKey| 'else))) + +\end{chunk} + +\defun{npLogical}{npLogical} +\calls{npLogical}{npLeftAssoc} +\calls{npLogical}{npDisjand} +\begin{chunk}{defun npLogical} +(defun |npLogical| () + (|npLeftAssoc| '(or) #'|npDisjand|)) + +\end{chunk} + +\defun{npDisjand}{npDisjand} +\calls{npDisjand}{npLeftAssoc} +\calls{npDisjand}{npDiscrim} +\begin{chunk}{defun npDisjand} +(defun |npDisjand| () + (|npLeftAssoc| '(and) #'|npDiscrim|)) + +\end{chunk} + +\defun{npDiscrim}{npDiscrim} +\calls{npDiscrim}{npLeftAssoc} +\calls{npDiscrim}{npQuiver} +\begin{chunk}{defun npDiscrim} +(defun |npDiscrim| () + (|npLeftAssoc| '(case has) #'|npQuiver|)) + +\end{chunk} + +\defun{npQuiver}{npQuiver} +\calls{npQuiver}{npRightAssoc} +\calls{npQuiver}{npRelation} +\begin{chunk}{defun npQuiver} +(defun |npQuiver| () + (|npRightAssoc| '(arrow larrow) #'|npRelation|)) + +\end{chunk} + +\defun{npRelation}{npRelation} +\calls{npRelation}{npLeftAssoc} +\calls{npRelation}{npSynthetic} +\begin{chunk}{defun npRelation} +(defun |npRelation| () + (|npLeftAssoc| '(equal notequal lt le gt ge oangle cangle) #'|npSynthetic|)) + +\end{chunk} + +\defun{npSynthetic}{npSynthetic} +\calls{npSynthetic}{npBy} +\calls{npSynthetic}{npAmpersandFrom} +\calls{npSynthetic}{npPush} +\calls{npSynthetic}{pfApplication} +\calls{npSynthetic}{npPop2} +\calls{npSynthetic}{npPop1} +\calls{npSynthetic}{pfInfApplication} +\begin{chunk}{defun npSynthetic} +(defun |npSynthetic| () + (cond + ((|npBy|) + ((lambda () + (loop + (cond + ((not (and (|npAmpersandFrom|) + (or (|npBy|) + (progn + (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) + nil)))) + (return nil)) + (t + (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) + t) + (t nil))) + +\end{chunk} + +\defun{npBy}{npBy} +\calls{npBy}{npLeftAssoc} +\calls{npBy}{npInterval} +\begin{chunk}{defun npBy} +(defun |npBy| () + (|npLeftAssoc| '(by) #'|npInterval|)) + +\end{chunk} + +\defun{npInterval}{} +\calls{npInterval}{npArith} +\calls{npInterval}{npSegment} +\calls{npInterval}{npEqPeek} +\calls{npInterval}{npPush} +\calls{npInterval}{pfApplication} +\calls{npInterval}{npPop1} +\calls{npInterval}{pfInfApplication} +\calls{npInterval}{npPop2} +\begin{chunk}{defun npInterval} +(defun |npInterval| () + (and + (|npArith|) + (or + (and + (|npSegment|) + (or + (and + (|npEqPeek| 'bar) + (|npPush| (|pfApplication| (|npPop1|) (|npPop1|)))) + (and + (|npArith|) + (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))) + (|npPush| (|pfApplication| (|npPop1|) (|npPop1|))))) + t))) + +\end{chunk} + +\defun{npSegment}{npSegment} +\calls{npSegment}{npEqPeek} +\calls{npSegment}{npPushId} +\calls{npSegment}{npFromdom} +\begin{chunk}{defun npSegment} +(defun |npSegment| () + (and (|npEqPeek| 'seg) (|npPushId|) (|npFromdom|))) + +\end{chunk} + +\defun{npArith}{npArith} +\calls{npArith}{npLeftAssoc} +\calls{npArith}{npSum} +\begin{chunk}{defun npArith} +(defun |npArith| () + (|npLeftAssoc| '(mod) #'|npSum|)) + +\end{chunk} + +\defun{npSum}{npSum} +\calls{npSum}{npLeftAssoc} +\calls{npSum}{npTerm} +\begin{chunk}{defun npSum} +(defun |npSum| () + (|npLeftAssoc| '(plus minus) #'|npTerm|)) + +\end{chunk} + +\defun{npTerm}{npTerm} +\calls{npTerm}{npInfGeneric} +\calls{npTerm}{npRemainder} +\calls{npTerm}{npPush} +\calls{npTerm}{pfApplication} +\calls{npTerm}{npPop2} +\calls{npTerm}{npPop1} +\begin{chunk}{defun npTerm} +(defun |npTerm| () + (or + (and + (|npInfGeneric| '(minus plus)) + (or + (and (|npRemainder|) (|npPush| (|pfApplication| (|npPop2|) (|npPop1|)))) + t)) + (|npRemainder|))) + +\end{chunk} + +\defun{npRemainder}{npRemainder} +\calls{npRemainder}{npLeftAssoc} +\calls{npRemainder}{npProduct} +\begin{chunk}{defun npRemainder} +(defun |npRemainder| () + (|npLeftAssoc| '(rem quo) #'|npProduct|)) + +\end{chunk} + +\defun{npProduct}{npProduct} +\calls{npProduct}{npLeftAssoc} +\calls{npProduct}{npPower} +\begin{chunk}{defun npProduct} +(defun |npProduct| () + (|npLeftAssoc| + '(times slash backslash slashslash backslashbackslash + slashbackslash backslashslash) + #'|npPower|)) + +\end{chunk} + +\defun{npPower}{npPower} +\calls{npPower}{npRightAssoc} +\calls{npPower}{npColon} +\begin{chunk}{defun npPower} +(defun |npPower| () + (|npRightAssoc| '(power carat) #'|npColon|)) + +\end{chunk} + +\defun{npAmpersandFrom}{npAmpersandFrom} +\calls{npAmpersandFrom}{npAmpersand} +\calls{npAmpersandFrom}{npFromdom} +\begin{chunk}{defun npAmpersandFrom} +(defun |npAmpersandFrom| () + (and (|npAmpersand|) (|npFromdom|))) + +\end{chunk} + +\defun{npFromdom}{npFromdom} +\calls{npFromdom}{npEqKey} +\calls{npFromdom}{npApplication} +\calls{npFromdom}{npTrap} +\calls{npFromdom}{npFromdom1} +\calls{npFromdom}{npPop1} +\calls{npFromdom}{npPush} +\calls{npFromdom}{pfFromDom} +\begin{chunk}{defun npFromdom} +(defun |npFromdom| () + (or + (and + (|npEqKey| '$) + (or (|npApplication|) (|npTrap|)) + (|npFromdom1| (|npPop1|)) + (|npPush| (|pfFromDom| (|npPop1|) (|npPop1|)))) + t)) + +\end{chunk} + +\defun{npFromdom1}{npFromdom1} +\calls{npFromdom1}{npEqKey} +\calls{npFromdom1}{npApplication} +\calls{npFromdom1}{npTrap} +\calls{npFromdom1}{npFromdom1} +\calls{npFromdom1}{npPop1} +\calls{npFromdom1}{npPush} +\calls{npFromdom1}{pfFromDom} +\begin{chunk}{defun npFromdom1} +(defun |npFromdom1| (c) + (or + (and + (|npEqKey| '$) + (or (|npApplication|) (|npTrap|)) + (|npFromdom1| (|npPop1|)) + (|npPush| (|pfFromDom| (|npPop1|) c))) + (|npPush| c))) + +\end{chunk} + +\defun{npAmpersand}{npAmpersand} +\calls{npAmpersand}{npEqKey} +\calls{npAmpersand}{npName} +\calls{npAmpersand}{npTrap} +\begin{chunk}{defun npAmpersand} +(defun |npAmpersand| () + (and + (|npEqKey| 'ampersand) + (or (|npName|) (|npTrap|)))) + +\end{chunk} + +\defun{npName}{npName} +\calls{npName}{npId} +\calls{npName}{npSymbolVariable} +\begin{chunk}{defun npName} +(defun |npName| () + (or (|npId|) (|npSymbolVariable|))) + +\end{chunk} + +\defdollar{npTokToNames} +\begin{chunk}{initvars} +(defvar |$npTokToNames| (list '~ '|#| '[] '{} '|[\|\|]| '|{\|\|}|)) + +\end{chunk} + +\defun{npId}{npId} +\calls{npId}{npPush} +\calls{npId}{npNext} +\calls{npId}{tokConstruct} +\calls{npId}{tokPosn} +\usesdollar{npId}{npTokToNames} +\usesdollar{npId}{ttok} +\usesdollar{npId}{stok} +\begin{chunk}{defun npId} +(defun |npId| () + (declare (special |$npTokToNames| |$ttok| |$stok|)) + (cond + ((eq (caar |$stok|) '|id|) + (|npPush| |$stok|) + (|npNext|)) + ((and (eq (caar |$stok|) '|key|) (member |$ttok| |$npTokToNames|)) + (|npPush| (|tokConstruct| '|id| |$ttok| (|tokPosn| |$stok|))) + (|npNext|)) + (t nil))) + +\end{chunk} + +\defun{npSymbolVariable}{npSymbolVariable} +\calls{npSymbolVariable}{npState} +\calls{npSymbolVariable}{npEqKey} +\calls{npSymbolVariable}{npId} +\calls{npSymbolVariable}{npPop1} +\calls{npSymbolVariable}{npPush} +\calls{npSymbolVariable}{tokConstruct} +\calls{npSymbolVariable}{tokPart} +\calls{npSymbolVariable}{tokPosn} +\calls{npSymbolVariable}{npRestore} +\begin{chunk}{defun npSymbolVariable} +(defun |npSymbolVariable| () + (let (a) + (setq a (|npState|)) + (cond + ((and (|npEqKey| 'backquote) (|npId|)) + (setq a (|npPop1|)) + (|npPush| (|tokConstruct| '|idsy| (|tokPart| a) (|tokPosn| a)))) + (t (|npRestore| a) nil)))) + +\end{chunk} + +\defun{npRightAssoc}{npRightAssoc} +\calls{npRightAssoc}{npState} +\calls{npRightAssoc}{npInfGeneric} +\calls{npRightAssoc}{npRightAssoc} +\calls{npRightAssoc}{npPush} +\calls{npRightAssoc}{pfApplication} +\calls{npRightAssoc}{npPop2} +\calls{npRightAssoc}{npPop1} +\calls{npRightAssoc}{pfInfApplication} +\calls{npRightAssoc}{npRestore} +\begin{chunk}{defun npRightAssoc} +(defun |npRightAssoc| (o p) + (let (a) + (setq a (|npState|)) + (cond + ((apply p nil) + ((lambda () + (loop + (cond + ((not + (and + (|npInfGeneric| o) + (or + (|npRightAssoc| o p) + (progn (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) nil)))) + (return nil)) + (t + (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) + t) + (t + (|npRestore| a) + nil)))) + +\end{chunk} + +\defun{npLeftAssoc}{p o p o p o p = (((p o p) o p) o p)} +\begin{verbatim} +p o p o p o p = (((p o p) o p) o p) +p o p o = (p o p) o +;npLeftAssoc(operations,parser)== +; if APPLY(parser,nil) +; then +; while npInfGeneric(operations) +; and (APPLY(parser,nil) or +; (npPush pfApplication(npPop2(),npPop1());false)) +; repeat +; npPush pfInfApplication(npPop2(),npPop2(),npPop1()) +; true +; else false +\end{verbatim} +\calls{npLeftAssoc}{npInfGeneric} +\calls{npLeftAssoc}{npPush} +\calls{npLeftAssoc}{pfApplication} +\calls{npLeftAssoc}{npPop2} +\calls{npLeftAssoc}{npPop1} +\calls{npLeftAssoc}{pfInfApplication} +\begin{chunk}{defun npLeftAssoc} +(defun |npLeftAssoc| (operations parser) + (when (apply parser nil) + ((lambda nil + (loop + (cond + ((not + (and + (|npInfGeneric| operations) + (or + (apply parser nil) + (progn (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) nil)))) + (return nil)) + (t + (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) + t)) + +\end{chunk} + +\defun{npInfGeneric}{npInfGeneric} +\calls{npInfGeneric}{npDDInfKey} +\calls{npInfGeneric}{npEqKey} +\begin{chunk}{defun npInfGeneric} +(defun |npInfGeneric| (s) + (and + (|npDDInfKey| s) + (or (|npEqKey| 'backset) t))) + +\end{chunk} + +\defun{npDDInfKey}{npDDInfKey} +\calls{npDDInfKey}{npInfKey} +\calls{npDDInfKey}{npState} +\calls{npDDInfKey}{npEqKey} +\calls{npDDInfKey}{npPush} +\calls{npDDInfKey}{pfSymb} +\calls{npDDInfKey}{npPop1} +\calls{npDDInfKey}{tokPosn} +\calls{npDDInfKey}{npRestore} +\calls{npDDInfKey}{tokConstruct} +\calls{npDDInfKey}{tokPart} +\usesdollar{npDDInfKey}{stok} +\begin{chunk}{defun npDDInfKey} +(defun |npDDInfKey| (s) + (let (b a) + (declare (special |$stok|)) + (or + (|npInfKey| s) + (progn + (setq a (|npState|)) + (setq b |$stok|) + (cond + ((and (|npEqKey| '|'|) (|npInfKey| s)) + (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| b)))) + (t + (|npRestore| a) + (cond + ((and (|npEqKey| 'backquote) (|npInfKey| s)) + (setq a (|npPop1|)) + (|npPush| (|tokConstruct| '|idsy| (|tokPart| a) (|tokPosn| a)))) + (t + (|npRestore| a) + nil)))))))) + +\end{chunk} + +\defun{npInfKey}{npInfKey} +\calls{npInfKey}{npPushId} +\usesdollar{npInfKey}{stok} +\usesdollar{npInfKey}{ttok} +\begin{chunk}{defun npInfKey} +(defun |npInfKey| (s) + (declare (special |$ttok| |$stok|)) + (and (eq (caar |$stok|) '|key|) (member |$ttok| s) (|npPushId|))) + +\end{chunk} + +\defun{npPushId}{npPushId} +\calls{npPushId}{tokConstruct} +\calls{npPushId}{tokPosn} +\calls{npPushId}{npNext} +\usesdollar{npPushId}{stack} +\usesdollar{npPushId}{stok} +\usesdollar{npPushId}{ttok} +\begin{chunk}{defun npPushId} +(defun |npPushId| () + (let (a) + (declare (special |$stack| |$stok| |$ttok|)) + (setq a (get |$ttok| 'infgeneric)) + (when a (setq |$ttok| a)) + (setq |$stack| + (cons (|tokConstruct| '|id| |$ttok| (|tokPosn| |$stok|)) |$stack|)) + (|npNext|))) + +\end{chunk} + +\defvar{npPParg} +\begin{chunk}{initvars} +(defvar *npPParg* nil "rewrite npPP without flets, using global scoping") + +\end{chunk} + +\defun{npPP}{npPP} +This was rewritten by NAG to remove flet. + +\calls{npPP}{npParened} +\calls{npPP}{npPPf} +\calls{npPP}{npPileBracketed} +\calls{npPP}{npPPg} +\calls{npPP}{npPush} +\calls{npPP}{pfEnSequence} +\calls{npPP}{npPop1} +\uses{npPP}{npPParg} +\begin{chunk}{defun npPP} +(defun |npPP| (f) + (declare (special *npPParg*)) + (setq *npPParg* f) + (or + (|npParened| #'npPPf) + (and (|npPileBracketed| #'npPPg) (|npPush| (|pfEnSequence| (|npPop1|)))) + (funcall f))) + +\end{chunk} + +\defun{npPPff}{npPPff} +\calls{npPPff}{npPop1} +\calls{npPPff}{npPush} +\usesdollar{npPPff}{npPParg} +\begin{chunk}{defun npPPff} +(defun npPPff () + (and (funcall *npPParg*) (|npPush| (list (|npPop1|))))) + +\end{chunk} + +\defun{npPPg}{npPPg} +\calls{npPPg}{npListAndRecover} +\calls{npPPg}{npPPf} +\calls{npPPg}{npPush} +\calls{npPPg}{pfAppend} +\calls{npPPg}{npPop1} +\begin{chunk}{defun npPPg} +(defun npPPg () + (and (|npListAndRecover| #'npPPf)) + (|npPush| (|pfAppend| (|npPop1|)))) + +\end{chunk} + +\defun{npPPf}{npPPf} +\calls{npPPf}{npSemiListing} +\calls{npPPf}{npPPff} +\begin{chunk}{defun npPPf} +(defun npPPf () + (|npSemiListing| #'npPPff)) + +\end{chunk} + +\defun{npEnclosed}{npEnclosed} +\calls{npEnclosed}{npEqKey} +\calls{npEnclosed}{npPush} +\calls{npEnclosed}{pfTuple} +\calls{npEnclosed}{pfListOf} +\calls{npEnclosed}{npMissingMate} +\calls{npEnclosed}{pfEnSequence} +\calls{npEnclosed}{npPop1} +\usesdollar{npEnclosed}{stok} +\begin{chunk}{defun npEnclosed} +(defun |npEnclosed| (open close fn f) + (let (a) + (declare (special |$stok|)) + (setq a |$stok|) + (when (|npEqKey| open) + (cond + ((|npEqKey| close) + (|npPush| (funcall fn a (|pfTuple| (|pfListOf| NIL))))) + ((and (apply f nil) + (or (|npEqKey| close) + (|npMissingMate| close a))) + (|npPush| (funcall fn a (|pfEnSequence| (|npPop1|))))) + ('t nil))))) + +\end{chunk} + +\defun{npState}{npState} +\usesdollar{npState}{stack} +\usesdollar{npState}{inputStream} +\begin{chunk}{defun npState} +(defun |npState| () + (declare (special |$stack| |$inputStream|)) + (cons |$inputStream| |$stack|)) + +\end{chunk} + +\defun{npTrap}{npTrap} +\throws{npTrap}{trappoint} +\calls{npTrap}{tokPosn} +\calls{npTrap}{ncSoftError} +\usesdollar{npTrap}{stok} +\begin{chunk}{defun npTrap} +(defun |npTrap| () + (declare (special |$stok|)) + (|ncSoftError| (|tokPosn| |$stok|) 'S2CY0002 nil) + (throw 'trappoint 'trapped)) + +\end{chunk} + +\defun{npTrapForm}{npTrapForm} +\throws{npTrapForm}{trappoint} +\calls{npTrapForm}{pfSourceStok} +\calls{npTrapForm}{syGeneralErrorHere} +\calls{npTrapForm}{ncSoftError} +\calls{npTrapForm}{tokPosn} +\begin{chunk}{defun npTrapForm} +(defun |npTrapForm| (x) + (let (a) + (setq a (|pfSourceStok| x)) + (cond + ((eq a '|NoToken|) + (|syGeneralErrorHere|) + (throw 'trappoint 'trapped)) + (t + (|ncSoftError| (|tokPosn| a) 'S2CY0002 nil) + (throw 'trappoint 'trapped))))) + +\end{chunk} + +\defun{npVariable}{npVariable} +\calls{npVariable}{npParenthesized} +\calls{npVariable}{npVariablelist} +\calls{npVariable}{npVariableName} +\calls{npVariable}{npPush} +\calls{npVariable}{pfListOf} +\calls{npVariable}{npPop1} +\begin{chunk}{defun npVariable} +(defun |npVariable| () + (or + (|npParenthesized| #'|npVariablelist|) + (and (|npVariableName|) (|npPush| (|pfListOf| (list (|npPop1|))))))) + +\end{chunk} + +\defun{npVariablelist}{npVariablelist} +\calls{npVariablelist}{npListing} +\calls{npVariablelist}{npVariableName} +\begin{chunk}{defun npVariablelist} +(defun |npVariablelist| () + (|npListing| #'|npVariableName|)) + +\end{chunk} + +\defun{npVariableName}{npVariableName} +\calls{npVariableName}{npName} +\calls{npVariableName}{npDecl} +\calls{npVariableName}{npPush} +\calls{npVariableName}{pfTyped} +\calls{npVariableName}{npPop1} +\calls{npVariableName}{pfNothing} +\begin{chunk}{defun npVariableName} +(defun |npVariableName| () + (and + (|npName|) + (or (|npDecl|) (|npPush| (|pfTyped| (|npPop1|) (|pfNothing|)))))) + +\end{chunk} + +\defun{npDecl}{npDecl} +\calls{npDecl}{npEqKey} +\calls{npDecl}{npType} +\calls{npDecl}{npTrap} +\calls{npDecl}{npPush} +\calls{npDecl}{pfTyped} +\calls{npDecl}{npPop2} +\calls{npDecl}{npPop1} +\begin{chunk}{defun npDecl} +(defun |npDecl| () + (and + (|npEqKey| 'colon) + (or (|npType|) (|npTrap|)) + (|npPush| (|pfTyped| (|npPop2|) (|npPop1|))))) + +\end{chunk} + +\defun{npParenthesized}{npParenthesized} +\calls{npParenthesized}{npParenthesize} +\begin{chunk}{defun npParenthesized} +(defun |npParenthesized| (f) + (or (|npParenthesize| '|(| '|)| f) (|npParenthesize| '|(\|| '|\|)| f))) + +\end{chunk} + +\defun{npParenthesize}{npParenthesize} +\calls{npParenthesize}{npEqKey} +\calls{npParenthesize}{npMissingMate} +\calls{npParenthesize}{npPush} +\usesdollar{npParenthesize}{stok} +\begin{chunk}{defun npParenthesize} +(defun |npParenthesize| (open close f) + (let (a) + (declare (special |$stok|)) + (setq a |$stok|) + (cond + ((|npEqKey| open) + (cond + ((and (apply f nil) + (or (|npEqKey| close) + (|npMissingMate| close a))) + t) + ((|npEqKey| close) (|npPush| nil)) + (t (|npMissingMate| close a)))) + (t nil)))) + +\end{chunk} + +\defun{npMissingMate}{npMissingMate} +\calls{npMissingMate}{ncSoftError} +\calls{npMissingMate}{tokPosn} +\calls{npMissingMate}{npMissing} +\begin{chunk}{defun npMissingMate} +(defun |npMissingMate| (close open) + (|ncSoftError| (|tokPosn| open) 'S2CY0008 nil) + (|npMissing| close)) + +\end{chunk} + +\defun{npExit}{npExit} +\calls{npExit}{npBackTrack} +\calls{npExit}{npAssign} +\calls{npExit}{npPileExit} +\begin{chunk}{defun npExit} +(defun |npExit| () + (|npBackTrack| #'|npAssign| 'exit #'|npPileExit|)) + +\end{chunk} + +\defun{npPileExit}{npPileExit} +\calls{npPileExit}{npAssign} +\calls{npPileExit}{npEqKey} +\calls{npPileExit}{npStatement} +\calls{npPileExit}{npPush} +\calls{npPileExit}{pfExit} +\calls{npPileExit}{npPop2} +\calls{npPileExit}{npPop1} +\begin{chunk}{defun npPileExit} +(defun |npPileExit| () + (and + (|npAssign|) + (or (|npEqKey| 'exit) (|npTrap|)) + (or (|npStatement|) (|npTrap|)) + (|npPush| (|pfExit| (|npPop2|) (|npPop1|))))) + +\end{chunk} + +\defun{npAssign}{npAssign} +\calls{npAssign}{npBackTrack} +\calls{npAssign}{npMDEF} +\calls{npAssign}{npAssignment} +\begin{chunk}{defun npAssign} +(defun |npAssign| () + (|npBackTrack| #'|npMDEF| 'becomes #'|npAssignment|)) + +\end{chunk} + +\defun{npAssignment}{npAssignment} +\calls{npAssignment}{npAssignVariable} +\calls{npAssignment}{npEqKey} +\calls{npAssignment}{npTrap} +\calls{npAssignment}{npGives} +\calls{npAssignment}{npPush} +\calls{npAssignment}{pfAssign} +\calls{npAssignment}{npPop2} +\calls{npAssignment}{npPop1} +\begin{chunk}{defun npAssignment} +(defun |npAssignment| () + (and + (|npAssignVariable|) + (or (|npEqKey| 'becomes) (|npTrap|)) + (or (|npGives|) (|npTrap|)) + (|npPush| (|pfAssign| (|npPop2|) (|npPop1|))))) + +\end{chunk} + +\defun{npAssignVariable}{npAssignVariable} +\calls{npAssignVariable}{npColon} +\calls{npAssignVariable}{npPush} +\calls{npAssignVariable}{pfListOf} +\calls{npAssignVariable}{npPop1} +\begin{chunk}{defun npAssignVariable} +(defun |npAssignVariable| () + (and (|npColon|) (|npPush| (|pfListOf| (list (|npPop1|)))))) + +\end{chunk} + +\defun{npColon}{npColon} +\calls{npColon}{npTypified} +\calls{npColon}{npAnyNo} +\calls{npColon}{npTagged} +\begin{chunk}{defun npColon} +(defun |npColon| () + (and (|npTypified|) (|npAnyNo| #'|npTagged|))) + +\end{chunk} + +\defun{npTagged}{npTagged} +\calls{npTagged}{npTypedForm1} +\calls{npTagged}{pfTagged} +\begin{chunk}{defun npTagged} +(defun |npTagged| () + (|npTypedForm1| 'colon #'|pfTagged|)) + +\end{chunk} + +\defun{npTypedForm1}{npTypedForm1} +\calls{npTypedForm1}{npEqKey} +\calls{npTypedForm1}{npType} +\calls{npTypedForm1}{npTrap} +\calls{npTypedForm1}{npPush} +\calls{npTypedForm1}{npPop2} +\calls{npTypedForm1}{npPop1} +\begin{chunk}{defun npTypedForm1} +(defun |npTypedForm1| (sy fn) + (and + (|npEqKey| sy) + (or (|npType|) (|npTrap|)) + (|npPush| (funcall fn (|npPop2|) (|npPop1|))))) + +\end{chunk} + +\defun{npTypified}{npTypified} +\calls{npTypified}{npApplication} +\calls{npTypified}{npAnyNo} +\calls{npTypified}{npTypeStyle} +\begin{chunk}{defun npTypified} +(defun |npTypified| () + (and (|npApplication|) (|npAnyNo| #'|npTypeStyle|))) + +\end{chunk} + +\defun{npTypeStyle}{npTypeStyle} +\calls{npTypeStyle}{npCoerceTo} +\calls{npTypeStyle}{npRestrict} +\calls{npTypeStyle}{npPretend} +\calls{npTypeStyle}{npColonQuery} +\begin{chunk}{defun npTypeStyle} +(defun |npTypeStyle| () + (or (|npCoerceTo|) (|npRestrict|) (|npPretend|) (|npColonQuery|))) + +\end{chunk} + +\defun{npPretend}{npPretend} +\calls{npPretend}{npTypedForm} +\calls{npPretend}{pfPretend} +\begin{chunk}{defun npPretend} +(defun |npPretend| () + (|npTypedForm| 'pretend #'|pfPretend|)) + +\end{chunk} + +\defun{npColonQuery}{npColonQuery} +\calls{npColonQuery}{npTypedForm} +\calls{npColonQuery}{pfRetractTo} +\begin{chunk}{defun npColonQuery} +(defun |npColonQuery| () + (|npTypedForm| 'atat #'|pfRetractTo|)) + +\end{chunk} + +\defun{npCoerceTo}{npCoerceTo} +\calls{npCoerceTo}{npTypedForm} +\calls{npCoerceTo}{pfCoerceto} +\begin{chunk}{defun npCoerceTo} +(defun |npCoerceTo| () + (|npTypedForm| 'coerce #'|pfCoerceto|)) + +\end{chunk} + +\defun{npTypedForm}{npTypedForm} +\calls{npTypedForm}{npEqKey} +\calls{npTypedForm}{npApplication} +\calls{npTypedForm}{npTrap} +\calls{npTypedForm}{npPush} +\calls{npTypedForm}{npPop2} +\calls{npTypedForm}{npPop1} +\begin{chunk}{defun npTypedForm} +(defun |npTypedForm| (sy fn) + (and + (|npEqKey| sy) + (or (|npApplication|) (|npTrap|)) + (|npPush| (funcall fn (|npPop2|) (|npPop1|))))) + +\end{chunk} + +\defun{npRestrict}{npRestrict} +\calls{npRestrict}{npTypedForm} +\calls{npRestrict}{pfRestrict} +\begin{chunk}{defun npRestrict} +(defun |npRestrict| () + (|npTypedForm| 'at #'|pfRestrict|)) + +\end{chunk} + +\defun{npListofFun}{npListofFun} +\calls{npListofFun}{npTrap} +\calls{npListofFun}{npPush} +\calls{npListofFun}{npPop3} +\calls{npListofFun}{npPop2} +\calls{npListofFun}{npPop1} +\usesdollar{npListofFun}{stack} +\begin{chunk}{defun npListofFun} +(defun |npListofFun| (f h g) + (let (a) + (declare (special |$stack|)) + (cond + ((apply f nil) + (cond + ((and (apply h nil) (or (apply f nil) (|npTrap|))) + (setq a |$stack|) + (setq |$stack| nil) + (do () + ((not (and (apply h nil) + (or (apply f nil) (|npTrap|)))))) + (setq |$stack| (cons (nreverse |$stack|) a)) + (|npPush| (funcall g (cons (|npPop3|) (cons (|npPop2|) (|npPop1|)))))) + (t t))) + (t nil)))) + +\end{chunk} + +\section{Functions on interpreter objects} +Interpreter objects used to be called triples because they had the +structure [value, type, environment]. For many years, the environment +was not used, so finally in January, 1990, the structure of objects +was changed to be (type . value). This was chosen because it was the +structure of objects of type Any. Sometimes the values are wrapped +(see the function isWrapped to see what this means physically). +Wrapped values are not actual values belonging to their types. An +unwrapped value must be evaluated to get an actual value. A wrapped +value must be unwrapped before being passed to a library function. +Typically, an unwrapped value in the interpreter consists of LISP +code, e.g., parts of a function that is being constructed. +-- RSS 1/14/90 + +These are the new structure functions. + +\begin{center} +\includegraphics{ps/v5mkObj.eps}\\ +{\bf {\Large Object representation}} +\end{center} + +\defmacro{mkObj} +\begin{chunk}{defmacro mkObj} +(defmacro mkObj (val mode) + `(cons ,mode ,val)) + +\end{chunk} + +\begin{center} +\includegraphics{ps/v5mkObjWrap.eps}\\ +{\bf {\Large Object representation}} +\end{center} + +\defmacro{mkObjWrap} +\calls{mkObjWrap}{wrap} +\begin{chunk}{defmacro mkObjWrap} +(defmacro mkObjWrap (val mode) + `(cons ,mode (|wrap| ,val))) + +\end{chunk} + +\defmacro{mkObjCode} +\begin{chunk}{defmacro mkObjCode} +(defmacro mkObjCode (val mode) + `(cons 'cons (cons (mkq ,mode) (cons ,val nil)))) + +\end{chunk} + +\defmacro{objSetVal} +\begin{chunk}{defmacro objSetVal} +(defmacro |objSetVal| (obj val) + `(rplacd ,obj ,val)) + +\end{chunk} + +\defmacro{objSetMode} +\begin{chunk}{defmacro objSetMode} +(defmacro |objSetMode| (obj mode) + `(rplaca ,obj ,mode)) + +\end{chunk} + +\defmacro{objVal} +\begin{chunk}{defmacro objVal} +(defmacro |objVal| (obj) + `(cdr ,obj)) + +\end{chunk} + +\defmacro{objValUnwrap} +\begin{chunk}{defmacro objValUnwrap} +(defmacro |objValUnwrap| (obj) + `(|unwrap| (cdr ,obj))) + +\end{chunk} + +\defmacro{objMode} +\begin{chunk}{defmacro objMode} +(defmacro |objMode| (obj) + `(car ,obj)) + +\end{chunk} + +\defun{objEnv}{objEnv} +\begin{chunk}{defun objEnv 0} +(defun |objEnv| (obj) + (declare (special $NE) (ignore obj)) + $NE) + +\end{chunk} + +\defmacro{objCodeVal} +\begin{chunk}{defmacro objCodeVal} +(defmacro |objCodeVal| (obj) + `(caddr ,obj)) + +\end{chunk} + +\defmacro{objCodeMode} +\begin{chunk}{defmacro objCodeMode} +(defmacro |objCodeMode| (obj) + `(cadr ,obj)) + +\end{chunk} + +\section{Macro handling} +\defun{phMacro}{phMacro} +\tpdhere{The pform function has a leading percent sign} +\begin{verbatim} +carrier[ptree,...] -> carrier[ptree, ptreePremacro,...] +\end{verbatim} +\calls{phMacro}{ncEltQ} +\calls{phMacro}{ncPutQ} +\calls{phMacro}{macroExpanded} +\calls{phMacro}{pform} +\begin{chunk}{defun phMacro} +(defun |phMacro| (carrier) + (let (ptree) + (setq ptree (|ncEltQ| carrier '|ptree|)) + (|ncPutQ| carrier '|ptreePremacro| ptree) + (setq ptree (|macroExpanded| ptree)) + (|ncPutQ| carrier '|ptree| ptree) + 'ok)) + +\end{chunk} + +\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} +\begin{chunk}{defun macroExpanded} +(defun |macroExpanded| (pf) + (let (|$posActive| |$macActive|) + (declare (special |$posActive| |$macActive|)) + (setq |$macActive| nil) + (setq |$posActive| nil) + (|macExpand| pf))) + +\end{chunk} + +\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} +\begin{chunk}{defun 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)))) + +\end{chunk} + +\defun{macApplication}{macApplication} +\calls{macApplication}{pfMapParts} +\calls{macApplication}{macExpand} +\calls{macApplication}{pfApplicationOp} +\calls{macApplication}{pfMLambda?} +\calls{macApplication}{pf0ApplicationArgs} +\calls{macApplication}{mac0MLambdaApply} +\usesdollar{macApplication}{pfMacros} +\begin{chunk}{defun macApplication} +(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|))))) + +\end{chunk} + +\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} +\begin{chunk}{defun mac0MLambdaApply} +(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|))))) + +\end{chunk} + +\defun{mac0ExpandBody}{mac0ExpandBody} +\calls{mac0ExpandBody}{pfSourcePosition} +\calls{mac0ExpandBody}{mac0InfiniteExpansion} +\calls{mac0ExpandBody}{macExpand} +\usesdollar{mac0ExpandBody}{posActive} +\usesdollar{mac0ExpandBody}{macActive} +\begin{chunk}{defun mac0ExpandBody} +(defun |mac0ExpandBody| (body opf |$macActive| |$posActive|) + (declare (special |$macActive| |$posActive|)) + (let (posn pf) + (cond + ((member 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))))) + +\end{chunk} + +\defun{mac0InfiniteExpansion}{mac0InfiniteExpansion} +\tpdhere{The pform function has a leading percent sign. fix this} + +\calls{mac0InfiniteExpansion}{mac0InfiniteExpansion,name} +\calls{mac0InfiniteExpansion}{ncSoftError} +\calls{mac0InfiniteExpansion}{pform} +\begin{chunk}{defun mac0InfiniteExpansion} +(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)) + +\end{chunk} + +\defun{mac0InfiniteExpansion,name}{mac0InfiniteExpansion,name} +\calls{mac0InfiniteExpansion,name}{mac0GetName} +\calls{mac0InfiniteExpansion,name}{pname} +\begin{chunk}{defun mac0InfiniteExpansion,name 0} +(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)))))) + +\end{chunk} + +\defun{mac0GetName}{mac0GetName} +Returns [state, body] or NIL. +Returns [sy, state] or NIL. + +\calls{mac0GetName}{pfMLambdaBody} +\usesdollar{mac0GetName}{pfMacros} +\begin{chunk}{defun mac0GetName} +(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)) + +\end{chunk} + +\defun{macId}{macId} +\calls{macId}{pfIdSymbol} +\calls{macId}{mac0Get} +\calls{macId}{pfCopyWithPos} +\calls{macId}{pfSourcePosition} +\calls{macId}{mac0ExpandBody} +\usesdollar{macId}{posActive} +\usesdollar{macId}{macActive} +\begin{chunk}{defun macId} +(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)))))))) + +\end{chunk} + +\defun{mac0Get}{mac0Get} +\calls{mac0Get}{ifcdr} +\usesdollar{mac0Get}{pfMacros} +\begin{chunk}{defun mac0Get} +(defun |mac0Get| (sy) + (declare (special |$pfMacros|)) + (ifcdr (assoc sy |$pfMacros|))) + +\end{chunk} + +\defun{macWhere}{macWhere} +\calls{macWhere}{macWhere,mac} +\usesdollar{macWhere}{pfMacros} +\begin{chunk}{defun macWhere} +(defun |macWhere| (pf) + (declare (special |$pfMacros|)) + (|macWhere,mac| pf |$pfMacros|)) + +\end{chunk} + +\defun{macWhere,mac}{macWhere,mac} +\calls{macWhere,mac}{pfMapParts} +\calls{macWhere,mac}{macExpand} +\usesdollar{macWhere,mac}{pfMacros} +\begin{chunk}{defun macWhere,mac} +(defun |macWhere,mac| (pf |$pfMacros|) + (declare (special |$pfMacros|)) + (|pfMapParts| #'|macExpand| pf)) + +\end{chunk} + +\defun{macLambda}{macLambda} +\calls{macLambda}{macLambda,mac} +\usesdollar{macLambda}{pfMacros} +\begin{chunk}{defun macLambda} +(defun |macLambda| (pf) + (declare (special |$pfMacros|)) + (|macLambda,mac| pf |$pfMacros|)) + +\end{chunk} + +\defun{macLambda,mac}{macLambda,mac} +\calls{macLambda,mac}{pfMapParts} +\calls{macLambda,mac}{macExpand} +\usesdollar{macLambda,mac}{pfMacros} +\begin{chunk}{defun macLambda,mac} +(defun |macLambda,mac| (pf |$pfMacros|) + (declare (special |$pfMacros|)) + (|pfMapParts| #'|macExpand| pf)) + +\end{chunk} + +\defun{macMacro}{Add appropriate definition the a Macro pform} +This function adds the 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} +\begin{chunk}{defun macMacro} +(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|)))))))) + +\end{chunk} + +\defun{mac0Define}{Add a macro to the global pfMacros list} +\usesdollar{mac0Define}{pfMacros} +\begin{chunk}{defun mac0Define 0} +(defun |mac0Define| (sy state body) + (declare (special |$pfMacros|)) + (setq |$pfMacros| (cons (list sy state body) |$pfMacros|))) + +\end{chunk} + +\defun{macSubstituteOuter}{macSubstituteOuter} +\calls{macSubstituteOuter}{mac0SubstituteOuter} +\calls{macSubstituteOuter}{macLambdaParameterHandling} +\begin{chunk}{defun macSubstituteOuter} +(defun |macSubstituteOuter| (pform) + (|mac0SubstituteOuter| (|macLambdaParameterHandling| nil pform) pform)) + +\end{chunk} + +\defun{mac0SubstituteOuter}{mac0SubstituteOuter} +\calls{mac0SubstituteOuter}{pfId?} +\calls{mac0SubstituteOuter}{macSubstituteId} +\calls{mac0SubstituteOuter}{pfLeaf?} +\calls{mac0SubstituteOuter}{pfLambda?} +\calls{mac0SubstituteOuter}{macLambdaParameterHandling} +\calls{mac0SubstituteOuter}{mac0SubstituteOuter} +\calls{mac0SubstituteOuter}{pfParts} +\begin{chunk}{defun mac0SubstituteOuter} +(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)))) + +\end{chunk} + +\defun{macLambdaParameterHandling}{macLambdaParameterHandling} +\calls{macLambdaParameterHandling}{pfLeaf?} +\calls{macLambdaParameterHandling}{pfLambda?} +\calls{macLambdaParameterHandling}{pfTypedId} +\calls{macLambdaParameterHandling}{pf0LambdaArgs} +\calls{macLambdaParameterHandling}{pfIdSymbol} +\calls{macLambdaParameterHandling}{pfMLambda?} +\calls{macLambdaParameterHandling}{pf0MLambdaArgs} +\calls{macLambdaParameterHandling}{pfLeaf} +\calls{macLambdaParameterHandling}{pfAbSynOp} +\calls{macLambdaParameterHandling}{pfLeafPosition} +\calls{macLambdaParameterHandling}{pfParts} +\calls{macLambdaParameterHandling}{macLambdaParameterHandling} +\begin{chunk}{defun 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 + (let ((pr (assoc par replist :test #'equal))) + (when pr (remove par replist :test #'equal))))) + 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)))))) + +\end{chunk} + +\defun{macSubstituteId}{macSubstituteId} +\calls{macSubstituteId}{pfIdSymbol} +\begin{chunk}{defun macSubstituteId} +(defun |macSubstituteId| (replist pform) + (let (ex) + (setq ex (assoc (|pfIdSymbol| pform) replist :test #'eq)) + (cond + (ex + (rplaca pform (cadr ex)) + (rplacd pform (cddr ex)) + pform) + (t pform)))) + +\end{chunk} + +\chapter{Pftrees} +\section{Abstract Syntax Trees Overview} + +Th functions create and examine abstract syntax trees. +These are called pforms, for short. + +The pform data structure + +\begin{itemize} +\item Leaves: [hd, tok, pos] where pos is optional +\item Trees: [hd, tree, tree, ...] +\item hd is either an id or (id . alist) +\end{itemize} + +The leaves are: + +\begin{tabular}{lcl} + char &:=& ('char expr position) \\ + Document &:=& ('Document expr position) \\ + error &:=& ('error expr position) \\ + expression &:=& ('expression expr position) \\ + float &:=& ('float expr position) \\ + id &:=& ('id expr position)\\ + idsy &:=& ('idsy expr position)\\ + integer &:=& ('integer expr position)\\ + string &:=& ('string expr position)\\ + symbol &:=& ('symbol expr position) +\end{tabular} + +The special nodes: + +\begin{tabular}{lcl} + ListOf &:=& ('listOf items)\\ + Nothing &:=& ('nothing)\\ + SemiColon &:=& ('SemiColon (Body: Expr)) +\end{tabular} + +The expression nodes: + +\begin{tabular}{lcl} + Add &:=& ('Add (Base: [Typed], Addin: Expr))\\ + And &:=& ('And left right)\\ + Application &:=& ('Application (Op: Expr, Arg: Expr))\\ + Assign &:=& ('Assign (LhsItems: [AssLhs], Rhs: Expr))\\ + Attribute &:=& ('Attribute (Expr: Primary))\\ + Break &:=& ('Break (From: ? Id))\\ + Coerceto &:=& ('Coerceto (Expr: Expr, Type: Type))\\ + Collect &:=& ('Collect (Body: Expr, Iterators: [Iterator]))\\ + ComDefinition &:=& ('ComDefinition (Doc: Document, Def: Definition))\\ + DeclPart &&\\ + Definition &:=& ('Definition (LhsItems: [Typed], Rhs: Expr))\\ + DefinitionSequence &:=& (Args: [DeclPart])\\ + Do &:=& ('Do (Body: Expr))\\ + Document &:=& ('Document strings)\\ + DWhere &:=& ('DWhere (Context: [DeclPart], Expr: [DeclPart]))\\ + EnSequence &:=&\\ + Exit &:=& ('Exit (Cond: ? Expr, Expr: ? Expr))\\ + Export &:=& ('Export (Items: [Typed]))\\ + Forin &:=& ('Forin (Lhs: [AssLhs], Whole: Expr))\\ + Free &:=& ('Free (Items: [Typed]))\\ + Fromdom &:=& ('Fromdom (What: Id, Domain: Type))\\ + Hide &:=& ('hide, arg)\\ + If &:=& ('If (Cond: Expr, Then: Expr, Else: ? Expr))\\ + Import &:=& ('Import (Items: [QualType]))\\ + Inline &:=& ('Inline (Items: [QualType]))\\ + Iterate &:=& ('Iterate (From: ? Id))\\ + Lambda &:=& ('Lambda (Args: [Typed], Rets: ReturnedTyped, Body: Expr))\\ + Literal \\ + Local &:=& ('Local (Items: [Typed]))\\ + Loop &:=& ('Loop (Iterators: [Iterator]))\\ + Macro &:=& ('Macro (Lhs: Id, Rhs: ExprorNot))\\ + MLambda &:=& ('MLambda (Args: [Id], Body: Expr))\\ + Not &:=& ('Not arg)\\ + Novalue &:=& ('Novalue (Expr: Expr))\\ + Or &:=& ('Or left right)\\ + Pretend &:=& ('Pretend (Expr: Expr, Type: Type))\\ + QualType &:=& ('QualType (Type: Type, Qual: ? Type))\\ + Restrict &:=& ('Restrict (Expr: Expr, Type: Type))\\ + Retract &:=& ('RetractTo (Expr: Expr, Type: Type))\\ + Return &:=& ('Return (Expr: ? Expr, From: ? Id))\\ + ReturnTyped &:=& ('returntyuped (type body))\\ + Rule &:=& ('Rule (lhsitems, rhsitems))\\ + Sequence &:=& ('Sequence (Args: [Expr]))\\ + Suchthat &:=& ('Suchthat (Cond: Expr))\\ + Symb &:=& if leaf then symbol else expression\\ + Tagged &:=& ('Tagged (Tag: Expr, Expr: Expr))\\ + TLambda &:=&('TLambda (Args: [Typed], \\ + &&\quad{}Rets: ReturnedTyped Type, Body: Expr))\\ + Tuple &:=& ('Tuple (Parts: [Expr]))\\ + Typed &:=& ('Typed (Id: Id, Type: ? Type))\\ + Typing &:=& ('Typing (Items: [Typed]))\\ + Until &:=& ('Until (Cond: Expr)) NOT USED\\ + WDeclare &:=& ('WDeclare (Signature: Typed, Doc: ? Document))\\ + Where &:=& ('Where (Context: [DeclPart], Expr: Expr))\\ + While &:=& ('While (Cond: Expr))\\ + With &:=& ('With (Base: [Typed], Within: [WithPart]))\\ + WIf &:=& ('WIf (Cond: Primary, Then: [WithPart], Else: [WithPart]))\\ + Wrong &:=& ('Wrong (Why: Document, Rubble: [Expr])) +\end{tabular} + +Special cases of expression nodes are: + +\begin{itemize} +\item Application. The Op parameter is one of + \verb/and, or, Y, |, {}, [], {||}, [||]/ +\item DeclPart. The comment is attached to all signatutres in + Typing, Import, Definition, Sequence, DWhere, Macro nodes +\item EnSequence. This is either a Tuple or Sequence depending on the +argument +\item Literal. One of integer symbol expression one zero char string float +of the form ('expression expr position) +\end{itemize} + +\section{Structure handlers} + +\defun{pfGlobalLinePosn}{pfGlobalLinePosn} +\calls{pfGlobalLinePosn}{poGlobalLinePosn} +\begin{chunk}{defun pfGlobalLinePosn} +(defun |pfGlobalLinePosn| (posn) + (|poGlobalLinePosn| posn)) + +\end{chunk} + +\defun{pfCharPosn}{pfCharPosn} +\calls{pfCharPosn}{poCharPosn} +\begin{chunk}{defun pfCharPosn} +(defun |pfCharPosn| (posn) + (|poCharPosn| posn)) + +\end{chunk} + +\defun{pfLinePosn}{pfLinePosn} +\calls{pfLinePosn}{poLinePosn} +\begin{chunk}{defun pfLinePosn} +(defun |pfLinePosn| (posn) + (|poLinePosn| posn)) + +\end{chunk} + +\defun{pfFileName}{pfFileName} +\calls{pfFileName}{poFileName} +\begin{chunk}{defun pfFileName} +(defun |pfFileName| (posn) + (|poFileName| posn)) + +\end{chunk} + +\defun{pfCopyWithPos}{pfCopyWithPos} +\calls{pfCopyWithPos}{pfLeaf?} +\calls{pfCopyWithPos}{pfLeaf} +\calls{pfCopyWithPos}{pfAbSynOp} +\calls{pfCopyWithPos}{tokPart} +\calls{pfCopyWithPos}{pfTree} +\calls{pfCopyWithPos}{pfParts} +\calls{pfCopyWithPos}{pfCopyWithPos} +\begin{chunk}{defun pfCopyWithPos} +(defun |pfCopyWithPos| (pform pos) + (if (|pfLeaf?| pform) + (|pfLeaf| (|pfAbSynOp| pform) (|tokPart| pform) pos) + (|pfTree| (|pfAbSynOp| pform) + (loop for p in (|pfParts| pform) + collect (|pfCopyWithPos| p pos))))) + +\end{chunk} + +\defun{pfMapParts}{pfMapParts} +\calls{pfMapParts}{pfLeaf?} +\calls{pfMapParts}{pfParts} +\calls{pfMapParts}{pfTree} +\calls{pfMapParts}{pfAbSynOp} +\begin{chunk}{defun pfMapParts} +(defun |pfMapParts| (f pform) + (let (parts1 parts0) + (if (|pfLeaf?| pform) + pform + (progn + (setq parts0 (|pfParts| pform)) + (setq parts1 (loop for p in parts0 collect (funcall f p))) + (if (reduce #'(lambda (u v) (and u v)) (mapcar #'eq parts0 parts1)) + pform + (|pfTree| (|pfAbSynOp| pform) parts1)))))) + +\end{chunk} + +\defun{pf0ApplicationArgs}{pf0ApplicationArgs} +\calls{pf0ApplicationArgs}{pf0FlattenSyntacticTuple} +\calls{pf0ApplicationArgs}{pfApplicationArg} +\begin{chunk}{defun pf0ApplicationArgs} +(defun |pf0ApplicationArgs| (pform) + (|pf0FlattenSyntacticTuple| (|pfApplicationArg| pform))) + +\end{chunk} + +\defun{pf0FlattenSyntacticTuple}{pf0FlattenSyntacticTuple} +\calls{pf0FlattenSyntacticTuple}{pfTuple?} +\calls{pf0FlattenSyntacticTuple}{pf0FlattenSyntacticTuple} +\calls{pf0FlattenSyntacticTuple}{pf0TupleParts} +\begin{chunk}{defun pf0FlattenSyntacticTuple} +(defun |pf0FlattenSyntacticTuple| (pform) + (if (null (|pfTuple?| pform)) + (list pform) + ; [:pf0FlattenSyntacticTuple p for p in pf0TupleParts pform] + ((lambda (arg0 arg1 p) + (loop + (cond + ((or (atom arg1) (progn (setq p (car arg1)) nil)) + (return (nreverse arg0))) + (t + (setq arg0 (append (reverse (|pf0FlattenSyntacticTuple| p)) arg0)))) + (setq arg1 (cdr arg1)))) + nil (|pf0TupleParts| pform) nil))) + +\end{chunk} + +\defun{pfSourcePosition}{pfSourcePosition} +\calls{pfSourcePosition}{pfLeaf?} +\calls{pfSourcePosition}{pfLeafPosition} +\calls{pfSourcePosition}{poNoPosition?} +\calls{pfSourcePosition}{pfSourcePosition} +\calls{pfSourcePosition}{pfParts} +\usesdollar{pfSourcePosition}{nopos} +\begin{chunk}{defun pfSourcePosition} +(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)))) + +\end{chunk} + +\defun{pfSequenceToList}{Convert a Sequence node to a list} +\calls{pfSequenceToList}{pfSequence?} +\calls{pfSequenceToList}{pfSequenceArgs} +\calls{pfSequenceToList}{pfListOf} +\begin{chunk}{defun pfSequenceToList} +(defun |pfSequenceToList| (x) + (if (|pfSequence?| x) + (|pfSequenceArgs| x) + (|pfListOf| (list x)))) + +\end{chunk} + +\defun{pfSpread}{pfSpread} +\calls{pfSpread}{pfTyped} +\begin{chunk}{defun pfSpread} +(defun |pfSpread| (arg1 arg2) + (mapcar #'(lambda (i) (|pfTyped| i arg2)) arg1)) + +\end{chunk} + +\defun{pfCheckItOut}{Deconstruct nodes to lists} +\calls{pfCheckItOut}{pfTagged?} +\calls{pfCheckItOut}{pfTaggedExpr} +\calls{pfCheckItOut}{pfNothing} +\calls{pfCheckItOut}{pfTaggedTag} +\calls{pfCheckItOut}{pfId?} +\calls{pfCheckItOut}{pfListOf} +\calls{pfCheckItOut}{pfTyped} +\calls{pfCheckItOut}{pfCollect1?} +\calls{pfCheckItOut}{pfCollectVariable1} +\calls{pfCheckItOut}{pfTuple?} +\calls{pfCheckItOut}{pf0TupleParts} +\calls{pfCheckItOut}{pfTaggedToTyped} +\calls{pfCheckItOut}{pfDefinition?} +\calls{pfCheckItOut}{pfApplication?} +\calls{pfCheckItOut}{pfFlattenApp} +\calls{pfCheckItOut}{pfTaggedToTyped1} +\calls{pfCheckItOut}{pfTransformArg} +\calls{pfCheckItOut}{npTrapForm} +\begin{chunk}{defun pfCheckItOut} +(defun |pfCheckItOut| (x) + (let (args op ls form rt result) + (if (|pfTagged?| x) + (setq rt (|pfTaggedExpr| x)) + (setq rt (|pfNothing|))) + (if (|pfTagged?| x) + (setq form (|pfTaggedTag| x)) + (setq form x)) + (cond + ((|pfId?| form) + (list (|pfListOf| (list (|pfTyped| form rt))) nil rt)) + ((|pfCollect1?| form) + (list (|pfListOf| (list (|pfCollectVariable1| form))) nil rt)) + ((|pfTuple?| form) + (list (|pfListOf| + (dolist (part (|pf0TupleParts| form) (nreverse result)) + (push (|pfTaggedToTyped| part) result))) + nil rt)) + ((|pfDefinition?| form) + (list (|pfListOf| (list (|pfTyped| form (|pfNothing|)))) nil rt)) + ((|pfApplication?| form) + (setq ls (|pfFlattenApp| form)) + (setq op (|pfTaggedToTyped1| (car ls))) + (setq args + (dolist (part (cdr ls) (nreverse result)) + (push (|pfTransformArg| part) result))) + (list (|pfListOf| (list op)) args rt)) + (t (|npTrapForm| form))))) + +\end{chunk} + +\defun{pfCheckMacroOut}{pfCheckMacroOut} +\calls{pfCheckMacroOut}{pfId?} +\calls{pfCheckMacroOut}{pfApplication?} +\calls{pfCheckMacroOut}{pfFlattenApp} +\calls{pfCheckMacroOut}{pfCheckId} +\calls{pfCheckMacroOut}{pfCheckArg} +\calls{pfCheckMacroOut}{npTrapForm} +\begin{chunk}{defun pfCheckMacroOut} +(defun |pfCheckMacroOut| (form) + (let (args op ls) + (cond + ((|pfId?| form) (list form nil)) + ((|pfApplication?| form) + (setq ls (|pfFlattenApp| form)) + (setq op (|pfCheckId| (car ls))) + (setq args (mapcar #'|pfCheckArg| (cdr ls))) + (list op args)) + (t (|npTrapForm| form))))) + +\end{chunk} + +\defun{pfCheckArg}{pfCheckArg} +\calls{pfCheckArg}{pfTuple?} +\calls{pfCheckArg}{pf0TupleParts} +\calls{pfCheckArg}{pfListOf} +\calls{pfCheckArg}{pfCheckId} +\begin{chunk}{defun pfCheckArg} +(defun |pfCheckArg| (args) + (let (argl) + (if (|pfTuple?| args) + (setq argl (|pf0TupleParts| args)) + (setq argl (list args))) + (|pfListOf| (mapcar #'|pfCheckId| argl)))) + +\end{chunk} + +\defun{pfCheckId}{pfCheckId} +\calls{pfCheckId}{pfId?} +\calls{pfCheckId}{npTrapForm} +\begin{chunk}{defun pfCheckId} +(defun |pfCheckId| (form) + (if (null (|pfId?| form)) + (|npTrapForm| form) + form)) + +\end{chunk} + +\defun{pfFlattenApp}{pfFlattenApp} +\calls{pfFlattenApp}{pfApplication?} +\calls{pfFlattenApp}{pfCollect1?} +\calls{pfFlattenApp}{pfFlattenApp} +\calls{pfFlattenApp}{pfApplicationOp} +\calls{pfFlattenApp}{pfApplicationArg} +\begin{chunk}{defun pfFlattenApp} +(defun |pfFlattenApp| (x) + (cond + ((|pfApplication?| x) + (cond + ((|pfCollect1?| x) (LIST x)) + (t + (append (|pfFlattenApp| (|pfApplicationOp| x)) + (|pfFlattenApp| (|pfApplicationArg| x)))))) + (t (list x)))) + +\end{chunk} + +\defun{pfCollect1?}{pfCollect1?} +\calls{pfCollect1?}{pfApplication?} +\calls{pfCollect1?}{pfApplicationOp} +\calls{pfCollect1?}{pfId?} +\calls{pfCollect1?}{pfIdSymbol} +\begin{chunk}{defun pfCollect1?} +(defun |pfCollect1?| (x) + (let (a) + (when (|pfApplication?| x) + (setq a (|pfApplicationOp| x)) + (when (|pfId?| a) (eq (|pfIdSymbol| a) '|\||))))) + +\end{chunk} + +\defun{pfCollectVariable1}{pfCollectVariable1} +\calls{pfCollectVariable1}{pfApplicationArg} +\calls{pfCollectVariable1}{pf0TupleParts} +\calls{pfCollectVariable1}{pfTaggedToTyped} +\calls{pfCollectVariable1}{pfTyped} +\calls{pfCollectVariable1}{pfSuch} +\calls{pfCollectVariable1}{pfTypedId} +\calls{pfCollectVariable1}{pfTypedType} +\begin{chunk}{defun pfCollectVariable1} +(defun |pfCollectVariable1| (x) + (let (id var a) + (setq a (|pfApplicationArg| x)) + (setq var (car (|pf0TupleParts| a))) + (setq id (|pfTaggedToTyped| var)) + (|pfTyped| + (|pfSuch| (|pfTypedId| id) (cadr (|pf0TupleParts| a))) + (|pfTypedType| id)))) + +\end{chunk} + +\defun{pfPushMacroBody}{pfPushMacroBody} +\calls{pfPushMacroBody}{pfMLambda} +\calls{pfPushMacroBody}{pfPushMacroBody} +\begin{chunk}{defun pfPushMacroBody} +(defun |pfPushMacroBody| (args body) + (if (null args) + body + (|pfMLambda| (car args) (|pfPushMacroBody| (cdr args) body)))) + +\end{chunk} + +\defun{pfSourceStok}{pfSourceStok} +\calls{pfSourceStok}{pfLeaf?} +\calls{pfSourceStok}{pfParts} +\calls{pfSourceStok}{pfSourceStok} +\calls{pfSourceStok}{pfFirst} +\begin{chunk}{defun pfSourceStok} +(defun |pfSourceStok| (x) + (cond + ((|pfLeaf?| x) x) + ((null (|pfParts| x)) '|NoToken|) + (t (|pfSourceStok| (|pfFirst| x))))) + +\end{chunk} + +\defun{pfTransformArg}{pfTransformArg} +\calls{pfTransformArg}{pfTuple?} +\calls{pfTransformArg}{pf0TupleParts} +\calls{pfTransformArg}{pfListOf} +\calls{pfTransformArg}{pfTaggedToTyped1} +\begin{chunk}{defun pfTransformArg} +(defun |pfTransformArg| (args) + (let (arglist result) + (if (|pfTuple?| args) + (setq arglist (|pf0TupleParts| args)) + (setq arglist (list args))) + (|pfListOf| + (dolist (|i| arglist (nreverse result)) + (push (|pfTaggedToTyped1| |i|) result))))) + +\end{chunk} + +\defun{pfTaggedToTyped1}{pfTaggedToTyped1} +\calls{pfTaggedToTyped1}{pfCollect1?} +\calls{pfTaggedToTyped1}{pfCollectVariable1} +\calls{pfTaggedToTyped1}{pfDefinition?} +\calls{pfTaggedToTyped1}{pfTyped} +\calls{pfTaggedToTyped1}{pfNothing} +\calls{pfTaggedToTyped1}{pfTaggedToTyped} +\begin{chunk}{defun pfTaggedToTyped1} +(defun |pfTaggedToTyped1| (arg) + (cond + ((|pfCollect1?| arg) (|pfCollectVariable1| arg)) + ((|pfDefinition?| arg) (|pfTyped| arg (|pfNothing|))) + (t (|pfTaggedToTyped| arg)))) + +\end{chunk} + +\defun{pfSuch}{pfSuch} +\calls{pfSuch}{pfInfApplication} +\calls{pfSuch}{pfId} +\begin{chunk}{defun pfSuch} +(defun |pfSuch| (x y) + (|pfInfApplication| (|pfId| '|\||) x y)) + +\end{chunk} + +\section{Special Nodes} + +\defun{pfListOf}{Create a Listof node} +\calls{pfListOf}{pfTree} +\begin{chunk}{defun pfListOf} +(defun |pfListOf| (x) + (|pfTree| '|listOf| x)) + +\end{chunk} + +\defun{pfNothing}{pfNothing} +\calls{pfNothing}{pfTree} +\begin{chunk}{defun pfNothing} +(defun |pfNothing| () + (|pfTree| '|nothing| nil)) + +\end{chunk} + +\defun{pfNothing?}{Is this a Nothing node?} +\calls{pfNothing?}{pfAbSynOp?} +\begin{chunk}{defun pfNothing?} +(defun |pfNothing?| (form) + (|pfAbSynOp?| form '|nothing|)) + +\end{chunk} + +\section{Leaves} + +\defun{pfDocument}{Create a Document node} +\calls{pfDocument}{pfLeaf} +\begin{chunk}{defun pfDocument} +(defun |pfDocument| (strings) + (|pfLeaf| '|Document| strings)) + +\end{chunk} + +\defun{pfId}{Construct an Id node} +\calls{pfId}{pfLeaf} +\begin{chunk}{defun pfId} +(defun |pfId| (expr) + (|pfLeaf| '|id| expr)) + +\end{chunk} + +\defun{pfId?}{Is this an Id node?} +\calls{pfId?}{pfAbSynOp?} +\begin{chunk}{defun pfId?} +(defun |pfId?| (form) + (or (|pfAbSynOp?| form '|id|) (|pfAbSynOp?| form '|idsy|))) + +\end{chunk} + +\defun{pfIdPos}{Construct an Id leaf node} +\calls{pfIdPos}{pfLeaf} +\begin{chunk}{defun pfIdPos} +(defun |pfIdPos| (expr pos) + (|pfLeaf| '|id| expr pos)) + +\end{chunk} + +\defun{pfIdSymbol}{Return the Id part} +\calls{pfIdSymbol}{tokPart} +\begin{chunk}{defun pfIdSymbol} +(defun |pfIdSymbol| (form) + (|tokPart| form)) + +\end{chunk} + +\defun{pfLeaf}{Construct a Leaf node} +\calls{pfLeaf}{tokConstruct} +\calls{pfLeaf}{ifcar} +\calls{pfLeaf}{pfNoPosition} +\begin{chunk}{defun pfLeaf} +(defun |pfLeaf| (x y &rest z) + (|tokConstruct| x y (or (ifcar z) (|pfNoPosition|)))) + +\end{chunk} + +\defun{pfLeaf?}{Is this a leaf node?} +\calls{pfLeaf?}{pfAbSynOp} +\begin{chunk}{defun pfLeaf?} +(defun |pfLeaf?| (form) + (member (|pfAbSynOp| form) + '(|id| |idsy| |symbol| |string| |char| |float| |expression| + |integer| |Document| |error|))) + +\end{chunk} + +\defun{pfLeafPosition}{Return the token position of a leaf node} +\calls{pfLeafPosition}{tokPosn} +\begin{chunk}{defun pfLeafPosition} +(defun |pfLeafPosition| (form) + (|tokPosn| form)) + +\end{chunk} + +\defun{pfLeafToken}{Return the Leaf Token} +\calls{pfLeafToken}{tokPart} +\begin{chunk}{defun pfLeafToken} +(defun |pfLeafToken| (form) + (|tokPart| form)) + +\end{chunk} + +\defun{pfLiteral?}{Is this a Literal node?} +\calls{pfLiteral?}{pfAbSynOp} +\begin{chunk}{defun pfLiteral? 0} +(defun |pfLiteral?| (form) + (member (|pfAbSynOp| form) + '(|integer| |symbol| |expression| |one| |zero| |char| |string| |float|))) + +\end{chunk} + +\defun{pfLiteralClass}{Create a LiteralClass node} +\calls{pfLiteralClass}{pfAbSynOp} +\begin{chunk}{defun pfLiteralClass} +(defun |pfLiteralClass| (form) + (|pfAbSynOp| form)) + +\end{chunk} + +\defun{pfLiteralString}{Return the LiteralString} +\calls{pfLiteralString}{tokPart} +\begin{chunk}{defun pfLiteralString} +(defun |pfLiteralString| (form) + (|tokPart| form)) + +\end{chunk} + +\defun{pfParts}{Return the parts of a tree node} +\begin{chunk}{defun pfParts 0} +(defun |pfParts| (form) + (cdr form)) + +\end{chunk} + +\defun{pfPile}{Return the argument unchanged} +\begin{chunk}{defun pfPile 0} +(defun |pfPile| (part) + part) + +\end{chunk} + +\defun{pfPushBody}{pfPushBody} +\calls{pfPushBody}{pfLambda} +\calls{pfPushBody}{pfNothing} +\calls{pfPushBody}{pfPushBody} +\begin{chunk}{defun pfPushBody} +(defun |pfPushBody| (rt args body) + (cond + ((null args) body) + ((null (cdr args)) (|pfLambda| (car args) rt body)) + (t + (|pfLambda| (car args) (|pfNothing|) + (|pfPushBody| rt (cdr args) body))))) + +\end{chunk} + +\defun{pfSexpr}{An S-expression which people can read.} +\calls{pfSexpr}{pfSexpr,strip} +\begin{chunk}{defun pfSexpr} +(defun |pfSexpr| (pform) + (|pfSexpr,strip| pform)) + +\end{chunk} + +\defun{pfSexpr,strip}{Create a human readable S-expression} +\calls{pfSexpr,strip}{pfId?} +\calls{pfSexpr,strip}{pfIdSymbol} +\calls{pfSexpr,strip}{pfLiteral?} +\calls{pfSexpr,strip}{pfLiteralString} +\calls{pfSexpr,strip}{pfLeaf?} +\calls{pfSexpr,strip}{tokPart} +\calls{pfSexpr,strip}{pfApplication?} +\calls{pfSexpr,strip}{pfApplicationArg} +\calls{pfSexpr,strip}{pfTuple?} +\calls{pfSexpr,strip}{pf0TupleParts} +\calls{pfSexpr,strip}{pfApplicationOp} +\calls{pfSexpr,strip}{pfSexpr,strip} +\calls{pfSexpr,strip}{pfAbSynOp} +\calls{pfSexpr,strip}{pfParts} +\begin{chunk}{defun pfSexpr,strip} +(defun |pfSexpr,strip| (pform) + (let (args a result) + (cond + ((|pfId?| pform) (|pfIdSymbol| pform)) + ((|pfLiteral?| pform) (|pfLiteralString| pform)) + ((|pfLeaf?| pform) (|tokPart| pform)) + ((|pfApplication?| pform) + (setq a (|pfApplicationArg| pform)) + (if (|pfTuple?| a) + (setq args (|pf0TupleParts| a)) + (setq args (list a))) + (dolist (p (cons (|pfApplicationOp| pform) args) (nreverse result)) + (push (|pfSexpr,strip| p) result))) + (t + (cons (|pfAbSynOp| pform) + (dolist (p (|pfParts| pform) (nreverse result)) + (push (|pfSexpr,strip| p) result))))))) + +\end{chunk} + +\defun{pfSymb}{Construct a Symbol or Expression node} +\calls{pfSymb}{pfLeaf?} +\calls{pfSymb}{pfSymbol} +\calls{pfSymb}{tokPart} +\calls{pfSymb}{ifcar} +\calls{pfSymb}{pfExpression} +\calls{pfSymb}{pfSexpr} +\begin{chunk}{defun pfSymb} +(defun |pfSymb| (expr &REST optpos) + (if (|pfLeaf?| expr) + (|pfSymbol| (|tokPart| expr) (ifcar optpos)) + (|pfExpression| (|pfSexpr| expr) (ifcar optpos)))) + +\end{chunk} + +\defun{pfSymbol}{Construct a Symbol leaf node} +\calls{pfSymbol}{pfLeaf} +\calls{pfSymbol}{ifcar} +\begin{chunk}{defun pfSymbol} +(defun |pfSymbol| (expr &rest optpos) + (|pfLeaf| '|symbol| expr (ifcar optpos))) + +\end{chunk} + +\defun{pfSymbol?}{Is this a Symbol node?} +\calls{pfSymbol?}{pfAbSynOp?} +\begin{chunk}{defun pfSymbol?} +(defun |pfSymbol?| (form) + (|pfAbSynOp?| form '|symbol|)) + +\end{chunk} + +\defun{pfSymbolSymbol}{Return the Symbol part} +\calls{pfSymbolSymbol}{tokPart} +\begin{chunk}{defun pfSymbolSymbol} +(defun |pfSymbolSymbol| (form) + (|tokPart| form)) + +\end{chunk} + +\section{Trees} + +\defun{pfTree}{Construct a tree node} +\begin{chunk}{defun pfTree 0} +(defun |pfTree| (x y) + (cons x y)) + +\end{chunk} + +\defun{pfAdd}{Construct an Add node} +\calls{pfAdd}{pfNothing} +\calls{pfAdd}{pfTree} +\begin{chunk}{defun pfAdd} +(defun |pfAdd| (pfbase pfaddin &rest addon) + (let (lhs) + (if addon + (setq lhs addon) + (setq lhs (|pfNothing|))) + (|pfTree| '|Add| (list pfbase pfaddin lhs)))) + +\end{chunk} + +\defun{pfAnd}{Construct an And node} +\calls{pfAnd}{pfTree} +\begin{chunk}{defun pfAnd} +(defun |pfAnd| (pfleft pfright) + (|pfTree| '|And| (list pfleft pfright))) + +\end{chunk} + +\defun{pfAttribute}{pfAttribute} +\calls{pfAttribute}{pfTree} +\begin{chunk}{defun pfAttribute} +(defun |pfAttribute| (pfexpr) + (|pfTree| '|Attribute| (list pfexpr))) + +\end{chunk} + +\defun{pfApplication}{Return an Application node} +\calls{pfApplication}{pfTree} +\begin{chunk}{defun pfApplication} +(defun |pfApplication| (pfop pfarg) + (|pfTree| '|Application| (list pfop pfarg))) + +\end{chunk} + +\defun{pfApplicationArg}{Return the Arg part of an Application node} +\begin{chunk}{defun pfApplicationArg 0} +(defun |pfApplicationArg| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfApplicationOp}{Return the Op part of an Application node} +\begin{chunk}{defun pfApplicationOp 0} +(defun |pfApplicationOp| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfAnd?}{Is this an And node?} +\calls{pfAnd?}{pfAbSynOp?} +\begin{chunk}{defun pfAnd?} +(defun |pfAnd?| (pf) + (|pfAbSynOp?| pf '|And|)) + +\end{chunk} + +\defun{pfAndLeft}{Return the Left part of an And node} +\begin{chunk}{defun pfAndLeft 0} +(defun |pfAndLeft| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfAndRight}{Return the Right part of an And node} +\begin{chunk}{defun pfAndRight 0} +(defun |pfAndRight| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfAppend}{Flatten a list of lists} +\begin{chunk}{defun pfAppend 0} +(defun |pfAppend| (list) + (apply #'append list)) + +\end{chunk} + +\defun{pfApplication?}{Is this an Application node?} +\calls{pfApplication?}{pfAbSynOp?} +\begin{chunk}{defun pfApplication?} +(defun |pfApplication?| (pf) + (|pfAbSynOp?| pf '|Application|)) + +\end{chunk} + +\defun{pfAssign}{Create an Assign node} +\calls{pfAssign}{pfTree} +\begin{chunk}{defun pfAssign} +(defun |pfAssign| (pflhsitems pfrhs) + (|pfTree| '|Assign| (list pflhsitems pfrhs))) + +\end{chunk} + +\defun{pfAssign?}{Is this an Assign node?} +\calls{pfAssign?}{pfAbSynOp?} +\begin{chunk}{defun pfAssign?} +(defun |pfAssign?| (pf) + (|pfAbSynOp?| pf '|Assign|)) + +\end{chunk} + +\defun{pf0AssignLhsItems}{Return the parts of an LhsItem of an Assign node} +\calls{pf0AssignLhsItems}{pfParts} +\calls{pf0AssignLhsItems}{pfAssignLhsItems} +\begin{chunk}{defun pf0AssignLhsItems 0} +(defun |pf0AssignLhsItems| (pf) + (|pfParts| (|pfAssignLhsItems| pf))) + +\end{chunk} + +\defun{pfAssignLhsItems}{Return the LhsItem of an Assign node} +\begin{chunk}{defun pfAssignLhsItems 0} +(defun |pfAssignLhsItems| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfAssignRhs}{Return the RHS of an Assign node} +\begin{chunk}{defun pfAssignRhs 0} +(defun |pfAssignRhs| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfBrace}{Construct an application node for a brace} +\calls{pfBrace}{pfApplication} +\calls{pfBrace}{pfIdPos} +\calls{pfBrace}{tokPosn} +\begin{chunk}{defun pfBrace} +(defun |pfBrace| (a part) + (|pfApplication| (|pfIdPos| '{} (|tokPosn| a)) part)) + +\end{chunk} + +\defun{pfBraceBar}{Construct an Application node for brace-bars} +\calls{pfBraceBar}{pfApplication} +\calls{pfBraceBar}{pfIdPos} +\calls{pfBraceBar}{tokPosn} +\begin{chunk}{defun pfBraceBar} +(defun |pfBraceBar| (a part) + (|pfApplication| (|pfIdPos| '|{\|\|}| (|tokPosn| a)) part)) + +\end{chunk} + +\defun{pfBracket}{Construct an Application node for a bracket} +\calls{pfBracket}{pfApplication} +\calls{pfBracket}{pfIdPos} +\calls{pfBracket}{tokPosn} +\begin{chunk}{defun pfBracket} +(defun |pfBracket| (a part) + (|pfApplication| (|pfIdPos| '[] (|tokPosn| a)) part)) + +\end{chunk} + +\defun{pfBracketBar}{Construct an Application node for bracket-bars} +\calls{pfBracketBar}{pfApplication} +\calls{pfBracketBar}{pfIdPos} +\calls{pfBracketBar}{tokPosn} +\begin{chunk}{defun pfBracketBar} +(defun |pfBracketBar| (a part) + (|pfApplication| (|pfIdPos| '|[\|\|]| (|tokPosn| a)) part)) + +\end{chunk} + +\defun{pfBreak}{Create a Break node} +\calls{pfBreak}{pfTree} +\begin{chunk}{defun pfBreak} +(defun |pfBreak| (pffrom) + (|pfTree| '|Break| (list pffrom))) + +\end{chunk} + +\defun{pfBreak?}{Is this a Break node?} +\calls{pfBreak?}{pfAbSynOp?} +\begin{chunk}{defun pfBreak?} +(defun |pfBreak?| (pf) + (|pfAbSynOp?| pf '|Break|)) + +\end{chunk} + +\defun{pfBreakFrom}{Return the From part of a Break node} +\begin{chunk}{defun pfBreakFrom 0} +(defun |pfBreakFrom| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfCoerceto}{Construct a Coerceto node} +\calls{pfCoerceto}{pfTree} +\begin{chunk}{defun pfCoerceto} +(defun |pfCoerceto| (pfexpr pftype) + (|pfTree| '|Coerceto| (list pfexpr pftype))) + +\end{chunk} + +\defun{pfCoerceto?}{Is this a CoerceTo node?} +\calls{pfCoerceto?}{pfAbSynOp?} +\begin{chunk}{defun pfCoerceto?} +(defun |pfCoerceto?| (pf) + (|pfAbSynOp?| pf '|Coerceto|)) + +\end{chunk} + +\defun{pfCoercetoExpr}{Return the Expression part of a CoerceTo node} +\begin{chunk}{defun pfCoercetoExpr 0} +(defun |pfCoercetoExpr| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfCoercetoType}{Return the Type part of a CoerceTo node} +\begin{chunk}{defun pfCoercetoType 0} +(defun |pfCoercetoType| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfCollectBody}{Return the Body of a Collect node} +\begin{chunk}{defun pfCollectBody 0} +(defun |pfCollectBody| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfCollectIterators}{Return the Iterators of a Collect node} +\begin{chunk}{defun pfCollectIterators 0} +(defun |pfCollectIterators| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfCollect}{Create a Collect node} +\calls{pfCollect}{pfTree} +\begin{chunk}{defun pfCollect} +(defun |pfCollect| (pfbody pfiterators) + (|pfTree| '|Collect| (list pfbody pfiterators))) + +\end{chunk} + +\defun{pfCollect?}{Is this a Collect node?} +\calls{pfCollect?}{pfAbSynOp?} +\begin{chunk}{defun pfCollect?} +(defun |pfCollect?| (pf) + (|pfAbSynOp?| pf '|Collect|)) + +\end{chunk} + +\defun{pfDefinition}{pfDefinition} +\calls{pfDefinition}{pfTree} +\begin{chunk}{defun pfDefinition} +(defun |pfDefinition| (pflhsitems pfrhs) + (|pfTree| '|Definition| (list pflhsitems pfrhs))) + +\end{chunk} + +\defun{pfDefinitionLhsItems}{Return the Lhs of a Definition node} +\begin{chunk}{defun pfDefinitionLhsItems 0} +(defun |pfDefinitionLhsItems| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfDefinitionRhs}{Return the Rhs of a Definition node} +\begin{chunk}{defun pfDefinitionRhs 0} +(defun |pfDefinitionRhs| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfDefinition?}{Is this a Definition node?} +\calls{pfDefinition?}{pfAbSynOp?} +\begin{chunk}{defun pfDefinition?} +(defun |pfDefinition?| (pf) + (|pfAbSynOp?| pf '|Definition|)) + +\end{chunk} + +\defun{pf0DefinitionLhsItems}{Return the parts of a Definition node} +\calls{pf0DefinitionLhsItems}{pfParts} +\calls{pf0DefinitionLhsItems}{pfDefinitionLhsItems} +\begin{chunk}{defun pf0DefinitionLhsItems} +(defun |pf0DefinitionLhsItems| (pf) + (|pfParts| (|pfDefinitionLhsItems| pf))) + +\end{chunk} + +\defun{pfDo}{Create a Do node} +\calls{pfDo}{pfTree} +\begin{chunk}{defun pfDo} +(defun |pfDo| (pfbody) + (|pfTree| '|Do| (list pfbody))) + +\end{chunk} + +\defun{pfDo?}{Is this a Do node?} +\calls{pfDo?}{pfAbSynOp?} +\begin{chunk}{defun pfDo?} +(defun |pfDo?| (pf) + (|pfAbSynOp?| pf '|Do|)) + +\end{chunk} + +\defun{pfDoBody}{Return the Body of a Do node} +\begin{chunk}{defun pfDoBody 0} +(defun |pfDoBody| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfEnSequence}{Construct a Sequence node} +\calls{pfEnSequence}{pfTuple} +\calls{pfEnSequence}{pfListOf} +\calls{pfEnSequence}{pfSequence} +\begin{chunk}{defun pfEnSequence} +(defun |pfEnSequence| (a) + (cond + ((null a) (|pfTuple| (|pfListOf| a))) + ((null (cdr a)) (car a)) + (t (|pfSequence| (|pfListOf| a))))) + +\end{chunk} + +\defun{pfExit}{Construct an Exit node} +\calls{pfExit}{pfTree} +\begin{chunk}{defun pfExit} +(defun |pfExit| (pfcond pfexpr) + (|pfTree| '|Exit| (list pfcond pfexpr))) + +\end{chunk} + +\defun{pfExit?}{Is this an Exit node?} +\calls{pfExit?}{pfAbSynOp?} +\begin{chunk}{defun pfExit?} +(defun |pfExit?| (pf) + (|pfAbSynOp?| pf '|Exit|)) + +\end{chunk} + +\defun{pfExitCond}{Return the Cond part of an Exit} +\begin{chunk}{defun pfExitCond 0} +(defun |pfExitCond| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfExitExpr}{Return the Expression part of an Exit} +\begin{chunk}{defun pfExitExpr 0} +(defun |pfExitExpr| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfExport}{Create an Export node} +\calls{pfExport}{pfTree} +\begin{chunk}{defun pfExport} +(defun |pfExport| (pfitems) + (|pfTree| '|Export| (list pfitems))) + +\end{chunk} + +\defun{pfExpression}{Construct an Expression leaf node} +\calls{pfExpression}{pfLeaf} +\calls{pfExpression}{ifcar} +\begin{chunk}{defun pfExpression} +(defun |pfExpression| (expr &rest optpos) + (|pfLeaf| '|expression| expr (ifcar optpos))) + +\end{chunk} + +\defun{pfFirst}{pfFirst} +\begin{chunk}{defun pfFirst 0} +(defun |pfFirst| (form) + (cadr form)) + +\end{chunk} + +\defun{pfFix}{Create an Application Fix node} +\calls{pfFix}{pfApplication} +\calls{pfFix}{pfId} +\begin{chunk}{defun pfFix} +(defun |pfFix| (pf) + (|pfApplication| (|pfId| 'Y) pf)) + +\end{chunk} + +\defun{pfFree}{Create a Free node} +\calls{pfFree}{pfTree} +\begin{chunk}{defun pfFree} +(defun |pfFree| (pfitems) + (|pfTree| '|Free| (list pfitems))) + +\end{chunk} + +\defun{pfFree?}{Is this a Free node?} +\calls{pfFree?}{pfAbSynOp?} +\begin{chunk}{defun pfFree?} +(defun |pfFree?| (pf) + (|pfAbSynOp?| pf '|Free|)) + +\end{chunk} + +\defun{pf0FreeItems}{Return the parts of the Items of a Free node} +\calls{pf0FreeItems}{pfParts} +\calls{pf0FreeItems}{pfFreeItems} +\begin{chunk}{defun pf0FreeItems} +(defun |pf0FreeItems| (pf) + (|pfParts| (|pfFreeItems| pf))) + +\end{chunk} + +\defun{pfFreeItems}{Return the Items of a Free node} +\begin{chunk}{defun pfFreeItems 0} +(defun |pfFreeItems| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfForin}{Construct a Forin node} +\calls{pfForin}{pfTree} +\begin{chunk}{defun pfForin} +(defun |pfForin| (pflhs pfwhole) + (|pfTree| '|Forin| (list pflhs pfwhole))) + +\end{chunk} + +\defun{pfForin?}{Is this a ForIn node?} +\calls{pfForin?}{pfAbSynOp?} +\begin{chunk}{defun pfForin?} +(defun |pfForin?| (pf) + (|pfAbSynOp?| pf '|Forin|)) + +\end{chunk} + +\defun{pf0ForinLhs}{Return all the parts of the LHS of a ForIn node} +\calls{pf0ForinLhs}{pfParts} +\calls{pf0ForinLhs}{pfForinLhs} +\begin{chunk}{defun pf0ForinLhs} +(defun |pf0ForinLhs| (pf) + (|pfParts| (|pfForinLhs| pf))) + +\end{chunk} + +\defun{pfForinLhs}{Return the LHS part of a ForIn node} +\begin{chunk}{defun pfForinLhs 0} +(defun |pfForinLhs| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfForinWhole}{Return the Whole part of a ForIn node} +\begin{chunk}{defun pfForinWhole 0} +(defun |pfForinWhole| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfFromDom}{pfFromDom} +\calls{pfFromDom}{pfApplication?} +\calls{pfFromDom}{pfApplication} +\calls{pfFromDom}{pfApplicationOp} +\calls{pfFromDom}{pfApplicationArg} +\calls{pfFromDom}{pfFromdom} +\begin{chunk}{defun pfFromDom} +(defun |pfFromDom| (dom expr) + (cond + ((|pfApplication?| expr) + (|pfApplication| + (|pfFromdom| (|pfApplicationOp| expr) dom) + (|pfApplicationArg| expr))) + (t (|pfFromdom| expr dom)))) + +\end{chunk} + +\defun{pfFromdom}{Construct a Fromdom node} +\calls{pfFromdom}{pfTree} +\begin{chunk}{defun pfFromdom} +(defun |pfFromdom| (pfwhat pfdomain) + (|pfTree| '|Fromdom| (list pfwhat pfdomain))) + +\end{chunk} + +\defun{pfFromdom?}{Is this a Fromdom mode?} +\calls{pfFromdom?}{pfAbSynOp?} +\begin{chunk}{defun pfFromdom?} +(defun |pfFromdom?| (pf) + (|pfAbSynOp?| pf '|Fromdom|)) + +\end{chunk} + +\defun{pfFromdomWhat}{Return the What part of a Fromdom node} +\begin{chunk}{defun pfFromdomWhat 0} +(defun |pfFromdomWhat| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfFromdomDomain}{Return the Domain part of a Fromdom node} +\begin{chunk}{defun pfFromdomDomain 0} +(defun |pfFromdomDomain| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfHide}{Construct a Hide node} +\calls{pfHide}{pfTree} +\begin{chunk}{defun pfHide} +(defun |pfHide| (a part) + (declare (ignore a)) + (|pfTree| '|Hide| (list part))) + +\end{chunk} + +\defun{pfIf}{pfIf} +\calls{pfIf}{pfTree} +\begin{chunk}{defun pfIf} +(defun |pfIf| (pfcond pfthen pfelse) + (|pfTree| '|If| (list pfcond pfthen pfelse))) + +\end{chunk} + +\defun{pfIf?}{Is this an If node?} +\calls{pfIf?}{pfAbSynOp?} +\begin{chunk}{defun pfIf?} +(defun |pfIf?| (pf) + (|pfAbSynOp?| pf '|If|)) + +\end{chunk} + +\defun{pfIfCond}{Return the Cond part of an If} +\begin{chunk}{defun pfIfCond 0} +(defun |pfIfCond| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfIfThen}{Return the Then part of an If} +\begin{chunk}{defun pfIfThen 0} +(defun |pfIfThen| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfIfThenOnly}{pfIfThenOnly} +\calls{pfIfThenOnly}{pfIf} +\calls{pfIfThenOnly}{pfNothing} +\begin{chunk}{defun pfIfThenOnly} +(defun |pfIfThenOnly| (pred cararg) + (|pfIf| pred cararg (|pfNothing|))) + +\end{chunk} + +\defun{pfIfElse}{Return the Else part of an If} +\begin{chunk}{defun pfIfElse 0} +(defun |pfIfElse| (pf) + (cadddr pf)) + +\end{chunk} + +\defun{pfImport}{Construct an Import node} +\calls{pfImport}{pfTree} +\begin{chunk}{defun pfImport} +(defun |pfImport| (pfitems) + (|pfTree| '|Import| (list pfitems))) + +\end{chunk} + +\defun{pfIterate}{Construct an Iterate node} +\calls{pfIterate}{pfTree} +\begin{chunk}{defun pfIterate} +(defun |pfIterate| (pffrom) + (|pfTree| '|Iterate| (list pffrom))) + +\end{chunk} + +\defun{pfIterate?}{Is this an Iterate node?} +\calls{pfIterate?}{pfAbSynOp?} +\begin{chunk}{defun pfIterate?} +(defun |pfIterate?| (pf) + (|pfAbSynOp?| pf '|Iterate|)) + +\end{chunk} + +\defun{pfInfApplication}{Handle an infix application} +\calls{pfInfApplication}{pfListOf} +\calls{pfInfApplication}{pfIdSymbol} +\calls{pfInfApplication}{pfAnd} +\calls{pfInfApplication}{pfOr} +\calls{pfInfApplication}{pfApplication} +\calls{pfInfApplication}{pfTuple} +\begin{chunk}{defun pfInfApplication} +(defun |pfInfApplication| (op left right) + (cond + ((eq (|pfIdSymbol| op) '|and|) (|pfAnd| left right)) + ((eq (|pfIdSymbol| op) '|or|) (|pfOr| left right)) + (t (|pfApplication| op (|pfTuple| (|pfListOf| (list left right))))))) + +\end{chunk} + +\defun{pfInline}{Create an Inline node} +\calls{pfInline}{pfTree} +\begin{chunk}{defun pfInline} +(defun |pfInline| (pfitems) + (|pfTree| '|Inline| (list pfitems))) + +\end{chunk} + +\defun{pfLam}{pfLam} +\calls{pfLam}{pfAbSynOp?} +\calls{pfLam}{pfFirst} +\calls{pfLam}{pfNothing} +\calls{pfLam}{pfSecond} +\calls{pfLam}{pfLambda} +\begin{chunk}{defun pfLam} +(defun |pfLam| (variable body) + (let (bdy rets) + (if (|pfAbSynOp?| body '|returntyped|) + (setq rets (|pfFirst| body)) + (setq rets (|pfNothing|))) + (if (|pfAbSynOp?| body '|returntyped|) + (setq bdy (|pfSecond| body)) + (setq bdy body)) + (|pfLambda| variable rets bdy))) + +\end{chunk} + +\defun{pfLambda}{pfLambda} +\calls{pfLambda}{pfTree} +\begin{chunk}{defun pfLambda} +(defun |pfLambda| (pfargs pfrets pfbody) + (|pfTree| '|Lambda| (list pfargs pfrets pfbody))) + +\end{chunk} + +\defun{pfLambdaBody}{Return the Body part of a Lambda node} +\begin{chunk}{defun pfLambdaBody 0} +(defun |pfLambdaBody| (pf) + (cadddr pf)) + +\end{chunk} + +\defun{pfLambdaRets}{Return the Rets part of a Lambda node} +\begin{chunk}{defun pfLambdaRets 0} +(defun |pfLambdaRets| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfLambda?}{Is this a Lambda node?} +\calls{pfLambda?}{pfAbSynOp?} +\begin{chunk}{defun pfLambda?} +(defun |pfLambda?| (pf) + (|pfAbSynOp?| pf '|Lambda|)) + +\end{chunk} + +\defun{pfLambdaArgs}{Return the Args part of a Lambda node} +\begin{chunk}{defun pfLambdaArgs 0} +(defun |pfLambdaArgs| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pf0LambdaArgs}{Return the Args of a Lambda Node} +\calls{pf0LambdaArgs}{pfParts} +\calls{pf0LambdaArgs}{pfLambdaArgs} +\begin{chunk}{defun pf0LambdaArgs} +(defun |pf0LambdaArgs| (pf) + (|pfParts| (|pfLambdaArgs| pf))) + +\end{chunk} + +\defun{pfLocal}{Construct a Local node} +\calls{pfLocal}{pfTree} +\begin{chunk}{defun pfLocal} +(defun |pfLocal| (pfitems) + (|pfTree| '|Local| (list pfitems))) + +\end{chunk} + +\defun{pfLocal?}{Is this a Local node?} +\calls{pfLocal?}{pfAbSynOp?} +\begin{chunk}{defun pfLocal?} +(defun |pfLocal?| (pf) + (|pfAbSynOp?| pf '|Local|)) + +\end{chunk} + +\defun{pf0LocalItems}{Return the parts of Items of a Local node} +\calls{pf0LocalItems}{pfParts} +\calls{pf0LocalItems}{pfLocalItems} +\begin{chunk}{defun pf0LocalItems} +(defun |pf0LocalItems| (pf) + (|pfParts| (|pfLocalItems| pf))) + +\end{chunk} + +\defun{pfLocalItems}{Return the Items of a Local node} +\begin{chunk}{defun pfLocalItems 0} +(defun |pfLocalItems| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfLoop}{Construct a Loop node} +\calls{pfLoop}{pfTree} +\begin{chunk}{defun pfLoop} +(defun |pfLoop| (pfiterators) + (|pfTree| '|Loop| (list pfiterators))) + +\end{chunk} + +\defun{pfLoop1}{pfLoop1} +\calls{pfLoop1}{pfLoop} +\calls{pfLoop1}{pfListOf} +\calls{pfLoop1}{pfDo} +\begin{chunk}{defun pfLoop1} +(defun |pfLoop1| (body) + (|pfLoop| (|pfListOf| (list (|pfDo| body))))) + +\end{chunk} + +\defun{pfLoop?}{Is this a Loop node?} +\calls{pfLoop?}{pfAbSynOp?} +\begin{chunk}{defun pfLoop?} +(defun |pfLoop?| (pf) + (|pfAbSynOp?| pf '|Loop|)) + +\end{chunk} + +\defun{pfLoopIterators}{Return the Iterators of a Loop node} +\begin{chunk}{defun pfLoopIterators 0} +(defun |pfLoopIterators| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pf0LoopIterators}{pf0LoopIterators} +\calls{pf0LoopIterators}{pfParts} +\calls{pf0LoopIterators}{pf0LoopIterators} +\begin{chunk}{defun pf0LoopIterators} +(defun |pf0LoopIterators| (pf) + (|pfParts| (|pfLoopIterators| pf))) + +\end{chunk} + +\defun{pfLp}{pfLp} +\calls{pfLp}{pfLoop} +\calls{pfLp}{pfListOf} +\calls{pfLp}{pfDo} +\begin{chunk}{defun pfLp} +(defun |pfLp| (iterators body) + (|pfLoop| (|pfListOf| (append iterators (list (|pfDo| body)))))) + +\end{chunk} + +\defun{pfMacro}{Create a Macro node} +\calls{pfMacro}{pfTree} +\begin{chunk}{defun pfMacro} +(defun |pfMacro| (pflhs pfrhs) + (|pfTree| '|Macro| (list pflhs pfrhs))) + +\end{chunk} + +\defun{pfMacro?}{Is this a Macro node?} +\calls{pfMacro?}{pfAbSynOp?} +\begin{chunk}{defun pfMacro?} +(defun |pfMacro?| (pf) + (|pfAbSynOp?| pf '|Macro|)) + +\end{chunk} + +\defun{pfMacroLhs}{Return the Lhs of a Macro node} +\begin{chunk}{defun pfMacroLhs 0} +(defun |pfMacroLhs| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfMacroRhs}{Return the Rhs of a Macro node} +\begin{chunk}{defun pfMacroRhs 0} +(defun |pfMacroRhs| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfMLambda}{Construct an MLambda node} +\calls{pfMLambda}{pfTree} +\begin{chunk}{defun pfMLambda} +(defun |pfMLambda| (pfargs pfbody) + (|pfTree| '|MLambda| (list pfargs pfbody))) + +\end{chunk} + +\defun{pfMLambda?}{Is this an MLambda node?} +\calls{pfMLambda?}{pfAbSynOp?} +\begin{chunk}{defun pfMLambda?} +(defun |pfMLambda?| (pf) + (|pfAbSynOp?| pf '|MLambda|)) + +\end{chunk} + +\defun{pfMLambdaArgs}{Return the Args of an MLambda} +\begin{chunk}{defun pfMLambdaArgs 0} +(defun |pfMLambdaArgs| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pf0MLambdaArgs}{Return the parts of an MLambda argument} +\calls{pf0MLambdaArgs}{pfParts} +\begin{chunk}{defun pf0MLambdaArgs} +(defun |pf0MLambdaArgs| (pf) + (|pfParts| (|pfMLambdaArgs| pf))) + +\end{chunk} + +\defun{pfMLambdaBody}{pfMLambdaBody} +\begin{chunk}{defun pfMLambdaBody 0} +(defun |pfMLambdaBody| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfNot?}{Is this a Not node?} +\calls{pfNot?}{pfAbSynOp?} +\begin{chunk}{defun pfNot?} +(defun |pfNot?| (pf) + (|pfAbSynOp?| pf '|Not|)) + +\end{chunk} + +\defun{pfNotArg}{Return the Arg part of a Not node} +\begin{chunk}{defun pfNotArg 0} +(defun |pfNotArg| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfNovalue}{Construct a NoValue node} +\calls{pfNovalue}{pfTree} +\begin{chunk}{defun pfNovalue} +(defun |pfNovalue| (pfexpr) + (|pfTree| '|Novalue| (list pfexpr))) + +\end{chunk} + +\defun{pfNovalue?}{Is this a Novalue node?} +\calls{pfNovalue?}{pfAbSynOp?} +\begin{chunk}{defun pfNovalue?} +(defun |pfNovalue?| (pf) + (|pfAbSynOp?| pf '|Novalue|)) + +\end{chunk} + +\defun{pfNovalueExpr}{Return the Expr part of a Novalue node} +\begin{chunk}{defun pfNovalueExpr 0} +(defun |pfNovalueExpr| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfOr}{Construct an Or node} +\calls{pfOr}{pfTree} +\begin{chunk}{defun pfOr} +(defun |pfOr| (pfleft pfright) + (|pfTree| '|Or| (list pfleft pfright))) + +\end{chunk} + +\defun{pfOr?}{Is this an Or node?} +\calls{pfOr?}{pfAbSynOp?} +\begin{chunk}{defun pfOr?} +(defun |pfOr?| (pf) + (|pfAbSynOp?| pf '|Or|)) + +\end{chunk} + +\defun{pfOrLeft}{Return the Left part of an Or node} +\begin{chunk}{defun pfOrLeft 0} +(defun |pfOrLeft| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfOrRight}{Return the Right part of an Or node} +\begin{chunk}{defun pfOrRight 0} +(defun |pfOrRight| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfParen}{Return the part of a parenthesised expression} +\begin{chunk}{defun pfParen} +(defun |pfParen| (a part) + (declare (ignore a)) + part) + +\end{chunk} + +\defun{pfPretend}{pfPretend} +\calls{pfPretend}{pfTree} +\begin{chunk}{defun pfPretend} +(defun |pfPretend| (pfexpr pftype) + (|pfTree| '|Pretend| (list pfexpr pftype))) + +\end{chunk} + +\defun{pfPretend?}{Is this a Pretend node?} +\calls{pfPretend?}{pfAbSynOp?} +\begin{chunk}{defun pfPretend?} +(defun |pfPretend?| (pf) + (|pfAbSynOp?| pf '|Pretend|)) + +\end{chunk} + +\defun{pfPretendExpr}{Return the Expression part of a Pretend node} +\begin{chunk}{defun pfPretendExpr 0} +(defun |pfPretendExpr| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfPretendType}{Return the Type part of a Pretend node} +\begin{chunk}{defun pfPretendType 0} +(defun |pfPretendType| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfQualType}{Construct a QualType node} +\calls{pfQualType}{pfTree} +\begin{chunk}{defun pfQualType} +(defun |pfQualType| (pftype pfqual) + (|pfTree| '|QualType| (list pftype pfqual))) + +\end{chunk} + +\defun{pfRestrict}{Construct a Restrict node} +\calls{pfRestrict}{pfTree} +\begin{chunk}{defun pfRestrict} +(defun |pfRestrict| (pfexpr pftype) + (|pfTree| '|Restrict| (list pfexpr pftype))) + +\end{chunk} + +\defun{pfRestrict?}{Is this a Restrict node?} +\calls{pfRestrict?}{pfAbSynOp?} +\begin{chunk}{defun pfRestrict?} +(defun |pfRestrict?| (pf) + (|pfAbSynOp?| pf '|Restrict|)) + +\end{chunk} + +\defun{pfRestrictExpr}{Return the Expr part of a Restrict node} +\begin{chunk}{defun pfRestrictExpr 0} +(defun |pfRestrictExpr| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfRestrictType}{Return the Type part of a Restrict node} +\begin{chunk}{defun pfRestrictType 0} +(defun |pfRestrictType| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfRetractTo}{Construct a RetractTo node} +\calls{pfRetractTo}{pfTree} +\begin{chunk}{defun pfRetractTo} +(defun |pfRetractTo| (pfexpr pftype) + (|pfTree| '|RetractTo| (list pfexpr pftype))) + +\end{chunk} + +\defun{pfReturn}{Construct a Return node} +\calls{pfReturn}{pfTree} +\begin{chunk}{defun pfReturn} +(defun |pfReturn| (pfexpr pffrom) + (|pfTree| '|Return| (list pfexpr pffrom))) + +\end{chunk} + +\defun{pfReturn?}{Is this a Return node?} +\calls{pfReturn?}{pfAbSynOp?} +\begin{chunk}{defun pfReturn?} +(defun |pfReturn?| (pf) + (|pfAbSynOp?| pf '|Return|)) + +\end{chunk} + +\defun{pfReturnExpr}{Return the Expr part of a Return node} +\begin{chunk}{defun pfReturnExpr 0} +(defun |pfReturnExpr| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfReturnNoName}{pfReturnNoName} +\calls{pfReturnNoName}{pfReturn} +\calls{pfReturnNoName}{pfNothing} +\begin{chunk}{defun pfReturnNoName} +(defun |pfReturnNoName| (|value|) + (|pfReturn| |value| (|pfNothing|))) + +\end{chunk} + +\defun{pfReturnTyped}{Construct a ReturnTyped node} +\calls{pfReturnTyped}{pfTree} +\begin{chunk}{defun pfReturnTyped} +(defun |pfReturnTyped| (type body) + (|pfTree| '|returntyped| (list type body))) + +\end{chunk} + +\defun{pfRule}{Construct a Rule node} +\calls{pfRule}{pfTree} +\begin{chunk}{defun pfRule} +(defun |pfRule| (pflhsitems pfrhs) + (|pfTree| '|Rule| (list pflhsitems pfrhs))) + +\end{chunk} + +\defun{pfRuleLhsItems}{Return the Lhs of a Rule node} +\begin{chunk}{defun pfRuleLhsItems 0} +(defun |pfRuleLhsItems| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfRuleRhs}{Return the Rhs of a Rule node} +\begin{chunk}{defun pfRuleRhs 0} +(defun |pfRuleRhs| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfRule?}{Is this a Rule node?} +\calls{pfRule?}{pfAbSynOp?} +\begin{chunk}{defun pfRule?} +(defun |pfRule?| (pf) + (|pfAbSynOp?| pf '|Rule|)) + +\end{chunk} + +\defun{pfSecond}{pfSecond} +\begin{chunk}{defun pfSecond 0} +(defun |pfSecond| (form) + (caddr form)) + +\end{chunk} + +\defun{pfSequence}{Construct a Sequence node} +\calls{pfSequence}{pfTree} +\begin{chunk}{defun pfSequence} +(defun |pfSequence| (pfargs) + (|pfTree| '|Sequence| (list pfargs))) + +\end{chunk} + +\defun{pfSequenceArgs}{Return the Args of a Sequence node} +\begin{chunk}{defun pfSequenceArgs 0} +(defun |pfSequenceArgs| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfSequence?}{ Is this a Sequence node?} +\calls{pfSequence?}{pfAbSynOp?} +\begin{chunk}{defun pfSequence?} +(defun |pfSequence?| (pf) + (|pfAbSynOp?| pf '|Sequence|)) + +\end{chunk} + +\defun{pf0SequenceArgs}{Return the parts of the Args of a Sequence node} +\calls{pf0SequenceArgs}{pfParts} +\calls{pf0SequenceArgs}{pfSequenceArgs} +\begin{chunk}{defun pf0SequenceArgs} +(defun |pf0SequenceArgs| (pf) + (|pfParts| (|pfSequenceArgs| pf))) + +\end{chunk} + +\defun{pfSuchthat}{Create a Suchthat node} +\calls{pfSuchthat}{pfTree} +\begin{chunk}{defun pfSuchthat} +(defun |pfSuchthat| (pfcond) + (|pfTree| '|Suchthat| (list pfcond))) + +\end{chunk} + +\defun{pfSuchthat?}{Is this a SuchThat node?} +\calls{pfSuchthat?}{pfAbSynOp?} +\begin{chunk}{defun pfSuchthat?} +(defun |pfSuchthat?| (pf) + (|pfAbSynOp?| pf '|Suchthat|)) + +\end{chunk} + +\defun{pfSuchthatCond}{Return the Cond part of a SuchThat node} +\begin{chunk}{defun pfSuchthatCond 0} +(defun |pfSuchthatCond| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfTagged}{Create a Tagged node} +\calls{pfTagged}{pfTree} +\begin{chunk}{defun pfTagged} +(defun |pfTagged| (pftag pfexpr) + (|pfTree| '|Tagged| (list pftag pfexpr))) + +\end{chunk} + +\defun{pfTagged?}{Is this a Tagged node?} +\calls{pfTagged?}{pfAbSynOp?} +\begin{chunk}{defun pfTagged?} +(defun |pfTagged?| (pf) + (|pfAbSynOp?| pf '|Tagged|)) + +\end{chunk} + +\defun{pfTaggedExpr}{Return the Expression portion of a Tagged node} +\begin{chunk}{defun pfTaggedExpr 0} +(defun |pfTaggedExpr| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfTaggedTag}{Return the Tag of a Tagged node} +\begin{chunk}{defun pfTaggedTag 0} +(defun |pfTaggedTag| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfTaggedToTyped}{pfTaggedToTyped} +\calls{pfTaggedToTyped}{pfTagged?} +\calls{pfTaggedToTyped}{pfTaggedExpr} +\calls{pfTaggedToTyped}{pfNothing} +\calls{pfTaggedToTyped}{pfTaggedTag} +\calls{pfTaggedToTyped}{pfId?} +\calls{pfTaggedToTyped}{pfId} +\calls{pfTaggedToTyped}{pfTyped} +\calls{pfTaggedToTyped}{pfSuch} +\calls{pfTaggedToTyped}{pfInfApplication} +\begin{chunk}{defun pfTaggedToTyped} +(defun |pfTaggedToTyped| (arg) + (let (a form rt) + (if (|pfTagged?| arg) + (setq rt (|pfTaggedExpr| arg)) + (setq rt (|pfNothing|))) + (if (|pfTagged?| arg) + (setq form (|pfTaggedTag| arg)) + (setq form arg)) + (cond + ((null (|pfId?| form)) + (setq a (|pfId| (gensym))) + (|pfTyped| (|pfSuch| a (|pfInfApplication| (|pfId| '=) a form)) rt)) + (t (|pfTyped| form rt))))) + +\end{chunk} + +\defun{pfTweakIf}{pfTweakIf} +\calls{pfTweakIf}{pfIfElse} +\calls{pfTweakIf}{pfNothing?} +\calls{pfTweakIf}{pfListOf} +\calls{pfTweakIf}{pfTree} +\calls{pfTweakIf}{pfIfCond} +\calls{pfTweakIf}{pfIfThen} +\begin{chunk}{defun pfTweakIf} +(defun |pfTweakIf| (form) + (let (b a) + (setq a (|pfIfElse| form)) + (setq b (if (|pfNothing?| a) (|pfListOf| NIL) a)) + (|pfTree| '|WIf| (list (|pfIfCond| form) (|pfIfThen| form) b)))) + +\end{chunk} + +\defun{pfTyped}{Construct a Typed node} +\calls{pfTyped}{pfTree} +\begin{chunk}{defun pfTyped} +(defun |pfTyped| (pfid pftype) + (|pfTree| '|Typed| (list pfid pftype))) + +\end{chunk} + +\defun{pfTyped?}{Is this a Typed node?} +\calls{pfTyped?}{pfAbSynOp?} +\begin{chunk}{defun pfTyped?} +(defun |pfTyped?| (pf) + (|pfAbSynOp?| pf '|Typed|)) + +\end{chunk} + +\defun{pfTypedType}{Return the Type of a Typed node} +\begin{chunk}{defun pfTypedType 0} +(defun |pfTypedType| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfTypedId}{Return the Id of a Typed node} +\begin{chunk}{defun pfTypedId 0} +(defun |pfTypedId| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfTyping}{Construct a Typing node} +\calls{pfTyping}{pfTree} +\begin{chunk}{defun pfTyping} +(defun |pfTyping| (pfitems) + (|pfTree| '|Typing| (list pfitems))) + +\end{chunk} + +\defun{pfTuple}{Return a Tuple node} +\calls{pfTuple}{pfTree} +\begin{chunk}{defun pfTuple} +(defun |pfTuple| (pfparts) + (|pfTree| '|Tuple| (list pfparts))) + +\end{chunk} + +\defun{pfTupleListOf}{Return a Tuple from a List} +\calls{pfTupleListOf}{pfTuple} +\calls{pfTupleListOf}{pfListOf} +\begin{chunk}{defun pfTupleListOf} +(defun |pfTupleListOf| (pfparts) + (|pfTuple| (|pfListOf| pfparts))) + +\end{chunk} + +\defun{pfTuple?}{Is this a Tuple node?} +\calls{pfTuple?}{pfAbSynOp?} +\begin{chunk}{defun pfTuple?} +(defun |pfTuple?| (pf) + (|pfAbSynOp?| pf '|Tuple|)) + +\end{chunk} + +\defun{pfTupleParts}{Return the Parts of a Tuple node} +\begin{chunk}{defun pfTupleParts 0} +(defun |pfTupleParts| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pf0TupleParts}{Return the parts of a Tuple} +\calls{pf0TupleParts}{pfParts} +\calls{pf0TupleParts}{pfTupleParts} +\begin{chunk}{defun pf0TupleParts} +(defun |pf0TupleParts| (pf) + (|pfParts| (|pfTupleParts| pf))) + +\end{chunk} + +\defun{pfUnSequence}{Return a list from a Sequence node} +\calls{pfUnSequence}{pfSequence?} +\calls{pfUnSequence}{pfAppend} +\calls{pfUnSequence}{pf0SequenceArgs} +\calls{pfUnSequence}{pfListOf} +\begin{chunk}{defun pfUnSequence} +(defun |pfUnSequence| (x) + (if (|pfSequence?| x) + (|pfListOf| (|pfAppend| (|pf0SequenceArgs| x))) + (|pfListOf| x))) + +\end{chunk} + +\defun{pfWDec}{The comment is attached to all signatutres} +\calls{pfWDec}{pfWDeclare} +\calls{pfWDec}{pfParts} +\begin{chunk}{defun pfWDec} +(defun |pfWDec| (doc name) + (mapcar #'(lambda (i) (|pfWDeclare| i doc)) (|pfParts| name))) + +\end{chunk} + +\defun{pfWDeclare}{Construct a WDeclare node} +\calls{pfWDeclare}{pfTree} +\begin{chunk}{defun pfWDeclare} +(defun |pfWDeclare| (pfsignature pfdoc) + (|pfTree| '|WDeclare| (list pfsignature pfdoc))) + +\end{chunk} + +\defun{pfWhere}{Construct a Where node} +\calls{pfWhere}{pfTree} +\begin{chunk}{defun pfWhere} +(defun |pfWhere| (pfcontext pfexpr) + (|pfTree| '|Where| (list pfcontext pfexpr))) + +\end{chunk} + +\defun{pfWhere?}{Is this a Where node?} +\calls{pfWhere?}{pfAbSynOp?} +\begin{chunk}{defun pfWhere?} +(defun |pfWhere?| (pf) + (|pfAbSynOp?| pf '|Where|)) + +\end{chunk} + +\defun{pf0WhereContext}{Return the parts of the Context of a Where node} +\calls{pf0WhereContext}{pfParts} +\calls{pf0WhereContext}{pfWhereContext} +\begin{chunk}{defun pf0WhereContext} +(defun |pf0WhereContext| (pf) + (|pfParts| (|pfWhereContext| pf))) + +\end{chunk} + +\defun{pfWhereContext}{Return the Context of a Where node} +\begin{chunk}{defun pfWhereContext 0} +(defun |pfWhereContext| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfWhereExpr}{Return the Expr part of a Where node} +\begin{chunk}{defun pfWhereExpr 0} +(defun |pfWhereExpr| (pf) + (caddr pf)) + +\end{chunk} + +\defun{pfWhile}{Construct a While node} +\calls{pfWhile}{pfTree} +\begin{chunk}{defun pfWhile} +(defun |pfWhile| (pfcond) + (|pfTree| '|While| (list pfcond))) + +\end{chunk} + +\defun{pfWhile?}{Is this a While node?} +\calls{pfWhile?}{pfAbSynOp?} +\begin{chunk}{defun pfWhile?} +(defun |pfWhile?| (pf) + (|pfAbSynOp?| pf '|While|)) + +\end{chunk} + +\defun{pfWhileCond}{Return the Cond part of a While node} +\begin{chunk}{defun pfWhileCond 0} +(defun |pfWhileCond| (pf) + (cadr pf)) + +\end{chunk} + +\defun{pfWith}{Construct a With node} +\calls{pfWith}{pfTree} +\begin{chunk}{defun pfWith} +(defun |pfWith| (pfbase pfwithin pfwithon) + (|pfTree| '|With| (list pfbase pfwithin pfwithon))) + +\end{chunk} + +\defun{pfWrong}{Create a Wrong node} +\calls{pfWrong}{pfTree} +\begin{chunk}{defun pfWrong} +(defun |pfWrong| (pfwhy pfrubble) + (|pfTree| '|Wrong| (list pfwhy pfrubble))) + +\end{chunk} + +\defun{pfWrong?}{Is this a Wrong node?} +\calls{pfWrong?}{pfAbSynOp?} +\begin{chunk}{defun pfWrong?} +(defun |pfWrong?| (pf) + (|pfAbSynOp?| pf '|Wrong|)) + +\end{chunk} + +\chapter{Pftree to s-expression translation} +Pftree to s-expression translation. Used to interface the new parser +technology to the interpreter. The input is a parseTree and the +output is an old-parser-style s-expression. + +\defun{pf2Sex}{Pftree to s-expression translation} +\calls{pf2Sex}{pf2Sex1} +\usesdollar{pf2Sex}{insideSEQ} +\usesdollar{pf2Sex}{insideApplication} +\usesdollar{pf2Sex}{insideRule} +\usesdollar{pf2Sex}{QuietCommand} +\begin{chunk}{defun pf2Sex} +(defun |pf2Sex| (pf) + (let (|$insideSEQ| |$insideApplication| |$insideRule|) + (declare (special |$insideSEQ| |$insideApplication| |$insideRule| + |$QuietCommand|)) + (setq |$QuietCommand| nil) + (setq |$insideRule| nil) + (setq |$insideApplication| nil) + (setq |$insideSEQ| nil) + (|pf2Sex1| pf))) + +\end{chunk} + +\defun{pf2Sex1}{Pftree to s-expression translation inner function} +\calls{pf2Sex1}{pfNothing?} +\calls{pf2Sex1}{pfSymbol?} +\calls{pf2Sex1}{pfSymbolSymbol} +\calls{pf2Sex1}{pfLiteral?} +\calls{pf2Sex1}{pfLiteral2Sex} +\calls{pf2Sex1}{pfIdSymbol} +\calls{pf2Sex1}{pfApplication?} +\calls{pf2Sex1}{pfApplication2Sex} +\calls{pf2Sex1}{pfTuple?} +\calls{pf2Sex1}{pf2Sex1} +\calls{pf2Sex1}{pf0TupleParts} +\calls{pf2Sex1}{pfIf?} +\calls{pf2Sex1}{pfIfCond} +\calls{pf2Sex1}{pfIfThen} +\calls{pf2Sex1}{pfIfElse} +\calls{pf2Sex1}{pfTagged?} +\calls{pf2Sex1}{pfTaggedTag} +\calls{pf2Sex1}{pfTaggedExpr} +\calls{pf2Sex1}{pfCoerceto?} +\calls{pf2Sex1}{pfCoercetoExpr} +\calls{pf2Sex1}{pfCoercetoType} +\calls{pf2Sex1}{pfPretend?} +\calls{pf2Sex1}{pfPretendExpr} +\calls{pf2Sex1}{pfPretendType} +\calls{pf2Sex1}{pfFromdom?} +\calls{pf2Sex1}{opTran} +\calls{pf2Sex1}{pfFromdomWhat} +\calls{pf2Sex1}{pfFromdomDomain} +\calls{pf2Sex1}{pfSequence?} +\calls{pf2Sex1}{pfSequence2Sex} +\calls{pf2Sex1}{pfExit?} +\calls{pf2Sex1}{pfExitCond} +\calls{pf2Sex1}{pfExitExpr} +\calls{pf2Sex1}{pfLoop?} +\calls{pf2Sex1}{loopIters2Sex} +\calls{pf2Sex1}{pf0LoopIterators} +\calls{pf2Sex1}{pfCollect?} +\calls{pf2Sex1}{pfCollect2Sex} +\calls{pf2Sex1}{pfForin?} +\calls{pf2Sex1}{pf0ForinLhs} +\calls{pf2Sex1}{pfForinWhole} +\calls{pf2Sex1}{pfWhile?} +\calls{pf2Sex1}{pfWhileCond} +\calls{pf2Sex1}{pfSuchthat?} +\calls{pf2Sex1}{keyedSystemError} +\calls{pf2Sex1}{pfSuchthatCond} +\calls{pf2Sex1}{pfDo?} +\calls{pf2Sex1}{pfDoBody} +\calls{pf2Sex1}{pfTyped?} +\calls{pf2Sex1}{pfTypedType} +\calls{pf2Sex1}{pfTypedId} +\calls{pf2Sex1}{pfAssign?} +\calls{pf2Sex1}{pf0AssignLhsItems} +\calls{pf2Sex1}{pfAssignRhs} +\calls{pf2Sex1}{pfDefinition?} +\calls{pf2Sex1}{pfDefinition2Sex} +\calls{pf2Sex1}{pfLambda?} +\calls{pf2Sex1}{pfLambda2Sex} +\calls{pf2Sex1}{pfMLambda?} +\calls{pf2Sex1}{pfRestrict?} +\calls{pf2Sex1}{pfRestrictExpr} +\calls{pf2Sex1}{pfRestrictType} +\calls{pf2Sex1}{pfFree?} +\calls{pf2Sex1}{pf0FreeItems} +\calls{pf2Sex1}{pfLocal?} +\calls{pf2Sex1}{pf0LocalItems} +\calls{pf2Sex1}{pfWrong?} +\calls{pf2Sex1}{spadThrow} +\calls{pf2Sex1}{pfAnd?} +\calls{pf2Sex1}{pfAndLeft} +\calls{pf2Sex1}{pfAndRight} +\calls{pf2Sex1}{pfOr?} +\calls{pf2Sex1}{pfOrLeft} +\calls{pf2Sex1}{pfOrRight} +\calls{pf2Sex1}{pfNot?} +\calls{pf2Sex1}{pfNotArg} +\calls{pf2Sex1}{pfNovalue?} +\calls{pf2Sex1}{pfNovalueExpr} +\calls{pf2Sex1}{pfRule?} +\calls{pf2Sex1}{pfRule2Sex} +\calls{pf2Sex1}{pfBreak?} +\calls{pf2Sex1}{pfBreakFrom} +\calls{pf2Sex1}{pfMacro?} +\calls{pf2Sex1}{pfReturn?} +\calls{pf2Sex1}{pfReturnExpr} +\calls{pf2Sex1}{pfIterate?} +\calls{pf2Sex1}{pfWhere?} +\calls{pf2Sex1}{pf0WhereContext} +\calls{pf2Sex1}{pfWhereExpr} +\calls{pf2Sex1}{pfAbSynOp} +\calls{pf2Sex1}{tokPart} +\usesdollar{pf2Sex1}{insideSEQ} +\usesdollar{pf2Sex1}{insideRule} +\usesdollar{pf2Sex1}{QuietCommand} +\begin{chunk}{defun pf2Sex1} +(defun |pf2Sex1| (pf) + (let (args idList type op tagPart tag s) + (declare (special |$insideSEQ| |$insideRule| |$QuietCommand|)) + (cond + ((|pfNothing?| pf) '|noBranch|) + ((|pfSymbol?| pf) + (if (eq |$insideRule| '|left|) + (progn + (setq s (|pfSymbolSymbol| pf)) + (list '|constant| (list 'quote s))) + (list 'quote (|pfSymbolSymbol| pf)))) + ((|pfLiteral?| pf) (|pfLiteral2Sex| pf)) + ((|pfId?| pf) + (if |$insideRule| + (progn + (setq s (|pfIdSymbol| pf)) + (if (member s '(|%pi| |%e| |%i|)) + s + (list 'quote s))) + (|pfIdSymbol| pf))) + ((|pfApplication?| pf) (|pfApplication2Sex| pf)) + ((|pfTuple?| pf) (cons '|Tuple| (mapcar #'|pf2Sex1| (|pf0TupleParts| pf)))) + ((|pfIf?| pf) + (list 'if (|pf2Sex1| (|pfIfCond| pf)) + (|pf2Sex1| (|pfIfThen| pf)) + (|pf2Sex1| (|pfIfElse| pf)))) + ((|pfTagged?| pf) + (setq tag (|pfTaggedTag| pf)) + (setq tagPart + (if (|pfTuple?| tag) + (cons '|Tuple| (mapcar #'|pf2Sex1| (|pf0TupleParts| tag))) + (|pf2Sex1| tag))) + (list '|:| tagPart (|pf2Sex1| (|pfTaggedExpr| pf)))) + ((|pfCoerceto?| pf) + (list '|::| (|pf2Sex1| (|pfCoercetoExpr| pf)) + (|pf2Sex1| (|pfCoercetoType| pf)))) + ((|pfPretend?| pf) + (list '|pretend| (|pf2Sex1| (|pfPretendExpr| pf)) + (|pf2Sex1| (|pfPretendType| pf)))) + ((|pfFromdom?| pf) + (setq op (|opTran| (|pf2Sex1| (|pfFromdomWhat| pf)))) + (when (eq op '|braceFromCurly|) (setq op 'seq)) + (list '|$elt| (|pf2Sex1| (|pfFromdomDomain| pf)) op)) + ((|pfSequence?| pf) (|pfSequence2Sex| pf)) + ((|pfExit?| pf) + (if |$insideSEQ| + (list '|exit| (|pf2Sex1| (|pfExitCond| pf)) + (|pf2Sex1| (|pfExitExpr| pf))) + (list 'if (|pf2Sex1| (|pfExitCond| pf)) + (|pf2Sex1| (|pfExitExpr| pf)) '|noBranch|))) + ((|pfLoop?| pf) (cons 'repeat (|loopIters2Sex| (|pf0LoopIterators| pf)))) + ((|pfCollect?| pf) (|pfCollect2Sex| pf)) + ((|pfForin?| pf) + (cons 'in + (append (mapcar #'|pf2Sex1| (|pf0ForinLhs| pf)) + (list (|pf2Sex1| (|pfForinWhole| pf)))))) + ((|pfWhile?| pf) (list 'while (|pf2Sex1| (|pfWhileCond| pf)))) + ((|pfSuchthat?| pf) + (if (eq |$insideRule| '|left|) + (|keyedSystemError| "S2GE0017" (list "pf2Sex1: pfSuchThat")) + (list '|\|| (|pf2Sex1| (|pfSuchthatCond| pf))))) + ((|pfDo?| pf) (|pf2Sex1| (|pfDoBody| pf))) + ((|pfTyped?| pf) + (setq type (|pfTypedType| pf)) + (if (|pfNothing?| type) + (|pf2Sex1| (|pfTypedId| pf)) + (list '|:| (|pf2Sex1| (|pfTypedId| pf)) (|pf2Sex1| (|pfTypedType| pf))))) + ((|pfAssign?| pf) + (setq idList (mapcar #'|pf2Sex1| (|pf0AssignLhsItems| pf))) + (if (not (eql (length idList) 1)) + (setq idList (cons '|Tuple| idList)) + (setq idList (car idList))) + (list 'let idList (|pf2Sex1| (|pfAssignRhs| pf)))) + ((|pfDefinition?| pf) (|pfDefinition2Sex| pf)) + ((|pfLambda?| pf) (|pfLambda2Sex| pf)) + ((|pfMLambda?| pf) '|/throwAway|) + ((|pfRestrict?| pf) + (list '@ (|pf2Sex1| (|pfRestrictExpr| pf)) + (|pf2Sex1| (|pfRestrictType| pf)))) + ((|pfFree?| pf) (cons '|free| (mapcar #'|pf2Sex1| (|pf0FreeItems| pf)))) + ((|pfLocal?| pf) (cons '|local| (mapcar #'|pf2Sex1| (|pf0LocalItems| pf)))) + ((|pfWrong?| pf) (|spadThrow|)) + ((|pfAnd?| pf) + (list '|and| (|pf2Sex1| (|pfAndLeft| pf)) + (|pf2Sex1| (|pfAndRight| pf)))) + ((|pfOr?| pf) + (list '|or| (|pf2Sex1| (|pfOrLeft| pf)) + (|pf2Sex1| (|pfOrRight| pf)))) + ((|pfNot?| pf) (list '|not| (|pf2Sex1| (|pfNotArg| pf)))) + ((|pfNovalue?| pf) + (setq |$QuietCommand| t) + (list 'seq (|pf2Sex1| (|pfNovalueExpr| pf)))) + ((|pfRule?| pf) (|pfRule2Sex| pf)) + ((|pfBreak?| pf) (list '|break| (|pfBreakFrom| pf))) + ((|pfMacro?| pf) '|/throwAway|) + ((|pfReturn?| pf) (list '|return| (|pf2Sex1| (|pfReturnExpr| pf)))) + ((|pfIterate?| pf) (list '|iterate|)) + ((|pfWhere?| pf) + (setq args (mapcar #'|pf2Sex1| (|pf0WhereContext| pf))) + (if (eql (length args) 1) + (cons '|where| (cons (|pf2Sex1| (|pfWhereExpr| pf)) args)) + (list '|where| (|pf2Sex1| (|pfWhereExpr| pf)) (cons 'seq args)))) +; -- under strange circumstances/piling, system commands can wind +; -- up in expressions. This just passes it through as a string for +; -- the user to figure out what happened. + ((eq (|pfAbSynOp| pf) '|command|) (|tokPart| pf)) + (t (|keyedSystemError| "S2GE0017" (list "pf2Sex1")))))) + +\end{chunk} + +\defun{pfLiteral2Sex}{Convert a Literal to an S-expression} +\calls{pfLiteral2Sex}{pfLiteralClass} +\calls{pfLiteral2Sex}{pfLiteralString} +\calls{pfLiteral2Sex}{float2Sex} +\calls{pfLiteral2Sex}{pfSymbolSymbol} +\calls{pfLiteral2Sex}{pfLeafToken} +\calls{pfLiteral2Sex}{keyedSystemError} +\usesdollar{pfLiteral2Sex}{insideRule} +\begin{chunk}{defun pfLiteral2Sex} +(defun |pfLiteral2Sex| (pf) + (let (s type) + (declare (special |$insideRule|)) + (setq type (|pfLiteralClass| pf)) + (cond + ((eq type '|integer|) (read-from-string (|pfLiteralString| pf))) + ((or (eq type '|string|) (eq type '|char|)) + (|pfLiteralString| pf)) + ((eq type '|float|) (|float2Sex| (|pfLiteralString| pf))) + ((eq type '|symbol|) + (if |$insideRule| + (progn + (setq s (|pfSymbolSymbol| pf)) + (list 'quote s)) + (|pfSymbolSymbol| pf))) + ((eq type '|expression|) (list 'quote (|pfLeafToken| pf))) + (t + (|keyedSystemError| 'S2GE0017 (list "pfLiteral2Sex: unexpected form")))))) + +\end{chunk} + +\defun{float2Sex}{Convert a float to an S-expression} +\usesdollar{float2Sex}{useBFasDefault} +\begin{chunk}{defun float2Sex} +(defun |float2Sex| (num) + (let (exp frac bfForm fracPartString intPart dotIndex expPart mantPart eIndex) + (declare (special |$useBFasDefault|)) + (setq eIndex (search "e" num)) + (if eIndex + (setq mantPart (subseq num 0 eIndex)) + (setq mantPart num)) + (if eIndex + (setq expPart (read-from-string (subseq num (+ eIndex 1)))) + (setq expPart 0)) + (setq dotIndex (search "." mantPart)) + (if dotIndex + (setq intPart (read-from-string (subseq mantPart 0 dotIndex))) + (setq intPart (read-from-string mantPart))) + (if dotIndex + (setq fracPartString (subseq mantPart (+ dotIndex 1))) + (setq fracPartString 0)) + (setq bfForm + (make-float intPart (read-from-string fracPartString) + (length fracPartString) expPart)) + (if |$useBFasDefault| + (progn + (setq frac (cadr bfForm)) + (setq exp (cddr bfForm)) + (list (list '|$elt| (list '|Float|) '|float|) frac exp 10)) + bfForm))) + +\end{chunk} + +\defun{pfApplication2Sex}{Change an Application node to an S-expression} +\calls{pfApplication2Sex}{pfOp2Sex} +\calls{pfApplication2Sex}{pfApplicationOp} +\calls{pfApplication2Sex}{opTran} +\calls{pfApplication2Sex}{pf0TupleParts} +\calls{pfApplication2Sex}{pfApplicationArg} +\calls{pfApplication2Sex}{pfTuple?} +\calls{pfApplication2Sex}{pf2Sex1} +\calls{pfApplication2Sex}{pf2Sex} +\calls{pfApplication2Sex}{pfSuchThat2Sex} +\calls{pfApplication2Sex}{hasOptArgs?} +\usesdollar{pfApplication2Sex}{insideApplication} +\usesdollar{pfApplication2Sex}{insideRule} +\begin{chunk}{defun pfApplication2Sex} +(defun |pfApplication2Sex| (pf) + (let (|$insideApplication| x val realOp tmp1 qt argSex typeList args op) + (declare (special |$insideApplication| |$insideRule|)) + (setq |$insideApplication| t) + (setq op (|pfOp2Sex| (|pfApplicationOp| pf))) + (setq op (|opTran| op)) + (cond + ((eq op '->) + (setq args (|pf0TupleParts| (|pfApplicationArg| pf))) + (if (|pfTuple?| (car args)) + (setq typeList (mapcar #'|pf2Sex1| (|pf0TupleParts| (car args)))) + (setq typeList (list (|pf2Sex1| (car args))))) + (setq args (cons (|pf2Sex1| (cadr args)) typeList)) + (cons '|Mapping| args)) + ((and (eq op '|:|) (eq |$insideRule| '|left|)) + (list '|multiple| (|pf2Sex| (|pfApplicationArg| pf)))) + ((and (eq op '?) (eq |$insideRule| '|left|)) + (list '|optional| (|pf2Sex| (|pfApplicationArg| pf)))) + (t + (setq args (|pfApplicationArg| pf)) + (cond + ((|pfTuple?| args) + (if (and (eq op '|\||) (eq |$insideRule| '|left|)) + (|pfSuchThat2Sex| args) + (progn + (setq argSex (cdr (|pf2Sex1| args))) + (cond + ((eq op '>) (list '< (cadr argSex) (car argSex))) + ((eq op '>=) (list '|not| (list '< (car argSex) (cadr argSex)))) + ((eq op '<=) (list '|not| (list '< (cadr argSex) (car argSex)))) + ((eq op 'and) (list '|and| (car argSex) (cadr argSex))) + ((eq op 'or) (list '|or| (car argSex) (cadr argSex))) + ((eq op '|Iterate|) (list '|iterate|)) + ((eq op '|by|) (cons 'by argSex)) + ((eq op '|braceFromCurly|) + (if (and (consp argSex) (eq (car argSex) 'seq)) + argSex + (cons 'seq argSex))) + ((and (consp op) + (progn + (setq qt (car op)) + (setq tmp1 (cdr op)) + (and (consp tmp1) + (eq (cdr tmp1) nil) + (progn + (setq realOp (car tmp1)) + t))) + (eq qt 'quote)) + (cons '|applyQuote| (cons op argSex))) + ((setq val (|hasOptArgs?| argSex)) (cons op val)) + (t (cons op argSex)))))) + ((and (consp op) + (progn + (setq qt (car op)) + (setq tmp1 (cdr op)) + (and (consp tmp1) + (eq (cdr tmp1) NIL) + (progn + (setq realOp (car tmp1)) + t))) + (eq qt 'quote)) + (list '|applyQuote| op (|pf2Sex1| args))) + ((eq op '|braceFromCurly|) + (setq x (|pf2Sex1| args)) + (if (and (consp x) (eq (car x) 'seq)) + x + (list 'seq x))) + ((eq op '|by|) (list 'by (|pf2Sex1| args))) + (t (list op (|pf2Sex1| args)))))))) + +\end{chunk} + +\defun{pfSuchThat2Sex}{Convert a SuchThat node to an S-expression} +\calls{pfSuchThat2Sex}{pf0TupleParts} +\calls{pfSuchThat2Sex}{pf2Sex1} +\calls{pfSuchThat2Sex}{pf2Sex} +\usesdollar{pfSuchThat2Sex}{predicateList} +\begin{chunk}{defun pfSuchThat2Sex} +(defun |pfSuchThat2Sex| (args) + (let (rhsSex lhsSex argList name) + (declare (special |$predicateList|)) + (setq name (gentemp)) + (setq argList (|pf0TupleParts| args)) + (setq lhsSex (|pf2Sex1| (car argList))) + (setq rhsSex (|pf2Sex| (cadr argList))) + (setq |$predicateList| + (cons (cons name (cons lhsSex rhsSex)) |$predicateList|)) + name)) + +\end{chunk} + +\defun{pfOp2Sex}{pfOp2Sex} +\calls{pfOp2Sex}{pf2Sex1} +\calls{pfOp2Sex}{pmDontQuote?} +\calls{pfOp2Sex}{pfSymbol?} +\usesdollar{pfOp2Sex}{quotedOpList} +\usesdollar{pfOp2Sex}{insideRule} +\begin{chunk}{defun pfOp2Sex} +(defun |pfOp2Sex| (pf) + (let (realOp tmp1 op alreadyQuoted) + (declare (special |$quotedOpList| |$insideRule|)) + (setq alreadyQuoted (|pfSymbol?| pf)) + (setq op (|pf2Sex1| pf)) + (cond + ((and (consp op) + (eq (car op) 'quote) + (progn + (setq tmp1 (cdr op)) + (and (consp tmp1) + (eq (cdr tmp1) nil) + (progn + (setq realOp (car tmp1)) t)))) + (cond + ((eq |$insideRule| '|left|) realOp) + ((eq |$insideRule| '|right|) + (cond + ((|pmDontQuote?| realOp) realOp) + (t + (setq |$quotedOpList| (cons op |$quotedOpList|)) + op))) + ((eq realOp '|\||) realOp) + ((eq realOp '|:|) realOp) + ((eq realOp '?) realOp) + (t op))) + (t op)))) + +\end{chunk} + +\defun{pmDontQuote?}{pmDontQuote?} +\begin{chunk}{defun pmDontQuote? 0} +(defun |pmDontQuote?| (sy) + (member sy + '(+ - * ** ^ / |log| |exp| |pi| |sqrt| |ei| |li| |erf| |ci| + |si| |dilog| |sin| |cos| |tan| |cot| |sec| |csc| |asin| + |acos| |atan| |acot| |asec| |acsc| |sinh| |cosh| |tanh| + |coth| |sech| |csch| |asinh| |acosh| |atanh| |acoth| + |asech| |acsc|))) + +\end{chunk} + +\defun{hasOptArgs?}{hasOptArgs?} +\begin{chunk}{defun hasOptArgs? 0} +(defun |hasOptArgs?| (argSex) + (let (rhs lhs opt nonOpt tmp1 tmp2) + (dolist (arg argSex) + (cond + ((and (consp arg) + (eq (car arg) 'optarg) + (progn + (setq tmp1 (cdr arg)) + (and (consp tmp1) + (progn + (setq lhs (car tmp1)) + (setq tmp2 (cdr tmp1)) + (and (consp tmp2) + (eq (cdr tmp2) nil) + (progn + (setq rhs (car tmp2)) + t)))))) + (setq opt (cons (list lhs rhs) opt))) + (t (setq nonOpt (cons arg nonOpt))))) + (when opt + (nconc (nreverse nonOpt) (list (cons '|construct| (nreverse opt))))))) + +\end{chunk} + +\defun{pfSequence2Sex}{Convert a Sequence node to an S-expression} +\calls{pfSequence2Sex}{pf2Sex1} +\calls{pfSequence2Sex}{pf0SequenceArgs} +\usesdollar{pfSequence2Sex}{insideSEQ} +\begin{chunk}{defun pfSequence2Sex} +(defun |pfSequence2Sex| (pf) + (let (|$insideSEQ| tmp1 ruleList seq) + (declare (special |$insideSEQ|)) + (setq |$insideSEQ| t) + (setq seq (|pfSequence2Sex0| (mapcar #'|pf2Sex1| (|pf0SequenceArgs| pf)))) + (cond + ((and (consp seq) + (eq (car seq) 'seq) + (progn (setq ruleList (cdr seq)) 't) + (consp ruleList) + (progn + (setq tmp1 (car ruleList)) + (and (consp tmp1) (eq (car tmp1) '|rule|)))) + (list '|ruleset| (cons '|construct| ruleList))) + (t seq)))) + +\end{chunk} + +\defun{pfSequence2Sex0}{pfSequence2Sex0} +\tpdhere{rewrite this using (dolist (item seqList)...)} +\begin{verbatim} +;pfSequence2Sex0 seqList == +; null seqList => "noBranch" +; seqTranList := [] +; while seqList ^= nil repeat +; item := first seqList +; item is ["exit", cond, value] => +; item := ["IF", cond, value, pfSequence2Sex0 rest seqList] +; seqTranList := [item, :seqTranList] +; seqList := nil +; seqTranList := [item ,:seqTranList] +; seqList := rest seqList +; #seqTranList = 1 => first seqTranList +; ["SEQ", :nreverse seqTranList] +\end{verbatim} +\calls{pfSequence2Sex0}{pfSequence2Sex0} +\begin{chunk}{defun pfSequence2Sex0} +(defun |pfSequence2Sex0| (seqList) + (let (value tmp2 cond tmp1 item seqTranList) + (if (null seqList) + '|noBranch| + (progn + ((lambda () + (loop + (if (not seqList) + (return nil) + (progn + (setq item (car seqList)) + (cond + ((and (consp item) + (eq (car item) '|exit|) + (progn + (setq tmp1 (cdr item)) + (and (consp tmp1) + (progn + (setq cond (car tmp1)) + (setq tmp2 (cdr tmp1)) + (and (consp tmp2) + (eq (cdr tmp2) nil) + (progn + (setq value (car tmp2)) + t)))))) + (setq item + (list 'if cond value (|pfSequence2Sex0| (cdr seqList)))) + (setq seqTranList (cons item seqTranList)) + (setq seqList nil)) + (t + (progn + (setq seqTranList (cons item seqTranList)) + (setq seqList (cdr seqList)))))))))) + (if (eql (length seqTranList) 1) + (car seqTranList) + (cons 'seq (nreverse seqTranList))))))) + +\end{chunk} + +\defun{loopIters2Sex}{Convert a loop node to an S-expression} +\tpdhere{rewrite using dsetq} +\begin{verbatim} +;loopIters2Sex iterList == +; result := nil +; for iter in iterList repeat +; sex := pf2Sex1 iter +; sex is ['IN, var, ['SEGMENT, i, ["BY", incr]]] => +; result := [ ['STEP, var, i, incr], :result] +; sex is ['IN, var, ["BY", ['SEGMENT, i, j], incr]] => +; result := [ ['STEP, var, i, incr, j], :result] +; sex is ['IN, var, ['SEGMENT, i, j]] => +; result := [ ['STEP, var, i, 1, j], :result] +; result := [sex, :result] +; nreverse result +\end{verbatim} +\calls{loopIters2Sex}{pf2Sex1} +\begin{chunk}{defun loopIters2Sex} +(defun |loopIters2Sex| (iterList) + (let (j incr i var sex result tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 tmp7 tmp8) + (dolist (iter iterList (nreverse result)) + (setq sex (|pf2Sex1| iter)) + (cond + ((and (consp sex) + (eq (car sex) 'in) + (progn + (setq tmp1 (cdr sex)) + (and (consp tmp1) + (progn + (setq var (car tmp1)) + (setq tmp2 (cdr tmp1)) + (and (consp tmp2) + (eq (cdr tmp2) nil) + (progn + (setq tmp3 (car tmp2)) + (and (consp tmp3) + (eq (car tmp3) 'segment) + (progn + (setq tmp4 (cdr tmp3)) + (and (consp tmp4) + (progn + (setq i (car tmp4)) + (setq tmp5 (cdr tmp4)) + (and (consp tmp5) + (eq (cdr tmp5) nil) + (progn + (setq tmp6 (car tmp5)) + (and (consp tmp6) + (eq (car tmp6) 'by) + (progn + (setq tmp7 (cdr tmp6)) + (and (consp tmp7) + (eq (cdr tmp7) nil) + (progn + (setq incr (car tmp7)) + t)))))))))))))))) + (setq result (cons (list 'step var i incr) result))) + ((and (consp sex) + (eq (car sex) 'in) + (progn + (setq tmp1 (cdr sex)) + (and (consp tmp1) + (progn + (setq var (car tmp1)) + (setq tmp2 (cdr tmp1)) + (and (consp tmp2) + (eq (cdr tmp2) nil) + (progn + (setq tmp3 (car tmp2)) + (and (consp tmp3) + (eq (car tmp3) 'by) + (progn + (setq tmp4 (cdr tmp3)) + (and (consp tmp4) + (progn + (setq tmp5 (car tmp4)) + (and (consp tmp5) + (eq (car tmp5) 'segment) + (progn + (setq tmp6 (cdr tmp5)) + (and (consp tmp6) + (progn + (setq i (car tmp6)) + (setq tmp7 (cdr tmp6)) + (and (consp tmp7) + (eq (cdr tmp7) nil) + (progn + (setq j (car tmp7)) + t))))))) + (progn + (setq tmp8 (cdr tmp4)) + (and (consp tmp8) + (eq (cdr tmp8) nil) + (progn + (setq incr (car tmp8)) + t)))))))))))) + (setq result (cons (list 'step var i incr j) result))) + ((and (consp sex) + (eq (car sex) 'in) + (progn + (setq tmp1 (cdr sex)) + (and (consp tmp1) + (progn + (setq var (car tmp1)) + (setq tmp2 (cdr tmp1)) + (and (consp tmp2) + (eq (cdr tmp2) nil) + (progn + (setq tmp3 (car tmp2)) + (and (consp tmp3) + (eq (car tmp3) 'segment) + (progn + (setq tmp4 (cdr tmp3)) + (and (consp tmp4) + (progn + (setq i (car tmp4)) + (setq tmp5 (cdr tmp4)) + (and (consp tmp5) + (eq (cdr tmp5) nil) + (progn + (setq j (car tmp5)) + t)))))))))))) + (setq result (cons (list 'step var i 1 j) result))) + (t (setq result (cons sex result))))))) + +\end{chunk} + +\defun{pfCollect2Sex}{Change a Collect node to an S-expression} +\calls{pfCollect2Sex}{loopIters2Sex} +\calls{pfCollect2Sex}{pfParts} +\calls{pfCollect2Sex}{pfCollectIterators} +\calls{pfCollect2Sex}{pf2Sex1} +\calls{pfCollect2Sex}{pfCollectBody} +\begin{chunk}{defun pfCollect2Sex} +(defun |pfCollect2Sex| (pf) + (let (var cond sex tmp1 tmp2 tmp3 tmp4) + (setq sex + (cons 'collect + (append (|loopIters2Sex| (|pfParts| (|pfCollectIterators| pf))) + (list (|pf2Sex1| (|pfCollectBody| pf)))))) + (cond + ((and (consp sex) + (eq (car sex) 'collect) + (progn + (setq tmp1 (cdr sex)) + (and (consp tmp1) + (progn + (setq tmp2 (car tmp1)) + (and (consp tmp2) + (eq (car tmp2) '|\||) + (progn + (setq tmp3 (cdr tmp2)) + (and (consp tmp3) + (eq (cdr tmp3) nil) + (progn + (setq cond (car tmp3)) + t))))) + (progn + (setq tmp4 (cdr tmp1)) + (and (consp tmp4) + (eq (cdr tmp4) nil) + (progn (setq var (car tmp4)) t))))) + (symbolp var)) + (list '|\|| var cond)) + (t sex)))) + +\end{chunk} + +\defun{pfDefinition2Sex}{Convert a Definition node to an S-expression} +\calls{pfDefinition2Sex}{pf2Sex1} +\calls{pfDefinition2Sex}{pf0DefinitionLhsItems} +\calls{pfDefinition2Sex}{pfDefinitionRhs} +\calls{pfDefinition2Sex}{systemError} +\calls{pfDefinition2Sex}{pfLambdaTran} +\usesdollar{pfDefinition2Sex}{insideApplication} +\begin{chunk}{defun pfDefinition2Sex} +(defun |pfDefinition2Sex| (pf) + (let (body argList tmp1 rhs id idList) + (declare (special |$insideApplication|)) + (if |$insideApplication| + (list 'optarg + (|pf2Sex1| (car (|pf0DefinitionLhsItems| pf))) + (|pf2Sex1| (|pfDefinitionRhs| pf))) + (progn + (setq idList (mapcar #'|pf2Sex1| (|pf0DefinitionLhsItems| pf))) + (if (not (eql (length idList) 1)) + (|systemError| + "lhs of definition must be a single item in the interpreter") + (progn + (setq id (car idList)) + (setq rhs (|pfDefinitionRhs| pf)) + (setq tmp1 (|pfLambdaTran| rhs)) + (setq argList (car tmp1)) + (setq body (cdr tmp1)) + (cons 'def + (cons + (if (eq argList '|id|) + id + (cons id argList)) + body)))))))) + +\end{chunk} + +\defun{pfLambdaTran}{Convert a Lambda node to an S-expression} +\calls{pfLambdaTran}{pfLambda?} +\calls{pfLambdaTran}{pf0LambdaArgs} +\calls{pfLambdaTran}{pfTyped?} +\calls{pfLambdaTran}{pfCollectArgTran} +\calls{pfLambdaTran}{pfTypedId} +\calls{pfLambdaTran}{pfNothing?} +\calls{pfLambdaTran}{pfTypedType} +\calls{pfLambdaTran}{pf2Sex1} +\calls{pfLambdaTran}{systemError} +\calls{pfLambdaTran}{pfLambdaRets} +\calls{pfLambdaTran}{pfLambdaBody} +\begin{chunk}{defun pfLambdaTran} +(defun |pfLambdaTran| (pf) + (let (retType argList argTypeList) + (cond + ((|pfLambda?| pf) + (dolist (arg (|pf0LambdaArgs| pf)) + (if (|pfTyped?| arg) + (progn + (setq argList + (cons (|pfCollectArgTran| (|pfTypedId| arg)) argList)) + (if (|pfNothing?| (|pfTypedType| arg)) + (setq argTypeList (cons nil argTypeList)) + (setq argTypeList + (cons (|pf2Sex1| (|pfTypedType| arg)) argTypeList)))) + (|systemError| "definition args should be typed"))) + (setq argList (nreverse argList)) + (unless (|pfNothing?| (|pfLambdaRets| pf)) + (setq retType (|pf2Sex1| (|pfLambdaRets| pf)))) + (setq argTypeList (cons retType (nreverse argTypeList))) + (cons argList + (list argTypeList + (mapcar #'(lambda (x) (declare (ignore x)) nil) argTypeList) + (|pf2Sex1| (|pfLambdaBody| pf))))) + (t (cons '|id| (list '(nil) '(nil) (|pf2Sex1| pf))))))) + +\end{chunk} + +\defun{pfCollectArgTran}{pfCollectArgTran} +\calls{pfCollectArgTran}{pfCollect?} +\calls{pfCollectArgTran}{pf2sex1} +\calls{pfCollectArgTran}{pfParts} +\calls{pfCollectArgTran}{pfCollectIterators} +\calls{pfCollectArgTran}{pfCollectBody} +\begin{chunk}{defun pfCollectArgTran} +(defun |pfCollectArgTran| (pf) + (let (cond tmp2 tmp1 id conds) + (cond + ((|pfCollect?| pf) + (setq conds (mapcar #'|pf2sex1| (|pfParts| (|pfCollectIterators| pf)))) + (setq id (|pf2Sex1| (|pfCollectBody| pf))) + (cond + ((and (consp conds) ; conds is [ ["|", cond] ] + (eq (cdr conds) nil) + (progn + (setq tmp1 (car conds)) + (and (consp tmp1) + (eq (car tmp1) '|\||) + (progn + (setq tmp2 (cdr tmp1)) + (and (consp tmp2) + (eq (cdr tmp2) nil) + (progn + (setq cond (car tmp2)) + t)))))) + (list '|\|| id cond)) + (t (cons id conds)))) + (t (|pf2Sex1| pf))))) + +\end{chunk} + +\defun{pfLambda2Sex}{Convert a Lambda node to an S-expression} +\calls{pfLambda2Sex}{pfLambdaTran} +\begin{chunk}{defun pfLambda2Sex} +(defun |pfLambda2Sex| (pf) + (let (body argList tmp1) + (setq tmp1 (|pfLambdaTran| pf)) + (setq argList (car tmp1)) + (setq body (cdr tmp1)) + (cons 'adef (cons argList body)))) + +\end{chunk} + +\defun{pfRule2Sex}{Convert a Rule node to an S-expression} +\calls{pfRule2Sex}{pfLhsRule2Sex} +\calls{pfRule2Sex}{pfRuleLhsItems} +\calls{pfRule2Sex}{pfRhsRule2Sex} +\calls{pfRule2Sex}{pfRuleRhs} +\calls{pfRule2Sex}{ruleLhsTran} +\calls{pfRule2Sex}{rulePredicateTran} +\usesdollar{pfRule2Sex}{multiVarPredicateList} +\usesdollar{pfRule2Sex}{predicateList} +\usesdollar{pfRule2Sex}{quotedOpList} +\begin{chunk}{defun pfRule2Sex} +(defun |pfRule2Sex| (pf) + (let (|$multiVarPredicateList| |$predicateList| |$quotedOpList| rhs lhs) + (declare (special |$multiVarPredicateList| |$predicateList| |$quotedOpList|)) + (setq |$quotedOpList| nil) + (setq |$predicateList| nil) + (setq |$multiVarPredicateList| nil) + (setq lhs (|pfLhsRule2Sex| (|pfRuleLhsItems| pf))) + (setq rhs (|pfRhsRule2Sex| (|pfRuleRhs| pf))) + (setq lhs (|ruleLhsTran| lhs)) + (|rulePredicateTran| + (if |$quotedOpList| + (list '|rule| lhs rhs (cons '|construct| |$quotedOpList|)) + (list '|rule| lhs rhs))))) + +\end{chunk} + +\defun{pfLhsRule2Sex}{Convert the Lhs of a Rule to an S-expression} +\calls{pfLhsRule2Sex}{pf2Sex1} +\usesdollar{pfLhsRule2Sex}{insideRule} +\begin{chunk}{defun pfLhsRule2Sex} +(defun |pfLhsRule2Sex| (lhs) + (let (|$insideRule|) + (declare (special |$insideRule|)) + (setq |$insideRule| '|left|) + (|pf2Sex1| lhs))) + +\end{chunk} + +\defun{pfRhsRule2Sex}{Convert the Rhs of a Rule to an S-expression} +\calls{pfRhsRule2Sex}{pf2Sex1} +\usesdollar{pfRhsRule2Sex}{insideRule} +\begin{chunk}{defun pfRhsRule2Sex} +(defun |pfRhsRule2Sex| (rhs) + (let (|$insideRule|) + (declare (special |$insideRule|)) + (setq |$insideRule| '|right|) + (|pf2Sex1| rhs))) + +\end{chunk} + +\defun{rulePredicateTran}{Convert a Rule predicate to an S-expression} +\begin{verbatim} +;rulePredicateTran rule == +; null $multiVarPredicateList => rule +; varList := patternVarsOf [rhs for [.,.,:rhs] in $multiVarPredicateList] +; predBody := +; CDR $multiVarPredicateList => +; ['AND, :[:pvarPredTran(rhs, varList) for [.,.,:rhs] in +; $multiVarPredicateList]] +; [ [.,.,:rhs],:.] := $multiVarPredicateList +; pvarPredTran(rhs, varList) +; ['suchThat, rule, +; ['construct, :[ ["QUOTE", var] for var in varList]], +; ['ADEF, '(predicateVariable), +; '((Boolean) (List (Expression (Integer)))), '(() ()), +; predBody]] +\end{verbatim} +\calls{rulePredicateTran}{patternVarsOf} +\calls{rulePredicateTran}{pvarPredTran} +\usesdollar{rulePredicateTran}{multiVarPredicateList} +\begin{chunk}{defun rulePredicateTran} +(defun |rulePredicateTran| (rule) + (let (predBody varList rhs tmp1 result) + (declare (special |$multiVarPredicateList|)) + (if (null |$multiVarPredicateList|) + rule + (progn + (setq varList + (|patternVarsOf| + ((lambda (t1 t2 t3) + (loop + (cond + ((or (atom t2) + (progn + (setq t3 (car t2)) + nil)) + (return (nreverse t1))) + (t + (and (consp t3) + (progn + (setq tmp1 (cdr t3)) + (and (consp tmp1) + (progn + (setq rhs (cdr tmp1)) + t))) + (setq t1 (cons rhs t1))))) + (setq t2 (cdr t2)))) + nil |$multiVarPredicateList| nil))) + (setq predBody + (cond + ((cdr |$multiVarPredicateList|) + (cons 'and + ((lambda (t4 t5 t6) + (loop + (cond + ((or (atom t5) + (progn + (setq t6 (car t5)) + nil)) + (return (nreverse t4))) + (t + (and (consp t6) + (progn + (setq tmp1 (cdr t6)) + (and (consp tmp1) + (progn + (setq rhs (cdr tmp1)) + t))) + (setq t4 + (append (reverse (|pvarPredTran| rhs varList)) + t4))))) + (setq t5 (cdr t5)))) + nil |$multiVarPredicateList| nil))) + (t + (progn + (setq rhs (cddar |$multiVarPredicateList|)) + (|pvarPredTran| rhs varList))))) + (dolist (var varList) (push (list 'quote var) result)) + (list '|suchThat| rule + (cons '|construct| (nreverse result)) + (list 'adef '(|predicateVariable|) + '((|Boolean|) + (|List| (|Expression| (|Integer|)))) + '(nil nil) predBody)))))) + +\end{chunk} + +\defun{patternVarsOf}{patternVarsOf} +\calls{patternVarsOf}{patternVarsOf1} +\begin{chunk}{defun patternVarsOf} +(defun |patternVarsOf| (expr) + (|patternVarsOf1| expr nil)) + +\end{chunk} + +\defun{patternVarsOf1}{patternVarsOf1} +\calls{patternVarsOf1}{patternVarsOf1} +\begin{chunk}{defun patternVarsOf1} +(defun |patternVarsOf1| (expr varList) + (let (argl op) + (cond + ((null expr) varList) + ((atom expr) + (cond + ((null (symbolp expr)) varList) + ((member expr varList) varList) + (t (cons expr varList)))) + ((and (consp expr) + (progn + (setq op (car expr)) + (setq argl (cdr expr)) + t)) + (progn + (dolist (arg argl) + (setq varList (|patternVarsOf1| arg varList))) + varList)) + (t varList)))) + +\end{chunk} + +\defun{pvarPredTran}{pvarPredTran} +\begin{chunk}{defun pvarPredTran} +(defun |pvarPredTran| (rhs varList) + (let ((i 0)) + (dolist (var varList rhs) + (setq rhs (nsubst (list '|elt| '|predicateVariable| (incf i)) var rhs))))) + +\end{chunk} + +\defun{ruleLhsTran}{Convert the Lhs of a Rule node to an S-expression} +\calls{ruleLhsTran}{patternVarsOf} +\calls{ruleLhsTran}{nsubst} +\usesdollar{ruleLhsTran}{predicateList} +\usesdollar{ruleLhsTran}{multiVarPredicateList} +\begin{chunk}{defun ruleLhsTran} +(defun |ruleLhsTran| (ruleLhs) + (let (predicate var vars predRhs predLhs name) + (declare (special |$predicateList| |$multiVarPredicateList|)) + (dolist (pred |$predicateList|) + (setq name (car pred)) + (setq predLhs (cadr pred)) + (setq predRhs (cddr pred)) + (setq vars (|patternVarsOf| predRhs)) + (cond + ((cdr vars) + (setq ruleLhs (nsubst predLhs name ruleLhs)) + (setq |$multiVarPredicateList| (cons pred |$multiVarPredicateList|))) + (t + (setq var (cadr predLhs)) + (setq predicate + (list '|suchThat| predLhs (list 'adef (list var) + '((|Boolean|) (|Expression| (|Integer|))) '(nil nil) predRhs))) + (setq ruleLhs (nsubst predicate name ruleLhs))))) + ruleLhs)) + +\end{chunk} + +\defun{opTran}{Translate ops into internal symbols} +\begin{chunk}{defun opTran 0} +(defun |opTran| (op) + (cond + ((equal op '|..|) 'segment) + ((eq op '[]) '|construct|) + ((eq op '{}) '|braceFromCurly|) + ((eq op 'is) '|is|) + (t op))) + +\end{chunk} + +\chapter{Keyed Message Handling} +Throughout the interpreter there are messages printed using a symbol +for a database lookup. This was done to enable translation of these +messages languages other than English. + +Axiom messages are read from a flat file database and returned +as one long string. They are preceded in the database by a key and +this is how they are referenced from code. For example, one key is +S2IL0001 which means: +\begin{verbatim} + S2 Scratchpad II designation + I from the interpreter + L originally from LISPLIB BOOT + 0001 a sequence number +\end{verbatim} + +Each message may contain formatting codes and and parameter codes. +The formatting codes are: +\begin{verbatim} + %b turn on bright printing + %ceoff turn off centering + %ceon turn on centering + %d turn off bright printing + %f user defined printing + %i start indentation of 3 more spaces + %l start a new line + %m math-print an expression + %rjoff turn off right justification (actually ragged left) + %rjon turn on right justification (actually ragged left) + %s pretty-print as an S-expression + %u unindent 3 spaces + %x# insert # spaces +\end{verbatim} + +The parameter codes look like \%1, \%2b, \%3p, \%4m, \%5bp, \%6s where the +digit is the parameter number and the letters following indicate +additional formatting. You can indicate as many additional formatting +qualifiers as you like, to the degree they make sense. +\begin{itemize} +\item The ``p'' code means to call prefix2String on the parameter, +a standard way of printing abbreviated types. +\item The ``P'' operator maps prefix2String over its arguments. +\item The ``o'' operation formats the argument as an operation name. +\item The ``b'' means to print that parameter in a bold (bright) font. +\item The ``c'' means to center that parameter on a new line. +\item The ``r'' means to right justify (ragged left) the argument. +\item The ``f'' means that the parameter is a list [fn, :args] +and that ``fn'' is to be called on ``args'' to get the text. +\end{itemize} + +Look in the file with the name defined in \verb|$defaultMsgDatabaseName| +above for examples. + +\defdollar{cacheMessages} +This is used for debugging +\begin{chunk}{initvars} +(defvar |$cacheMessages| t) + +\end{chunk} + +\defdollar{msgAlist} +\begin{chunk}{initvars} +(defvar |$msgAlist| nil) + +\end{chunk} + +\defdollar{testingErrorPrefix} +\begin{chunk}{initvars} +(defvar |$testingErrorPrefix| "Daly Bug") + +\end{chunk} + +\defdollar{texFormatting} +\begin{chunk}{initvars} +(defvar |$texFormatting| nil) + +\end{chunk} + +\defvar{*msghash*} +\begin{chunk}{initvars} +(defvar *msghash* nil "hash table keyed by msg number") + +\end{chunk} + +\defdollar{msgdbPrims} +\begin{chunk}{initvars} +(defvar |$msgdbPrims| + '(|%b| |%d| |%l| |%i| |%u| %U |%n| |%x| |%ce| |%rj| "%U" "%b" "%d" + "%l" "%i" "%u" "%U" "%n" "%x" "%ce" "%rj")) + +\end{chunk} + +\defdollar{msgdbPunct} +\begin{chunk}{initvars} +(defvar |$msgdbPunct| + '(|.| |,| ! |:| |;| ? ] |)| "." "," "!" ":" ";" "?" "]" ")")) + +\end{chunk} + +\defdollar{msgdbNoBlanksBeforeGroup} +\begin{chunk}{initvars} +(defvar |$msgdbNoBlanksBeforeGroup| + `(" " | | "%" % ,@|$msgdbPrims| ,@|$msgdbPunct|)) + +\end{chunk} + +\defdollar{msgdbNoBlanksAfterGroup} +\begin{chunk}{initvars} +(defvar |$msgdbNoBlanksAfterGroup| + `(" " | | "%" % ,@|$msgdbPrims| [ |(| "[" "(")) + +\end{chunk} + +\defun{fetchKeyedMsg}{Fetch a message from the message database} +If the {\tt *msghash*} hash table is empty we call {\tt cacheKeyedMsg} +to fill the table, otherwise we do a key lookup in the hash table. +\calls{fetchKeyedMsg}{object2Identifier} +\calls{fetchKeyedMsg}{cacheKeyedMsg} +\usesdollar{fetchKeyedMsg}{defaultMsgDatabaseName} +\uses{fetchKeyedMsg}{*msghash*} +\begin{chunk}{defun fetchKeyedMsg} +(defun |fetchKeyedMsg| (key ignore) + (declare (ignore ignore) (special *msghash* |$defaultMsgDatabaseName|)) + (setq key (|object2Identifier| key)) + (unless *msghash* + (setq *msghash* (make-hash-table)) + (cacheKeyedMsg |$defaultMsgDatabaseName|)) + (gethash key *msghash*)) + +\end{chunk} + +\defun{cacheKeyedMsg}{Cache messages read from message database} +\catches{cacheKeyedMsg}{done} +\throws{cacheKeyedMsg}{done} +\uses{cacheKeyedMsg}{*msghash*} +\begin{chunk}{defun cacheKeyedMsg} +(defun cacheKeyedMsg (file) + (let ((line "") (msg "") key) + (declare (special *msghash*)) + (with-open-file (in file) + (catch 'done + (loop + (setq line (read-line in nil nil)) + (cond + ((null line) + (when key (setf (gethash key *msghash*) msg)) + (throw 'done nil)) + ((= (length line) 0)) + ((char= (schar line 0) #\S) + (when key (setf (gethash key *msghash*) msg)) + (setq key (intern line "BOOT")) + (setq msg "")) + ('else + (setq msg (concatenate 'string msg line))))))))) + +\end{chunk} + +\defun{getKeyedMsg}{getKeyedMsg} +\calls{getKeyedMsg}{fetchKeyedMsg} +\begin{chunk}{defun getKeyedMsg} +(defun |getKeyedMsg| (key) (|fetchKeyedMsg| key nil)) + +\end{chunk} + +\defun{sayKeyedMsg}{Say a message using a keyed lookup} +\calls{sayKeyedMsg}{sayKeyedMsgLocal} +\usesdollar{sayKeyedMsg}{texFormatting} +\begin{chunk}{defun sayKeyedMsg} +(defun |sayKeyedMsg| (key args) + (let (|$texFormatting|) + (declare (special |$texFormatting|)) + (setq |$texFormatting| nil) + (|sayKeyedMsgLocal| key args))) + +\end{chunk} + +\defun{sayKeyedMsgLocal}{Handle msg formatting and print to file} +\calls{sayKeyedMsgLocal}{segmentKeyedMsg} +\calls{sayKeyedMsgLocal}{getKeyedMsg} +\calls{sayKeyedMsgLocal}{substituteSegmentedMsg} +\calls{sayKeyedMsgLocal}{flowSegmentedMsg} +\calls{sayKeyedMsgLocal}{sayMSG2File} +\calls{sayKeyedMsgLocal}{sayMSG} +\usesdollar{sayKeyedMsgLocal}{printMsgsToFile} +\usesdollar{sayKeyedMsgLocal}{linelength} +\usesdollar{sayKeyedMsgLocal}{margin} +\usesdollar{sayKeyedMsgLocal}{displayMsgNumber} +\begin{chunk}{defun sayKeyedMsgLocal} +(defun |sayKeyedMsgLocal| (key args) + (let (msg msgp) + (declare (special |$printMsgsToFile| $linelength $margin |$displayMsgNumber|)) + (setq msg (|segmentKeyedMsg| (|getKeyedMsg| key))) + (setq msg (|substituteSegmentedMsg| msg args)) + (when |$displayMsgNumber| (setq msg `("%b" ,key |:| "%d" . ,msg))) + (setq msgp (|flowSegmentedMsg| msg $linelength $margin)) + (when |$printMsgsToFile| (|sayMSG2File| msgp)) + (|sayMSG| msgp))) + +\end{chunk} + +\defun{segmentKeyedMsg}{Break a message into words} +\calls{segmentKeyedMsg}{string2Words} +\begin{chunk}{defun segmentKeyedMsg} +(defun |segmentKeyedMsg| (msg) (|string2Words| msg)) + +\end{chunk} + +\defun{sayMSG2File}{Write a msg into spadmsg.listing file} +\calls{sayMSG2File}{makePathname} +\calls{sayMSG2File}{defiostream} +\calls{sayMSG2File}{sayBrightly1} +\calls{sayMSG2File}{shut} +\begin{chunk}{defun sayMSG2File} +(defun |sayMSG2File| (msg) + (let (file str) + (setq file (|makePathname| '|spadmsg| '|listing| 'a)) + (setq str (defiostream `((mode . output) (file . ,file)) 255 0)) + (sayBrightly1 msg str) + (shut str))) + +\end{chunk} + +\defun{sayMSG}{sayMSG} +\calls{saymsg}{saybrightly1} +\usesdollar{sayMSG}{algebraOutputStream} +\begin{chunk}{defun sayMSG} +(defun |sayMSG| (x) + (declare (special |$algebraOutputStream|)) + (when x (sayBrightly1 x |$algebraOutputStream|))) + +\end{chunk} + +\chapter{Stream Utilities} +The input stream is parsed into a large s-expression by repeated calls +to Delay. Delay takes a function f and an argument x and returns a list +consisting of \verb|("nonnullstream" f x)|. Eventually multiple calls are made +and a large list structure is created that consists of +\verb|("nonnullstream" f x ("nonnullstream" f1 x1 ("nonnullstream" f2 x2...| + +This delay structure is given to StreamNull which walks along the +list looking at the head. If the head is ``nonnullstream'' then the +function is applied to the argument. + +So, in effect, the input is ``zipped up'' into a Delay data structure +which is then evaluated by calling StreamNull. This "zippered stream" +parser was a research project at IBM and Axiom was the testbed (which +explains the strange parsing technique). + +\defun{npNull}{npNull} +\calls{npNull}{StreamNull} +\begin{chunk}{defun npNull} +(defun |npNull| (x) (|StreamNull| x)) + +\end{chunk} + +\defun{StreamNull}{StreamNull} +\calls{StreamNull}{eqcar} +\label{StreamNull} +\sig{StreamNull}{Delay}{Union(T,NIL)} +\begin{chunk}{defun StreamNull 0} +(defun |StreamNull| (delay) + (let (parsepair) + (cond + ((or (null delay) (eqcar delay '|nullstream|)) t) + (t + ((lambda nil + (loop + (cond + ((not (eqcar delay '|nonnullstream|)) (return nil)) + (t + (setq parsepair (apply (cadr delay) (cddr delay))) + (rplaca delay (car parsepair)) + (rplacd delay (cdr parsepair))))))) + (eqcar delay '|nullstream|))))) + +\end{chunk} + +\chapter{Code Piles} +The insertpiles function converts a line-list to a line-forest where +a line is a token-dequeue and has a column which is an integer. +An A-forest is an A-tree-list +An A-tree has a root which is an A, and subtrees which is an A-forest. + +A forest with more than one tree corresponds to a Scratchpad pile +structure (t1;t2;t3;...;tn), and a tree corresponds to a pile item. +The ( ; and ) tokens are inserted into a >1-forest, otherwise +the root of the first tree is concatenated with its forest. +column t is the number of spaces before the first non-space in line t + +\defun{insertpile}{insertpile} +\calls{insertpile}{npNull} +\calls{insertpile}{pilePlusComment} +\calls{insertpile}{pilePlusComments} +\calls{insertpile}{pileTree} +\calls{insertpile}{pileCforest} +\begin{chunk}{defun insertpile} +(defun |insertpile| (s) + (let (stream a t1 h1 t2 h tmp1) + (cond + ((|npNull| s) (list nil 0 nil s)) + (t + (setq tmp1 (list (car s) (cdr s))) + (setq h (car tmp1)) + (setq t2 (cadr tmp1)) + (cond + ((|pilePlusComment| h) + (setq tmp1 (|pilePlusComments| s)) + (setq h1 (car tmp1)) + (setq t1 (cadr tmp1)) + (setq a (|pileTree| (- 1) t1)) + (cons (list (|pileCforest| + (append h1 (cons (elt a 2) nil)))) + (elt a 3))) + (t + (setq stream (cadar s)) + (setq a (|pileTree| -1 s)) + (cons (list (list (elt a 2) stream)) (elt a 3)))))))) + +\end{chunk} + +\defun{pilePlusComment}{pilePlusComment} +\calls{pilePlusComment}{tokType} +\calls{pilePlusComments}{npNull} +\calls{pilePlusComments}{pilePlusComment} +\calls{pilePlusComments}{pilePlusComments} +\begin{chunk}{defun pilePlusComment} +(defun |pilePlusComment| (arg) + (eq (|tokType| (caar arg)) '|comment|)) + +\end{chunk} +\defun{pilePlusComments}{pilePlusComments} +\begin{chunk}{defun pilePlusComments} +(defun |pilePlusComments| (s) + (let (t1 h1 t2 h tmp1) + (cond + ((|npNull| s) (list nil s)) + (t + (setq tmp1 (list (car s) (cdr s))) + (setq h (car tmp1)) + (setq t2 (cadr tmp1)) + (cond + ((|pilePlusComment| h) + (setq tmp1 (|pilePlusComments| t2)) + (setq h1 (car tmp1)) + (setq t1 (cadr tmp1)) + (list (cons h h1) t1)) + (t + (list nil s))))))) + +\end{chunk} + +\defun{pileTree}{pileTree} +\calls{pileTree}{npNull} +\calls{pileTree}{pileColumn} +\calls{pileTree}{pileForests} +\begin{chunk}{defun pileTree} +(defun |pileTree| (n s) + (let (hh t1 h tmp1) + (cond + ((|npNull| s) (list nil n nil s)) + (t + (setq tmp1 (list (car s) (cdr s))) + (setq h (car tmp1)) + (setq t1 (cadr tmp1)) + (setq hh (|pileColumn| (car h))) + (cond + ((< n hh) (|pileForests| (car h) hh t1)) + (t (list nil n nil s))))))) + +\end{chunk} + +\defun{pileColumn}{pileColumn} +\calls{pileColumn}{tokPosn} +\begin{chunk}{defun pileColumn} +(defun |pileColumn| (arg) + (cdr (|tokPosn| (caar arg)))) + +\end{chunk} + +\defun{pileForests}{pileForests} +\calls{pileForests}{pileForest} +\calls{pileForests}{npNull} +\calls{pileForests}{pileForests} +\calls{pileForests}{pileCtree} +\begin{chunk}{defun pileForests} +(defun |pileForests| (h n s) + (let (t1 h1 tmp1) + (setq tmp1 (|pileForest| n s)) + (setq h1 (car tmp1)) + (setq t1 (cadr tmp1)) + (cond + ((|npNull| h1) (list t n h s)) + (t (|pileForests| (|pileCtree| h h1) n t1))))) + +\end{chunk} + +\defun{pileForest}{pileForest} +\calls{pileForest}{pileTree} +\calls{pileForest}{pileForest1} +\begin{chunk}{defun pileForest} +(defun |pileForest| (n s) + (let (t1 h1 t2 h hh b tmp) + (setq tmp (|pileTree| n s)) + (setq b (car tmp)) + (setq hh (cadr tmp)) + (setq h (caddr tmp)) + (setq t2 (cadddr tmp)) + (cond + (b + (setq tmp (|pileForest1| hh t2)) + (setq h1 (car tmp)) + (setq t1 (cadr tmp)) + (list (cons h h1) t1)) + (t + (list nil s))))) + +\end{chunk} + +\defun{pileForest1}{pileForest1} +\calls{pileForest1}{eqpileTree} +\calls{pileForest1}{pileForest1} +\begin{chunk}{defun pileForest1} +(defun |pileForest1| (n s) + (let (t1 h1 t2 h n1 b tmp) + (setq tmp (|eqpileTree| n s)) + (setq b (car tmp)) + (setq n1 (cadr tmp)) + (setq h (caddr tmp)) + (setq t2 (cadddr tmp)) + (cond + (b + (setq tmp (|pileForest1| n t2)) + (setq h1 (car tmp)) + (setq t1 (cadr tmp)) + (list (cons h h1) t1)) + (t (list nil s))))) + +\end{chunk} + +\defun{eqpileTree}{eqpileTree} +\calls{eqpileTree}{npNull} +\calls{eqpileTree}{pileColumn} +\calls{eqpileTree}{pileForests} +\begin{chunk}{defun eqpileTree} +(defun |eqpileTree| (n s) + (let (hh t1 h tmp) + (cond + ((|npNull| s) (list nil n nil s)) + (t + (setq tmp (list (car s) (cdr s))) + (setq h (car tmp)) + (setq t1 (cadr tmp)) + (setq hh (|pileColumn| (car h))) + (cond + ((equal hh n) (|pileForests| (car h) hh t1)) + (t (list nil n nil s))))))) + +\end{chunk} + +\defun{pileCtree}{pileCtree} +\calls{pileCtree}{dqAppend} +\calls{pileCtree}{pileCforest} +\begin{chunk}{defun pileCtree} +(defun |pileCtree| (x y) + (|dqAppend| x (|pileCforest| y))) + +\end{chunk} + +\defun{pileCforest}{pileCforest} +Only enpiles forests with $>=2$ trees + +\calls{pileCforest}{tokPart} +\calls{pileCforest}{enPile} +\calls{pileCforest}{separatePiles} +\begin{chunk}{defun pileCforest} +(defun |pileCforest| (x) + (let (f) + (cond + ((null x) nil) + ((null (cdr x)) (setq f (car x)) + (cond + ((eq (|tokPart| (caar f)) 'if) (|enPile| f)) + (t f))) + (t (|enPile| (|separatePiles| x)))))) + +\end{chunk} + +\defun{enPile}{enPile} +\calls{enPile}{dqConcat} +\calls{enPile}{dqUnit} +\calls{enPile}{tokConstruct} +\calls{enPile}{firstTokPosn} +\calls{enPile}{lastTokPosn} +\begin{chunk}{defun enPile} +(defun |enPile| (x) + (|dqConcat| + (list + (|dqUnit| (|tokConstruct| '|key| 'settab (|firstTokPosn| x))) + x + (|dqUnit| (|tokConstruct| '|key| 'backtab (|lastTokPosn| x)))))) + +\end{chunk} + +\defun{firstTokPosn}{firstTokPosn} +\calls{firstTokPosn}{tokPosn} +\begin{chunk}{defun firstTokPosn} +(defun |firstTokPosn| (arg) (|tokPosn| (caar arg))) + +\end{chunk} + +\defun{lastTokPosn}{lastTokPosn} +\calls{lastTokPosn}{tokPosn} +\begin{chunk}{defun lastTokPosn} +(defun |lastTokPosn| (arg) (|tokPosn| (cadr arg))) + +\end{chunk} + +\defun{separatePiles}{separatePiles} +\calls{separatePiles}{dqUnit} +\calls{separatePiles}{tokConstruct} +\calls{separatePiles}{lastTokPosn} +\calls{separatePiles}{dqConcat} +\calls{separatePiles}{separatePiles} +\begin{chunk}{defun separatePiles} +(defun |separatePiles| (x) + (let (semicolon a) + (cond + ((null x) nil) + ((null (cdr x)) (car x)) + (t + (setq a (car x)) + (setq semicolon + (|dqUnit| (|tokConstruct| '|key| 'backset (|lastTokPosn| a)))) + (|dqConcat| (list a semicolon (|separatePiles| (cdr x)))))))) + +\end{chunk} + +\chapter{Dequeue Functions} +The dqUnit makes a unit dq i.e. a dq with one item, from the item +\defun{dqUnit}{dqUnit} +\begin{chunk}{defun dqUnit 0} +(defun |dqUnit| (s) + (let (a) + (setq a (list s)) + (cons a a))) + +\end{chunk} + +\defun{dqConcat}{dqConcat} +The dqConcat function concatenates a list of dq's, destroying all but the last + +\calls{dqConcat}{dqAppend} +\calls{dqConcat}{dqConcat} +\begin{chunk}{defun dqConcat} +(defun |dqConcat| (ld) + (cond + ((null ld) nil) + ((null (cdr ld)) (car ld)) + (t (|dqAppend| (car ld) (|dqConcat| (cdr ld)))))) + +\end{chunk} + +\defun{dqAppend}{dqAppend} +The dqAppend function appends 2 dq's, destroying the first +\begin{chunk}{defun dqAppend 0} +(defun |dqAppend| (x y) + (cond + ((null x) y) + ((null y) x) + (t + (rplacd (cdr x) (car y)) + (rplacd x (cdr y)) x))) + +\end{chunk} + +\defun{dqToList}{dqToList} +\begin{chunk}{defun dqToList 0} +(defun |dqToList| (s) + (when s (car s))) + +\end{chunk} + +\chapter{Message Handling} + +\section{The Line Object} + +\defun{lnCreate}{Line object creation} +This is called in only one place, the incLine1 function. +\begin{chunk}{defun lnCreate 0} +(defun |lnCreate| (extraBlanks string globalNum &rest optFileStuff) + (let ((localNum (first optFileStuff)) + (filename (second optFileStuff))) + (unless localNum (setq localNum 0)) + (list extraBlanks string globalNum localNum filename))) + +\end{chunk} + +\defun{lnExtraBlanks}{Line element 0; Extra blanks} +\begin{chunk}{defun lnExtraBlanks 0} +(defun |lnExtraBlanks| (lineObject) (elt lineObject 0)) + +\end{chunk} + +\defun{lnString}{Line element 1; String} +\begin{chunk}{defun lnString 0} +(defun |lnString| (lineObject) (elt lineObject 1)) + +\end{chunk} + +\defun{lnGlobalNum}{Line element 2; Globlal number} +\begin{chunk}{defun lnGlobalNum 0} +(defun |lnGlobalNum| (lineObject) (elt lineObject 2)) + +\end{chunk} + +\defun{lnSetGlobalNum}{Line element 2; Set Global number} +\begin{chunk}{defun lnSetGlobalNum 0} +(defun |lnSetGlobalNum| (lineObject num) + (setf (elt lineObject 2) num)) + +\end{chunk} + +\defun{lnLocalNum}{Line elemnt 3; Local number} +\begin{chunk}{defun lnLocalNum 0} +(defun |lnLocalNum| (lineObject) (elt lineObject 3)) + +\end{chunk} + +\defun{lnPlaceOfOrigin}{Line element 4; Place of origin} +\begin{chunk}{defun lnPlaceOfOrigin 0} +(defun |lnPlaceOfOrigin| (lineObject) (elt lineObject 4)) + +\end{chunk} + +\defun{lnImmediate?}{Line element 4: Is it a filename?} +\calls{lnImmediate?}{lnFileName?} +\begin{chunk}{defun lnImmediate? 0} +(defun |lnImmediate?| (lineObject) (null (|lnFileName?| lineObject))) + +\end{chunk} + +\defun{lnFileName?}{Line element 4: Is it a filename?} +\begin{chunk}{defun lnFileName? 0} +(defun |lnFileName?| (lineObject) + (let (filename) + (when (consp (setq filename (elt lineObject 4))) filename))) + +\end{chunk} + +\defun{lnFileName}{Line element 4; Get filename} +\calls{lnFileName}{lnFileName?} +\calls{lnFileName}{ncBug} +\begin{chunk}{defun lnFileName} +(defun |lnFileName| (lineObject) + (let (fN) + (if (setq fN (|lnFileName?| lineObject)) + fN + (|ncBug| "there is no file name in %1" (list lineObject))))) + +\end{chunk} + + +\section{Messages} + +\defun{msgCreate}{msgCreate} +\begin{verbatim} +msgObject + tag -- catagory of msg + -- attributes as a-list + 'imPr => dont save for list processing + toWhere, screen or file + 'norep => only display once in list + pos -- position with possible FROM/TO tag + key -- key for message database + argL -- arguments to be placed in the msg test + prefix -- things like "Error: " + text -- the actual text +\end{verbatim} +\calls{msgCreate}{setMsgForcedAttrList} +\calls{msgCreate}{putDatabaseStuff} +\calls{msgCreate}{initImPr} +\calls{msgCreate}{initToWhere} +\begin{chunk}{defun msgCreate} +(defun |msgCreate| (tag posWTag key argL optPre &rest optAttr) + (let (msg) + (when (consp key) (setq tag '|old|)) + (setq msg (list tag posWTag key argL optPre nil)) + (when (car optAttr) (|setMsgForcedAttrList| msg (car optAttr))) + (|putDatabaseStuff| msg) + (|initImPr| msg) + (|initToWhere| msg) + msg)) + +\end{chunk} + +\defmacro{getMsgPosTagOb} +\begin{chunk}{defmacro getMsgPosTagOb 0} +(defmacro |getMsgPosTagOb| (msg) + `(elt ,msg 1)) + +\end{chunk} + +\defmacro{getMsgKey} +\begin{chunk}{defmacro getMsgKey 0} +(defmacro |getMsgKey| (msg) + `(elt ,msg 2)) + +\end{chunk} + +\defmacro{getMsgArgL} +\begin{chunk}{defmacro getMsgArgL 0} +(defmacro |getMsgArgL| (msg) + `(elt ,msg 3)) + +\end{chunk} + +\defmacro{getMsgPrefix} +\begin{chunk}{defmacro getMsgPrefix 0} +(defmacro |getMsgPrefix| (msg) + `(elt ,msg 4)) + +\end{chunk} + +\defmacro{setMsgPrefix} +\begin{chunk}{defmacro setMsgPrefix 0} +(defmacro |setMsgPrefix| (msg val) + `(setf (elt ,msg 4) ,val)) + +\end{chunk} + +\defmacro{getMsgText} +\begin{chunk}{defmacro getMsgText 0} +(defmacro |getMsgText| (msg) + `(elt ,msg 5)) + +\end{chunk} + +\defmacro{setMsgText} +\begin{chunk}{defmacro setMsgText 0} +(defmacro |setMsgText| (msg val) + `(setf (elt ,msg 5) ,val)) + +\end{chunk} + +\defmacro{getMsgPrefix?} +\begin{chunk}{defmacro getMsgPrefix? 0} +(defmacro |getMsgPrefix?| (msg) + `(let ((pre (|getMsgPrefix| ,msg))) + (unless (eq pre '|noPre|) pre))) + +\end{chunk} + +\defmacro{getMsgTag} +The valid message tags are: +line, old, error, warn, bug, unimple, remark, stat, say, debug + +\calls{getMsgTag}{ncTag} +\begin{chunk}{defmacro getMsgTag 0} +(defmacro |getMsgTag| (msg) + `(|ncTag| ,msg)) + +\end{chunk} + +\defmacro{getMsgTag?} +\calls{getMsgTag?}{ifcar} +\calls{getMsgTag?}{getMsgTag} +\begin{chunk}{defmacro getMsgTag? 0} +(defmacro |getMsgTag?| (msg) + `(ifcar (member (|getMsgTag| ,msg) + (list '|line| '|old| '|error| '|warn| '|bug| + '|unimple| '|remark| '|stat| '|say| '|debug|)))) + +\end{chunk} + +\defmacro{line?} +\calls{line?}{getMsgTag} +\begin{chunk}{defmacro line?} +(defmacro |line?| (msg) + `(eq (|getMsgTag| ,msg) '|line|)) + +\end{chunk} + +\defmacro{leader?} +\calls{leader?}{getMsgTag} +\begin{chunk}{defmacro leader?} +(defmacro |leader?| (msg) + `(eq (|getMsgTag| ,msg) '|leader|)) + +\end{chunk} + +\defmacro{toScreen?} +\calls{toScreen?}{getMsgToWhere} +\begin{chunk}{defmacro toScreen?} +(defmacro |toScreen?| (msg) + `(not (eq (|getMsgToWhere| ,msg) '|fileOnly|))) + +\end{chunk} + +\defun{ncSoftError}{ncSoftError} +Messages for the USERS of the compiler. +The program being compiled has a minor error. +Give a message and continue processing. + +\calls{ncSoftError}{desiredMsg} +\calls{ncSoftError}{processKeyedError} +\calls{ncSoftError}{msgCreate} +\usesdollar{ncSoftError}{newcompErrorCount} +\begin{chunk}{defun ncSoftError} +(defun |ncSoftError| (pos erMsgKey erArgL &rest optAttr) + (declare (special |$newcompErrorCount|)) + (setq |$newcompErrorCount| (+ |$newcompErrorCount| 1)) + (when (|desiredMsg| erMsgKey) + (|processKeyedError| + (|msgCreate| '|error| pos erMsgKey erArgL + "Error" optAttr)))) + +\end{chunk} + +\defun{ncHardError}{ncHardError} +The program being compiled is seriously incorrect. +Give message and throw to a recovery point. + +\calls{ncHardError}{desiredMsg} +\calls{ncHardError}{processKeyedError} +\calls{ncHardError}{msgCreate} +\calls{ncHardError}{ncError} +\usesdollar{ncHardError}{newcompErrorCount} +\begin{chunk}{defun ncHardError} +(defun |ncHardError| (pos erMsgKey erArgL &rest optAttr) + (let (erMsg) + (declare (special |$newcompErrorCount|)) + (setq |$newcompErrorCount| (+ |$newcompErrorCount| 1)) + (if (|desiredMsg| erMsgKey) + (setq erMsg + (|processKeyedError| + (|msgCreate| '|error| pos erMsgKey erArgL "Error" optAttr))) + (|ncError|)))) + +\end{chunk} + +\defun{desiredMsg}{desiredMsg} +\begin{chunk}{defun desiredMsg 0} +(defun |desiredMsg| (erMsgKey &rest optCatFlag) + (declare (ignore erMsgKey)) + (cond + ((null (null optCatFlag)) (car optCatFlag)) + (t t))) + +\end{chunk} + +\defun{processKeyedError}{processKeyedError} +\calls{processKeyedError}{getMsgTag?} +\calls{processKeyedError}{getMsgKey} +\calls{processKeyedError}{getMsgPrefix?} +\calls{processKeyedError}{sayBrightly} +\calls{processKeyedError}{CallerName} +\calls{processKeyedError}{msgImPr?} +\calls{processKeyedError}{msgOutputter} +\usesdollar{processKeyedError}{ncMsgList} +\begin{chunk}{defun processKeyedError} +(defun |processKeyedError| (msg) + (prog (pre erMsg) + (declare (special |$ncMsgList|)) + (cond + ((eq (|getMsgTag?| msg) '|old|) + (setq erMsg (|getMsgKey| msg)) + (cond + ((setq pre (|getMsgPrefix?| msg)) + (setq erMsg (cons '|%b| (cons pre (cons '|%d| erMsg)))))) + (|sayBrightly| (cons "old msg from " (cons (|CallerName| 4) erMsg)))) + ((|msgImPr?| msg) (|msgOutputter| msg)) + (t (setq |$ncMsgList| (cons msg |$ncMsgList|)))))) + +\end{chunk} + +\defun{msgOutputter}{msgOutputter} +\calls{msgOutputter}{getStFromMsg} +\calls{msgOutputter}{leader?} +\calls{msgOutputter}{line?} +\calls{msgOutputter}{toScreen?} +\calls{msgOutputter}{flowSegmentedMsg} +\calls{msgOutputter}{sayBrightly} +\calls{msgOutputter}{toFile?} +\calls{msgOutputter}{alreadyOpened?} +\usesdollar{msgOutputter}{linelength} +\begin{chunk}{defun msgOutputter} +(defun |msgOutputter| (msg) + (let (alreadyOpened shouldFlow st) + (declare (special $linelength)) + (setq st (|getStFromMsg| msg)) + (setq shouldFlow (null (or (|leader?| msg) (|line?| msg)))) + (when (|toScreen?| msg) + (when shouldFlow (setq st (|flowSegmentedMsg| st $linelength 0))) + (|sayBrightly| st)) + (when (|toFile?| msg) + (when shouldFlow (setq st (|flowSegmentedMsg| st (- $linelength 6) 0))) + (setq alreadyOpened (|alreadyOpened?| msg))))) + +\end{chunk} + +\defun{listOutputter}{listOutputter} +\calls{listOutputter}{msgOutputter} +\begin{chunk}{defun listOutputter} +(defun |listOutputter| (outputList) + (dolist (msg outputList) + (|msgOutputter| msg))) + +\end{chunk} + +\defun{getStFromMsg}{getStFromMsg} +\calls{getStFromMsg}{getPreStL} +\calls{getStFromMsg}{getMsgPrefix?} +\calls{getStFromMsg}{getMsgTag} +\calls{getStFromMsg}{getMsgText} +\calls{getStFromMsg}{getPosStL} +\calls{getStFromMsg}{getMsgKey?} +\calls{getStFromMsg}{pname} +\calls{getStFromMsg}{getMsgLitSym} +\calls{getStFromMsg}{tabbing} +\begin{chunk}{defun getStFromMsg} +(defun |getStFromMsg| (msg) + (let (st posStL preStL) + (setq preStL (|getPreStL| (|getMsgPrefix?| msg))) + (cond + ((eq (|getMsgTag| msg) '|line|) + (cons "" + (cons "%x1" (append preStL (cons (|getMsgText| msg) nil))))) + (t + (setq posStL (|getPosStL| msg)) + (setq st + (cons posStL + (cons (|getMsgLitSym| msg) + (cons "" + (append preStL + (cons (|tabbing| msg) + (|getMsgText| msg))))))))))) + +\end{chunk} + +\defdollar{preLength} +\begin{chunk}{initvars} +(defvar |$preLength| 11) + +\end{chunk} + +\defun{getPreStL}{getPreStL} +\calls{getPreStL}{size} +\usesdollar{getPreStL}{preLength} +\begin{chunk}{defun getPreStL 0} +(defun |getPreStL| (optPre) + (let (spses extraPlaces) + (declare (special |$preLength|)) + (cond + ((null optPre) (list " ")) + (t + (setq spses + (cond + ((< 0 (setq extraPlaces (- (- |$preLength| (size optPre)) 3))) + (make-string extraPlaces)) + (t ""))) + (list '|%b| optPre spses ":" '|%d|))))) + +\end{chunk} + +\defun{getPosStL}{getPosStL} +\calls{getPosStL}{showMsgPos?} +\calls{getPosStL}{getMsgPos} +\calls{getPosStL}{msgImPr?} +\calls{getPosStL}{decideHowMuch} +\calls{getPosStL}{listDecideHowMuch} +\calls{getPosStL}{ppos} +\calls{getPosStL}{remLine} +\calls{getPosStL}{remFile} +\usesdollar{getPosStL}{lastPos} +\begin{chunk}{defun getPosStL} +(defun |getPosStL| (msg) + (let (printedOrigin printedLineNum printedFileName fullPrintedPos howMuch + msgPos) + (declare (special |$lastPos|)) + (cond + ((null (|showMsgPos?| msg)) "") + (t + (setq msgPos (|getMsgPos| msg)) + (setq howMuch + (if (|msgImPr?| msg) + (|decideHowMuch| msgPos |$lastPos|) + (|listDecideHowMuch| msgPos |$lastPos|))) + (setq |$lastPos| msgPos) + (setq fullPrintedPos (|ppos| msgPos)) + (setq printedFileName + (cons "%x2" (cons "[" (append (|remLine| fullPrintedPos) (cons "]" nil))))) + (setq printedLineNum + (cons "%x2" (cons "[" (append (|remFile| fullPrintedPos) (cons "]" nil))))) + (setq printedOrigin + (cons "%x2" (cons "[" (append fullPrintedPos (cons "]" nil))))) + (cond + ((eq howMuch 'org) + (cons "" (append printedOrigin (cons '|%l| nil)))) + ((eq howMuch 'line) + (cons "" (append printedLineNum (cons '|%l| nil)))) + ((eq howMuch 'file) + (cons "" (append printedFileName (cons '|%l| nil)))) + ((eq howMuch 'all) + (cons "" + (append printedFileName + (cons '|%l| + (cons "" + (append printedLineNum + (cons '|%l| nil))))))) + (t "")))))) + +\end{chunk} + +\defun{ppos}{ppos} +\calls{ppos}{pfNoPosition?} +\calls{ppos}{pfImmediate?} +\calls{ppos}{pfCharPosn} +\calls{ppos}{pfLinePosn} +\calls{ppos}{porigin} +\calls{ppos}{pfFileName} +\begin{chunk}{defun ppos} +(defun |ppos| (p) + (let (org lpos cpos) + (cond + ((|pfNoPosition?| p) (list "no position")) + ((|pfImmediate?| p) (list "console")) + (t + (setq cpos (|pfCharPosn| p)) + (setq lpos (|pfLinePosn| p)) + (setq org (|porigin| (|pfFileName| p))) + (list org " " "line" " " lpos))))) + +\end{chunk} + +\defun{remFile}{remFile} +\calls{remFile}{ifcdr} +\calls{remLine}{ifcar} +\begin{chunk}{defun remFile} +(defun |remFile| (positionList) (ifcdr (ifcdr positionList))) + +\end{chunk} + +\defun{showMsgPos?}{showMsgPos?} +\calls{showMsgPos?}{msgImPr?} +\calls{showMsgPos?}{leader?} +\usesdollar{showMsgPos?}{erMsgToss} +\begin{chunk}{defun showMsgPos? 0} +(defun |showMsgPos?| (msg) + (declare (special |$erMsgToss|)) + (or |$erMsgToss| (and (null (|msgImPr?| msg)) (null (|leader?| msg))))) + +\end{chunk} + +\defdollar{imPrGuys} +\begin{chunk}{initvars} +(defvar |$imPrGuys| (list '|imPr|)) + +\end{chunk} + +\defun{msgImPr?}{msgImPr?} +\calls{msgImPr?}{getMsgCatAttr} +\begin{chunk}{defun msgImPr?} +(defun |msgImPr?| (msg) + (eq (|getMsgCatAttr| msg '|$imPrGuys|) '|imPr|)) + +\end{chunk} + +\defun{getMsgCatAttr}{getMsgCatAttr} +\calls{getMsgCatAttr}{ifcdr} +\calls{getMsgCatAttr}{qassq} +\calls{getMsgCatAttr}{ncAlist} +\begin{chunk}{defun getMsgCatAttr} +(defun |getMsgCatAttr| (msg cat) + (ifcdr (qassq cat (|ncAlist| msg)))) + +\end{chunk} + +\defun{getMsgPos}{getMsgPos} +\calls{getMsgPos}{getMsgFTTag?} +\calls{getMsgPos}{getMsgPosTagOb} +\begin{chunk}{defun getMsgPos} +(defun |getMsgPos| (msg) + (if (|getMsgFTTag?| msg) + (cadr (|getMsgPosTagOb| msg)) + (|getMsgPosTagOb| msg))) + +\end{chunk} + +\defun{getMsgFTTag?}{getMsgFTTag?} +\calls{getMsgFTTag?}{ifcar} +\calls{getMsgFTTag?}{getMsgPosTagOb} +\begin{chunk}{defun getMsgFTTag?} +(defun |getMsgFTTag?| (msg) + (ifcar (member (ifcar (|getMsgPosTagOb| msg)) (list 'from 'to 'fromto)))) + +\end{chunk} + +\defun{decideHowMuch}{decideHowMuch} +When printing a msg, we wish not to show pos information that was +shown for a previous msg with identical pos info. +org prints out the word noposition or console +\calls{decideHowMuch}{poNopos?} +\calls{decideHowMuch}{poPosImmediate?} +\calls{decideHowMuch}{poFileName} +\calls{decideHowMuch}{poLinePosn} +\begin{chunk}{defun decideHowMuch} +(defun |decideHowMuch| (pos oldPos) + (cond + ((or (and (|poNopos?| pos) (|poNopos?| oldPos)) + (and (|poPosImmediate?| pos) (|poPosImmediate?| oldPos))) + 'none) + ((or (|poNopos?| pos) (|poPosImmediate?| pos)) 'org) + ((or (|poNopos?| oldPos) (|poPosImmediate?| oldPos)) 'all) + ((not (equal (|poFileName| oldPos) (|poFileName| pos))) 'all) + ((not (equal (|poLinePosn| oldPos) (|poLinePosn| pos))) 'line) + (t 'none))) + +\end{chunk} + +\defun{poNopos?}{poNopos?} +\begin{chunk}{defun poNopos? 0} +(defun |poNopos?| (posn) + (equal posn (list '|noposition|))) + +\end{chunk} + +\defun{poPosImmediate?}{poPosImmediate?} +\calls{poPosImmediate?}{poNopos?} +\calls{poPosImmediate?}{lnImmediate?} +\calls{poPosImmediate?}{poGetLineObject} +\begin{chunk}{defun poPosImmediate?} +(defun |poPosImmediate?| (txp) + (unless (|poNopos?| txp) (|lnImmediate?| (|poGetLineObject| txp)))) + +\end{chunk} + +\defun{poFileName}{poFileName} +\calls{poFileName}{lnFileName} +\calls{poFileName}{poGetLineObject} +\begin{chunk}{defun poFileName} +(defun |poFileName| (posn) + (if posn + (|lnFileName| (|poGetLineObject| posn)) + (caar posn))) + +\end{chunk} + +\defun{poGetLineObject}{poGetLineObject} +\begin{chunk}{defun poGetLineObject 0} +(defun |poGetLineObject| (posn) + (car posn)) + +\end{chunk} + +\defun{poLinePosn}{poLinePosn} +\calls{poLinePosn}{lnLocalNum} +\calls{poLinePosn}{poGetLineObject} +\begin{chunk}{defun poLinePosn} +(defun |poLinePosn| (posn) + (if posn + (|lnLocalNum| (|poGetLineObject| posn)) + (cdar posn))) + +\end{chunk} + +\defun{listDecideHowMuch}{listDecideHowMuch} +\calls{listDecideHowMuch}{poNopos?} +\calls{listDecideHowMuch}{poPosImmediate?} +\calls{listDecideHowMuch}{poGlobalLinePosn} +\begin{chunk}{defun listDecideHowMuch} +(defun |listDecideHowMuch| (pos oldPos) + (cond + ((or (and (|poNopos?| pos) (|poNopos?| oldPos)) + (and (|poPosImmediate?| pos) (|poPosImmediate?| oldPos))) + 'none) + ((|poNopos?| pos) 'org) + ((|poNopos?| oldPos) 'none) + ((< (|poGlobalLinePosn| pos) (|poGlobalLinePosn| oldPos)) + (if (|poPosImmediate?| pos) 'org 'line)) + (t 'none))) + +\end{chunk} + +\defun{remLine}{remLine} +\begin{chunk}{defun remLine 0} +(defun |remLine| (positionList) (list (ifcar positionList))) + +\end{chunk} + +\defun{getMsgKey?}{getMsgKey?} +\calls{getMsgKey?}{identp} +\begin{chunk}{defun getMsgKey? 0} +(defun |getMsgKey?| (msg) + (let ((val (|getMsgKey| msg))) + (when (identp val) val))) + +\end{chunk} + +\defun{getMsgLitSym}{getMsgLitSym} +\calls{getMsgLitSym}{getMsgKey?} +\begin{chunk}{defun getMsgLitSym} +(defun |getMsgLitSym| (msg) + (if (|getMsgKey?| msg) " " "*")) + +\end{chunk} + +\defun{tabbing}{tabbing} +\calls{tabbing}{getMsgPrefix?} +\usesdollar{tabbing}{preLength} +\begin{chunk}{defun tabbing} +(defun |tabbing| (msg) + (let (chPos) + (declare (special |$preLength|)) + (setq chPos 2) + (when (|getMsgPrefix?| msg) (setq chPos (- (+ chPos |$preLength|) 1))) + (cons '|%t| chPos))) + +\end{chunk} + +\defdollar{toWhereGuys} +\begin{chunk}{initvars} +(defvar |$toWhereGuys| (list '|fileOnly| '|screenOnly|)) + +\end{chunk} + +\defun{getMsgToWhere}{getMsgToWhere} +\calls{getMsgToWhere}{getMsgCatAttr} +\begin{chunk}{defun getMsgToWhere} +(defun |getMsgToWhere| (msg) (|getMsgCatAttr| msg '|$toWhereGuys|)) + +\end{chunk} + +\defun{toFile?}{toFile?} +\calls{toFile?}{getMsgToWhere} +\usesdollar{toFile?}{fn} +\begin{chunk}{defun toFile?} +(defun |toFile?| (msg) + (and (not (eq (|getMsgToWhere| msg) '|screenOnly|)))) + +\end{chunk} + +\defun{alreadyOpened?}{alreadyOpened?} +\calls{alreadyOpened?}{msgImPr?} +\begin{chunk}{defun alreadyOpened?} +(defun |alreadyOpened?| (msg) (null (|msgImPr?| msg))) + +\end{chunk} + +\defun{setMsgForcedAttrList}{setMsgForcedAttrList} +\calls{setMsgForcedAttrList}{setMsgForcedAttr} +\calls{setMsgForcedAttrList}{whichCat} +\begin{chunk}{defun setMsgForcedAttrList} +(defun |setMsgForcedAttrList| (msg attrlist) + (dolist (attr attrlist) + (|setMsgForcedAttr| msg (|whichCat| attr) attr))) + +\end{chunk} + +\defun{setMsgForcedAttr}{setMsgForcedAttr} +\calls{setMsgForcedAttr}{setMsgCatlessAttr} +\calls{setMsgForcedAttr}{ncPutQ} +\begin{chunk}{defun setMsgForcedAttr} +(defun |setMsgForcedAttr| (msg cat attr) + (if (eq cat '|catless|) + (|setMsgCatlessAttr| msg attr) + (|ncPutQ| msg cat attr))) + +\end{chunk} + +\defdollar{attrCats} +\begin{chunk}{initvars} +(defvar |$attrCats| (list '|$imPrGuys| '|$toWhereGuys| '|$repGuys|)) + +\end{chunk} + +\defun{whichCat}{whichCat} +\calls{whichCat}{ListMember?} +\usesdollar{whichCat}{attrCats} +\begin{chunk}{defun whichCat} +(defun |whichCat| (attr) + (let ((found '|catless|) done) + (declare (special |$attrCats|)) + (loop for cat in |$attrCats| do + (when (|ListMember?| attr (eval cat)) + (setq found cat) + (setq done t)) + until done) + found)) + +\end{chunk} + +\defun{setMsgCatlessAttr}{setMsgCatlessAttr} +\tpdhere{Changed from |catless| to '|catless|} + +\calls{setMsgCatlessAttr}{ncPutQ} +\calls{setMsgCatlessAttr}{ifcdr} +\calls{setMsgCatlessAttr}{qassq} +\calls{setMsgCatlessAttr}{ncAlist} +\begin{chunk}{defun setMsgCatlessAttr} +(defun |setMsgCatlessAttr| (msg attr) + (|ncPutQ| msg catless (cons attr (ifcdr (qassq catless (|ncAlist| msg)))))) + +\end{chunk} + +\defun{putDatabaseStuff}{putDatabaseStuff} +\tpdhere{The variable al is undefined} +\calls{putDatabaseStuff}{getMsgInfoFromKey} +\calls{putDatabaseStuff}{setMsgUnforcedAttrList} +\calls{putDatabaseStuff}{setMsgText} +\begin{chunk}{defun putDatabaseStuff} +(defun |putDatabaseStuff| (msg) + (let (attributes text tmp) + (setq tmp (|getMsgInfoFromKey| msg)) + (setq text (car tmp)) + (setq attributes (cadr tmp)) + (when attributes (|setMsgUnforcedAttrList| msg attributes)) + (|setMsgText| msg text))) + +\end{chunk} + +\defun{getMsgInfoFromKey}{getMsgInfoFromKey} +\calls{getMsgInfoFromKey}{getMsgKey?} +\calls{getMsgInfoFromKey}{getErFromDbL} +\calls{getMsgInfoFromKey}{getMsgKey} +\calls{getMsgInfoFromKey}{segmentKeyedMsg} +\calls{getMsgInfoFromKey}{removeAttributes} +\calls{getMsgInfoFromKey}{substituteSegmentedMsg} +\calls{getMsgInfoFromKey}{getMsgArgL} +\usesdollar{getMsgInfoFromKey}{msgDatabaseName} +\begin{chunk}{defun getMsgInfoFromKey} +(defun |getMsgInfoFromKey| (msg) + (let (|$msgDatabaseName| attributes tmp msgText msgKey) + (declare (special |$msgDatabaseName|)) + (setq |$msgDatabaseName| nil) + (setq msgText + (cond + ((setq msgKey (|getMsgKey?| msg)) + (|fetchKeyedMsg| msgKey nil)) + (t (|getMsgKey| msg)))) + (setq msgText (|segmentKeyedMsg| msgText)) + (setq tmp (|removeAttributes| msgText)) + (setq msgText (car tmp)) + (setq attributes (cadr tmp)) + (setq msgText (|substituteSegmentedMsg| msgText (|getMsgArgL| msg))) + (list msgText attributes))) + +\end{chunk} + +\defun{setMsgUnforcedAttrList}{setMsgUnforcedAttrList} +\calls{setMsgUnforcedAttrList}{setMsgUnforcedAttr} +\calls{setMsgUnforcedAttrList}{whichCat} +\begin{chunk}{defun setMsgUnforcedAttrList} +(defun |setMsgUnforcedAttrList| (msg attrlist) + (dolist (attr attrlist) + (|setMsgUnforcedAttr| msg (|whichCat| attr) attr))) + +\end{chunk} + +\defun{setMsgUnforcedAttr}{setMsgUnforcedAttr} +\calls{setMsgUnforcedAttr}{setMsgCatlessAttr} +\calls{setMsgUnforcedAttr}{qassq} +\calls{setMsgUnforcedAttr}{ncAlist} +\calls{setMsgUnforcedAttr}{ncPutQ} +\begin{chunk}{defun setMsgUnforcedAttr} +(defun |setMsgUnforcedAttr| (msg cat attr) + (cond + ((eq cat '|catless|) (|setMsgCatlessAttr| msg attr)) + ((null (qassq cat (|ncAlist| msg))) (|ncPutQ| msg cat attr)))) + +\end{chunk} + +\defdollar{imPrTagGuys} +\begin{chunk}{initvars} +(defvar |$imPrTagGuys| (list '|unimple| '|bug| '|debug| '|say| '|warn|)) + +\end{chunk} + +\defun{initImPr}{initImPr} +\calls{initImPr}{getMsgTag} +\calls{initImPr}{setMsgUnforcedAttr} +\usesdollar{initImPr}{imPrTagGuys} +\usesdollar{initImPr}{erMsgToss} +\begin{chunk}{defun initImPr} +(defun |initImPr| (msg) + (declare (special |$imPrTagGuys| |$erMsgToss|)) + (when (or |$erMsgToss| (member (|getMsgTag| msg) |$imPrTagGuys|)) + (|setMsgUnforcedAttr| msg '|$imPrGuys| '|imPr|))) + +\end{chunk} + +\defun{initToWhere}{initToWhere} +\calls{initToWhere}{getMsgCatAttr} +\calls{initToWhere}{setMsgUnforcedAttr} +\begin{chunk}{defun initToWhere} +(defun |initToWhere| (msg) + (if (member '|trace| (|getMsgCatAttr| msg '|catless|)) + (|setMsgUnforcedAttr| msg '|$toWhereGuys| '|screenOnly|))) + +\end{chunk} + +\defun{ncBug}{Report a bug in the compiler} +Bug in the compiler: something which shouldn't have happened did. + +\calls{ncBug}{processKeyedError} +\calls{ncBug}{msgCreate} +\calls{ncBug}{enable-backtrace} +\calls{ncBug}{ncAbort} +\usesdollar{ncBug}{nopos} +\usesdollar{ncBug}{newcompErrorCount} +\begin{chunk}{defun ncBug} +(defun |ncBug| (erMsgKey erArgL &rest optAttr) + (let (erMsg) + (declare (special |$nopos| |$newcompErrorCount|)) + (setq |$newcompErrorCount| (+ |$newcompErrorCount| 1)) + (setq erMsg + (|processKeyedError| + (|msgCreate| '|bug| |$nopos| erMsgKey erArgL "Bug!" optAttr))) + (break) + (|ncAbort|))) + +\end{chunk} + +\defun{processMsgList}{processMsgList} +\calls{processMsgList}{erMsgSort} +\calls{processMsgList}{makeMsgFromLine} +\calls{processMsgList}{poGlobalLinePosn} +\calls{processMsgList}{getMsgPos} +\calls{processMsgList}{queueUpErrors} +\calls{processMsgList}{listOutputter} +\usesdollar{processMsgList}{noRepList} +\usesdollar{processMsgList}{outputList} +\begin{chunk}{defun processMsgList} +(defun |processMsgList| (erMsgList lineList) + (let (|$noRepList| |$outputList| st globalNumOfLine msgLine) + (declare (special |$noRepList| |$outputList|)) + (setq |$outputList| nil) + (setq |$noRepList| nil) + (setq erMsgList (|erMsgSort| erMsgList)) + (dolist (line lineList) + (setq msgLine (|makeMsgFromLine| line)) + (setq |$outputList| (cons msgLine |$outputList|)) + (setq globalNumOfLine (|poGlobalLinePosn| (|getMsgPos| msgLine))) + (setq erMsgList (|queueUpErrors| globalNumOfLine erMsgList))) + (setq |$outputList| (append erMsgList |$outputList|)) + (setq st "---------SOURCE-TEXT-&-ERRORS------------------------") + (|listOutputter| (reverse |$outputList|)))) + +\end{chunk} + +\defun{erMsgSort}{erMsgSort} +\calls{erMsgSort}{erMsgSep} +\calls{erMsgSort}{listSort} +\begin{chunk}{defun erMsgSort} +(defun |erMsgSort| (erMsgList) + (let (msgWOPos msgWPos tmp) + (setq tmp (|erMsgSep| erMsgList)) + (setq msgWPos (car tmp)) + (setq msgWOPos (cadr tmp)) + (setq msgWPos (|listSort| #'|erMsgCompare| msgWPos)) + (setq msgWOPos (reverse msgWOPos)) + (append msgWPos msgWOPos))) + +\end{chunk} + +\defun{erMsgCompare}{erMsgCompare} +\calls{erMsgCompare}{compareposns} +\calls{erMsgCompare}{getMsgPos} +\begin{chunk}{defun erMsgCompare} +(defun |erMsgCompare| (ob1 ob2) + (|compareposns| (|getMsgPos| ob2) (|getMsgPos| ob1))) + +\end{chunk} + +\defun{compareposns}{compareposns} +\calls{compareposns}{poGlobalLinePosn} +\calls{compareposns}{poCharPosn} +\begin{chunk}{defun compareposns} +(defun |compareposns| (a b) + (let (c d) + (setq c (|poGlobalLinePosn| a)) + (setq d (|poGlobalLinePosn| b)) + (if (equal c d) + (not (< (|poCharPosn| a) (|poCharPosn| b))) + (not (< c d))))) + +\end{chunk} + +\defun{erMsgSep}{erMsgSep} +\calls{erMsgSep}{poNopos?} +\calls{erMsgSep}{getMsgPos} +\begin{chunk}{defun erMsgSep} +(defun |erMsgSep| (erMsgList) + (let (msgWOPos msgWPos) + (dolist (msg erMsgList) + (if (|poNopos?| (|getMsgPos| msg)) + (setq msgWOPos (cons msg msgWOPos)) + (setq msgWPos (cons msg msgWPos)))) + (list msgWPos msgWOPos))) + +\end{chunk} + +\defun{makeMsgFromLine}{makeMsgFromLine} +\calls{makeMsgFromLine}{getLinePos} +\calls{makeMsgFromLine}{getLineText} +\calls{makeMsgFromLine}{poGlobalLinePosn} +\calls{makeMsgFromLine}{poLinePosn} +\calls{makeMsgFromLine}{strconc} +\calls{makeMsgFromLine}{rep} +\calls{makeMsgFromLine}{char} +\calls{makeMsgFromLine}{size} +\usesdollar{makeMsgFromLine}{preLength} +\begin{chunk}{defun makeMsgFromLine} +(defun |makeMsgFromLine| (line) + (let (localNumOfLine stNum globalNumOfLine textOfLine posOfLine) + (declare (special |$preLength|)) + (setq posOfLine (|getLinePos| line)) + (setq textOfLine (|getLineText| line)) + (setq globalNumOfLine (|poGlobalLinePosn| posOfLine)) + (setq stNum (princ-to-string (|poLinePosn| posOfLine))) + (setq localNumOfLine + (strconc (|rep| #\space (- |$preLength| 7 (size stNum))) stNum)) + (list '|line| posOfLine nil nil (strconc "Line" localNumOfLine) textOfLine))) + +\end{chunk} + +\defun{rep}{rep} +\tpdhere{This function should be replaced by fillerspaces} +\begin{chunk}{defun rep 0} +(defun |rep| (c n) + (if (< 0 n) + (make-string n :initial-element (character c)) + "")) + +\end{chunk} + +\defun{getLinePos}{getLinePos} +\begin{chunk}{defun getLinePos 0} +(defun |getLinePos| (line) (car line)) + +\end{chunk} + +\defun{getLineText}{getLineText} +\begin{chunk}{defun getLineText 0} +(defun |getLineText| (line) (cdr line)) + +\end{chunk} + +\defun{queueUpErrors}{queueUpErrors} +\begin{verbatim} +;queueUpErrors(globalNumOfLine,msgList)== +; thisPosMsgs := [] +; notThisLineMsgs := [] +; for msg in msgList _ +; while thisPosIsLess(getMsgPos msg,globalNumOfLine) repeat +; --these are msgs that refer to positions from earlier compilations +; if not redundant (msg,notThisPosMsgs) then +; notThisPosMsgs := [msg,:notThisPosMsgs] +; msgList := rest msgList +; for msg in msgList _ +; while thisPosIsEqual(getMsgPos msg,globalNumOfLine) repeat +; if not redundant (msg,thisPosMsgs) then +; thisPosMsgs := [msg,:thisPosMsgs] +; msgList := rest msgList +; if thisPosMsgs then +; thisPosMsgs := processChPosesForOneLine thisPosMsgs +; $outputList := NCONC(thisPosMsgs,$outputList) +; if notThisPosMsgs then +; $outputList := NCONC(notThisPosMsgs,$outputList) +; msgList +\end{verbatim} +\calls{queueUpErrors}{processChPosesForOneLine} +\usesdollar{queueUpErrors}{outputList} +\begin{chunk}{defun queueUpErrors} +(DEFUN |queueUpErrors| (|globalNumOfLine| |msgList|) + (PROG (|notThisPosMsgs| |notThisLineMsgs| |thisPosMsgs|) + (DECLARE (SPECIAL |$outputList|)) + (RETURN + (PROGN + (SETQ |thisPosMsgs| NIL) + (SETQ |notThisLineMsgs| NIL) + ((LAMBDA (|bfVar#7| |msg|) + (LOOP + (COND + ((OR (ATOM |bfVar#7|) + (PROGN (SETQ |msg| (CAR |bfVar#7|)) NIL) + (NOT (|thisPosIsLess| (|getMsgPos| |msg|) + |globalNumOfLine|))) + (RETURN NIL)) + ('T + (PROGN + (COND + ((NULL (|redundant| |msg| |notThisPosMsgs|)) + (SETQ |notThisPosMsgs| + (CONS |msg| |notThisPosMsgs|)))) + (SETQ |msgList| (CDR |msgList|))))) + (SETQ |bfVar#7| (CDR |bfVar#7|)))) + |msgList| NIL) + ((LAMBDA (|bfVar#8| |msg|) + (LOOP + (COND + ((OR (ATOM |bfVar#8|) + (PROGN (SETQ |msg| (CAR |bfVar#8|)) NIL) + (NOT (|thisPosIsEqual| (|getMsgPos| |msg|) + |globalNumOfLine|))) + (RETURN NIL)) + ('T + (PROGN + (COND + ((NULL (|redundant| |msg| |thisPosMsgs|)) + (SETQ |thisPosMsgs| (CONS |msg| |thisPosMsgs|)))) + (SETQ |msgList| (CDR |msgList|))))) + (SETQ |bfVar#8| (CDR |bfVar#8|)))) + |msgList| NIL) + (COND + (|thisPosMsgs| + (SETQ |thisPosMsgs| + (|processChPosesForOneLine| |thisPosMsgs|)) + (SETQ |$outputList| (NCONC |thisPosMsgs| |$outputList|)))) + (COND + (|notThisPosMsgs| + (SETQ |$outputList| + (NCONC |notThisPosMsgs| |$outputList|)))) + |msgList|)))) + +\end{chunk} + +\defun{thisPosIsLess}{thisPosIsLess} +\calls{thisPosIsLess}{poNopos?} +\calls{thisPosIsLess}{poGlobalLinePosn} +\begin{chunk}{defun thisPosIsLess} +(defun |thisPosIsLess| (pos num) + (unless (|poNopos?| pos) (< (|poGlobalLinePosn| pos) num))) + +\end{chunk} + +\defun{thisPosIsEqual}{thisPosIsEqual} +\calls{thisPosIsEqual}{poNopos?} +\calls{thisPosIsEqual}{poGlobalLinePosn} +\begin{chunk}{defun thisPosIsEqual} +(defun |thisPosIsEqual| (pos num) + (unless (|poNopos?| pos) (equal (|poGlobalLinePosn| pos) num))) + +\end{chunk} + +\defun{redundant}{redundant} +\begin{verbatim} +redundant(msg,thisPosMsgs) == + found := NIL + if msgNoRep? msg then + for item in $noRepList repeat + sameMsg?(msg,item) => return (found := true) + $noRepList := [msg,$noRepList] + found or MEMBER(msg,thisPosMsgs) +\end{verbatim} +\calls{redundant}{msgNoRep?} +\calls{redundant}{sameMsg?} +\usesdollar{redundant}{noRepList} +\begin{chunk}{defun redundant} +(defun |redundant| (msg thisPosMsgs) + (prog (found) + (declare (special |$noRepList|)) + (return + (progn + (cond + ((|msgNoRep?| msg) + ((lambda (Var9 item) + (loop + (cond + ((or (atom Var9) (progn (setq item (car Var9)) nil)) + (return nil)) + (t + (cond + ((|sameMsg?| msg item) (return (setq found t)))))) + (setq Var9 (cdr Var9)))) + |$noRepList| nil) + (setq |$noRepList| (list msg |$noRepList|)))) + (or found (member msg thisPosMsgs)))))) + +\end{chunk} + +\defdollar{repGuys} +\begin{chunk}{initvars} +(defvar |$repGuys| (list '|noRep| '|rep|)) + +\end{chunk} + +\defun{msgNoRep?}{msgNoRep?} +\calls{msgNoRep?}{getMsgCatAttr} +\begin{chunk}{defun msgNoRep?} +(defun |msgNoRep?| (msg) (eq (|getMsgCatAttr| msg '|$repGuys|) '|noRep|)) + +\end{chunk} + +\defun{sameMsg?}{sameMsg?} +\calls{sameMsg?}{getMsgKey} +\calls{sameMsg?}{getMsgArgL} +\begin{chunk}{defun sameMsg?} +(defun |sameMsg?| (msg1 msg2) + (and (equal (|getMsgKey| msg1) (|getMsgKey| msg2)) + (equal (|getMsgArgL| msg1) (|getMsgArgL| msg2)))) + +\end{chunk} + +\defun{processChPosesForOneLine}{processChPosesForOneLine} +\calls{processChPosesForOneLine}{posPointers} +\calls{processChPosesForOneLine}{getMsgFTTag?} +\calls{processChPosesForOneLine}{putFTText} +\calls{processChPosesForOneLine}{poCharPosn} +\calls{processChPosesForOneLine}{getMsgPos} +\calls{processChPosesForOneLine}{getMsgPrefix} +\calls{processChPosesForOneLine}{setMsgPrefix} +\calls{processChPosesForOneLine}{strconc} +\calls{processChPosesForOneLine}{size} +\calls{processChPosesForOneLine}{makeLeaderMsg} +\usesdollar{processChPosesForOneLine}{preLength} +\begin{chunk}{defun processChPosesForOneLine} +(defun |processChPosesForOneLine| (msgList) + (let (leaderMsg oldPre posLetter chPosList) + (declare (special |$preLength|)) + (setq chPosList (|posPointers| msgList)) + (dolist (msg msgList) + (when (|getMsgFTTag?| msg) (|putFTText| msg chPosList)) + (setq posLetter (cdr (assoc (|poCharPosn| (|getMsgPos| msg)) chPosList))) + (setq oldPre (|getMsgPrefix| msg)) + (|setMsgPrefix| msg + (strconc oldPre + (make-string (- |$preLength| 4 (size oldPre))) posLetter))) + (setq leaderMsg (|makeLeaderMsg| chPosList)) + (nconc msgList (list leaderMsg)))) + +\end{chunk} + +\defun{poCharPosn}{poCharPosn} +\begin{chunk}{defun poCharPosn 0} +(defun |poCharPosn| (posn) + (cdr posn)) + +\end{chunk} + +\defun{makeLeaderMsg}{makeLeaderMsg} +\begin{verbatim} +makeLeaderMsg chPosList == + st := MAKE_-FULL_-CVEC ($preLength- 3) + oldPos := -1 + for [posNum,:posLetter] in reverse chPosList repeat + st := STRCONC(st, _ + rep(char ".", (posNum - oldPos - 1)),posLetter) + oldPos := posNum + ['leader,$nopos,'nokey,NIL,NIL,[st] ] +\end{verbatim} +\usesdollar{makeLeaderMsg}{nopos} +\usesdollar{makeLeaderMsg}{preLength} +\begin{chunk}{defun makeLeaderMsg} +(defun |makeLeaderMsg| (chPosList) + (let (posLetter posNum oldPos st) + (declare (special |$nopos| |$preLength|)) + (setq st (make-string (- |$preLength| 3))) + (setq oldPos -1) + ((lambda (Var15 Var14) + (loop + (cond + ((or (atom Var15) (progn (setq Var14 (car Var15)) nil)) + (return nil)) + (t + (and (consp Var14) + (progn + (setq posNum (car Var14)) + (setq posLetter (cdr Var14)) + t) + (progn + (setq st + (strconc st (|rep| #\. (- posNum oldPos 1)) posLetter)) + (setq oldPos posNum))))) + (setq Var15 (cdr Var15)))) + (reverse chPosList) nil) + (list '|leader| |$nopos| '|nokey| nil nil (list st)))) + +\end{chunk} + +\defun{posPointers}{posPointers} +\tpdhere{getMsgFTTag is nonsense} + +\calls{posPointers}{poCharPosn} +\calls{posPointers}{getMsgPos} +\calls{posPointers}{ifcar} +\calls{posPointers}{getMsgPos2} +\calls{posPointers}{insertPos} +\uses{posPointers}{getMsgFTTag} +\begin{chunk}{defun posPointers} +(defun |posPointers| (msgList) + (let (posLetterList pos ftPosList posList increment pointers) + (declare (special |getMsgFTTag|)) + (setq pointers "ABCDEFGHIJKLMONPQRS") + (setq increment 0) + (dolist (msg msgList) + (setq pos (|poCharPosn| (|getMsgPos| msg))) + (unless (equal pos (ifcar posList)) + (setq posList (cons pos posList))) + ; this should probably read TPDHERE + ; (when (eq (|getMsgPosTagOb| msg) 'fromto)) + (when (eq |getMsgFTTag| 'fromto) + (setq ftPosList (cons (|poCharPosn| (|getMsgPos2| msg)) ftPosList)))) + (dolist (toPos ftPosList) + (setq posList (|insertPos| toPos posList))) + (dolist (pos posList) + (setq posLetterList + (cons (cons pos (elt pointers increment)) posLetterList)) + (setq increment (+ increment 1))) + posLetterList)) + +\end{chunk} + +\defun{getMsgPos2}{getMsgPos2} +\calls{getMsgPos2}{getMsgFTTag?} +\calls{getMsgPos2}{getMsgPosTagOb} +\calls{getMsgPos2}{ncBug} +\begin{chunk}{defun getMsgPos2} +(defun |getMsgPos2| (msg) + (if (|getMsgFTTag?| msg) + (caddr (|getMsgPosTagOb| msg)) + (|ncBug| "not a from to" nil))) + +\end{chunk} + +\defun{insertPos}{insertPos} +This function inserts a position in the proper place of a position list. +This is used for the 2nd pos of a fromto +\calls{insertPos}{done} +\begin{chunk}{defun insertPos 0} +(defun |insertPos| (newPos posList) + (let (pos top bot done) + (setq bot (cons 0 posList)) + (do () (done) + (setq top (cons (car bot) top)) + (setq bot (cdr bot)) + (setq pos (car bot)) + (setq done + (cond + ((< pos newPos) nil) + ((equal pos newPos) t) + ((< newPos pos) + (setq top (cons newPos top)) + t)))) + (cons (cdr (reverse top)) bot))) + +\end{chunk} + +\defun{putFTText}{putFTText} +\calls{putFTText}{getMsgFTTag?} +\calls{putFTText}{poCharPosn} +\calls{putFTText}{getMsgPos} +\calls{putFTText}{setMsgText} +\calls{putFTText}{getMsgText} +\calls{putFTText}{getMsgPos2} +\begin{chunk}{defun putFTText} +(defun |putFTText| (msg chPosList) + (let (charMarker2 pos2 markingText charMarker pos tag) + (setq tag (|getMsgFTTag?| msg)) + (setq pos (|poCharPosn| (|getMsgPos| msg))) + (setq charMarker (cdr (assoc pos chPosList))) + (cond + ((eq tag 'from) + (setq markingText (list "(from " charMarker " and on) ")) + (|setMsgText| msg (append markingText (|getMsgText| msg)))) + ((eq tag 'to) + (setq markingText (list "(up to " charMarker ") ")) + (|setMsgText| msg (append markingText (|getMsgText| msg)))) + ((eq tag 'fromto) + (setq pos2 (|poCharPosn| (|getMsgPos2| msg))) + (setq charMarker2 (cdr (assoc pos2 chPosList))) + (setq markingText (list "(from " charMarker " up to " charMarker2 ") ")) + (|setMsgText| msg (append markingText (|getMsgText| msg))))))) + +\end{chunk} + +\defun{From}{From} +This is called from parameter list of nc message functions +\begin{chunk}{defun From 0} +(defun |From| (pos) (list 'from pos)) + +\end{chunk} + +\defun{To}{To} +This is called from parameter list of nc message functions +\begin{chunk}{defun To 0} +(defun |To| (pos) (list 'to pos)) + +\end{chunk} + +\defun{FromTo}{FromTo} +This is called from parameter list of nc message functions +\begin{chunk}{defun FromTo 0} +(defun |FromTo| (pos1 pos2) (list 'fromto pos1 pos2)) + +\end{chunk} + +\chapter{The Interpreter Syntax} +\section{syntax assignment} +\label{assignment} +\index{assignment} +\index{syntax!assignment} +\index{assignment!syntax} +\begin{chunk}{assignment.help} + +Immediate, Delayed, and Multiple Assignment + +==================================================================== +Immediate Assignment +==================================================================== + +A variable in Axiom refers to a value. A variable has a name beginning +with an uppercase or lowercase alphabetic character, "%", or "!". +Successive characters (if any) can be any of the above, digits, or "?". +Case is distinguished. The following are all examples of valid, distinct +variable names: + + a tooBig? a1B2c3%!? + A %j numberOfPoints + beta6 %J numberofpoints + +The ":=" operator is the immediate assignment operator. Use it to +associate a value with a variable. The syntax for immediate assignment +for a single variable is: + + variable := expression + +The value returned by an immediate assignment is the value of expression. + + a := 1 + 1 + Type: PositiveInteger + +The right-hand side of the expression is evaluated, yielding 1. The value +is then assigned to a. + + b := a + 1 + Type: PositiveInteger + +The right-hand side of the expression is evaluated, yieldig 1. This value +is then assigned to b. Thus a and b both have the value 1 after the sequence +of assignments. + + a := 2 + 2 + Type: PositiveInteger + +What is the value of b if a is assigned the value 2? + + b + 1 + Type: PositiveInteger + +The value of b is left unchanged. + +This is what we mean when we say this kind of assignment is immediate. +The variable b has no dependency on a after the initial assignment. This +is the usual notion of assignment in programming languages such as C, +Pascal, and Fortran. + +==================================================================== +Delayed Assignment +==================================================================== + +Axiom provides delayed assignment with "==". This implements a delayed +evaluation of the right-hand side and dependency checking. The syntax for +delayed assignment is + + variable == expression + +The value returned by a delayed assignment is the unique value of Void. + + a == 1 + Type: Void + + b == a + Type: Void + +Using a and b as above, these are the corresponding delayed assignments. + + a + Compiling body of rule a to compute value of type PositiveInteger + 1 + Type: PositiveInteger + +The right-hand side of each delayed assignment is left unevaluated until +the variables on the left-hand sides are evaluated. + + b + Compiling body of rule b to compute value of type PositiveInteger + 1 + Type: PositiveInteger + +This gives the same results as before. But if we change a to 2 + + a == 2 + Compiled code for a has been cleared. + Compiled code for b has been cleared. + 1 old definition(s) deleted for function or rule a + Type: Void + +Then a evaluates to 2, as expected + + a + Compiling body of rule a to compute value of type PositiveInteger + 2 + Type: PositiveInteger + +but the value of b reflects the change to a + + b + Compiling body of rule b to compute value of type PositiveInteger + 2 + Type: PositiveInteger + +==================================================================== +Multiple Immediate Assignments +==================================================================== + +It is possible to set several variables at the same time by using a +tuple of variables and a tuple of expressions. A tuple is a collection +of things separated by commas, often surrounded by parentheses. The +syntax for multiple immediate assignment is + + ( var1, var2, ..., varN ) := ( expr1, expr2, ..., exprN ) + +The value returned by an immediate assignment is the value of exprN. + + ( x, y ) := ( 1, 2 ) + 2 + Type: PositiveInteger + +This sets x to 1 and y to 2. Multiple immediate assignments are parallel +in the sense that the expressions on the right are all evaluated before +any assignments on the left are made. However, the order of evaluation +of these expressions is undefined. + + ( x, y ) := ( y, x ) + 1 + Type: PositiveInteger + + x + 2 + Type: PositiveInteger + +The variable x now has the previous value of y. + + y + 1 + Type: PositiveInteger + +The variable y now has the previous value of x. + +There is no syntactic form for multiple delayed assignments. + +\end{chunk} + +\section{syntax blocks} +\label{blocks} +\index{blocks} +\index{syntax!blocks} +\index{blocks!syntax} +\begin{chunk}{blocks.help} +==================================================================== +Blocks +==================================================================== + +A block is a sequence of expressions evaluated in the order that they +appear, except as modified by control expressions such as leave, return, +iterate, and if-then-else constructions. The value of a block is the +value of the expression last evaluated in the block. + +To leave a block early, use "=>". For example, + + i < 0 => x + +The expression before the "=>" must evaluate to true or false. The +expression following the "=>" is the return value of the block. + +A block can be constructed in two ways: + + 1. the expressions can be separated by semicolons and the resulting + expression surrounded by parentheses, and + 2. the expressions can be written on succeeding lines with each line + indented the same number of spaces (which must be greater than zero). + A block entered in this form is called a pile + +Only the first form is available if you are entering expressions directly +to Axiom. Both forms are available in .input files. The syntax for a simple +block of expressions entered interactively is + + ( expression1 ; expression2 ; ... ; expressionN ) + +The value returned by a block is the value of an "=>" expression, or +expressionN if no "=>" is encountered. + +In .input files, blocks can also be written in piles. The examples +given here are assumed to come from .input files. + + a := + i := gcd(234,672) + i := 2*i**5 - i + 1 + 1 / i + + 1 + ----- + 23323 + Type: Fraction Integer + +In this example, we assign a rational number to a using a block consisting +of three expressions. This block is written as a pile. Each expression in +the pile has the same indentation, in this case two spaces to the right of +the first line. + + a := ( i := gcd(234,672); i := 2*i**5 - i + 1; 1 / i ) + + 1 + ----- + 23323 + Type: Fraction Integer + +Here is the same block written on one line. This is how you are required +to enter it at the input prompt. + + ( a := 1; b := 2; c := 3; [a,b,c] ) + [1,2,3] + Type: List PositiveInteger + +AAxiom gives you two ways of writing a block and the preferred way in +an .input file is to use a pile. Roughly speaking, a pile is a block +whose consituent expressions are indented the same amount. You begin a +pile by starting a new line for the first expression, indenting it to +the right of the previous line. You then enter the second expression on +a new line, vertically aligning it with the first line. And so on. If +you need to enter an inner pile, further indent its lines to the right +of the outer pile. Axiom knows where a pile ends. It ends when a subsequent +line is indented to the left of the pile or the end of the file. + +Also See: +o )help if +o )help repeat +o )help while +o )help for +o )help suchthat +o )help parallel +o )help lists + +\end{chunk} +\footnote{ +\fnref{if} +\fnref{repeat} +\fnref{while} +\fnref{for} +\fnref{suchthat} +\fnref{parallel} +\fnref{lists}} + +\section{system clef} +\label{clef} +\index{clef} +\index{syntax!clef} +\index{clef!syntax} +\begin{chunk}{clef.help} + +Entering printable keys generally inserts new text into the buffer (unless +in overwrite mode, see below). Other special keys can be used to modify +the text in the buffer. In the description of the keys below, ^n means +Control-n, or holding the CONTROL key down while pressing "n". Errors +will ring the terminal bell. + +^A/^E : Move cursor to beginning/end of the line. +^F/^B : Move cursor forward/backward one character. +^D : Delete the character under the cursor. +^H, DEL : Delete the character to the left of the cursor. +^K : Kill from the cursor to the end of line. +^L : Redraw current line. +^O : Toggle overwrite/insert mode. Initially in insert mode. Text + added in overwrite mode (including yanks) overwrite + existing text, while insert mode does not overwrite. +^P/^N : Move to previous/next item on history list. +^R/^S : Perform incremental reverse/forward search for string on + the history list. Typing normal characters adds to the current + search string and searches for a match. Typing ^R/^S marks + the start of a new search, and moves on to the next match. + Typing ^H or DEL deletes the last character from the search + string, and searches from the starting location of the last search. + Therefore, repeated DEL's appear to unwind to the match nearest + the point at which the last ^R or ^S was typed. If DEL is + repeated until the search string is empty the search location + begins from the start of the history list. Typing ESC or + any other editing character accepts the current match and + loads it into the buffer, terminating the search. +^T : Toggle the characters under and to the left of the cursor. +^Y : Yank previously killed text back at current location. Note that + this will overwrite or insert, depending on the current mode. +^U : Show help (this text). +TAB : Perform command completion based on word to the left of the cursor. + Words are deemed to contain only the alphanumeric and the % ! ? _ + characters. +NL, CR : returns current buffer to the program. + +DOS and ANSI terminal arrow key sequences are recognized, and act like: + + up : same as ^P + down : same as ^N + left : same as ^B + right : same as ^F + +\end{chunk} + +\section{syntax collection} +\label{collection} +\index{collection} +\index{syntax!collection} +\index{collection!syntax} +\begin{chunk}{collection.help} +==================================================================== +Collection -- Creating Lists and Streams with Iterators +==================================================================== + +All of the loop expressions which do not use the repeat leave or +iterate words can be used to create lists and streams. For example: + +This creates a simple list of the integers from 1 to 10: + + list := [i for i in 1..10] + [1,2,3,4,5,6,7,8,9,10] + Type: List PositiveInteger + +Create a stream of the integers greater than or equal to 1: + + stream := [i for i in 1..] + [1,2,3,4,5,6,7,...] + Type: Stream PositiveInteger + +This is a list of the prime numbers between 1 and 10, inclusive: + + [i for i in 1..10 | prime? i] + [2,3,5,7] + Type: List PositiveInteger + +This is a stream of the prime integers greater than or equal to 1: + + [i for i in 1.. | prime? i] + [2,3,5,7,11,13,17,...] + Type: Stream PositiveInteger + +This is a list of the integers between 1 and 10, inclusive, whose +squares are less than 700: + + [i for i in 1..10 while i*i < 700] + [1,2,3,4,5,6,7,8,9,10] + Type: List PositiveInteger + +This is a stream of the integers greater than or equal to 1 whose +squares are less than 700: + + [i for i in 1.. while i*i < 700] + [1,2,3,4,5,6,7,...] + Type: Stream PositiveInteger + +The general syntax of a collection is + + [ collectExpression iterator1 iterator2 ... iteratorN ] + +where each iterator is either a for or a while clause. The loop +terminates immedidately when the end test of any iterator succeeds +or when a return expression is evaluated in collectExpression. The +value returned by the collection is either a list or a stream of +elements, one for each iteration of the collectExpression. + +Be careful when you use while to create a stream. By default Axiom +tries to compute and display the first ten elements of a stream. If +the while condition is not satisfied quickly, Axiom can spend a long +(potentially infinite) time trying to compute the elements. Use + + )set streams calculate + +to change the defaults to something else. This also affects the number +of terms computed and displayed for power series. For the purposes of +these examples we have use this system command to display fewer than +ten terms. + +\end{chunk} + +\section{syntax for} +\label{for} +\index{for} +\index{syntax!for} +\index{for!syntax} +\begin{chunk}{for.help} +==================================================================== +for loops +==================================================================== + +Axiom provide the for and in keywords in repeat loops, allowing you +to integrate across all elements of a list, or to have a variable take +on integral values from a lower bound to an upper bound. We shall refer +to these modifying clauses of repeat loops as for clauses. These clauses +can be present in addition to while clauses (See )help while). As with +all other types of repeat loops, leave (see )help leave) can be used to +prematurely terminate evaluation of the loop. + +The syntax for a simple loop using for is + + for iterator repeat loopbody + +The iterator has several forms. Each form has an end test which is +evaluted before loopbody is evaluated. A for loop terminates immediately +when the end test succeeds (evaluates to true) or when a leave or return +expression is evaluated in loopbody. The value returned by the loop is +the unique value of Void. + +==================================================================== +for i in n..m repeat +==================================================================== + +If for is followed by a variable name, the in keyword and then an integer +segment of the form n..m, the end test for this loop is the predicate +i > m. The body of the loop is evaluated m-n+1 times if this number is +greater than 0. If this number is less than or equal to 0, the loop body +is not evaluated at all. + +The variable i has the value n, n+1, ..., m for successive iterations +of the loop body. The loop variable is a local variable within the loop +body. Its value is not available outside the loop body and its value and +type within the loop body completely mask any outer definition of a +variable with the same name. + + for i in 10..12 repeat output(i**3) + 1000 + 1331 + 1728 + Type: Void + +The loop prints the values of 10^3, 11^3, and 12^3. + + a := [1,2,3] + [1,2,3] + Type: List PositiveInteger + + for i in 1..#a repeat output(a.i) + 1 + 2 + 3 + Type: Void + +Iterate across this list using "." to access the elements of a list +and the # operation to count its elements. + +This type of iteration is applicable to anything that uses ".". You +can also use it with functions that use indices to extract elements. + + m := matrix [ [1,2],[4,3],[9,0] ] + +- -+ + | 1 2 | + | 4 3 | + | 9 0 | + +- -+ + Type: Matrix Integer + +Define m to be a matrix. + + for i in 1..nrows(m) repeat output row(m.i) + [1,2] + [4,3] + [9,0] + Type: Void + +Display the rows of m. + +You can iterate with for-loops. + + for i in 1..5 repeat + if odd?(i) then iterate + output(i) + 2 + 4 + Type: Void + +Display the even integers in a segment. + +==================================================================== +for i in n..m by s repeat +==================================================================== + +By default, the difference between values taken on by a variable in +loops such as + + for i in n..m repeat ... + +is 1. It is possible to supply another, possibly negative, step value +by using the by keyword along with for and in. Like the upper and lower +bounds, the step value following the by keyword must be an integer. Note +that the loop + + for i in 1..2 by 0 repeat output(i) + +will not terminate by itself, as the step value does not change the +index from its initial value of 1. + + for i in 1..5 by 2 repeat output(i) + 1 + 3 + 5 + Type: Void + +This expression displays the odd integers between two bounds. + + for i in 5..1 by -2 repeat output(i) + 5 + 3 + 1 + Type: Void + +Use this to display the numbers in reverse order. + +==================================================================== +for i in n.. repeat +==================================================================== + +If the value after the ".." is omitted, the loop has no end test. A +potentially infinite loop is thus created. The variable is given the +successive values n, n+1, n+2, ... and the loop is terminated only +if a leave or return expression is evaluated in the loop body. However, +you may also add some other modifying clause on the repeat, for example, +a while clause, to stop the loop. + + for i in 15.. while not prime?(i) repeat output(i) + 15 + 16 + Type: Void + +This loop displays the integers greater than or equal to 15 and less +than the first prime number greater than 15. + +==================================================================== +for x in l repeat +==================================================================== + +Another variant of the for loop has the form: + + for x in list repeat loopbody + +This form is used when you want to iterate directly over the elements +of a list. In this form of the for loop, the variable x takes on the +value of each successive element in l. The end test is most simply +stated in English: "are there no more x in l?" + + l := [0, -5, 3] + [0, -5, 3] + Type: List Integer + + for x in l repeat output(x) + 0 + -5 + 3 + Type: Void + +This displays all of the elements of the list l, one per line. + +Since the list constructing expression + + expand [n..m] + +creates the list + + [n, n+1, ..., m] + +you might be tempted to think that the loops + + for i in n..m repeat output(i) + +and + + for x in expand [n..m] repeat output(x) + +are equivalent. The second form first creates the expanded list +(no matter how large it might be) and then does the iteration. The +first form potentially runs in much less space, as the index variable +i is simply incremented once per loop and the list is not actually +created. Using the first form is much more efficient. + +Of course, sometimes you really want to iterate across a specific list. +This displays each of the factors of 2400000: + + for f in factors(factor(2400000)) repeat output(f) + [factor= 2, exponent= 8] + [factor= 3, exponent= 1] + [factor= 5, exponent= 5] + Type: Void + +\end{chunk} + +\section{syntax if} +\label{if} +\index{if} +\index{syntax!if} +\index{if!syntax} +\begin{chunk}{if.help} +==================================================================== +If-then-else +==================================================================== + +Like many other programming languages, Axiom uses the three keywords +if, then, and else to form conditional expressions. The else part of +the conditional is optional. The expression between the if and then +keywords is a predicate: an expression that evaluates to or is +convertible to either true or false, that is, a Boolean. + +The syntax for conditional expressions is + + if predicate then expression1 else expression2 + +where the "else expression2" part is optional. The value returned from +a conditional expression is expression1 if the predicate evaluates to +true and expression2 otherwise. If no else clause is given, the value +is always the unique value of Void. + +An if-then-else expression always returns a value. If the else clause +is missing then the entire expression returns the unique value of Void. +If both clauses are present, the type of the value returned by if is +obtained by resolving the types of the values of the two clauses. + +The predicate must evaluate to, or be convertible to, an object of type +Boolean: true or false. By default, the equal sign "=" creates an equation. + + x + 1 = y + x + 1 = y + Type: Equation Polynomial Integer + +This is an equation, not a boolean condition. In particular, it is +an object of type Equation Polynomial Integer. + +However, for predicates in if expressions, Axiom places a default +target type of Boolean on the predicate and equality testing is performed. +Thus you need not qualify the "=" in any way. In other contexts you may +need to tell Axiom that you want to test for equality rather than create +an equation. In these cases, use "@" and a target type of Boolean. + +The compound symbol meaning "not equal" in Axiom is "~=". This can be +used directly without a package call or a target specification. The +expression "a ~= b" is directly translated to "not(a = b)". + +Many other functions have return values of type Boolean. These include +<, <=, >, >=, ~=, and member?. By convention, operations with names +ending in "?" return Boolean values. + +The usual rules for piles are suspended for conditional expressions. In +.input files, the then and else keywords can begin in the same column +as the corresponding if by may also appear to the right. Each of the +following styles of writing if-then-else expressions is acceptable: + + if i>0 then output("positive") else output("nonpositive") + + if i>0 then output("positive") + else output("nonpositive") + + if i>0 then output("positive") + else output("nonpositive") + + if i>0 + then output("positive") + else output("nonpositive") + + if i>0 + then output("positive") + else output("nonpositive") + +A block can follow the then or else keywords. In the following two +assignments to a, the then and else clauses each are followed by two +line piles. The value returned in each is the value of the second line. + + a := + if i > 0 then + j := sin(i * pi()) + exp(j + 1/j) + else + j := cos(i * 0.5 * pi()) + log(abs(j)**5 + i) + + + a := + if i > 0 + then + j := sin(i * pi()) + exp(j + 1/j) + else + j := cos(i * 0.5 * pi()) + log(abs(j)**5 + i) + +These are both equivalent to the following: + + a := + if i > 0 then (j := sin(i * pi()); exp(j + 1/j)) + else (j := cos(i * 0.5 * pi()); log(abs(j)**5 + i)) + +\end{chunk} + +\section{syntax iterate} +\label{iterate} +\index{iterate} +\index{syntax!iterate} +\index{iterate!syntax} +\begin{chunk}{iterate.help} +==================================================================== +iterate in loops +==================================================================== + +Axiom provides an iterate expression that skips over the remainder +of a loop body and starts the next loop execution. We first initialize +a counter. + + i := 0 + 0 + Type: NonNegativeInteger + +Display the even integers from 2 to 5: + + repeat + i := i + 1 + if i > 5 then leave + if odd?(i) then iterate + output(i) + 2 + 4 + Type: Void + +\end{chunk} + +\section{syntax leave} +\label{leave} +\index{leave} +\index{syntax!leave} +\index{leave!syntax} +\begin{chunk}{leave.help} +==================================================================== +leave in loops +==================================================================== + +The leave keyword is often more useful in terminating a loop. A +leave causes control to transfer to the expression immediately following +the loop. As loops always return the unique value of Void, you cannot +return a value with leave. That is, leave takes no argument. + + f() == + i := 1 + repeat + if factorial(i) > 1000 then leave + i := i + 1 + i + Type: Void + +This example is a modification of the last example in the previous +section. Instead of using return we'll use leave. + + f() + 7 + Type: PositiveInteger + +The loop terminates when factorial(i) gets big enough. The last line +of the function evaluates to the corresponding "good" value of i +and the function terminates, returning that value. + +You can only use leave to terminate the evaluation of one loop. Lets +consider a loop within a loop, that is, a loop with a nested loop. +First, we initialize two counter variables. + + (i,j) := (1,1) + 1 + Type: PositiveInteger + + repeat + repeat + if (i + j) > 10 then leave + j := j + 1 + if (i + j) > 10 then leave + i := i + 1 + Type: Void + +Nested loops must have multiple leave expressions at the appropriate +nesting level. How would you rewrite this so (i + j) > 10 is only +evaluated once? + +==================================================================== +leave vs => in loop bodies +==================================================================== + +Compare the following two loops: + + i := 1 i := 1 + repeat repeat + i := i + 1 i := i + 1 + i > 3 => i if i > 3 then leave + output(i) output(i) + +In the example on the left, the values 2 and 3 for i are displayed but +then the "=>" does not allow control to reach the call to output again. +The loop will not terminate until you run out of space or interrupt the +execution. The variable i will continue to be incremented because the +"=>" only means to leave the block, not the loop. + +In the example on the right, upon reaching 4, the leave will be executed, +and both the block and the loop will terminate. This is one of the reasons +why both "=>" and leave are provided. Using a while clase with the "=>" +lets you simulate the action of leave. + +\end{chunk} + +\section{syntax parallel} +\label{parallel} +\index{parallel} +\index{syntax!parallel} +\index{parallel!syntax} +\begin{chunk}{parallel.help} +==================================================================== +parallel iteration +==================================================================== + +Sometimes you want to iterate across two lists in parallel, or perhaps +you want to traverse a list while incrementing a variable. + +The general syntax of a repeat loop is + + iterator1, iterator2, ..., iteratorN repeat loopbody + +where each iterator is either a for or a while clause. The loop +terminates immediately when the end test of any iterator succeeds or +when a leave or return expression is evaluated in loopbody. The value +returned by the loop is the unique value of Void. + + l := [1,3,5,7] + [1,3,5,7] + Type: List PositiveInteger + + m := [100,200] + [100,200] + Type: List PositiveInteger + + sum := 0 + 0 + Type: NonNegativeInteger + +Here we write a loop to iterate across two lists, computing the sum +of the pairwise product of the elements: + + for x in l for y in m repeat + sum := sum + x*y + Type: Void + +The last two elements of l are not used in the calculation because +m has two fewer elements than l. + + sum + 700 + Type: NonNegativeInteger + +This is the "dot product". + +Next we write a loop to compute the sum of the products of the loop +elements with their positions in the loop. + + l := [2,3,5,7,11,13,17,19,23,29,31,37] + [2,3,5,7,11,13,17,19,23,29,31,37] + Type: List PositiveInteger + + sum := 0 + 0 + Type: NonNegativeInteger + + for i in 0.. for x in l repeat sum := i * x + Type: Void + +Here looping stops when the list l is exhaused, even though the +for i in 0.. specifies no terminating condition. + + sum + 407 + Type: NonNegativeInteger + +When "|" is used to qualify any of the for clauses in a parallel +iteration, the variables in the predicates can be from an outer +scope or from a for clause in or to the left of the modified clause. + +This is correct: + + for i in 1..10 repeat + for j in 200..300 | ood? (i+j) repeat + output [i,j] + +But this is not correct. The variable j has not been defined outside +the inner loop: + + for i in 1..01 | odd? (i+j) repeat -- wrong, j not defined + for j in 200..300 repeat + output [i,j] + +It is possible to mix several of repeat modifying clauses on a loop: + + for i in 1..10 + for j in 151..160 | odd? j + while i + j < 160 repeat + output [i,j] + [1,151] + [3,153] + Type: Void + +Here are useful rules for composing loop expressions: + + 1. while predicates can only refer to variables that are global (or + in an outer scope) or that are defined in for clauses to the left + of the predicate. + 2. A "such that" predicate (somthing following "|") must directly + follow a for clause and can only refer to variables that are + global (or in an outer scope) or defined in the modified for clause + or any for clause to the left. + +\end{chunk} + +\section{syntax repeat} +\label{repeat} +\index{repeat} +\index{syntax!repeat} +\index{repeat!syntax} +\begin{chunk}{repeat.help} +==================================================================== +Repeat Loops +==================================================================== + +A loop is an expression that contains another expression, called the loop +body, which is to be evaluated zero or more times. All loops contain the +repeat keyword and return the unique value of Void. Loops can contain +inner loops to any depth. + +The most basic loop is of the form + + repeat loopbody + +Unless loopbody contains a leave or return expression, the loop repeats +foreer. The value returned by the loop is the unique value of Void. + +Axiom tries to determine completely the type of every object in a loop +and then to translate the loop body to Lisp or even to machine code. This +translation is called compilation. + +If Axiom decides that it cannot compile the loop, it issues a message +stating the problem and then the following message: + + We will attemp to step through and interpret the code + +It is still possible that Axiom can evalute the loop but in interpret-code +mode. + +==================================================================== +Return in Loops +==================================================================== + +A return expression is used to exit a function with a particular value. +In particular, if a return is in a loop within the function, the loop +is terminated whenever the return is evaluated. + + f() == + i := 1 + repeat + if factorial(i) > 1000 then return i + i := i + 1 + Type: Void + + f() + Type: Void + +When factorial(i) is big enough, control passes from inside the loop +all the way outside the function, returning the value of i (so we think). +What went wrong? Isn't it obvious that this function should return an +integer? Well, Axiom makes no attempt to analyze the structure of a +loop to determine if it always returns a value because, in general, this +is impossible. So Axiom has this simple rule: the type of the function is +determined by the type of its body, in this case a block. The normal value +of a block is the value of its last expression, in this case, a loop. And +the value of every loop is the unique value of Void. So the return type +of f is Void. + +There are two ways to fix this. The best way is for you to tell Axiom +what the return type of f is. You do this by giving f a declaration + + f:() -> Integer + +prior to calling for its value. This tells Axiom "trust me -- an integer +is returned". Another way is to add a dummy expression as follows. + + f() == + i := 1 + repeat + if factorial(i) > 1000 then return i + i := i + 1 + 0 + Type: Void + +Note that the dummy expression will never be evaluated but it is the +last expression in the function and will determine the return type. + + f() + 7 + Type: PositiveInteger + +==================================================================== +leave in loops +==================================================================== + +The leave keyword is often more useful in terminating a loop. A +leave causes control to transfer to the expression immediately following +the loop. As loops always return the unique value of Void, you cannot +return a value with leave. That is, leave takes no argument. + + f() == + i := 1 + repeat + if factorial(i) > 1000 then leave + i := i + 1 + i + Type: Void + +This example is a modification of the last example in the previous +section. Instead of using return we'll use leave. + + f() + 7 + Type: PositiveInteger + +The loop terminates when factorial(i) gets big enough. The last line +of the function evaluates to the corresponding "good" value of i +and the function terminates, returning that value. + +You can only use leave to terminate the evaluation of one loop. Lets +consider a loop within a loop, that is, a loop with a nested loop. +First, we initialize two counter variables. + + (i,j) := (1,1) + 1 + Type: PositiveInteger + + repeat + repeat + if (i + j) > 10 then leave + j := j + 1 + if (i + j) > 10 then leave + i := i + 1 + Type: Void + +Nested loops must have multiple leave expressions at the appropriate +nesting level. How would you rewrite this so (i + j) > 10 is only +evaluated once? + +==================================================================== +leave vs => in loop bodies +==================================================================== + +Compare the following two loops: + + i := 1 i := 1 + repeat repeat + i := i + 1 i := i + 1 + i > 3 => i if i > 3 then leave + output(i) output(i) + +In the example on the left, the values 2 and 3 for i are displayed but +then the "=>" does not allow control to reach the call to output again. +The loop will not terminate until you run out of space or interrupt the +execution. The variable i will continue to be incremented because the +"=>" only means to leave the block, not the loop. + +In the example on the right, upon reaching 4, the leave will be executed, +and both the block and the loop will terminate. This is one of the reasons +why both "=>" and leave are provided. Using a while clase with the "=>" +lets you simulate the action of leave. + +==================================================================== +iterate in loops +==================================================================== + +Axiom provides an iterate expression that skips over the remainder +of a loop body and starts the next loop execution. We first initialize +a counter. + + i := 0 + 0 + Type: NonNegativeInteger + +Display the even integers from 2 to 5: + + repeat + i := i + 1 + if i > 5 then leave + if odd?(i) then iterate + output(i) + 2 + 4 + Type: Void + +Also See: +o )help blocks +o )help if +o )help while +o )help for +o )help suchthat +o )help parallel +o )help lists + +\end{chunk} +\footnote{ +\fnref{blocks} +\fnref{if} +\fnref{while} +\fnref{for} +\fnref{suchthat} +\fnref{parallel} +\fnref{lists}} + +\section{syntax suchthat} +\label{suchthat} +\index{suchthat} +\index{syntax!suchthat} +\index{suchthat!syntax} +\begin{chunk}{suchthat.help} +==================================================================== +Such that predicates +==================================================================== + +A for loop can be followed by a "|" and then a predicate. The predicate +qualifies the use of the values from the iterator that follows the for. +Think of the vertical bar "|" as the phrase "such that". + + for n in 0..4 | odd? n repeat output n + 1 + 3 + Type: Void + +This loop expression prints out the integers n in the given segment +such that n is odd. + +A for loop can also be written + + for iterator | predicate repeat loopbody + +which is equivalent to: + + for iterator repeat if predicate then loopbody else iterate + +The predicate need not refer only to the variable in the for clause. +Any variable in an outer scope can be part of the predicate. + + for i in 1..50 repeat + for j in 1..50 | factorial(i+j) < 25 repeat + output [i,j] + [1,1] + [1,2] + [1,3] + [2,1] + [2,2] + [3,1] + Type: Void + +\end{chunk} + +\section{syntax syntax} +\label{syntax} +\begin{chunk}{syntax.help} + +The Axiom Interactive Language has the following features documented here. + +More information is available by typing + + )help feature + +where feature is one of: + + assignment -- Immediate and delayed assignments + blocks -- Blocks of expressions + collection -- creating lists with iterators + for -- for loops + if -- If-then-else statements + iterate -- using iterate in loops + leave -- using leave in loops + parallel -- parallel iterations + repeat -- repeat loops + suchthat -- suchthat predicates + while -- while loops + +\end{chunk} + +\section{syntax while} +\index{while} +\index{syntax!while} +\index{while!syntax} +\begin{chunk}{while.help} +==================================================================== +while loops +==================================================================== + +The repeat in a loop can be modified by adding one or more while +clauses. Each clause contains a predicate immediately following the +while keyword. The predicate is tested before the evaluation of the +body of the loop. The loop body is evaluated whenever the predicate +in a while clause is true. + +The syntax for a simple loop using while is + + while predicate repeat loopbody + +The predicate is evaluated before loopbody is evaluated. A while loop +terminates immediately when predicate evaluates to false or when a +leave or return expression is evaluted. See )help repeat for more +information on leave and return. + +Here is a simple example of using while in a loop. We first initialize +the counter. + + i := 1 + 1 + Type: PositiveInteger + + while i < 1 repeat + output "hello" + i := i + 1 + Type: Void + +The steps involved in computing this example are + (1) set i to 1 + (2) test the condition i < 1 and determine that it is not true + (3) do not evaluate the loop body and therefore do not display "hello" + + (x, y) := (1, 1) + 1 + Type: PositiveInteger + +If you have multiple predicates to be tested use the logical and +operation to separate them. Axiom evaluates these predicates from +left to right. + + while x < 4 and y < 10 repeat + output [x,y] + x := x + 1 + y := y + 2 + [1,1] + [2,3] + [3,5] + Type: Void + + +A leave expression can be included in a loop body to terminate a loop +even if the predicate in any while clauses are not false. + + (x, y) := (1, 1) + 1 + Type: PositiveInteger + + while x < 4 and y < 10 repeat + if x + y > 7 then leave + output [x,y] + x := x + 1 + y := y + 2 + [1,1] + [2,3] + Type: Void + +\end{chunk} + +\chapter{Abstract Syntax Trees (ptrees)} +\begin{verbatim} +Abstract Syntax Trees + +These functions create and examine abstract +syntax trees. These are called pform, for short. + +!! This file also contains constructors for concrete syntax, although +!! they should be somewhere else. + +THE PFORM DATA STRUCTURE + Leaves: [hd, tok, pos] + Trees: [hd, tree, tree, ...] + hd is either an id or (id . alist) + +\end{verbatim} + +\defun{tokConstruct}{Construct a leaf token} +The tokConstruct function is a constructer and selectors for leaf tokens. +A leaf token looks like [head, token, position] +where head is either an id or (id . alist) + +\calls{tokConstruct}{ifcar} +\calls{tokConstruct}{pfNoPosition?} +\calls{tokConstruct}{ncPutQ} +\begin{chunk}{defun tokConstruct} +(defun |tokConstruct| (head token &rest position) + (let (result) + (setq result (cons head token)) + (cond + ((ifcar position) + (cond + ((|pfNoPosition?| (car position)) result) + (t (|ncPutQ| result '|posn| (car position)) result))) + (t result)))) + +\end{chunk} + +\defun{pfAbSynOp}{Return a part of a node} +\calls{pfAbSynOp}{ifcar} +\begin{chunk}{defun pfAbSynOp} +(defun |pfAbSynOp| (form) + (let (hd) + (setq hd (car form)) + (or (ifcar hd) hd))) + +\end{chunk} + +\defun{pfAbSynOp?}{Compare a part of a node} +\calls{pfAbSynOp?}{eqcar} +\begin{chunk}{defun pfAbSynOp?} +(defun |pfAbSynOp?| (form op) + (let (hd) + (setq hd (car form)) + (or (eq hd op) (eqcar hd op)))) + +\end{chunk} + +\defun{pfNoPosition?}{pfNoPosition?} +\calls{pfNoPosition?}{poNoPosition?} +\begin{chunk}{defun pfNoPosition?} +(defun |pfNoPosition?| (pos) + (|poNoPosition?| pos)) + +\end{chunk} + +\defun{poNoPosition?}{poNoPosition?} +\calls{poNoPosition?}{eqcar} +\begin{chunk}{defun poNoPosition? 0} +(defun |poNoPosition?| (pos) + (eqcar pos '|noposition|)) + +\end{chunk} + +\defun{tokType}{tokType} +\calls{tokType}{ncTag} +\begin{chunk}{defun tokType} +(defun |tokType| (x) (|ncTag| x)) + +\end{chunk} + +\defun{tokPart}{tokPart} +\begin{chunk}{defun tokPart 0} +(defun |tokPart| (x) (cdr x)) + +\end{chunk} + +\defun{tokPosn}{tokPosn} +\calls{tokPosn}{qassq} +\calls{tokPosn}{ncAlist} +\calls{tokPosn}{pfNoPosition} +\begin{chunk}{defun tokPosn} +(defun |tokPosn| (x) + (let (a) + (setq a (qassq '|posn| (|ncAlist| x))) + (cond + (a (cdr a)) + (t (|pfNoPosition|))))) + +\end{chunk} + +\defun{pfNoPosition}{pfNoPosition} +\calls{pfNoPosition}{poNoPosition} +\begin{chunk}{defun pfNoPosition} +(defun |pfNoPosition| () (|poNoPosition|)) + +\end{chunk} + +\defun{poNoPosition}{poNoPosition} +\usesdollar{poNoPosition}{nopos} +\begin{chunk}{defun poNoPosition 0} +(defun |poNoPosition| () + (declare (special |$nopos|)) + |$nopos|) + +\end{chunk} + +\chapter{Attributed Structures} +For objects which are pairs where the CAR field is either just a tag +(an identifier) or a pair which is the tag and an association list. + +\defun{ncTag}{ncTag} +Pick off the tag +\calls{ncTag}{ncBug} +\calls{ncTag}{qcar} +\calls{ncTag}{identp} +\begin{chunk}{defun ncTag} +(defun |ncTag| (x) + (cond + ((null (consp x)) (|ncBug| 's2cb0031 nil)) + (t + (setq x (qcar x)) + (cond + ((identp x) x) + ((null (consp x)) (|ncBug| 's2cb0031 nil)) + (t (qcar x)))))) + +\end{chunk} + +\defun{ncAlist}{ncAlist} +Pick off the property list +\calls{ncAlist}{ncBug} +\calls{ncAlist}{qcar} +\calls{ncAlist}{identp} +\calls{ncAlist}{qcdr} +\begin{chunk}{defun ncAlist} +(defun |ncAlist| (x) + (cond + ((null (consp x)) (|ncBug| 's2cb0031 nil)) + (t + (setq x (qcar x)) + (cond + ((identp x) nil) + ((null (consp x)) (|ncBug| 's2cb0031 nil)) + (t (qcdr x)))))) + +\end{chunk} + +\defun{ncEltQ}{ncEltQ} +Get the entry for key k on x's association list + +\calls{ncEltQ}{qassq} +\calls{ncEltQ}{ncAlist} +\calls{ncEltQ}{ncBug} +\begin{chunk}{defun ncEltQ} +(defun |ncEltQ| (x k) + (let (r) + (setq r (qassq k (|ncAlist| x))) + (cond + ((null r) (|ncBug| 's2cb0007 (list k))) + (t (cdr r))))) + +\end{chunk} + +\defun{ncPutQ}{ncPutQ} +\begin{verbatim} +;-- Put (k . v) on the association list of x and return v +;-- case1: ncPutQ(x,k,v) where k is a key (an identifier), v a value +;-- put the pair (k . v) on the association list of x and return v +;-- case2: ncPutQ(x,k,v) where k is a list of keys, v a list of values +;-- equivalent to [ncPutQ(x,key,val) for key in k for val in v] +;ncPutQ(x,k,v) == +; LISTP k => +; for key in k for val in v repeat ncPutQ(x,key,val) +; v +; r := QASSQ(k,ncAlist x) +; if NULL r then +; r := CONS( CONS(k,v), ncAlist x) +; RPLACA(x,CONS(ncTag x,r)) +; else +; RPLACD(r,v) +; v\end{verbatim} +\calls{ncPutQ}{qassq} +\calls{ncPutQ}{ncAlist} +\calls{ncPutQ}{ncTag} +\begin{chunk}{defun ncPutQ} +(defun |ncPutQ| (x k v) + (let (r) + (cond + ((listp k) + ((lambda (Var1 key Var2 val) + (loop + (cond + ((or (atom Var1) + (progn (setq key (car Var1)) nil) + (atom Var2) + (progn (setq val (car Var2)) nil)) + (return nil)) + (t + (|ncPutQ| x key val))) + (setq Var1 (cdr Var1)) + (setq Var2 (cdr Var2)))) + k nil v nil) + v) + (t + (setq r (qassq k (|ncAlist| x))) + (cond + ((null r) + (setq r (cons (cons k v) (|ncAlist| x))) + (rplaca x (cons (|ncTag| x) r))) + (t + (rplacd r v))) + v)))) + +\end{chunk} + +\subsection{Special Category Names} + +\defdollar{EmptyMode} +The CONTAINED predicate is used to walk internal structures +such as modemaps to see if the $X$ object occurs within $Y$. One +particular use is in a function called isPartialMode to decide +if a modemap is only partially complete. If this is true then the +modemap will contain the constant \verb|$EmptyMode|. So the call +ends up being CONTAINED \verb|$EmptyMode| Y. +\begin{chunk}{initvars} +(defvar |$EmptyMode| '|$EmptyMode|) + +\end{chunk} + +\defdollar{AnonymousFunction} +\begin{chunk}{initvars} +(defvar |$AnonymousFunction| '(|AnonymousFunction|)) + +\end{chunk} + +\defdollar{Any} +\begin{chunk}{initvars} +(defvar |$Any| '(|Any|)) + +\end{chunk} + +\defdollar{BFtag} +\begin{chunk}{initvars} +(defvar |$BFtag| '|:BF:|) + +\end{chunk} + +\defdollar{Boolean} +\begin{chunk}{initvars} +(defvar |$Boolean| '(|Boolean|)) + +\end{chunk} + +\defdollar{Category} +\begin{chunk}{initvars} +(defvar |$Category| '(|Category|)) + +\end{chunk} + +\defdollar{Domain} +\begin{chunk}{initvars} +(defvar |$Domain| '(|Domain|)) + +\end{chunk} + +\defdollar{Exit} +\begin{chunk}{initvars} +(defvar |$Exit| '(|Exit|)) + +\end{chunk} + +\defdollar{Expression} +\begin{chunk}{initvars} +(defvar |$Expression| '(|OutputForm|)) + +\end{chunk} + +\defdollar{OutputForm} +\begin{chunk}{initvars} +(defvar |$OutputForm| '(|OutputForm|)) + +\end{chunk} + +\defdollar{BigFloat} +\begin{chunk}{initvars} +(defvar |$BigFloat| '(|Float|)) + +\end{chunk} + +\defdollar{Float} +\begin{chunk}{initvars} +(defvar |$Float| '(|Float|)) + +\end{chunk} + +\defdollar{DoubleFloat} +\begin{chunk}{initvars} +(defvar |$DoubleFloat| '(|DoubleFloat|)) + +\end{chunk} + +\defdollar{FontTable} +\begin{chunk}{initvars} +(defvar |$FontTable| '(|FontTable|)) + +\end{chunk} + +\defdollar{Integer} +\begin{chunk}{initvars} +(defvar |$Integer| '(|Integer|)) + +\end{chunk} + +\defdollar{ComplexInteger} +\begin{chunk}{initvars} +(defvar |$ComplexInteger| (LIST '|Complex| |$Integer|)) + +\end{chunk} + +\defdollar{Mode} +\begin{chunk}{initvars} +(defvar |$Mode| '(|Mode|)) + +\end{chunk} + +\defdollar{NegativeInteger} +\begin{chunk}{initvars} +(defvar |$NegativeInteger| '(|NegativeInteger|)) + +\end{chunk} + +\defdollar{NonNegativeInteger} +\begin{chunk}{initvars} +(defvar |$NonNegativeInteger| '(|NonNegativeInteger|)) + +\end{chunk} + +\defdollar{NonPositiveInteger} +\begin{chunk}{initvars} +(defvar |$NonPositiveInteger| '(|NonPositiveInteger|)) + +\end{chunk} + +\defdollar{PositiveInteger} +\begin{chunk}{initvars} +(defvar |$PositiveInteger| '(|PositiveInteger|)) + +\end{chunk} + +\defdollar{RationalNumber} +\begin{chunk}{initvars} +(defvar |$RationalNumber| '(|Fraction| (|Integer|))) + +\end{chunk} + +\defdollar{String} +\begin{chunk}{initvars} +(defvar |$String| '(|String|)) + +\end{chunk} + +\defdollar{StringCategory} +\begin{chunk}{initvars} +(defvar |$StringCategory| '(|StringCategory|)) + +\end{chunk} + +\defdollar{Symbol} +\begin{chunk}{initvars} +(defvar |$Symbol| '(|Symbol|)) + +\end{chunk} + +\defdollar{Void} +\begin{chunk}{initvars} +(defvar |$Void| '(|Void|)) + +\end{chunk} + +\defdollar{QuotientField} +\begin{chunk}{initvars} +(defvar |$QuotientField| '|Fraction|) + +\end{chunk} + +\defdollar{FunctionalExpression} +\begin{chunk}{initvars} +(defvar |$FunctionalExpression| '|Expression|) + +\end{chunk} + +\defdollar{defaultFunctionTargets} +\begin{chunk}{initvars} +(defvar |$defaultFunctionTargets| '(())) + +\end{chunk} + +;; Old names +\defdollar{SmallInteger} +\begin{chunk}{initvars} +(defvar |$SmallInteger| '(|SingleInteger|)) + +\end{chunk} + +;; New Names +\defdollar{SingleFloat} +\begin{chunk}{initvars} +(defvar |$SingleFloat| '(|SingleFloat|)) + +\end{chunk} + +\defdollar{DoubleFloat} +\begin{chunk}{initvars} +(defvar |$DoubleFloat| '(|DoubleFloat|)) + +\end{chunk} + +\defdollar{SingleInteger} +\begin{chunk}{initvars} +(defvar |$SingleInteger| '(|SingleInteger|)) + +\end{chunk} + + +\chapter{Function Selection} +\begin{verbatim} +New Selection of Modemaps + +selection of applicable modemaps is done in two steps: + first it tries to find a modemap inside an argument domain, and if + this fails, by evaluation of pattern modemaps +the result is a list of functions with signatures, which have the + following form: + [sig,elt,cond] where + sig is the signature gained by evaluating the modemap condition + elt is the slot number to get the implementation + cond are runtime checks which are the results of evaluating the + modemap condition + +the following flags are used: + $Coerce is NIL, if function selection is done which requires exact + matches (e.g. for coercion functions) + if $SubDom is true, then runtime checks have to be compiled +\end{verbatim} + +\defun{ofCategory}{ofCategory} +\calls{ofCategory}{identp} +\calls{ofCategory}{ofCategory} +\calls{ofCategory}{hasCaty} +\defsdollar{ofCategory}{Subst} +\defsdollar{ofCategory}{hope} +\begin{chunk}{defun ofCategory} +(defun |ofCategory| (dom cat) + (let (|$Subst| |$hope|) + (declare (special |$Subst| |$hope|)) + (cond + ((identp dom) nil) + ((and (listp cat) (eq (car cat) '|Join|)) + (every #'(lambda (c) (|ofCategory| dom c)) (cdr cat))) + (t (not (eq (|hasCaty| dom cat nil) '|failed|)))))) + +\end{chunk} + +\defun{isPartialMode}{isPartialMode} +The isPartialMode function tests whether m contains \verb|$EmptyMode|. The +constant \verb|$EmptyMode| evaluates to \verb?|$EmptyMode|?. This constant +is inserted in a modemap during compile time if the modemap is not yet +complete. + +\calls{isPartialMode}{contained} +\refsdollar{isPartialMode}{EmptyMode} +\begin{chunk}{defun isPartialMode} +(defun |isPartialMode| (m) + (declare (special |$EmptyMode|)) + (contained |$EmptyMode| m)) + +\end{chunk} + +\defun{hasCaty}{hasCaty} +This calls hasCat, which looks up a hashtable and returns: +\begin{verbatim} + 1. T, NIL or a (has x1 x2) condition, if cat is not parameterized + 2. a list of pairs (argument to cat,condition) otherwise +\end{verbatim} +then the substitution sl is augmented, or the result is 'failed +\calls{hasCaty}{hasAttSig} +\calls{hasCaty}{subCopy} +\calls{hasCaty}{constructSubst} +\calls{hasCaty}{hasSig} +\calls{hasCaty}{hasAtt} +\calls{hasCaty}{hasCat} +\calls{hasCaty}{opOf} +\calls{hasCaty}{kdr} +\calls{hasCaty}{mkDomPvar} +\calls{hasCaty}{domArg} +\calls{hasCaty}{augmentSub} +\calls{hasCaty}{domArg2} +\calls{hasCaty}{unifyStruct} +\calls{hasCaty}{hasCaty1} +\refsdollar{hasCaty}{domPvar} +\begin{chunk}{defun hasCaty} +(defun |hasCaty| (d cat sl) + (let (x y S z cond sp dom zp s1 ncond i) + (declare (special |$domPvar|)) + (cond + ((and (consp cat) (eq (qcar cat) 'category) (consp (qcdr cat))) + (|hasAttSig| d (|subCopy| (qcddr cat) (|constructSubst| d)) sl)) + ((and (consp cat) (eq (qcar cat) 'signature) (consp (qcdr cat)) + (consp (qcddr cat)) (eq (qcdddr cat) nil)) + (|hasSig| d (qcadr cat) (|subCopy| (qcaddr cat) (|constructSubst| d)) sl)) + ((and (consp cat) (eq (qcar cat) 'attribute) + (consp (qcdr cat)) (eq (qcddr cat) nil)) + (|hasAtt| d (|subCopy| (qcadr cat) (|constructSubst| d)) sl)) + ((setq x (|hasCat| (|opOf| d) (|opOf| cat))) + (cond + ((setq y (kdr cat)) + (setq s (|constructSubst| d)) + (do ((next x (cdr next)) (endtest nil (null (eq s1 '|failed|)))) + ((or (atom next) endtest) nil) + (setq z (caar next)) + (setq cond (cdar next)) + (setq sp + (loop for item in s + collect (cons (car item) (|mkDomPvar| (car item) (cdr item) z y)))) + (when |$domPvar| + (setq i -1) + (setq dom + (cons (car d) + (loop for arg in (rest d) + collect (|domArg| arg (incf i) z y)))) + (setq sl (|augmentSub| |$domPvar| dom (copy sl)))) + (setq zp + (loop for a in z + collect (|domArg2| a s sp))) + (setq s1 (|unifyStruct| y zp (copy sl))) + (cond + ((null (eq s1 '|failed|)) + (setq s1 + (cond + ((atom cond) s1) + (t + (setq ncond (|subCopy| cond s)) + (cond + ((and (consp ncond) (eq (qcar ncond) '|has|) + (consp (qcdr ncond)) (equal (qcadr ncond) d) + (consp (qcddr ncond)) (eq (qcdddr ncond) nil) + (equal (qcaddr ncond) cat)) + '|failed|) + (t (|hasCaty1| ncond s1))))))) + (t nil))) + s1) + ((atom x) sl) + (t + (setq ncond (|subCopy| x (|constructSubst| d))) + (cond + ((and (consp ncond) (eq (qcar ncond) '|has|) (consp (qcdr ncond)) + (equal (qcadr ncond) d) (consp (qcddr ncond)) + (eq (qcdddr ncond) nil) (equal (qcaddr ncond) cat)) + '|failed|) + (t (|hasCaty1| ncond sl)))))) + (t '|failed|)))) + +\end{chunk} + +\defun{domArg}{domArg} +\refsdollar{domArg}{FormalMapVariableList} +\begin{chunk}{defun domArg} +(defun |domArg| (type i subs y) + (let (p) + (declare (special |$FormalMapVariableList|)) + (if (setq p (member (elt |$FormalMapVariableList| i) subs)) + (elt y (- (|#| subs) (|#| p))) + type))) + +\end{chunk} + +\defun{domArg2}{domArg2} +\calls{domArg2}{isSharpVar} +\calls{domArg2}{subCopy} +\refsdollar{domArg2}{domPvar} +\begin{chunk}{defun domArg2} +(defun |domArg2| (arg sl1 sl2) + (declare (special |$domPvar|)) + (cond + ((|isSharpVar| arg) (|subCopy| arg sl1)) + ((and (eq arg '$) |$domPvar|) |$domPvar|) + (t (|subCopy| arg sl2)))) + +\end{chunk} + +\defun{hasSig}{hasSig} +The function hasSig tests whether domain dom has function foo with +signature sig under substitution sl. +\calls{hasSig}{constructor?} +\calls{hasSig}{cnstructSubst} +\calls{hasSig}{assq} +\calls{hasSig}{getOperationAlistFromLisplib} +\calls{hasSig}{hasCate} +\calls{hasSig}{subCopy} +\calls{hasSig}{hasSigAnd} +\calls{hasSig}{hasSigOr} +\calls{hasSig}{keyedSystemError} +\calls{hasSig}{unifyStruct} +\defsdollar{hasSig}{domPvar} +\begin{chunk}{defun hasSig} +(defun |hasSig| (dom foo sig sl) + (let (|$domPvar| fun s0 p x cond s) + (declare (special |$domPvar|)) + (cond + ((setq fun (|constructor?| (car dom))) + (setq s0 (|constructSubst| dom)) + (cond + ((setq p (assq foo (|getOperationAlistFromLisplib| (car dom)))) + (do ((next (cdr p) (cdr next)) + (endtest nil (null (eq s '|failed|)))) + ((or (atom next) endtest) nil) + (setq x (caar next)) + (setq cond (caddar next)) + (setq s + (cond + ((atom cond) (copy sl)) + ((and (consp cond) (eq (qcar cond) '|has|) + (consp (qcdr cond)) (consp (qcddr cond)) + (eq (qcdr (qcddr cond)) nil)) + (|hasCate| (|subCopy| (qcadr cond) s0) + (|subCopy| (qcaddr cond) s0) + (copy sl))) + ((and (consp cond) + (or (eq (qcar cond) 'and) (eq (qcar cond) '|and|))) + (|hasSigAnd| (qcdr cond) s0 sl)) + ((and (consp cond) + (or (eq (qcar cond) 'or) (eq (qcar cond) '|or|))) + (|hasSigOr| (qcdr cond) s0 sl)) + (t + (|keyedSystemError| 'S2GE0016 + (list "hasSig" "unexpected condition for signature"))))) + (unless (eq s '|failed|) + (setq s (|unifyStruct| (|subCopy| x s0) sig s)))) + s) + (t '|failed|))) + (t '|failed|)))) + +\end{chunk} + +\defun{hasAtt}{hasAtt} +The hasAtt function tests whether dom has attribute att under sl +needs s0 similar to hasSig. +\calls{hasAtt}{subCopy} +\calls{hasAtt}{getdatabase} +\calls{hasAtt}{constructSubst} +\calls{hasAtt}{getInfovec} +\calls{hasAtt}{unifyStruct} +\calls{hasAtt}{hasCatExpression} +\defsdollar{hasAtt}{domPvar} +\begin{chunk}{defun hasAtt} +(defun |hasAtt| (dom att sl) + (let (|$domPvar| fun atts u x cond s) + (declare (special |$domPvar|)) + (cond + ((setq fun (car dom)) + (cond + ((setq atts + (|subCopy| (getdatabase fun 'attributes) (|constructSubst| dom))) + (cond + ((consp (setq u (|getInfovec| (car dom)))) + (do ((next atts (cdr next)) + (endtest nil (null (eq s '|failed|)))) + ((or (atom next) endtest) nil) + (setq x (caar next)) + (setq cond (cdar next)) + (setq s (|unifyStruct| x att (copy sl))) + (cond + ((and (null (atom cond)) (null (eq s '|failed|))) + (setq s (|hasCatExpression| cond s))))) + s) + (t + (do ((next atts (cdr next)) + (endtest nil (null (eq s '|failed|)))) + ((or (atom next) endtest) nil) + (setq x (caar next)) + (setq cond (cadar next)) + (setq s (|unifyStruct| x att (copy sl))) + (cond + ((and (null (atom cond)) (null (eq s '|failed|))) + (setq s (|hasCatExpression| cond s))))) + s))) + (t '|failed|))) + (t '|failed|)))) + +\end{chunk} + +\defun{hasSigAnd}{hasSigAnd} +\calls{hasSigAnd}{hasCate} +\calls{hasSigAnd}{subCopy} +\calls{hasSigAnd}{keyedSystemError} +\begin{chunk}{defun hasSigAnd} +(defun |hasSigAnd| (andCls s0 sl) + (let (sa dead) + (setq sa '|failed|) + (loop for cls in andCls + do + (when dead (return)) + (setq sa + (cond + ((atom cls) (copy sl)) + ((and (consp cls) (eq (qcar cls) '|has|) (consp (qcdr cls)) + (consp (qcddr cls)) (eq (qcdddr cls) nil)) + (|hasCate| (|subCopy| (qcadr cls) s0) + (|subCopy| (qcaddr cls) s0) + (copy sl))) + (t + (|keyedSystemError| 'S2GE0016 + (list "hasSigAnd" "unexpected condition for signature"))))) + (when (eq sa '|failed|) (setq dead t))) + sa)) + +\end{chunk} + +\defun{hasSigOr}{hasSigOr} +\calls{hasSigOr}{hasCate} +\calls{hasSigOr}{hasSigAnd} +\calls{hasSigOr}{keyedSystemError} +\begin{chunk}{defun hasSigOr} +(defun |hasSigOr| (orCls s0 sl) + (let (sa found) + (setq sa '|failed|) + (loop for cls in orCls + until found + do + (setq sa + (cond + ((atom cls) (copy sl)) + ((and (consp cls) (eq (qcar cls) '|has|) (consp (qcdr cls)) + (consp (qcddr cls)) (eq (qcdddr cls) nil)) + (|hasCate| (|subCopy| (qcadr cls) s0) + (|subCopy| (qcaddr cls) s0) + (copy sl))) + ((and (consp cls) + (or (eq (qcar cls) 'and) (eq (qcar cls) '|and|))) + (|hasSigAnd| (qcdr cls) s0 sl)) + (t + (|keyedSystemError| 'S2GE0016 + (list "hasSigOr" "unexpected condition for signature"))))) + (unless (eq sa '|failed|) (setq found t))) + sa)) + +\end{chunk} + +\defun{hasAttSig}{hasAttSig} +The argument d is domain, x is a list of attributes and signatures. +The result is an augmented SL, if d has x, 'failed otherwise. + +\calls{hasAttSig}{hasAtt} +\calls{hasAttSig}{hasSig} +\calls{hasAttSig}{keyedSystemError} +\begin{chunk}{defun hasAttSig} +(defun |hasAttSig| (d x sl) + (loop for y in x + until (eq sl '|failed|) + do + (setq sl + (cond + ((and (consp y) (eq (qcar y) 'attribute) + (consp (qcdr y)) (eq (qcddr y) nil)) + (|hasAtt| d (qcadr y) sl)) + ((and (consp y) (eq (qcar y) 'signature) + (consp (qcdr y)) (consp (qcddr y)) (eq (qcdddr y) nil)) + (|hasSig| d (qcadr y) (qcaddr y) sl)) + (t + (|keyedSystemError| 'S2GE0016 + (list "hasAttSig" "unexpected form of unnamed category")))))) + sl) + +\end{chunk} + +\defun{hasCate1}{hasCate1} +\calls{hasCate1}{hasCate} +\defsdollar{hasCate1}{domPvar} +\begin{chunk}{defun hasCate1} +(defun |hasCate1| (dom cat sl domPvar) + (let (|$domPvar|) + (declare (special |$domPvar|)) + (setq |$domPvar| domPvar) + (|hasCate| dom cat sl))) + +\end{chunk} + +\defun{hasCatExpression}{hasCatExpression} +\calls{hasCatExpression}{hasCatExpression} +\calls{hasCatExpression}{hasCate} +\calls{hasCatExpression}{keyedSystemError} +\begin{chunk}{defun hasCatExpression} +(defun |hasCatExpression| (cond sl) + (let (y) + (cond + ((and (consp cond) (eq (qcar cond) 'or)) + (when + (let (result) + (loop for x in (qcdr cond) + do (setq result + (or result + (not (eq (setq y (|hasCatExpression| x sl)) '|failed|))))) + result) + y)) + ((and (consp cond) (eq (qcar cond) 'and)) + (when + (let ((result t)) + (loop for x in (qcdr cond) + do (setq result + (and result + (not (eq (setq sl (|hasCatExpression| x sl)) '|failed|))))) + result) + sl)) + ((and (consp cond) (eq (qcar cond) '|has|) + (consp (qcdr cond)) (consp (qcddr cond)) (eq (qcdddr cond) nil)) + (|hasCate| (qcadr cond) (qcaddr cond) sl)) + (t + (|keyedSystemError| 'S2GE0016 + (list "hasSig" "unexpected condition for attribute")))))) + +\end{chunk} + +\defun{unifyStruct}{unifyStruct} +\calls{unifyStruct}{isPatternVar} +\calls{unifyStruct}{unifyStructVar} +\calls{unifyStruct}{unifyStruct} +\begin{chunk}{defun unifyStruct} +(defun |unifyStruct| (s1 s2 sl) + (declare (special |$domPvar| |$hope| |$Coerce| |$Subst|)) + (cond + ((equal s1 s2) sl) + (t + (when (and (consp s1) (eq (qcar s1) '|:|) + (consp (qcdr s1)) (consp (qcddr s1)) (eq (qcdddr s1) nil)) + (setq s1 (qcadr s1))) + (when (and (consp s2) (eq (qcar s2) '|:|) + (consp (qcdr s2)) (consp (qcddr s2)) (eq (qcdddr s2) nil)) + (setq s2 (qcadr s2))) + (when (and (null (atom s1)) (eq (car s1) '|#|)) + (setq s1 (length (cadr s1)))) + (when (and (null (atom s2)) (eq (car s2) '|#|)) + (setq s2 (length (cadr s2)))) + (cond + ((equal s1 s2) sl) + ((|isPatternVar| s1) (|unifyStructVar| s1 s2 sl)) + ((|isPatternVar| s2) (|unifyStructVar| s2 s1 sl)) + ((or (atom s1) (atom s2)) '|failed|) + (t + (loop until (or (null s1) (null s2) (eq sl '|failed|)) + do + (setq sl (|unifyStruct| (car s1) (car s2) sl)) + (setq s1 (cdr s1)) + (setq s2 (cdr s2))) + (if (or s1 s2) '|failed| sl)))))) + +\end{chunk} + +\defun{unifyStructVar}{unifyStructVar} +The first argument is a pattern variable, which is not substituted by sl +\calls{unifyStructVar}{contained} +\calls{unifyStructVar}{lassoc} +\calls{unifyStructVar}{unifyStruct} +\calls{unifyStructVar}{constructor?} +\calls{unifyStructVar}{subCopy} +\calls{unifyStructVar}{containsVars} +\calls{unifyStructVar}{canCoerce} +\calls{unifyStructVar}{resolveTT} +\calls{unifyStructVar}{isPatternVar} +\calls{unifyStructVar}{augmentSub} +\refsdollar{unifyStructVar}{domPvar} +\refsdollar{unifyStructVar}{Coerce} +\refsdollar{unifyStructVar}{Subst} +\defsdollar{unifyStructVar}{hope} +\begin{chunk}{defun unifyStructVar} +(defun |unifyStructVar| (v ss sl) + (let (ps s1 s0 s ns0 ns1 s3) + (declare (special |$domPvar| |$hope| |$Coerce| |$Subst|)) + (cond + ((contained v ss) '|failed|) + (t + (setq ps (lassoc ss sl)) + (setq s1 (if ps ps ss)) + (cond + ((or (setq s0 (lassoc v sl)) (setq s0 (lassoc v |$Subst|))) + (setq s (|unifyStruct| s0 s1 (copy sl))) + (cond + ((eq s '|failed|) + (cond + ((and |$Coerce| (null (atom s0)) (|constructor?| (car s0))) + (cond + ((or (|containsVars| s0) (|containsVars| s1)) + (setq ns0 (|subCopy| s0 sl)) + (setq ns1 (|subCopy| s1 sl)) + (cond + ((or (|containsVars| ns0) (|containsVars| ns1)) + (setq |$hope| t) + '|failed|) + (t + (cond + ((|canCoerce| ns0 ns1) (setq s3 s1)) + ((|canCoerce| ns1 ns0) (setq s3 s0)) + (t (setq s3 nil))) + (cond + (s3 + (cond + ((not (equal s3 s0)) + (setq sl (|augmentSub| v s3 sl)))) + (cond + ((and (not (equal s3 s1)) (|isPatternVar| ss)) + (setq sl (|augmentSub| ss s3 sl)))) + sl) + (t '|failed|))))) + (|$domPvar| + (setq s3 (|resolveTT| s0 s1)) + (cond + (s3 + (cond + ((not (equal s3 s0)) + (setq sl (|augmentSub| v s3 sl)))) + (cond + ((and (not (equal s3 s1)) (|isPatternVar| ss)) + (setq sl (|augmentSub| ss s3 sl)))) + sl) + (t '|failed|))) + (t '|failed|))) + (t '|failed|))) + (t (|augmentSub| v ss s)))) + (t (|augmentSub| v ss sl))))))) + +\end{chunk} + +\defun{containsVars}{containsVars} +The function containsVars tests whether term t contains a * variable. + +\calls{containsVars}{isPatternVar} +\calls{containsVars}{containsVars1} +\begin{chunk}{defun containsVars} +(defun |containsVars| (arg) + (if (atom arg) + (|isPatternVar| arg) + (|containsVars1| arg))) + +\end{chunk} + +\defun{isPatternVar}{isPatternVar} +\begin{chunk}{defun isPatternVar} +(defun |isPatternVar| (v) + (and (identp v) + (member v + '(** *1 *2 *3 *4 *5 *6 *7 *8 *9 *10 *11 *12 *13 *14 *15 + *16 *17 *18 *19 *20)) + t)) + +\end{chunk} + +\defun{containsVars1}{containsVars1} +The function containsVars1 tests whether term t contains a * variable. +This is a recursive version, which works on a list. + +\calls{containsVars1}{isPatternVar} +\calls{containsVars1}{containsVars1} +\begin{chunk}{defun containsVars1} +(defun |containsVars1| (arg) + (let ((t1 (car arg)) (t2 (cdr arg))) + (if (atom t1) + (or (|isPatternVar| t1) + (if (atom t2) (|isPatternVar| t2) (|containsVars1| t2))) + (or (|containsVars1| t1) + (if (atom t2) (|isPatternVar| t2) (|containsVars1| t2)))))) + +\end{chunk} + +\defun{hasCaty1}{hasCaty1} +The cond is either a (has a b) or an OR clause of such conditions. +SL is augmented, if cond is true, otherwise the result is 'failed + +\calls{hasCaty1}{hasCate} +\calls{hasCaty1}{hasCaty1} +\calls{hasCaty1}{keyedSystemError} +\defsdollar{hasCaty1}{domPvar} +\begin{chunk}{defun hasCaty1} +(defun |hasCaty1| (cond sl) + (let (|$domPvar| a s) + (declare (special |$domPvar|)) + (setq |$domPvar| nil) + (cond + ((and (consp cond) (eq (qcar cond) '|has|) + (consp (qcdr cond)) (consp (qcddr cond)) (eq (qcdddr cond) nil)) + (|hasCate| (qcadr cond) (qcaddr cond) sl)) + ((and (consp cond) (EQ (qcar cond) 'and)) + (loop for x in (qcdr cond) + while (not (eq s '|failed|)) + do + (setq s + (cond + ((and (consp x) (eq (qcar x) '|has|) + (consp (qcdr x)) (consp (qcddr x)) (eq (qcdr (qcddr x)) nil)) + (|hasCate| (qcadr x) (qcaddr x) sl)) + ((and (consp x) (eq (qcdr x) nil) + (consp (qcar x)) (eq (qcaar x) '|has|) + (consp (qcdar x)) (consp (qcddar x)) + (eq (qcdr (qcddar x)) nil)) + (|hasCate| a (qcaddar x) sl)) + (t (|hasCaty1| x sl))))) + s) + ((and (consp cond) (eq (qcar cond) 'or)) + (do ((next (qcdr cond) (cdr next)) (x nil) + (nextitem nil (null (eq s '|failed|)))) + ((or (atom next) + (progn (setq x (car next)) nil) + nextitem) + nil) + (setq s + (cond + ((and (consp x) (eq (qcar x) '|has|) + (consp (qcdr x)) (consp (qcddr x)) (eq (qcdddr x) nil)) + (|hasCate| (qcadr x) (qcaddr x) (copy sl))) + ((and (consp x) (eq (qcdr x) nil) (consp (qcar x)) + (eq (qcaar x) '|has|) (consp (qcdar x)) (consp (qcddar x)) + (eq (qcdddar x) nil)) + (|hasCate| (qcadar x) (qcaddar x) (copy sl))) + (t (|hasCaty1| x (copy sl)))))) + s) + (t + (|keyedSystemError| 'S2GE0016 + (list "hasCaty1" "unexpected condition from category table")))))) + +\end{chunk} + +\defun{mkDomPvar}{mkDomPvar} +\calls{mkDomPvar}{domArg} +\calls{mkDomPvar}{length} +\refsdollar{mkDomPvar}{FormalMapVariableList} +\begin{chunk}{defun mkDomPvar} +(defun |mkDomPvar| (p d subs y) + (let (l) + (declare (special |$FormalMapVariableList|)) + (if (setq l (member p |$FormalMapVariableList|)) + (|domArg| d (- (|#| |$FormalMapVariableList|) (|#| l)) subs y) + d))) + +\end{chunk} + +\defun{hasCate}{hasCate} +\calls{hasCate}{isPatternVar} +\calls{hasCate}{hasCate1} +\calls{hasCate}{hasCateSpecial} +\calls{hasCate}{containsVariables} +\calls{hasCate}{subCopy} +\calls{hasCate}{hasCaty} +\refsdollar{hasCate}{EmptyMode} +\refsdollar{hasCate}{Subst} +\defsdollar{hasCate}{hope} +\begin{chunk}{defun hasCate} +(defun |hasCate| (dom cat sl) + (let (nsl p s sl1) + (declare (special |$hope| |$Subst| |$EmptyMode|)) + (cond + ((equal dom |$EmptyMode|) nil) + ((|isPatternVar| dom) + (cond + ((and (setq p (assq dom sl)) + (not (eq (setq nsl (|hasCate| (cdr p) cat sl)) '|failed|))) + nsl) + ((or (setq p (assq dom |$Subst|)) (setq p (assq dom sl))) + (setq s (|hasCate1| (cdr p) cat sl dom)) + (cond + ((null (eq s '|failed|)) s) + (t (|hasCateSpecial| dom (cdr p) cat sl)))) + (t + (when (not (eq sl '|failed|)) (setq |$hope| t)) + '|failed|))) + (t + (setq sl1 + (loop for item in sl + when (null (|containsVariables| (cdr item))) + collect item)) + (when sl1 (setq cat (|subCopy| cat sl1))) + (|hasCaty| dom cat sl))))) + +\end{chunk} + +\defun{constructSubst}{constructSubst} +\calls{constructSubst}{internl} +\calls{constructSubst}{stringimage} +\begin{chunk}{defun constructSubst} +(defun |constructSubst| (d) + (let (sl (i 0)) + (setq sl (list (cons '$ d))) + (when (listp d) + (dolist (x (cdr d)) + (setq i (1+ i)) + (setq sl (cons (cons (internl "#" (stringimage i)) x) sl)))) + sl)) + +\end{chunk} + +\defun{hasCateSpecial}{hasCateSpecial} +The variable v is a pattern variable, dom is its binding under \verb|$Subst|. +We try to change dom so that it has category cat under sl. +The result is a substitution list or 'failed. + +\calls{hasCateSpecial}{eqcar} +\calls{hasCateSpecial}{isSubDomain} +\calls{hasCateSpecial}{canCoerceFrom} +\calls{hasCateSpecial}{containsVars} +\calls{hasCateSpecial}{augmentSub} +\calls{hasCateSpecial}{hasCate} +\calls{hasCateSpecial}{hasCaty} +\calls{hasCateSpecial}{hasCateSpecialNew} +\refsdollar{hasCateSpecial}{Integer} +\refsdollar{hasCateSpecial}{QuotientField} +\begin{chunk}{defun hasCateSpecial} +(defun |hasCateSpecial| (v dom cat sl) + (let (arg d domp nsl) + (declare (special |$Integer| |$QuotientField|)) + (cond + ((and (consp dom) (eq (qcar dom) '|FactoredForm|) + (consp (qcdr dom)) (eq (qcddr dom) nil)) + (setq arg (qcadr dom)) + (when (|isSubDomain| arg |$Integer|) (setq arg |$Integer|)) + (setq d (list '|FactoredRing| arg)) + (setq sl (|hasCate| arg '(|Ring|) (|augmentSub| v d sl))) + (if (eq sl '|failed|) + '|failed| + (|hasCaty| d cat sl))) + ((or (eqcar cat '|Field|) (eqcar cat '|DivisionRing|)) + (when (|isSubDomain| dom |$Integer|) (setq dom |$Integer|)) + (setq d (list |$QuotientField| dom)) + (|hasCaty| dom '(|IntegralDomain|) (|augmentSub| v d sl))) + ((and (consp cat) (eq (qcar cat) '|PolynomialCategory|) + (consp (qcdr cat))) + (setq domp (cons '|Polynomial| (list (qcadr cat)))) + (and (or (|containsVars| (qcadr cat)) (|canCoerceFrom| dom domp)) + (|hasCaty| domp cat (|augmentSub| v domp sl)))) + ((|isSubDomain| dom |$Integer|) + (setq nsl (|hasCate| |$Integer| cat (|augmentSub| v |$Integer| sl))) + (if (eq nsl '|failed|) + (|hasCateSpecialNew| v dom cat sl) + (|hasCaty| |$Integer| cat nsl))) + (t + (|hasCateSpecialNew| v dom cat sl))))) + +\end{chunk} + +\defun{hasCateSpecialNew}{hasCateSpecialNew} +\calls{hasCateSpecialNew}{member} +\calls{hasCateSpecialNew}{eqcar} +\calls{hasCateSpecialNew}{augmentSub} +\calls{hasCateSpecialNew}{defaultTargetFE} +\calls{hasCateSpecialNew}{isEqualOrSubDomain} +\calls{hasCateSpecialNew}{underDomainOf} +\calls{hasCateSpecialNew}{hasCaty} +\refsdollar{hasCateSpecialNew}{Integer} +\refsdollar{hasCateSpecialNew}{ComplexInteger} +\refsdollar{hasCateSpecialNew}{RationalNumber} +\begin{chunk}{defun hasCateSpecialNew} +(defun |hasCateSpecialNew| (v dom cat sl) + (let (fe alg fefull d partialResult) + (declare (special |$RationalNumber| |$ComplexInteger| |$Integer|)) + (setq fe + (|member| (qcar cat) + '(|ElementaryFunctionCategory| + |TrigonometricFunctionCategory| + |ArcTrigonometricFunctionCategory| + |HyperbolicFunctionCategory| + |ArcHyperbolicFunctionCategory| + |PrimitiveFunctionCategory| + |SpecialFunctionCategory| + |Evalable| + |CombinatorialOpsCategory| + |TranscendentalFunctionCategory| + |AlgebraicallyClosedFunctionSpace| + |ExpressionSpace| + |LiouvillianFunctionCategory| + |FunctionSpace|))) + (setq alg + (|member| (qcar cat) + '(|RadicalCategory| + |AlgebraicallyClosedField|))) + (setq fefull + (or fe alg (eqcar cat '|CombinatorialFunctionCategory|))) + (setq partialResult + (cond + ((or (eqcar dom '|Variable|) (eqcar dom '|Symbol|)) + (cond + ((|member| (car cat) + '(|SemiGroup| + |AbelianSemiGroup| + |Monoid| + |AbelianGroup| + |AbelianMonoid| + |PartialDifferentialRing| + |Ring| + |InputForm|)) + (setq d (list '|Polynomial| |$Integer|)) + (|augmentSub| v d sl)) + ((eqcar cat '|Group|) + (setq d (list '|Fraction| (list '|Polynomial| |$Integer|))) + (|augmentSub| v d sl)) + (fefull + (setq d (|defaultTargetFE| dom)) + (|augmentSub| v d sl)) + (t '|failed|))) + ((|isEqualOrSubDomain| dom |$Integer|) + (cond + (fe + (setq d (|defaultTargetFE| |$Integer|)) + (|augmentSub| v d sl)) + (alg + (setq d '(|AlgebraicNumber|)) + (|augmentSub| v d sl)) + (t '|failed|))) + ((equal (|underDomainOf| dom) |$ComplexInteger|) + (setq d (|defaultTargetFE| |$ComplexInteger|)) + (|hasCaty| d cat (|augmentSub| v d sl))) + ((and (equal dom |$RationalNumber|) alg) + (setq d '(|AlgebraicNumber|)) + (|augmentSub| v d sl)) + (fefull + (setq d (|defaultTargetFE| dom)) + (|augmentSub| v d sl)) + (t '|failed|))) + (if (eq partialResult '|failed|) + '|failed| + (|hasCaty| d cat partialResult)))) + +\end{chunk} + +\defun{defaultTargetFE}{defaultTargetFE} +\calls{defaultTargetFE}{typeIsASmallInteger} +\calls{defaultTargetFE}{isEqualOrSubDomain} +\calls{defaultTargetFE}{ifcar} +\calls{defaultTargetFE}{defaultTargetFE} +\refsdollar{defaultTargetFE}{FunctionalExpression} +\refsdollar{defaultTargetFE}{Integer} +\refsdollar{defaultTargetFE}{Symbol} +\refsdollar{defaultTargetFE}{RationalNumber} +\begin{chunk}{defun defaultTargetFE} +(defun |defaultTargetFE| (&rest dom) + (let (a options) + (declare (special |$FunctionalExpression| |$Integer| |$Symbol| + |$RationalNumber|)) + (setq a (car dom)) + (setq options (cdr dom)) + (cond + ((or (and (consp a) (eq (qcar a) '|Variable|) + (consp (qcdr a)) (eq (qcddr a) nil)) + (equal a |$RationalNumber|) + (member (qcar a) (list (qcar |$Symbol|) '|RationalRadicals| '|Pi|)) + (|typeIsASmallInteger| a) + (|isEqualOrSubDomain| a |$Integer|) + (equal a '(|AlgebraicNumber|))) + (if (ifcar options) + (list |$FunctionalExpression| (list '|Complex| |$Integer|)) + (list |$FunctionalExpression| |$Integer|))) + ((and (consp a) (eq (qcar a) '|Complex|) + (consp (qcdr a)) (eq (qcddr a) nil)) + (|defaultTargetFE| (qcadr a) t)) + ((and (consp a) (consp (qcdr a)) (eq (qcddr a) nil) + (member (qcar a) '(|Polynomial| |RationalFunction| |Fraction|))) + (|defaultTargetFE| (qcadr a) (ifcar options))) + ((and (consp a) (equal (qcar a) |$FunctionalExpression|) + (consp (qcdr a)) (eq (qcddr a) nil)) + a) + ((ifcar options) + (list |$FunctionalExpression| (list '|Complex| a))) + (t + (list |$FunctionalExpression| a))))) + +\end{chunk} + +\defun{isEqualOrSubDomain}{isEqualOrSubDomain} +\calls{isEqualOrSubDomain}{isSubDomain} +\begin{chunk}{defun isEqualOrSubDomain} +(defun |isEqualOrSubDomain| (d1 d2) + (or (equal d1 d2) + (|isSubDomain| d1 d2) + (and (atom d1) + (or (and (consp d2) (eq (qcar d2) '|Variable|) + (consp (qcdr d2)) (eq (qcddr d2) nil) + (equal (qcadr d2) d1)) + (and (consp d2) (eq (qcdr d2) nil) + (equal (qcar d2) d1)))) + (and (atom d2) + (or (and (consp d1) (eq (qcar d1) '|Variable|) + (consp (qcdr d1)) (eq (qcddr d1) nil) + (equal (qcadr d1) d2)) + (and (consp d1) (eq (qcdr d1) nil) + (equal (qcar d1) d2)))))) + +\end{chunk} + +\chapter{System Command Handling} +The system commands are the top-level commands available in Axiom +that can all be invoked by prefixing the symbol with a closed-paren. +Thus, to see they copyright you type: +\begin{verbatim} + )copyright +\end{verbatim} +New commands need to be added to this table. The command invoked will +be the first entry of the pair and the ``user level'' of the command +will be the second entry. + +See:\\ +\begin{itemize} +\item The \fnref{abbreviations} command +\item The \fnref{boot} command +\item The \fnref{browse} command +\item The \fnref{cd} command +\item The \fnref{clear} command +\item The \fnref{close} command +\item The \fnref{compile} command +\item The \fnref{copyright} command +\item The \fnref{credits} command +\item The \fnref{display} command +\item The \fnref{edit} command +\item The \fnref{fin} command +\item The \fnref{frame} command +\item The \fnref{help} command +\item The \fnref{history} command +\item The \fnref{lisp} command +\item The \fnref{library} command +\item The \fnref{load} command +\item The \fnref{ltrace} command +\item The \fnref{pquit} command +\item The \fnref{quit} command +\item The \fnref{read} command +\item The \fnref{regress} command +\item The \fnref{savesystem} command +\item The \fnref{set} command +\item The \fnref{show} command +\item The \fnref{spool} command +\item The \fnref{summary} command +\item The \fnref{synonym} command +\item The \fnref{system} command +\item The \fnref{tangle} command +\item The \fnref{trace} command +\item The \fnref{trademark} command +\item The \fnref{undo} command +\item The \fnref{what} command +\item The \fnref{with} command +\item The \fnref{workfiles} command +\item The \fnref{zsystemdevelopment} command +\end{itemize} + +\section{Variables Used} +\defdollar{systemCommands} +\begin{chunk}{initvars} +(defvar |$systemCommands| nil) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) + (setq |$systemCommands| + '( + (|abbreviations| . |compiler| ) + (|boot| . |development|) + (|browse| . |development|) + (|cd| . |interpreter|) + (|clear| . |interpreter|) + (|close| . |interpreter|) + (|compiler| . |compiler| ) + (|copyright| . |interpreter|) + (|credits| . |interpreter|) + (|describe| . |interpreter|) + (|display| . |interpreter|) + (|edit| . |interpreter|) + (|fin| . |development|) + (|frame| . |interpreter|) + (|help| . |interpreter|) + (|history| . |interpreter|) + (|lisp| . |development|) + (|library| . |interpreter|) + (|load| . |interpreter|) + (|ltrace| . |interpreter|) + (|pquit| . |interpreter|) + (|quit| . |interpreter|) + (|read| . |interpreter|) + (|regress| . |interpreter|) + (|savesystem| . |interpreter|) + (|set| . |interpreter|) + (|show| . |interpreter|) + (|spool| . |interpreter|) + (|summary| . |interpreter|) + (|synonym| . |interpreter|) + (|system| . |interpreter|) + (|tangle| . |interpreter|) + (|trace| . |interpreter|) + (|trademark| . |interpreter|) + (|undo| . |interpreter|) + (|what| . |interpreter|) + (|with| . |interpreter|) + (|workfiles| . |development|) + (|zsystemdevelopment| . |interpreter|) + ))) + +\end{chunk} + +\defdollar{syscommands} +This table is used to look up a symbol to see if it might be a command. +\begin{chunk}{initvars} +(defvar $syscommands nil) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) + (setq $syscommands (mapcar #'car |$systemCommands|))) + +\end{chunk} + +\defdollar{noParseCommands} +This is a list of the commands which have their arguments passed verbatim. +Certain functions, such as the lisp function need to be able to handle +all kinds of input that will not be acceptable to the interpreter. +\begin{chunk}{initvars} +(defvar |$noParseCommands| nil) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) + (setq |$noParseCommands| + '(|boot| |copyright| |credits| |fin| |lisp| |pquit| |quit| + |synonym| |system| |trademark| ))) + +\end{chunk} + +\section{Functions} +\defun{handleNoParseCommands}{handleNoParseCommands} +The system commands given by the global variable +\verb|$noParseCommands| require essentially no preprocessing/parsing +of their arguments. Here we dispatch the functions which implement +these commands. + +There are four standard commands which receive arguments +\begin{itemize} +\item boot +\item lisp +\item synonym +\item system +\end{itemize} + +There are six standard commands which do not receive arguments -- +\begin{itemize} +\item quit +\item fin +\item pquit +\item credits +\item copyright +\item trademark +\end{itemize} + +As these commands do not necessarily +exhaust those mentioned in \verb|$noParseCommands|, we provide a +generic dispatch based on two conventions: commands which do not +require an argument name themselves, those which do have their names +prefixed by ``np''. This makes it possible to dynamically define +new system commands provided you handle the argument parsing. + +\defun{doSystemCommand}{Handle a top level command} +\calls{doSystemCommand}{concat} +\calls{doSystemCommand}{expand-tabs} +\calls{doSystemCommand}{processSynonyms} +\calls{doSystemCommand}{substring} +\calls{doSystemCommand}{getFirstWord} +\calls{doSystemCommand}{unAbbreviateKeyword} +\calls{doSystemCommand}{member} +\calls{doSystemCommand}{handleNoParseCommands} +\calls{doSystemCommand}{splitIntoOptionBlocks} +\calls{doSystemCommand}{handleTokensizeSystemCommands} +\calls{doSystemCommand}{handleParsedSystemCommands} +\usesdollar{doSystemCommand}{tokenCommands} +\usesdollar{doSystemCommand}{noParseCommands} +\uses{doSystemCommand}{line} +\begin{chunk}{defun doSystemCommand} +(defun |doSystemCommand| (string) + (let (line tok unab optionList) + (declare (special line |$tokenCommands| |$noParseCommands|)) + (setq string (concat ")" (expand-tabs string))) + (setq line string) + (|processSynonyms|) + (setq string line) + (setq string (substring string 1 nil)) + (cond + ((string= string "") nil) + (t + (setq tok (|getFirstWord| string)) + (cond + (tok + (setq unab (|unAbbreviateKeyword| tok)) + (cond + ((|member| unab |$noParseCommands|) + (|handleNoParseCommands| unab string)) + (t + (setq optionList (|splitIntoOptionBlocks| string)) + (cond + ((|member| unab |$tokenCommands|) + (|handleTokensizeSystemCommands| unab optionList)) + (t + (|handleParsedSystemCommands| unab optionList) + nil))))) + (t nil)))))) + +\end{chunk} + +\defun{splitIntoOptionBlocks}{Split block into option block} +\calls{splitIntoOptionBlocks}{stripSpaces} +\begin{chunk}{defun splitIntoOptionBlocks} +(defun |splitIntoOptionBlocks| (str) + (let (inString block (blockStart 0) (parenCount 0) blockList) + (dotimes (i (1- (|#| str))) + (cond + ((char= (elt str i) #\" ) (setq inString (null inString))) + (t + (when (and (char= (elt str i) #\( ) (null inString)) + (incf parenCount)) + (when (and (char= (elt str i) #\) ) (null inString)) + (decf parenCount)) + (when + (and (char= (elt str i) #\) ) + (null inString) + (= parenCount -1)) + (setq block (|stripSpaces| (subseq str blockStart i))) + (setq blockList (cons block blockList)) + (setq blockStart (1+ i)) + (setq parenCount 0))))) + (setq blockList (cons (|stripSpaces| (subseq str blockStart)) blockList)) + (nreverse blockList))) + +\end{chunk} + +\defun{handleTokensizeSystemCommands}{Tokenize a system command} +\calls{handleTokensizeSystemCommands}{dumbTokenize} +\calls{handleTokensizeSystemCommands}{tokTran} +\calls{handleTokensizeSystemCommands}{systemCommand} +\begin{chunk}{defun handleTokensizeSystemCommands} +(defun |handleTokensizeSystemCommands| (unabr optionList) + (declare (ignore unabr)) + (let (parcmd) + (setq optionList (mapcar #'(lambda (x) (|dumbTokenize| x)) optionList)) + (setq parcmd + (mapcar #'(lambda (opt) (mapcar #'(lambda (tok) (|tokTran| tok)) opt)) + optionLIst)) + (when parcmd (|systemCommand| parcmd)))) + +\end{chunk} + +\defun{systemCommand}{Handle system commands} +You can type ``)?'' and see trivial help information. +You can type ``)? compile'' and see compiler related information + +\calls{systemCommand}{selectOptionLC} +\calls{systemCommand}{helpSpad2Cmd} +\calls{systemCommand}{selectOption} +\calls{systemCommand}{commandsForUserLevel} +\usesdollar{systemCommand}{options} +\usesdollar{systemCommand}{e} +\usesdollar{systemCommand}{systemCommands} +\usesdollar{systemCommand}{syscommands} +\usesdollar{systemCommand}{CategoryFrame} +\begin{chunk}{defun systemCommand} +(defun |systemCommand| (cmd) + (let (|$options| |$e| op argl options fun) + (declare (special |$options| |$e| |$systemCommands| $syscommands + |$CategoryFrame|)) + (setq op (caar cmd)) + (setq argl (cdar cmd)) + (setq options (cdr cmd)) + (setq |$options| options) + (setq |$e| |$CategoryFrame|) + (setq fun (|selectOptionLC| op $syscommands '|commandError|)) + (if (and argl (eq (elt argl 0) '?) (not (eq fun '|synonym|))) + (|helpSpad2Cmd| (cons fun nil)) + (progn + (setq fun + (|selectOption| fun (|commandsForUserLevel| |$systemCommands|) + '|commandUserLevelError|)) + (funcall fun argl))))) + +\end{chunk} + +\defun{commandsForUserLevel}{Select commands matching this user level} +The \verb|$UserLevel| contains one of three values: +{\tt compiler}, {\tt development}, or {\tt interpreter}. This variable +is used to select a subset of commands from the list stored in +\verb|$systemCommands|, representing all of the commands that are +valid for this level. +\calls{commandsForUserLevel}{satisfiesUserLevel} +\begin{chunk}{defun commandsForUserLevel} +(defun |commandsForUserLevel| (arg) + (let (c) + (dolist (pair arg) + (when (|satisfiesUserLevel| (cdr pair)) + (setq c (cons (car pair) c)))) + (nreverse c))) + +\end{chunk} + +\defun{commandError}{No command begins with this string} +\calls{commandError}{commandErrorMessage} +\begin{chunk}{defun commandError} +(defun |commandError| (x u) + (|commandErrorMessage| '|command| x u)) + +\end{chunk} + +\defun{optionError}{No option begins with this string} +\calls{optionError}{commandErrorMessage} +\begin{chunk}{defun optionError} +(defun |optionError| (x u) + (|commandErrorMessage| '|option| x u)) + +\end{chunk} + +\defdollar{oldline} +\begin{chunk}{initvars} +(defvar $oldline nil "used to output command lines") + +\end{chunk} + +\defun{commandErrorMessage}{No command/option begins with this string} +\calls{commandErrorMessage}{commandAmbiguityError} +\calls{commandErrorMessage}{sayKeyedMsg} +\calls{commandErrorMessage}{terminateSystemCommand} +\usesdollar{commandErrorMessage}{oldline} +\uses{commandErrorMessage}{line} +\begin{chunk}{defun commandErrorMessage} +(defun |commandErrorMessage| (kind x u) + (declare (special $oldline line)) + (setq $oldline line) + (if u + (|commandAmbiguityError| kind x u) + (progn + (|sayKeyedMsg| 'S2IZ0008 (list kind x)) + (|terminateSystemCommand|)))) + +\end{chunk} + +\defun{optionUserLevelError}{Option not available at this user level} +\calls{optionUserLevelError}{userLevelErrorMessage} +\begin{chunk}{defun optionUserLevelError} +(defun |optionUserLevelError| (x u) + (|userLevelErrorMessage| '|option| x u)) + +\end{chunk} + +\defun{commandUserLevelError}{Command not available at this user level} +\calls{commandUserLevelError}{userLevelErrorMessage} +\begin{chunk}{defun commandUserLevelError} +(defun |commandUserLevelError| (x u) + (|userLevelErrorMessage| '|command| x u)) + +\end{chunk} + +\defun{userLevelErrorMessage}{Command not available error message} +\calls{userLevelErrorMessage}{commandAmbiguityError} +\calls{userLevelErrorMessage}{sayKeyedMsg} +\calls{userLevelErrorMessage}{terminateSystemCommand} +\usesdollar{userLevelErrorMessage}{UserLevel} +\begin{chunk}{defun userLevelErrorMessage} +(defun |userLevelErrorMessage| (kind x u) + (declare (special |$UserLevel|)) + (if u + (|commandAmbiguityError| kind x u) + (progn + (|sayKeyedMsg| 'S2IZ0007 (list |$UserLevel| kind)) + (|terminateSystemCommand|)))) + +\end{chunk} + +\defun{satisfiesUserLevel}{satisfiesUserLevel} +\usesdollar{satisfiesUserLevel}{UserLevel} +\begin{chunk}{defun satisfiesUserLevel 0} +(defun |satisfiesUserLevel| (x) + (declare (special |$UserLevel|)) + (cond + ((eq x '|interpreter|) t) + ((eq |$UserLevel| '|interpreter|) nil) + ((eq x '|compiler|) t) + ((eq |$UserLevel| '|compiler|) nil) + (t t))) + +\end{chunk} + +\defun{hasOption}{hasOption} +\calls{hasOption}{stringPrefix?} +\calls{hasOption}{pname} +\begin{chunk}{defun hasOption} +(defun |hasOption| (al opt) + (let ((optPname (pname opt)) found) + (loop for pair in al do + (when (|stringPrefix?| (pname (car pair)) optPname) (setq found pair)) + until found) + found)) + +\end{chunk} + +\defun{terminateSystemCommand}{terminateSystemCommand} +\calls{terminateSystemCommand}{tersyscommand} +\begin{chunk}{defun terminateSystemCommand} +(defun |terminateSystemCommand| nil (tersyscommand)) + +\end{chunk} + +\defun{tersyscommand}{Terminate a system command} +\calls{tersyscommand}{spadThrow} +\begin{chunk}{defun tersyscommand} +(defun tersyscommand () + (let (chr tok) + (fresh-line) + (setq chr 'endoflinechr) + (setq tok 'end_unit) + (|spadThrow|))) + +\end{chunk} + +\defun{commandAmbiguityError}{commandAmbiguityError} +\calls{commandAmbiguityError}{sayKeyedMsg} +\calls{commandAmbiguityError}{sayMSG} +\calls{commandAmbiguityError}{bright} +\calls{commandAmbiguityError}{terminateSystemCommand} +\begin{chunk}{defun commandAmbiguityError} +(defun |commandAmbiguityError| (kind x u) + (|sayKeyedMsg| 's2iz0009 (list kind x)) + (dolist (a u) (|sayMSG| (cons " " (|bright| a)))) + (|terminateSystemCommand|)) + +\end{chunk} + +\defun{getParserMacroNames}{getParserMacroNames} +The \verb|$pfMacros| is a list of all of the user-defined macros. + +\usesdollar{getParserMacroNames}{pfMacros} +\begin{chunk}{defun getParserMacroNames 0} +(defun |getParserMacroNames| () + (declare (special |$pfMacros|)) + (remove-duplicates (mapcar #'car |$pfMacros|))) + +\end{chunk} + +\defun{clearParserMacro}{clearParserMacro} +Note that if a macro is defined twice this will clear the last instance. +Thus: +\begin{verbatim} + a ==> 3 + a ==> 4 + )d macros + a ==> 4 + )clear prop a + )d macros + a ==> 3 + )clear prop a + )d macros + nil +\end{verbatim} +\calls{clearParserMacro}{ifcdr} +\calls{clearParserMacro}{assoc} +\calls{clearParserMacro}{remalist} +\usesdollar{clearParserMacro}{pfMacros} +\begin{chunk}{defun clearParserMacro} +(defun |clearParserMacro| (macro) + (declare (special |$pfMacros|)) + (when (ifcdr (|assoc| macro |$pfMacros|)) + (setq |$pfMacros| (remalist |$pfMacros| macro)))) + +\end{chunk} + +\defun{displayMacro}{displayMacro} +\calls{displayMacro}{isInterpMacro} +\calls{displayMacro}{sayBrightly} +\calls{displayMacro}{bright} +\calls{displayMacro}{strconc} +\calls{displayMacro}{object2String} +\calls{displayMacro}{mathprint} +\usesdollar{displayMacro}{op} +\begin{chunk}{defun displayMacro} +(defun |displayMacro| (name) + (let (|$op| m body args) + (declare (special |$op|)) + (setq m (|isInterpMacro| name)) + (cond + ((null m) + (|sayBrightly| + (cons " " (append (|bright| name) + (cons "is not an interpreter macro." nil))))) + (t + (setq |$op| (strconc "macro " (|object2String| name))) + (setq args (car m)) + (setq body (cdr m)) + (setq args + (cond + ((null args) nil) + ((null (cdr args)) (car args)) + (t (cons '|Tuple| args)))) + (|mathprint| (cons 'map (cons (cons args body) nil))))))) + +\end{chunk} + +\defun{displayWorkspaceNames}{displayWorkspaceNames} +\calls{displayWorkspaceNames}{getInterpMacroNames} +\calls{displayWorkspaceNames}{getParserMacroNames} +\calls{displayWorkspaceNames}{sayMessage} +\calls{displayWorkspaceNames}{msort} +\calls{displayWorkspaceNames}{getWorkspaceNames} +\calls{displayWorkspaceNames}{sayAsManyPerLineAsPossible} +\calls{displayWorkspaceNames}{sayBrightly} +\calls{displayWorkspaceNames}{setdifference} +\begin{chunk}{defun displayWorkspaceNames} +(defun |displayWorkspaceNames| () + (let (pmacs names imacs) + (setq imacs (|getInterpMacroNames|)) + (setq pmacs (|getParserMacroNames|)) + (|sayMessage| "Names of User-Defined Objects in the Workspace:") + (setq names (msort (append (|getWorkspaceNames|) pmacs))) + (if names + (|sayAsManyPerLineAsPossible| (mapcar #'|object2String| names)) + (|sayBrightly| " * None *")) + (setq imacs (setdifference imacs pmacs)) + (when imacs + (|sayMessage| "Names of System-Defined Objects in the Workspace:") + (|sayAsManyPerLineAsPossible| (mapcar #'|object2String| imacs))))) + +\end{chunk} + +\defun{getWorkspaceNames}{getWorkspaceNames} +\begin{verbatim} +;getWorkspaceNames() == +; NMSORT [n for [n,:.] in CAAR $InteractiveFrame | +; (n ^= "--macros--" and n^= "--flags--")] +\end{verbatim} +\calls{getWorkspaceNames}{seq} +\calls{getWorkspaceNames}{nmsort} +\calls{getWorkspaceNames}{exit} +\usesdollar{getWorkspaceNames}{InteractiveFrame} +\begin{chunk}{defun getWorkspaceNames} +(defun |getWorkspaceNames| () + (PROG (n) + (declare (special |$InteractiveFrame|)) + (return + (seq (nmsort (PROG (G166322) + (setq G166322 NIL) + (RETURN + (DO ((G166329 (CAAR |$InteractiveFrame|) + (CDR G166329)) + (G166313 NIL)) + ((OR (ATOM G166329) + (PROGN + (SETQ G166313 (CAR G166329)) + NIL) + (PROGN + (PROGN + (setq n (CAR G166313)) + G166313) + NIL)) + (NREVERSE0 G166322)) + (SEQ (EXIT (COND + ((AND (not (eq n '|--macros--|)) + (not (eq n '|--flags--|))) + (SETQ G166322 + (CONS n G166322)))))))))))))) + +\end{chunk} + +\defun{fixObjectForPrinting}{fixObjectForPrinting} +The \verb|$msgdbPrims| variable is set to: +\begin{verbatim} +(|%b| |%d| |%l| |%i| |%u| %U |%n| |%x| |%ce| |%rj| + "%U" "%b" "%d" "%l" "%i" "%u" "%U" "%n" "%x" "%ce" "%rj") +\end{verbatim} +\calls{fixObjectForPrinting}{object2Identifier} +\calls{fixObjectForPrinting}{member} +\calls{fixObjectForPrinting}{strconc} +\calls{fixObjectForPrinting}{pname} +\usesdollar{fixObjectForPrinting}{msgdbPrims} +\begin{chunk}{defun fixObjectForPrinting} +(defun |fixObjectForPrinting| (v) + (let (vp) + (declare (special |$msgdbPrims|)) + (setq vp (|object2Identifier| v)) + (cond + ((eq vp '%) "\\%") + ((|member| vp |$msgdbPrims|) (strconc "\\" (pname vp))) + (t v)))) + +\end{chunk} + +\defun{displayProperties,sayFunctionDeps}{displayProperties,sayFunctionDeps} +\begin{verbatim} +;displayProperties(option,l) == +; $dependentAlist : local := nil +; $dependeeAlist : local := nil +; [opt,:vl]:= (l or ['properties]) +; imacs := getInterpMacroNames() +; pmacs := getParserMacroNames() +; macros := REMDUP append(imacs, pmacs) +; if vl is ['all] or null vl then +; vl := MSORT append(getWorkspaceNames(),macros) +; if $frameMessages then sayKeyedMsg("S2IZ0065",[$interpreterFrameName]) +; null vl => +; null $frameMessages => sayKeyedMsg("S2IZ0066",NIL) +; sayKeyedMsg("S2IZ0067",[$interpreterFrameName]) +; interpFunctionDepAlists() +; for v in vl repeat +; isInternalMapName(v) => 'iterate +; pl := getIProplist(v) +; option = 'flags => getAndSay(v,"flags") +; option = 'value => displayValue(v,getI(v,'value),nil) +; option = 'condition => displayCondition(v,getI(v,"condition"),nil) +; option = 'mode => displayMode(v,getI(v,'mode),nil) +; option = 'type => displayType(v,getI(v,'value),nil) +; option = 'properties => +; v = "--flags--" => nil +; pl is [ ['cacheInfo,:.],:.] => nil +; v1 := fixObjectForPrinting(v) +; sayMSG ['"Properties of",:bright prefix2String v1,'":"] +; null pl => +; v in pmacs => +; sayMSG '" This is a user-defined macro." +; displayParserMacro v +; isInterpMacro v => +; sayMSG '" This is a system-defined macro." +; displayMacro v +; sayMSG '" none" +; propsSeen:= nil +; for [prop,:val] in pl | ^MEMQ(prop,propsSeen) and val repeat +; prop in '(alias generatedCode IS_-GENSYM mapBody localVars) => +; nil +; prop = 'condition => +; displayCondition(prop,val,true) +; prop = 'recursive => +; sayMSG '" This is recursive." +; prop = 'isInterpreterFunction => +; sayMSG '" This is an interpreter function." +; sayFunctionDeps v where +; sayFunctionDeps x == +; if dependents := GETALIST($dependentAlist,x) then +; null rest dependents => +; sayMSG ['" The following function or rule ", +; '"depends on this:",:bright first dependents] +; sayMSG +; '" The following functions or rules depend on this:" +; msg := ["%b",'" "] +; for y in dependents repeat msg := ['" ",y,:msg] +; sayMSG [:nreverse msg,"%d"] +; if dependees := GETALIST($dependeeAlist,x) then +; null rest dependees => +; sayMSG ['" This depends on the following function ", +; '"or rule:",:bright first dependees] +; sayMSG +; '" This depends on the following functions or rules:" +; msg := ["%b",'" "] +; for y in dependees repeat msg := ['" ",y,:msg] +; sayMSG [:nreverse msg,"%d"] +; prop = 'isInterpreterRule => +; sayMSG '" This is an interpreter rule." +; sayFunctionDeps v +; prop = 'localModemap => +; displayModemap(v,val,true) +; prop = 'mode => +; displayMode(prop,val,true) +; prop = 'value => +; val => displayValue(v,val,true) +; sayMSG ['" ",prop,'": ",val] +; propsSeen:= [prop,:propsSeen] +; sayKeyedMsg("S2IZ0068",[option]) +; terminateSystemCommand() +\end{verbatim} +\calls{displayProperties,sayFunctionDeps}{seq} +\calls{displayProperties,sayFunctionDeps}{getalist} +\calls{displayProperties,sayFunctionDeps}{exit} +\calls{displayProperties,sayFunctionDeps}{sayMSG} +\calls{displayProperties,sayFunctionDeps}{bright} +\usesdollar{displayProperties,sayFunctionDeps}{dependeeAlist} +\usesdollar{displayProperties,sayFunctionDeps}{dependentAlist} +\begin{chunk}{defun displayProperties,sayFunctionDeps} +(defun |displayProperties,sayFunctionDeps| (x) + (prog (dependents dependees msg) + (declare (special |$dependeeAlist| |$dependentAlist|)) + (return + (seq + (if (setq dependents (getalist |$dependentAlist| x)) + (seq + (if (null (cdr dependents)) + (exit + (|sayMSG| (cons " The following function or rule " + (cons "depends on this:" (|bright| (car dependents))))))) + (|sayMSG| " The following functions or rules depend on this:") + (setq msg (cons '|%b| (cons " " nil))) + (do ((G166397 dependents (cdr G166397)) (y nil)) + ((or (atom G166397) (progn (setq y (car G166397)) nil)) nil) + (seq (exit (setq msg (cons " " (cons y msg)))))) + (exit (|sayMSG| (append (nreverse msg) (cons '|%d| nil))))) + nil) + (exit + (if (setq dependees (getalist |$dependeeAlist| x)) + (seq + (if (null (cdr dependees)) + (exit + (|sayMSG| (cons " This depends on the following function " + (cons "or rule:" (|bright| (car dependees))))))) + (|sayMSG| " This depends on the following functions or rules:") + (setq msg (cons '|%b| (cons " " nil))) + (do ((G166406 dependees (cdr G166406)) (y nil)) + ((or (atom G166406) (progn (setq y (car G166406)) nil)) nil) + (seq (exit (setq msg (cons " " (cons y msg)))))) + (exit (|sayMSG| (append (nreverse msg) (cons '|%d| nil))))) + nil)))))) + +\end{chunk} + +\defun{displayValue}{displayValue} +\calls{displayValue}{sayMSG} +\calls{displayValue}{fixObjectForPrinting} +\calls{displayValue}{pname} +\calls{displayValue}{objValUnwrap} +\calls{displayValue}{objMode} +\calls{displayValue}{displayRule} +\calls{displayValue}{strconc} +\calls{displayValue}{prefix2String} +\calls{displayValue}{objMode} +\calls{displayValue}{getdatabase} +\calls{displayValue}{concat} +\calls{displayValue}{form2String} +\calls{displayValue}{mathprint} +\calls{displayValue}{outputFormat} +\calls{displayValue}{objMode} +\usesdollar{displayValue}{op} +\usesdollar{displayValue}{EmptyMode} +\begin{chunk}{defun displayValue} +(defun |displayValue| (|$op| u omitVariableNameIfTrue) + (declare (special |$op|)) + (let (expr op rhs label labmode) + (declare (special |$EmptyMode|)) + (if (null u) + (|sayMSG| + (list '| Value of | (|fixObjectForPrinting| (pname |$op|)) ": (none)")) + (progn + (setq expr (|objValUnwrap| u)) + (if (or (and (consp expr) (progn (setq op (qcar expr)) t) (eq op 'map)) + (equal (|objMode| u) |$EmptyMode|)) + (|displayRule| |$op| expr) + (progn + (cond + (omitVariableNameIfTrue + (setq rhs "): ") + (setq label "Value (has type ")) + (t + (setq rhs ": ") + (setq label (strconc "Value of " (pname |$op|) ": ")))) + (setq labmode (|prefix2String| (|objMode| u))) + (when (atom labmode) (setq labmode (list labmode))) + (if (eq (getdatabase expr 'constructorkind) '|domain|) + (|sayMSG| (|concat| " " label labmode rhs (|form2String| expr))) + (|mathprint| + (cons 'concat + (cons label + (append labmode + (cons rhs + (cons (|outputFormat| expr (|objMode| u)) nil))))))) + nil)))))) + +\end{chunk} + +\defun{displayType}{displayType} +\calls{displayType}{sayMSG} +\calls{displayType}{fixObjectForPrinting} +\calls{displayType}{pname} +\calls{displayType}{prefix2String} +\calls{displayType}{objMode} +\calls{displayType}{concat} +\usesdollar{displayType}{op} +\begin{chunk}{defun displayType} +(defun |displayType| (|$op| u omitVariableNameIfTrue) + (declare (special |$op|) (ignore omitVariableNameIfTrue)) + (let (type) + (if (null u) + (|sayMSG| + (list " Type of value of " (|fixObjectForPrinting| (pname |$op|)) + ": (none)")) + (progn + (setq type (|prefix2String| (|objMode| u))) + (when (atom type) (setq type (list type))) + (|sayMSG| + (|concat| + (cons " Type of value of " + (cons (|fixObjectForPrinting| (pname |$op|)) + (cons ": " type))))) + nil)))) + +\end{chunk} + +\defun{getAndSay}{getAndSay} +\calls{getAndSay}{getI} +\calls{getAndSay}{sayMSG} +\begin{chunk}{defun getAndSay} +(defun |getAndSay| (v prop) + (let (val) + (if (setq val (|getI| v prop)) + (|sayMSG| (cons '| | (cons val (cons '|%l| nil)))) + (|sayMSG| (cons '| none| (cons '|%l| nil)))))) + +\end{chunk} + +\defun{displayProperties}{displayProperties} +\calls{displayProperties}{getInterpMacroNames} +\calls{displayProperties}{getParserMacroNames} +\calls{displayProperties}{remdup} +\calls{displayProperties}{qcdr} +\calls{displayProperties}{qcar} +\calls{displayProperties}{msort} +\calls{displayProperties}{getWorkspaceNames} +\calls{displayProperties}{sayKeyedMsg} +\calls{displayProperties}{interpFunctionDepAlists} +\calls{displayProperties}{isInternalMapName} +\calls{displayProperties}{getIProplist} +\calls{displayProperties}{getAndSay} +\calls{displayProperties}{displayValue} +\calls{displayProperties}{getI} +\calls{displayProperties}{displayCondition} +\calls{displayProperties}{displayMode} +\calls{displayProperties}{displayType} +\calls{displayProperties}{fixObjectForPrinting} +\calls{displayProperties}{sayMSG} +\calls{displayProperties}{bright} +\calls{displayProperties}{prefix2String} +\calls{displayProperties}{member} +\calls{displayProperties}{displayParserMacro} +\calls{displayProperties}{isInterpMacro} +\calls{displayProperties}{displayMacro} +\calls{displayProperties}{displayProperties,sayFunctionDeps} +\calls{displayProperties}{displayModemap} +\calls{displayProperties}{exit} +\calls{displayProperties}{seq} +\calls{displayProperties}{terminateSystemCommand} +\usesdollar{displayProperties}{dependentAlist} +\usesdollar{displayProperties}{dependeeAlist} +\usesdollar{displayProperties}{frameMessages} +\usesdollar{displayProperties}{interpreterFrameName} +\begin{chunk}{defun displayProperties} +(defun |displayProperties| (option al) + (let (|$dependentAlist| |$dependeeAlist| tmp1 opt imacs pmacs macros vl pl + tmp2 vone prop val propsSeen) + (declare (special |$dependentAlist| |$dependeeAlist| |$frameMessages| + |$interpreterFrameName|)) + (setq |$dependentAlist| nil) + (setq |$dependeeAlist| nil) + (setq tmp1 (or al (cons '|properties| nil))) + (setq opt (car tmp1)) + (setq vl (cdr tmp1)) + (setq imacs (|getInterpMacroNames|)) + (setq pmacs (|getParserMacroNames|)) + (setq macros (remdup (append imacs pmacs))) + (when (or + (and (consp vl) (eq (qcdr vl) nil) (eq (qcar vl) '|all|)) + (null vl)) + (setq vl (msort (append (|getWorkspaceNames|) macros)))) + (when |$frameMessages| + (|sayKeyedMsg| 'S2IZ0065 (cons |$interpreterFrameName| nil))) + (cond + ((null vl) + (if (null |$frameMessages|) + (|sayKeyedMsg| 'S2IZ0066 nil)) + (|sayKeyedMsg| 'S2IZ0067 (cons |$interpreterFrameName| nil))) + (t + (|interpFunctionDepAlists|) + (do ((G166440 vl (cdr G166440)) (v nil)) + ((or (atom G166440) (progn (setq v (car G166440)) nil)) nil) + (seq (exit + (cond + ((|isInternalMapName| v) '|iterate|) + (t + (setq pl (|getIProplist| v)) + (cond + ((eq option '|flags|) + (|getAndSay| v '|flags|)) + ((eq option '|value|) + (|displayValue| v (|getI| v '|value|) nil)) + ((eq option '|condition|) + (|displayCondition| v (|getI| v '|condition|) nil)) + ((eq option '|mode|) + (|displayMode| v (|getI| v '|mode|) nil)) + ((eq option '|type|) + (|displayType| v (|getI| v '|value|) nil)) + ((eq option '|properties|) + (cond + ((eq v '|--flags--|) + nil) + ((and (consp pl) + (progn + (setq tmp2 (qcar pl)) + (and (consp tmp2) (eq (qcar tmp2) '|cacheInfo|)))) + nil) + (t + (setq vone (|fixObjectForPrinting| v)) + (|sayMSG| + (cons "Properties of" + (append (|bright| (|prefix2String| vone)) (cons ":" nil)))) + (cond + ((null pl) + (cond + ((|member| v pmacs) + (|sayMSG| " This is a user-defined macro.") + (|displayParserMacro| v)) + ((|isInterpMacro| v) + (|sayMSG| " This is a system-defined macro.") + (|displayMacro| v)) + (t + (|sayMSG| " none")))) + (t + (setq propsSeen nil) + (do ((G166451 pl (cdr G166451)) (G166425 nil)) + ((or (atom G166451) + (progn (setq G166425 (car G166451)) nil) + (progn + (progn + (setq prop (car G166425)) + (setq val (cdr G166425)) + G166425) + nil)) + nil) + (seq (exit + (cond + ((and (null (member prop propsSeen)) val) + (cond + ((|member| prop + '(|alias| |generatedCode| IS-GENSYM + |mapBody| |localVars|)) + nil) + ((eq prop '|condition|) + (|displayCondition| prop val t)) + ((eq prop '|recursive|) + (|sayMSG| " This is recursive.")) + ((eq prop '|isInterpreterFunction|) + (|sayMSG| " This is an interpreter function.") + (|displayProperties,sayFunctionDeps| v)) + ((eq prop '|isInterpreterRule|) + (|sayMSG| " This is an interpreter rule.") + (|displayProperties,sayFunctionDeps| v)) + ((eq prop '|localModemap|) + (|displayModemap| v val t)) + ((eq prop '|mode|) + (|displayMode| prop val t)) + (t + (when (eq prop '|value|) + (exit + (when val + (exit (|displayValue| v val t))))) + (|sayMSG| (list " " prop ": " val)) + (setq propsSeen (cons prop propsSeen)))))))))))))) + (t + (|sayKeyedMsg| 'S2IZ0068 (cons option nil))))))))) + (|terminateSystemCommand|))))) + +\end{chunk} + +\defun{displayParserMacro}{displayParserMacro} +\calls{displayParserMacro}{pfPrintSrcLines} +\usesdollar{displayParserMacro}{pfMacros} +\begin{chunk}{defun displayParserMacro} +(defun |displayParserMacro| (m) + (let ((m (assq m |$pfMacros|))) + (declare (special |$pfMacros|)) + (when m (|pfPrintSrcLines| (caddr m))))) + +\end{chunk} + +\defun{displayCondition}{displayCondition} +\calls{displayCondition}{bright} +\calls{displayCondition}{sayBrightly} +\calls{displayCondition}{concat} +\calls{displayCondition}{pred2English} +\begin{chunk}{defun displayCondition} +(defun |displayCondition| (v condition giveVariableIfNil) + (let (varPart condPart) + (when giveVariableIfNil (setq varPart (cons '| of| (|bright| v)))) + (setq condPart (or condition '|true|)) + (|sayBrightly| + (|concat| '| condition| varPart '|: | (|pred2English| condPart))))) + +\end{chunk} + +\defun{interpFunctionDepAlists}{interpFunctionDepAlists} +\calls{interpFunctionDepAlists}{putalist} +\calls{interpFunctionDepAlists}{getalist} +\calls{interpFunctionDepAlists}{getFlag} +\usesdollar{interpFunctionDepAlists}{e} +\usesdollar{interpFunctionDepAlists}{dependeeAlist} +\usesdollar{interpFunctionDepAlists}{dependentAlist} +\usesdollar{interpFunctionDepAlists}{InteractiveFrame} +\begin{chunk}{defun interpFunctionDepAlists} +(defun |interpFunctionDepAlists| () + (let (|$e|) + (declare (special |$e| |$dependeeAlist| |$dependentAlist| + |$InteractiveFrame|)) + (setq |$e| |$InteractiveFrame|) + (setq |$dependentAlist| (cons (cons nil nil) nil)) + (setq |$dependeeAlist| (cons (cons nil nil) nil)) + (mapcar #'(lambda (dep) + (let (dependee dependent) + (setq dependee (first dep)) + (setq dependent (second dep)) + (setq |$dependentAlist| + (putalist |$dependentAlist| dependee + (cons dependent (getalist |$dependentAlist| dependee)))) + (spadlet |$dependeeAlist| + (putalist |$dependeeAlist| dependent + (cons dependee (getalist |$dependeeAlist| dependent)))))) + (|getFlag| '|$dependencies|)))) + + +\end{chunk} + +\defun{displayModemap}{displayModemap} +\calls{displayModemap}{bright} +\calls{displayModemap}{sayBrightly} +\calls{displayModemap}{concat} +\calls{displayModemap}{formatSignature} +\begin{chunk}{defun displayModemap} +(defun |displayModemap| (v val giveVariableIfNil) + (labels ( + (g (v mm giveVariableIfNil) + (let (local signature fn varPart prefix) + (setq local (caar mm)) + (setq signature (cdar mm)) + (setq fn (cadr mm)) + (unless (eq local '|interpOnly|) + (spadlet varPart (unless giveVariableIfNil (cons " of" (|bright| v)))) + (spadlet prefix + (cons '| Compiled function type| (append varPart (cons '|: | nil)))) + (|sayBrightly| (|concat| prefix (|formatSignature| signature))))))) + (mapcar #'(lambda (x) (g v x giveVariableIfNil)) val))) + +\end{chunk} + +\defun{displayMode}{displayMode} +\calls{displayMode}{bright} +\calls{displayMode}{fixObjectForPrinting} +\calls{displayMode}{sayBrightly} +\calls{displayMode}{concat} +\calls{displayMode}{prefix2String} +\begin{chunk}{defun displayMode} +(defun |displayMode| (v mode giveVariableIfNil) + (let (varPart) + (when mode + (unless giveVariableIfNil + (setq varPart (cons '| of| (|bright| (|fixObjectForPrinting| v))))) + (|sayBrightly| + (|concat| '| Declared type or mode| varPart '|: | + (|prefix2String| mode)))))) + +\end{chunk} + +\defun{dumbTokenize}{Split into tokens delimted by spaces} +\calls{dumbTokenize}{stripSpaces} +\begin{chunk}{defun dumbTokenize} +(defun |dumbTokenize| (str) + (let (inString token (tokenStart 0) previousSpace tokenList) + (dotimes (i (1- (|#| str))) + (cond + ((char= (elt str i) #\") ; don't split strings + (setq inString (null inString)) + (setq previousSpace nil)) + ((and (char= (elt str i) #\space) (null inString)) + (unless previousSpace + (setq token (|stripSpaces| (subseq str tokenStart i))) + (setq tokenList (cons token tokenList)) + (setq tokenStart (1+ i)) + (setq previousSpace t))) + (t + (setq previousSpace nil)))) + (setq tokenList (cons (|stripSpaces| (subseq str tokenStart)) tokenList)) + (nreverse tokenList))) + +\end{chunk} + +\defun{tokTran}{Convert string tokens to their proper type} +\calls{tokTran}{isIntegerString} +\begin{chunk}{defun tokTran} +(defun |tokTran| (tok) + (let (tmp) + (if (stringp tok) + (cond + ((eql (|#| tok) 0) nil) + ((setq tmp (|isIntegerString| tok)) tmp) + ((char= (elt tok 0) #\" ) (subseq tok 1 (1- (|#| tok)))) + (t (intern tok))) + tok))) + +\end{chunk} + +\defun{isIntegerString}{Is the argument string an integer?} +\begin{chunk}{defun isIntegerString 0} +(defun |isIntegerString| (tok) + (multiple-value-bind (int len) (parse-integer tok :junk-allowed t) + (when (and int (= len (length tok))) int))) + +\end{chunk} + +\defun{handleParsedSystemCommands}{Handle parsed system commands} +\calls{handleParsedSystemCommands}{dumbTokenize} +\calls{handleParsedSystemCommands}{parseSystemCmd} +\calls{handleParsedSystemCommands}{tokTran} +\calls{handleParsedSystemCommands}{systemCommand} +\begin{chunk}{defun handleParsedSystemCommands} +(defun |handleParsedSystemCommands| (unabr optionList) + (declare (ignore unabr)) + (let (restOptionList parcmd trail) + (setq restOptionList (mapcar #'|dumbTokenize| (cdr optionList))) + (setq parcmd (|parseSystemCmd| (car optionList))) + (setq trail + (mapcar #'(lambda (opt) + (mapcar #'(lambda (tok) (|tokTran| tok)) opt)) restOptionList)) + (|systemCommand| (cons parcmd trail)))) + +\end{chunk} + +\defun{parseSystemCmd}{Parse a system command} +\calls{parseSystemCmd}{tokTran} +\calls{parseSystemCmd}{stripSpaces} +\calls{parseSystemCmd}{parseFromString} +\calls{parseSystemCmd}{dumbTokenize} +\begin{chunk}{defun parseSystemCmd} +(defun |parseSystemCmd| (opt) + (let (spaceIndex) + (if (setq spaceIndex (search " " opt)) + (list + (|tokTran| (|stripSpaces| (subseq opt 0 spaceIndex))) + (|parseFromString| (|stripSpaces| (subseq opt spaceIndex)))) + (mapcar #'|tokTran| (|dumbTokenize| opt))))) + +\end{chunk} + +\defun{getFirstWord}{Get first word in a string} +\calls{getFirstWord}{subseq} +\calls{getFirstWord}{stringSpaces} +\begin{chunk}{defun getFirstWord} +(defun |getFirstWord| (string) + (let (spaceIndex) + (setq spaceIndex (search " " string)) + (if spaceIndex + (|stripSpaces| (subseq string 0 spaceIndex)) + string))) + +\end{chunk} + +\defun{unAbbreviateKeyword}{Unabbreviate keywords in commands} +\calls{unAbbreviateKeyword}{selectOptionLC} +\calls{unAbbreviateKeyword}{selectOption} +\calls{unAbbreviateKeyword}{commandsForUserLevel} +\usesdollar{unAbbreviateKeyword}{systemCommands} +\usesdollar{unAbbreviateKeyword}{currentLine} +\usesdollar{unAbbreviateKeyword}{syscommands} +\uses{unAbbreviateKeyword}{line} +\begin{chunk}{defun unAbbreviateKeyword} +(defun |unAbbreviateKeyword| (x) + (let (xp) + (declare (special |$systemCommands| |$currentLine| $syscommands line)) + (setq xp (|selectOptionLC| x $syscommands '|commandErrorIfAmbiguous|)) + (cond + ((null xp) + (setq xp '|system|) + (setq line (concat ")system " (substring line 1 (1- (|#| line))))) + (spadlet |$currentLine| line))) + (|selectOption| xp (|commandsForUserLevel| |$systemCommands|) + '|commandUserLevelError|))) + +\end{chunk} + +\defun{commandErrorIfAmbiguous}{The command is ambiguous error} +\calls{commandErrorIfAmbiguous}{commandAmbiguityError} +\usesdollar{commandErrorIfAmbiguous}{oldline} +\uses{commandErrorIfAmbiguous}{line} +\begin{chunk}{defun commandErrorIfAmbiguous} +(defun |commandErrorIfAmbiguous| (x u) + (declare (special $oldline line)) + (when u + (setq $oldline line) + (|commandAmbiguityError| '|command| x u))) + +\end{chunk} + +\calls{handleNoParseCommands}{stripSpaces} +\calls{handleNoParseCommands}{nplisp} +\calls{handleNoParseCommands}{stripLisp} +\calls{handleNoParseCommands}{sayKeyedMsg} +\calls{handleNoParseCommands}{npboot} +\calls{handleNoParseCommands}{npsystem} +\calls{handleNoParseCommands}{npsynonym} +\calls{handleNoParseCommands}{member} +\calls{handleNoParseCommands}{concat} +\begin{chunk}{defun handleNoParseCommands} +(defun |handleNoParseCommands| (unab string) + (let (spaceindex funname) + (setq string (|stripSpaces| string)) + (setq spaceindex (search " " string)) + (cond + ((eq unab '|lisp|) + (if spaceindex + (|nplisp| (|stripLisp| string)) + (|sayKeyedMsg| 's2iv0005 nil))) + ((eq unab '|boot|) + (if spaceindex + (|npboot| (subseq string (1+ spaceindex))) + (|sayKeyedMsg| 's2iv0005 nil))) + ((eq unab '|system|) + (if spaceindex + (|npsystem| unab string) + (|sayKeyedMsg| 's2iv0005 nil))) + ((eq unab '|synonym|) + (if spaceindex + (|npsynonym| unab (subseq string (1+ spaceindex))) + (|npsynonym| unab ""))) + ((null spaceindex) + (funcall unab)) + ((|member| unab '(|quit| |fin| |pquit| |credits| |copyright| |trademark|)) + (|sayKeyedMsg| 's2iv0005 nil)) + (t + (setq funname (intern (concat "np" (string unab)))) + (funcall funname (subseq string (1+ spaceindex))))))) + +\end{chunk} + +\defun{stripSpaces}{Remove the spaces surrounding a string} +\tpdhere{This should probably be a macro or eliminated} +\begin{chunk}{defun stripSpaces 0} +(defun |stripSpaces| (str) + (string-trim '(#\space) str)) + +\end{chunk} + +\defun{stripLisp}{Remove the lisp command prefix} +\begin{chunk}{defun stripLisp 0} +(defun |stripLisp| (str) + (if (string= (subseq str 0 4) "lisp") + (subseq str 4) + str)) + +\end{chunk} + +\defun{nplisp}{Handle the )lisp command} +\usesdollar{nplisp}{ans} +\begin{chunk}{defun nplisp 0} +(defun |nplisp| (str) + (declare (special |$ans|)) + (setq |$ans| (eval (read-from-string str))) + (format t "~&Value = ~S~%" |$ans|)) + +\end{chunk} + +\defun{npboot}{The )boot command is no longer supported} +\tpdhere{Remove all boot references from top level} +\begin{chunk}{defun npboot 0} +(defun |npboot| (str) + (declare (ignore str)) + (format t "The )boot command is no longer supported~%")) + +\end{chunk} + +\defun{npsystem}{Handle the )system command} +Note that unAbbreviateKeyword returns the word ``system'' for unknown words +so we have to search for this case. This complication may never arrive +in practice. + +\calls{npsystem}{sayKeyedMsg} +\begin{chunk}{defun npsystem} +(defun |npsystem| (unab str) + (let (spaceIndex sysPart) + (setq spaceIndex (search " " str)) + (cond + ((null spaceIndex) (|sayKeyedMsg| 'S2IZ0080 (list str))) + (t + (setq sysPart (subseq str 0 spaceIndex)) + (if (search sysPart (string unab)) + (obey (subseq str (1+ spaceIndex))) + (|sayKeyedMsg| 'S2IZ0080 (list sysPart))))))) + +\end{chunk} + +\defun{npsynonym}{Handle the )synonym command} +\calls{npsynonym}{npProcessSynonym} +\begin{chunk}{defun npsynonym} +(defun |npsynonym| (unab str) + (declare (ignore unab)) + (|npProcessSynonym| str)) + +\end{chunk} + +\defun{npProcessSynonym}{Handle the synonym system command} +\calls{npProcessSynonym}{printSynonyms} +\calls{npProcessSynonym}{processSynonymLine} +\calls{npProcessSynonym}{putalist} +\calls{npProcessSynonym}{terminateSystemCommand} +\usesdollar{npProcessSynonym}{CommandSynonymAlist} +\begin{chunk}{defun npProcessSynonym} +(defun |npProcessSynonym| (str) + (let (pair) + (declare (special |$CommandSynonymAlist|)) + (if (= (length str) 0) + (|printSynonyms| nil) + (progn + (setq pair (|processSynonymLine| str)) + (if |$CommandSynonymAlist| + (putalist |$CommandSynonymAlist| (car pair) (cdr pair))) + (setq |$CommandSynonymAlist| (cons pair nil)))) + (|terminateSystemCommand|))) + +\end{chunk} + +\defun{printSynonyms}{printSynonyms} +\calls{printSynonyms}{centerAndHighlight} +\calls{printSynonyms}{specialChar} +\calls{printSynonyms}{filterListOfStringsWithFn} +\calls{printSynonyms}{synonymsForUserLevel} +\calls{printSynonyms}{printLabelledList} +\usesdollar{printSynonyms}{CommandSynonymAlist} +\usesdollar{printSynonyms}{linelength} +\begin{chunk}{defun printSynonyms} +(defun |printSynonyms| (patterns) + (prog (ls t1) + (declare (special |$CommandSynonymAlist| $linelength)) + (|centerAndHighlight| '|System Command Synonyms| + $linelength (|specialChar| '|hbar|)) + (setq ls + (|filterListOfStringsWithFn| patterns + (do ((t2 (|synonymsForUserLevel| |$CommandSynonymAlist|) (cdr t2))) + ((atom t2) (nreverse0 t1)) + (push (cons (princ-to-string (caar t2)) (cdar t2)) t1)) + #'car)) + (|printLabelledList| ls "user" "synonyms" ")" patterns))) + +\end{chunk} + +\defun{printLabelledList}{Print a list of each matching synonym} +The prefix goes before each element on each side of the list, eg, ")" + +\calls{printLabelledList}{sayMessage} +\calls{printLabelledList}{blankList} +\calls{printLabelledList}{substring} +\calls{printLabelledList}{entryWidth} +\calls{printLabelledList}{sayBrightly} +\calls{printLabelledList}{concat} +\calls{printLabelledList}{fillerSpaces} +\begin{chunk}{defun printLabelledList} +(defun |printLabelledList| (ls label1 label2 prefix patterns) + (let (comm syn wid) + (if (null ls) + (if (null patterns) + (|sayMessage| (list " No " label1 "-defined " label2 " in effect.")) + (|sayMessage| + `(" No " ,label1 "-defined " ,label2 " satisfying patterns:" + |%l| " " |%b| ,@(append (|blankList| patterns) (list '|%d|))))) + (progn + (when patterns + (|sayMessage| + `(,label1 "-defined " ,label2 " satisfying patterns:" |%l| " " + |%b| ,@(append (|blankList| patterns) (list '|%d|))))) + (do ((t1 ls (cdr t1))) + ((atom t1) nil) + (setq syn (caar t1)) + (setq comm (cdar t1)) + (when (string= (substring syn 0 1) "|") + (setq syn (substring syn 1 nil))) + (when (string= syn "%i") (setq syn "%i ")) + (setq wid (max (- 30 (|entryWidth| syn)) 1)) + (|sayBrightly| + (|concat| '|%b| prefix syn '|%d| (|fillerSpaces| wid ".") + " " prefix comm))) + (|sayBrightly| ""))))) + +\end{chunk} + +\defdollar{tokenCommands} +This is a list of the commands that expect the interpreter to parse +their arguments. Thus the history command expects that Axiom will have +tokenized and validated the input before calling the history function. +\begin{chunk}{initvars} +(defvar |$tokenCommands| nil) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) + (setq |$tokenCommands| + '( |abbreviations| + |cd| + |clear| + |close| + |compiler| + |depends| + |display| + |describe| + |edit| + |frame| + |frame| + |help| + |history| + |input| + |library| + |load| + |ltrace| + |read| + |regress| + |savesystem| + |set| + |spool| + |tangle| + |undo| + |what| + |with| + |workfiles| + |zsystemdevelopment| + ))) + +\end{chunk} + +\defdollar{InitialCommandSynonymAlist} +Axiom can create ``synonyms'' for commands. We create an initial table +of synonyms which are in common use. +\begin{chunk}{initvars} +(defvar |$InitialCommandSynonymAlist| nil) + +\end{chunk} + +\defun{axiomVersion}{Print the current version information} +\uses{axiomVersion}{*yearweek*} +\uses{axiomVersion}{*build-version*} +\begin{chunk}{defun axiomVersion 0} +(defun axiomVersion () + (declare (special *build-version* *yearweek*)) + (concatenate 'string "Axiom " *build-version* " built on " *yearweek*)) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) + (setq |$InitialCommandSynonymAlist| + '( + (|?| . "what commands") + (|ap| . "what things") + (|apr| . "what things") + (|apropos| . "what things") + (|cache| . "set functions cache") + (|cl| . "clear") + (|cls| . "zsystemdevelopment )cls") + (|cms| . "system") + (|co| . "compiler") + (|d| . "display") + (|dep| . "display dependents") + (|dependents| . "display dependents") + (|e| . "edit") + (|expose| . "set expose add constructor") + (|fc| . "zsystemdevelopment )c") + (|fd| . "zsystemdevelopment )d") + (|fdt| . "zsystemdevelopment )dt") + (|fct| . "zsystemdevelopment )ct") + (|fctl| . "zsystemdevelopment )ctl") + (|fe| . "zsystemdevelopment )e") + (|fec| . "zsystemdevelopment )ec") + (|fect| . "zsystemdevelopment )ect") + (|fns| . "exec spadfn") + (|fortran| . "set output fortran") + (|h| . "help") + (|hd| . "system hypertex &") + (|kclam| . "boot clearClams ( )") + (|killcaches| . "boot clearConstructorAndLisplibCaches ( )") + (|patch| . "zsystemdevelopment )patch") + (|pause| . "zsystemdevelopment )pause") + (|prompt| . "set message prompt") + (|recurrence| . "set functions recurrence") + (|restore| . "history )restore") + (|save| . "history )save") + (|startGraphics| . "system $AXIOM/lib/viewman &") + (|startNAGLink| . "system $AXIOM/lib/nagman &") + (|stopGraphics| . "lisp (|sockSendSignal| 2 15)") + (|stopNAGLink| . "lisp (|sockSendSignal| 8 15)") + (|time| . "set message time") + (|type| . "set message type") + (|unexpose| . "set expose drop constructor") + (|up| . "zsystemdevelopment )update") + (|version| . "lisp (axiomVersion)") + (|w| . "what") + (|wc| . "what categories") + (|wd| . "what domains") + (|who| . "lisp (pprint credits)") + (|wp| . "what packages") + (|ws| . "what synonyms") +))) + +\end{chunk} + +\defdollar{CommandSynonymAlist} +The actual list of synonyms is initialized to be the same as the +above initial list of synonyms. The user synonyms that are added +during a session are pushed onto this list for later lookup. +\begin{chunk}{initvars} +(defvar |$CommandSynonymAlist| nil) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) + (setq |$CommandSynonymAlist| (copy-alist |$InitialCommandSynonymAlist|))) + +\end{chunk} + +\defun{ncloopCommand}{ncloopCommand} +The \$systemCommandFunction is set in SpadInterpretStream +to point to the function InterpExecuteSpadSystemCommand. +The system commands are handled by the function in the ``hook'' +variable \verb|$systemCommandFunction| which +has the default function \verb|InterpExecuteSpadSystemCommand|. +Thus, when a system command is entered this function is called. + +The only exception is the \verb|)include| function which inserts +the contents of a file inline in the input stream. This is useful +for processing \verb|)read| of input files. + +\calls{ncloopCommand}{ncloopPrefix?} +\calls{ncloopCommand}{ncloopInclude1} +\callsdollar{ncloopCommand}{systemCommandFunction} +\usesdollar{ncloopCommand}{systemCommandFunction} +\label{ncloopCommand} +\begin{chunk}{defun ncloopCommand} +(defun |ncloopCommand| (line n) + (let (a) + (declare (special |$systemCommandFunction|)) + (if (setq a (|ncloopPrefix?| ")include" line)) + (|ncloopInclude1| a n) + (progn + (funcall |$systemCommandFunction| line) + n)))) + +\end{chunk} + +\defun{ncloopPrefix?}{ncloopPrefix?} +If we find the prefix string in the whole string starting at position zero +we return the remainder of the string without the leading prefix. +\begin{chunk}{defun ncloopPrefix? 0} +(defun |ncloopPrefix?| (prefix whole) + (when (eql (search prefix whole) 0) + (subseq whole (length prefix)))) + +\end{chunk} + +\defun{selectOptionLC}{selectOptionLC} +\calls{selectOptionLC}{selectOption} +\calls{selectOptionLC}{downcase} +\calls{selectOptionLC}{object2Identifier} +\begin{chunk}{defun selectOptionLC} +(defun |selectOptionLC| (x l errorFunction) + (|selectOption| (downcase (|object2Identifier| x)) l errorFunction)) + +\end{chunk} + +\defun{selectOption}{selectOption} +\calls{selectOption}{member} +\calls{selectOption}{identp} +\calls{selectOption}{stringPrefix?} +\calls{selectOption}{pname} +\calls{selectOption}{qcdr} +\calls{selectOption}{qcar} +\begin{chunk}{defun selectOption} +(defun |selectOption| (x l errorfunction) + (let (u y) + (cond + ((|member| x l) x) + ((null (identp x)) + (cond + (errorfunction (funcall errorfunction x u)) + (t nil))) + (t + (setq u + (let (t0) + (do ((t1 l (cdr t1)) (y nil)) + ((or (atom t1) (progn (setq y (car t1)) nil)) (nreverse0 t0)) + (if (|stringPrefix?| (pname x) (pname y)) + (setq t0 (cons y t0)))))) + (cond + ((and (consp u) (eq (qcdr u) nil) (progn (setq y (qcar u)) t)) y) + (errorfunction (funcall errorfunction x u)) + (t nil)))))) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{abbreviations} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{abbreviations.help} +==================================================================== +A.2. )abbreviation +==================================================================== + +User Level Required: compiler + +Command Syntax: + + - )abbreviation query [nameOrAbbrev] + - )abbreviation category abbrev fullname [)quiet] + - )abbreviation domain abbrev fullname [)quiet] + - )abbreviation package abbrev fullname [)quiet] + - )abbreviation remove nameOrAbbrev + +Command Description: + +This command is used to query, set and remove abbreviations for category, +domain and package constructors. Every constructor must have a unique +abbreviation. This abbreviation is part of the name of the subdirectory under +which the components of the compiled constructor are stored. Furthermore, by +issuing this command you let the system know what file to load automatically +if you use a new constructor. Abbreviations must start with a letter and then +be followed by up to seven letters or digits. Any letters appearing in the +abbreviation must be in uppercase. + +When used with the query argument, this command may be used to list the name +associated with a particular abbreviation or the abbreviation for a +constructor. If no abbreviation or name is given, the names and corresponding +abbreviations for all constructors are listed. + +The following shows the abbreviation for the constructor List: + +)abbreviation query List + +The following shows the constructor name corresponding to the abbreviation +NNI: + +)abbreviation query NNI + +The following lists all constructor names and their abbreviations. + +)abbreviation query + +To add an abbreviation for a constructor, use this command with category, +domain or package. The following add abbreviations to the system for a +category, domain and package, respectively: + +)abbreviation domain SET Set +)abbreviation category COMPCAT ComplexCategory +)abbreviation package LIST2MAP ListToMap + +If the )quiet option is used, no output is displayed from this command. You +would normally only define an abbreviation in a library source file. If this +command is issued for a constructor that has already been loaded, the +constructor will be reloaded next time it is referenced. In particular, you +can use this command to force the automatic reloading of constructors. + +To remove an abbreviation, the remove argument is used. This is usually only +used to correct a previous command that set an abbreviation for a constructor +name. If, in fact, the abbreviation does exist, you are prompted for +confirmation of the removal request. Either of the following commands will +remove the abbreviation VECTOR2 and the constructor name VectorFunctions2 +from the system: + +)abbreviation remove VECTOR2 +)abbreviation remove VectorFunctions2 + +Also See: +o )compile + +\end{chunk} + +\defun{abbreviations}{abbreviations} +\calls{abbreviations}{abbreviationsSpad2Cmd} +\begin{chunk}{defun abbreviations} +(defun |abbreviations| (l) + (|abbreviationsSpad2Cmd| l)) + +\end{chunk} +\defun{abbreviationsSpad2Cmd}{abbreviationsSpad2Cmd} +\calls{abbreviationsSpad2Cmd}{listConstructorAbbreviations} +\calls{abbreviationsSpad2Cmd}{abbreviation?} +\calls{abbreviationsSpad2Cmd}{abbQuery} +\calls{abbreviationsSpad2Cmd}{deldatabase} +\calls{abbreviationsSpad2Cmd}{size} +\calls{abbreviationsSpad2Cmd}{sayKeyedMsg} +\calls{abbreviationsSpad2Cmd}{mkUserConstructorAbbreviation} +\calls{abbreviationsSpad2Cmd}{setdatabase} +\calls{abbreviationsSpad2Cmd}{seq} +\calls{abbreviationsSpad2Cmd}{exit} +\calls{abbreviationsSpad2Cmd}{opOf} +\calls{abbreviationsSpad2Cmd}{helpSpad2Cmd} +\calls{abbreviationsSpad2Cmd}{selectOptionLC} +\calls{abbreviationsSpad2Cmd}{qcar} +\calls{abbreviationsSpad2Cmd}{qcdr} +\usesdollar{abbreviationsSpad2Cmd}{options} +\begin{chunk}{defun abbreviationsSpad2Cmd} +(defun |abbreviationsSpad2Cmd| (arg) + (let (abopts quiet opt key type constructor t2 a b al) + (declare (special |$options|)) + (if (null arg) + (|helpSpad2Cmd| '(|abbreviations|)) + (progn + (setq abopts '(|query| |domain| |category| |package| |remove|)) + (setq quiet nil) + (do ((t0 |$options| (cdr t0)) (t1 nil)) + ((or (atom t0) + (progn (setq t1 (car t0)) nil) + (progn (progn (setq opt (car t1)) t1) nil)) + nil) + (setq opt (|selectOptionLC| opt '(|quiet|) '|optionError|)) + (when (eq opt '|quiet|) (setq quiet t))) + (when + (and (consp arg) + (progn + (setq opt (qcar arg)) + (setq al (qcdr arg)) + t)) + (setq key (|opOf| (car al))) + (setq type (|selectOptionLC| opt abopts '|optionError|)) + (cond + ((eq type '|query|) + (cond + ((null al) (|listConstructorAbbreviations|)) + ((setq constructor (|abbreviation?| key)) + (|abbQuery| constructor)) + (t (|abbQuery| key)))) + ((eq type '|remove|) + (deldatabase key 'abbreviation)) + ((oddp (size al)) + (|sayKeyedMsg| 's2iz0002 (list type))) + (t + (do () (nil nil) + (seq + (exit + (cond + ((null al) (return '|fromLoop|)) + (t + (setq t2 al) + (setq a (car t2)) + (setq b (cadr t2)) + (setq al (cddr t2)) + (|mkUserConstructorAbbreviation| b a type) + (setdatabase b 'abbreviation a) + (setdatabase b 'constructorkind type)))))) + (unless quiet + (|sayKeyedMsg| 's2iz0001 (list a type (|opOf| b))))))))))) + +\end{chunk} + +\defun{listConstructorAbbreviations}{listConstructorAbbreviations} +\calls{listConstructorAbbreviations}{upcase} +\calls{listConstructorAbbreviations}{queryUserKeyedMsg} +\calls{listConstructorAbbreviations}{string2id-n} +\calls{listConstructorAbbreviations}{whatSpad2Cmd} +\calls{listConstructorAbbreviations}{sayKeyedMsg} +\begin{chunk}{defun listConstructorAbbreviations} +(defun |listConstructorAbbreviations| () + (let (x) + (setq x (upcase (|queryUserKeyedMsg| 's2iz0056 nil))) + (if (member (string2id-n x 1) '(Y YES)) + (progn + (|whatSpad2Cmd| '(|categories|)) + (|whatSpad2Cmd| '(|domains|)) + (|whatSpad2Cmd| '(|packages|))) + (|sayKeyedMsg| 's2iz0057 nil)))) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{boot} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{boot.help} +==================================================================== +A.3. )boot +==================================================================== + +User Level Required: development + +Command Syntax: + + - )boot bootExpression + +Command Description: + +This command is used by AXIOM system developers to execute expressions +written in the BOOT language. For example, + +)boot times3(x) == 3*x + +creates and compiles the Lisp function ``times3'' obtained by translating the +BOOT code. + +Also See: +o )fin +o )lisp +o )set +o )system + +\end{chunk} +\footnote{ +\fnref{fin} +\fnref{lisp} +\fnref{set} +\fnref{system}} + +This command is in the list of \verb|$noParseCommands| +\ref{noParseCommands} which means that its arguments are passed +verbatim. This will eventually result in a call to the function +\verb|handleNoParseCommands| \ref{handleNoParseCommands} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{browse} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{browse.help} + +User Level Required: development + +Command Syntax: + + )browse + +Command Description: + +This command is used by Axiom system users to start the Axiom top level +loop listening for browser connections. + +\end{chunk} +\section{Overview} +The Axiom book on the help browser is a complete rewrite of the +hyperdoc mechanism. There are several components that were needed +to make this function. Most of the web browser components are +described in bookvol11.pamphlet. This portion describes some of +the design issues needed to support the interface. + +The axServer command takes a port (defaulting to 8085) and a +program to handle the browser interaction (defaulting to multiServ). +The axServer function opens the port, constructs the stream, and +passes the stream to multiServ. The multiServ loop processes one +interaction at a time. + +So the basic process is that the Axiom ``)browse'' command opens a +socket and listens for http requests. Based on the type of request +(either 'GET' or 'POST') and the content of the request, which is +one of: +\begin{itemize} +\item command - algebra request/response +\item lispcall - a lisp s-expression to be evaluated +\item showcall - an Axiom )show command +\end{itemize} +the multiServ function will call a handler function to evaluate +the command line and construct a response. GET requests result +in a new browser page. POST requests result in an inline result. + +Most responses contain the fields: +\begin{itemize} +\item stepnum - this is the Axiom step number +\item command - this is the original command from the browser +\item algebra - this is the Axiom 2D algebra output +\item mathml - this is the MathML version of the Axiom algebra +\item type - this is the type of the Axiom result +\end{itemize} + +\section{Browsers, MathML, and Fonts} +This work has the Firefox browser as its target. Firefox has built-in +support for MathML, javascript, and XMLHttpRequests. More details +are available in bookvol11.pamphlet but the very basic machinery for +communication with the browser involves a dance between the browser +and the multiServ function (see the axserver.spad.pamphlet). + +In particular, a simple request is embedded in a web page as: +\begin{verbatim} +
    +
  • + +
    +
    • +
+\end{verbatim} +which says that this is an html ``input'' field of type ``submit''. +The CSS display class is ``subbut'' which is of a different color +than the surrounding text to make it obvious that you can click on +this field. Clickable fields that have no response text are of class +``noresult''. + +The javascript call to ``makeRequest'' gives the ``id'' of this input +field, which must be unique in the page, as an argument. In this case, +the argument is 'p3'. The ``value'' field holds the display text which +will be passed back to Axiom as a command. + +When the result arrives the ``showanswer'' function will select out +the mathml field of the response, construct the ``id'' of the html +div to hold the response by concatenating the string ``ans'' (answer) +to the ``id'' of the request resulting, in this case, as ``ansp3''. +The ``showanswer'' function will find this div and replace it with a +div containing the mathml result. + +The ``makeRequest'' function is: +\begin{verbatim} + function makeRequest(arg) { + http_request = new XMLHttpRequest(); + var command = commandline(arg); + //alert(command); + http_request.open('POST', '127.0.0.1:8085', true); + http_request.onreadystatechange = handleResponse; + http_request.setRequestHeader('Content-Type', 'text/plain'); + http_request.send("command="+command); + return(false); +\end{verbatim} +It contains a request to open a local server connection to Axiom, +sets ``handleResponse'' as the function to call on reply, sets up +the type of request, fills in the command field, and sends off the +http request. + +When a response is received, the ``handleResponse'' function checks +for the correct reply state, strips out the important text, and +calls ``showanswer''. +\begin{verbatim} + function handleResponse() { + if (http_request.readyState == 4) { + if (http_request.status == 200) { + showanswer(http_request.responseText,'mathAns'); + } else + { + alert('There was a problem with the request.'+ http_request.statusText); + } + } + } +\end{verbatim} +See bookvol11.pamphlet for further details. + +\section{The axServer/multiServ loop} +The basic call to start an Axiom browser listener is: +\begin{verbatim} + )set message autoload off + )set output mathml on + axServer(8085,multiServ)$AXSERV +\end{verbatim} + +This call sets the port, opens a socket, attaches it to a stream, +and then calls ``multiServ'' with that stream. The ``multiServ'' +function loops serving web responses to that port. + +\section{\enspace{}The )browse command} +In order to make the whole process cleaner the function ``)browse'' +handles the details. This code creates the command-line function for )browse + +The browse function does the internal equivalent of the following 3 command +line statments: +\begin{verbatim} + )set message autoload off + )set output mathml on + axServer(8085,multiServ)$AXSERV +\end{verbatim} +which causes Axiom to start serving web pages on port 8085 + +For those unfamiliar with calling algebra from lisp there are a +few points to mention. + +The loadLib needs to be called to load the algebra code into the image. +Normally this is automatic but we are not using the interpreter so +we need to do this ``by hand''. + +Each algebra file contains a "constructor function" which builds the +domain, which is a vector, and then caches the vector so that every +call to the contructor returns an EQ vector, that is, the same vector. +In this case, we call the constructor $\vert$AxiomServer$\vert$ + +The axServer function was mangled internally to +$\vert$AXSERV;axServer;IMV;2$\vert$. +The multiServ function was mangled to $\vert$AXSERV;multiServ;SeV;3$\vert$ +Note well that if you change axserver.spad these names might change +which will generate the error message along the lines of: +\begin{verbatim} + System error: + The function $\vert$AXSERV;axServer;IMV;2$\vert$ is undefined. +\end{verbatim} + +To fix this you need to look at int/algebra/AXSERV.nrlib/code.lsp +and find the new mangled function name. A better solution would +be to dynamically look up the surface names in the domain vector. + +Each Axiom function expects the domain vector as the last argument. +This is not obvious from the call as the interpreter supplies it. +We must do that ``by hand''. + +We don't call the multiServ function. We pass it as a parameter to +the axServer function. When it does get called by the SPADCALL +macro it needs to be a lisp pair whose car is the function and +whose cdr is the domain vector. We construct that pair here as +the second argument to axServer. The third, hidden, argument to +axServer is the domain vector which we supply ``by hand''. + +The socket can be supplied on the command line but defaults to 8085. +Axiom supplies the arguments as a list. + +\calls{browse}{set} +\calls{browse}{loadLib} +\calls{browse}{AxiomServer} +\calls{browse}{AXSERV;axServer;IMV;2} +\begin{chunk}{defun browse} +(defun |browse| (socket) + (let (axserv browser) + (if socket + (setq socket (car socket)) + (setq socket 8085)) + (|set| '(|mes| |auto| |off|)) + (|set| '(|out| |mathml| |on|)) + (|loadLib| '|AxiomServer|) + (setq axserv (|AxiomServer|)) + (setq browser + (|AXSERV;axServer;IMV;2| socket + (cons #'|AXSERV;multiServ;SeV;3| axserv) axserv)))) + +\end{chunk} +Now we have to bolt it into Axiom. This involves two lookups. + +We create the lisp pair +\begin{verbatim} + (|browse| . |development|) +\end{verbatim} +and cons it into the \$systemCommands command table. This allows the +command to be executed in development mode. This lookup decides if +this command is allowed. It also has the side-effect of putting the +command into the \$SYSCOMMANDS variable which is used to determine +if the token is a command. + +\section{\enspace{}The server support code} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{cd} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{cd.help} +==================================================================== +A.4. )cd +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )cd directory + +Command Description: + +This command sets the AXIOM working current directory. The current directory +is used for looking for input files (for )read), AXIOM library source files +(for )compile), saved history environment files (for )history )restore), +compiled AXIOM library files (for )library), and files to edit (for )edit). +It is also used for writing spool files (via )spool), writing history input +files (via )history )write) and history environment files (via )history +)save),and compiled AXIOM library files (via )compile). + +If issued with no argument, this command sets the AXIOM current directory to +your home directory. If an argument is used, it must be a valid directory +name. Except for the ``)'' at the beginning of the command, this has the same +syntax as the operating system cd command. + +Also See: +o )compile +o )edit +o )history +o )library +o )read +o )spool + +\end{chunk} +\footnote{ +\fnref{edit} +\fnref{history} +\fnref{library} +\fnref{read} +\fnref{spool}} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{clear} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{clear.help} +==================================================================== +A.6. )clear +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )clear all + - )clear completely + - )clear properties all + - )clear properties obj1 [obj2 ...] + - )clear value all + - )clear value obj1 [obj2 ...] + - )clear mode all + - )clear mode obj1 [obj2 ...] + +Command Description: + +This command is used to remove function and variable declarations, +definitions and values from the workspace. To empty the entire workspace and +reset the step counter to 1, issue + +)clear all + +To remove everything in the workspace but not reset the step counter, issue + +)clear properties all + +To remove everything about the object x, issue + +)clear properties x + +To remove everything about the objects x, y and f, issue + +)clear properties x y f + +The word properties may be abbreviated to the single letter ``p''. + +)clear p all +)clear p x +)clear p x y f + +All definitions of functions and values of variables may be removed by either + +)clear value all +)clear v all + +This retains whatever declarations the objects had. To remove definitions and +values for the specific objects x, y and f, issue + +)clear value x y f +)clear v x y f + +To remove the declarations of everything while leaving the definitions and +values, issue + +)clear mode all +)clear m all + +To remove declarations for the specific objects x, y and f, issue + +)clear mode x y f +)clear m x y f + +The )display names and )display properties commands may be used to see what +is currently in the workspace. + +The command + +)clear completely + +does everything that )clear all does, and also clears the internal system +function and constructor caches. + +Also See: +o )display +o )history +o )undo + +\end{chunk} +\footnote{ +\fnref{display} +\fnref{history} +\fnref{undo}} + +\defdollar{clearOptions} +\begin{chunk}{initvars} +(defvar |$clearOptions| '(|modes| |operations| |properties| |types| |values|)) + +\end{chunk} + +\defun{clear}{clear} +\calls{clear}{clearSpad2Cmd} +\begin{chunk}{defun clear} +(defun |clear| (l) + (|clearSpad2Cmd| l)) + +\end{chunk} + +\defdollar{clearExcept} +\begin{chunk}{initvars} +(defvar |$clearExcept| nil) + +\end{chunk} + +\defun{clearSpad2Cmd}{clearSpad2Cmd} +TPDHERE: Note that this function also seems to parse out )except +)completely and )scaches which don't seem to be documented. +\calls{clearSpad2Cmd}{selectOptionLC} +\calls{clearSpad2Cmd}{sayKeyedMsg} +\calls{clearSpad2Cmd}{clearCmdAll} +\calls{clearSpad2Cmd}{clearCmdCompletely} +\calls{clearSpad2Cmd}{clearCmdSortedCaches} +\calls{clearSpad2Cmd}{clearCmdExcept} +\calls{clearSpad2Cmd}{clearCmdParts} +\calls{clearSpad2Cmd}{updateCurrentInterpreterFrame} +\usesdollar{clearSpad2Cmd}{clearExcept} +\usesdollar{clearSpad2Cmd}{options} +\usesdollar{clearSpad2Cmd}{clearOptions} +\begin{chunk}{defun clearSpad2Cmd} +(defun |clearSpad2Cmd| (l) + (let (|$clearExcept| opt optlist arg) + (declare (special |$clearExcept| |$options| |$clearOptions|)) + (cond + (|$options| + (setq |$clearExcept| + (prog (t0) + (setq t0 t) + (return + (do ((t1 nil (null t0)) + (t2 |$options| (cdr t2)) + (t3 nil)) + ((or t1 + (atom t2) + (progn (setq t3 (car t2)) nil) + (progn (progn (setq opt (car t3)) t3) nil)) + t0) + (setq t0 + (and t0 + (eq + (|selectOptionLC| opt '(|except|) '|optionError|) + '|except|))))))))) + (cond + ((null l) + (setq optlist + (prog (t4) + (setq t4 nil) + (return + (do ((t5 |$clearOptions| (cdr t5)) (x nil)) + ((or (atom t5) (progn (setq x (car t5)) nil)) t4) + (setq t4 (append t4 `(|%l| " " ,x))))))) + (|sayKeyedMsg| 's2iz0010 (list optlist))) + (t + (setq arg + (|selectOptionLC| (car l) '(|all| |completely| |scaches|) nil)) + (cond + ((eq arg '|all|) (|clearCmdAll|)) + ((eq arg '|completely|) (|clearCmdCompletely|)) + ((eq arg '|scaches|) (|clearCmdSortedCaches|)) + (|$clearExcept| (|clearCmdExcept| l)) + (t + (|clearCmdParts| l) + (|updateCurrentInterpreterFrame|))))))) + +\end{chunk} + +\defun{clearCmdSortedCaches}{clearCmdSortedCaches} +\calls{clearCmdSortedCaches}{compiledLookupCheck} +\calls{clearCmdSortedCaches}{spadcall} +\usesdollar{clearCmdSortedCaches}{lookupDefaults} +\usesdollar{clearCmdSortedCaches}{Void} +\usesdollar{clearCmdSortedCaches}{ConstructorCache} +\begin{chunk}{defun clearCmdSortedCaches} +(defun |clearCmdSortedCaches| () + (let (|$lookupDefaults| domain pair) + (declare (special |$lookupDefaults| |$Void| |$ConstructorCache|)) + (do ((t0 (hget |$ConstructorCache| '|SortedCache|) (cdr t0)) + (t1 nil)) + ((or (atom t0) + (progn + (setq t1 (car t0)) + (setq domain (cddr t1)) + nil)) + nil) + (setq pair (|compiledLookupCheck| '|clearCache| (list |$Void|) domain)) + (spadcall pair)))) + +\end{chunk} + +\defun{compiledLookupCheck}{compiledLookupCheck} +\calls{compiledLookupCheck}{compiledLookup} +\calls{compiledLookupCheck}{keyedSystemError} +\calls{compiledLookupCheck}{formatSignature} +\begin{chunk}{defun compiledLookupCheck} +(defun |compiledLookupCheck| (op sig dollar) + (let (fn) + (setq fn (|compiledLookup| op sig dollar)) + (cond + ((and (null fn) (eq op '^)) + (setq fn (|compiledLookup| '** sig dollar))) + ((and (null fn) (eq op '**)) + (setq fn (|compiledLookup| '^ sig dollar))) + (t nil)) + (cond + ((null fn) + (|keyedSystemError| 'S2NR0001 + (list op (|formatSignature| sig) (elt dollar 0)))) + (t fn)))) + +\end{chunk} + +\defdollar{functionTable} +\begin{chunk}{initvars} +(defvar |$functionTable| nil) + +\end{chunk} + +\defun{clearCmdCompletely}{clearCmdCompletely} +\calls{clearCmdCompletely}{clearCmdAll} +\calls{clearCmdCompletely}{sayKeyedMsg} +\calls{clearCmdCompletely}{clearClams} +\calls{clearCmdCompletely}{clearConstructorCaches} +\calls{clearCmdCompletely}{reclaim} +\usesdollar{clearCmdCompletely}{localExposureData} +\usesdollar{clearCmdCompletely}{xdatabase} +\usesdollar{clearCmdCompletely}{CatOfCatDatabase} +\usesdollar{clearCmdCompletely}{DomOfCatDatabase} +\usesdollar{clearCmdCompletely}{JoinOfCatDatabase} +\usesdollar{clearCmdCompletely}{JoinOfDomDatabase} +\usesdollar{clearCmdCompletely}{attributeDb} +\usesdollar{clearCmdCompletely}{functionTable} +\usesdollar{clearCmdCompletely}{existingFiles} +\usesdollar{clearCmdCompletely}{localExposureDataDefault} +\begin{chunk}{defun clearCmdCompletely} +(defun |clearCmdCompletely| () + (declare (special |$localExposureData| |$xdatabase| |$CatOfCatDatabase| + |$DomOfCatDatabase| |$JoinOfCatDatabase| |$JoinOfDomDatabase| + |$attributeDb| |$functionTable| |$existingFiles| + |$localExposureDataDefault|)) + (|clearCmdAll|) + (setq |$localExposureData| (copy-seq |$localExposureDataDefault|)) + (setq |$xdatabase| nil) + (setq |$CatOfCatDatabase| nil) + (setq |$DomOfCatDatabase| nil) + (setq |$JoinOfCatDatabase| nil) + (setq |$JoinOfDomDatabase| nil) + (setq |$attributeDb| nil) + (setq |$functionTable| nil) + (|sayKeyedMsg| 's2iz0013 nil) + (|clearClams|) + (|clearConstructorCaches|) + (setq |$existingFiles| (make-hash-table :test #'equal)) + (|sayKeyedMsg| 's2iz0014 nil) + (reclaim) + (|sayKeyedMsg| 's2iz0015 nil)) + +\end{chunk} + +\defun{clearCmdAll}{clearCmdAll} +\calls{clearCmdAll}{clearCmdSortedCaches} +\calls{clearCmdAll}{untraceMapSubNames} +\calls{clearCmdAll}{resetInCoreHist} +\calls{clearCmdAll}{deleteFile} +\calls{clearCmdAll}{histFileName} +\calls{clearCmdAll}{updateCurrentInterpreterFrame} +\calls{clearCmdAll}{clearMacroTable} +\calls{clearCmdAll}{sayKeyedMsg} +\usesdollar{clearCmdAll}{frameRecord} +\usesdollar{clearCmdAll}{previousBindings} +\usesdollar{clearCmdAll}{variableNumberAlist} +\usesdollar{clearCmdAll}{InteractiveFrame} +\usesdollar{clearCmdAll}{useInternalHistoryTable} +\usesdollar{clearCmdAll}{internalHistoryTable} +\usesdollar{clearCmdAll}{frameMessages} +\usesdollar{clearCmdAll}{interpreterFrameName} +\usesdollar{clearCmdAll}{currentLine} +\begin{chunk}{defun clearCmdAll} +(defun |clearCmdAll| () + (declare (special |$frameRecord| |$previousBindings| |$variableNumberAlist| + |$InteractiveFrame| |$useInternalHistoryTable| |$internalHistoryTable| + |$frameMessages| |$interpreterFrameName| |$currentLine|)) + (|clearCmdSortedCaches|) + (setq |$frameRecord| nil) + (setq |$previousBindings| nil) + (setq |$variableNumberAlist| nil) + (|untraceMapSubNames| /tracenames) + (setq |$InteractiveFrame| (list (list nil))) + (|resetInCoreHist|) + (when |$useInternalHistoryTable| + (setq |$internalHistoryTable| nil) + (|deleteFile| (|histFileName|))) + (setq |$IOindex| 1) + (|updateCurrentInterpreterFrame|) + (setq |$currentLine| ")clear all") + (|clearMacroTable|) + (when |$frameMessages| + (|sayKeyedMsg| 's2iz0011 (list |$interpreterFrameName|)) + (|sayKeyedMsg| 's2iz0012 nil))) + +\end{chunk} + +\defun{clearMacroTable}{clearMacroTable} +\usesdollar{clearMacroTable}{pfMacros} +\begin{chunk}{defun clearMacroTable 0} +(defun |clearMacroTable| () + (declare (special |$pfMacros|)) + (setq |$pfMacros| nil)) + +\end{chunk} + +\defun{clearCmdExcept}{clearCmdExcept} +Clear all the options except the argument. +\calls{clearCmdExcept}{stringPrefix?} +\calls{clearCmdExcept}{object2String} +\calls{clearCmdExcept}{clearCmdParts} +\usesdollar{clearCmdExcept}{clearOptions} +\begin{chunk}{defun clearCmdExcept} +(defun |clearCmdExcept| (arg) + (let ((opt (car arg)) (vl (cdr arg))) + (declare (special |$clearOptions|)) + (dolist (option |$clearOptions|) + (unless (|stringPrefix?| (|object2String| opt) (|object2String| option)) + (|clearCmdParts| (cons option vl)))))) + +\end{chunk} + +\defun{clearCmdParts}{clearCmdParts} +\calls{clearCmdParts}{selectOptionLC} +\calls{clearCmdParts}{pname} +\calls{clearCmdParts}{types} +\calls{clearCmdParts}{modes} +\calls{clearCmdParts}{values} +\calls{clearCmdParts}{boot-equal} +\calls{clearCmdParts}{assocleft} +\calls{clearCmdParts}{remdup} +\calls{clearCmdParts}{assoc} +\calls{clearCmdParts}{isMap} +\calls{clearCmdParts}{get} +\calls{clearCmdParts}{exit} +\calls{clearCmdParts}{untraceMapSubNames} +\calls{clearCmdParts}{seq} +\calls{clearCmdParts}{recordOldValue} +\calls{clearCmdParts}{recordNewValue} +\calls{clearCmdParts}{deleteAssoc} +\calls{clearCmdParts}{sayKeyedMsg} +\calls{clearCmdParts}{getParserMacroNames} +\calls{clearCmdParts}{getInterpMacroNames} +\calls{clearCmdParts}{clearDependencies} +\calls{clearCmdParts}{member} +\calls{clearCmdParts}{clearParserMacro} +\calls{clearCmdParts}{sayMessage} +\calls{clearCmdParts}{fixObjectForPrinting} +\usesdollar{clearCmdParts}{e} +\usesdollar{clearCmdParts}{InteractiveFrame} +\usesdollar{clearCmdParts}{clearOptions} +\begin{chunk}{defun clearCmdParts} +(defun |clearCmdParts| (arg) + (let (|$e| (opt (car arg)) option pmacs imacs (vl (cdr arg)) p1 lm prop p2) + (declare (special |$e| |$InteractiveFrame| |$clearOptions|)) + (setq option (|selectOptionLC| opt |$clearOptions| '|optionError|)) + (setq option (intern (pname option))) + (setq option + (case option + (|types| '|mode|) + (|modes| '|mode|) + (|values| '|value|) + (t option))) + (if (null vl) + (|sayKeyedMsg| 's2iz0055 nil) + (progn + (setq pmacs (|getParserMacroNames|)) + (setq imacs (|getInterpMacroNames|)) + (cond + ((boot-equal vl '(|all|)) + (setq vl (assocleft (caar |$InteractiveFrame|))) + (setq vl (remdup (append vl pmacs))))) + (setq |$e| |$InteractiveFrame|) + (do ((t0 vl (cdr t0)) (x nil)) + ((or (atom t0) (progn (setq x (car t0)) nil)) nil) + (|clearDependencies| x t) + (when (and (eq option '|properties|) (|member| x pmacs)) + (|clearParserMacro| x)) + (when (and (eq option '|properties|) + (|member| x imacs) + (null (|member| x pmacs))) + (|sayMessage| (cons + " You cannot clear the definition of the system-defined macro " + (cons (|fixObjectForPrinting| x) + (cons (intern "." "BOOT") nil))))) + (cond + ((setq p1 (|assoc| x (caar |$InteractiveFrame|))) + (cond + ((eq option '|properties|) + (cond + ((|isMap| x) + (seq + (cond + ((setq lm + (|get| x '|localModemap| |$InteractiveFrame|)) + (cond + ((consp lm) + (exit (|untraceMapSubNames| (cons (cadar lm) nil)))))) + (t nil))))) + (dolist (p2 (cdr p1)) + (setq prop (car p2)) + (|recordOldValue| x prop (cdr p2)) + (|recordNewValue| x prop nil)) + (setf (caar |$InteractiveFrame|) + (|deleteAssoc| x (caar |$InteractiveFrame|)))) + ((setq p2 (|assoc| option (cdr p1))) + (|recordOldValue| x option (cdr p2)) + (|recordNewValue| x option nil) + (rplacd p2 nil)))))) + nil)))) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{close} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{close.help} +==================================================================== +A.5. )close +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )close + - )close )quietly + +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 example and you +do not want the extra window around anymore, issue + +)close + +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 + + This is the last AXIOM session. Do you want to kill AXIOM? + +Type "y" (followed by the Return key) if this is what you had in mind. Type +"n" (followed by the Return key) to cancel the command. + +You can use the )quietly option to force AXIOM to close down the interpreter +client process without closing down the entire AXIOM session. + +Also See: +o )quit +o )pquit + +\end{chunk} +\footnote{ +\fnref{quit} +\fnref{pquit}} + +\defun{queryClients}{queryClients} +Returns the number of active scratchpad clients + +\calls{queryClients}{sockSendInt} +\calls{queryClients}{sockGetInt} +\usesdollar{queryClients}{SessionManager} +\usesdollar{queryClients}{QueryClients} +\begin{chunk}{defun queryClients} +(defun |queryClients| () + (declare (special |$SessionManager| |$QueryClients|)) + (|sockSendInt| |$SessionManager| |$QueryClients|) + (|sockGetInt| |$SessionManager|)) + +\end{chunk} + +\defun{close}{close} +\calls{close}{throwKeyedMsg} +\calls{close}{sockSendInt} +\calls{close}{closeInterpreterFrame} +\calls{close}{selectOptionLC} +\calls{close}{upcase} +\calls{close}{queryUserKeyedMsg} +\calls{close}{string2id-n} +\calls{close}{queryClients} +\usesdollar{close}{SpadServer} +\usesdollar{close}{SessionManager} +\usesdollar{close}{CloseClient} +\usesdollar{close}{currentFrameNum} +\usesdollar{close}{options} +\begin{chunk}{defun close} +(defun |close| (args) + (declare (ignore args)) + (let (numClients opt fullopt quiet x) + (declare (special |$SpadServer| |$SessionManager| |$CloseClient| + |$currentFrameNum| |$options|)) + (if (null |$SpadServer|) + (|throwKeyedMsg| 's2iz0071 nil)) + (progn + (setq 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 (setq opt (car t1)) t1) nil)) + nil) + (setq fullopt (|selectOptionLC| opt '(|quiet|) '|optionError|)) + (unless quiet (setq quiet (eq fullopt '|quiet|)))) + (cond + (quiet + (|sockSendInt| |$SessionManager| |$CloseClient|) + (|sockSendInt| |$SessionManager| |$currentFrameNum|) + (|closeInterpreterFrame| nil)) + (t + (setq x (upcase (|queryUserKeyedMsg| 's2iz0072 nil))) + (when (member (string2id-n x 1) '(yes y)) (bye))))))))) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{compile} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{compile.help} +==================================================================== +A.7. )compile +==================================================================== + +User Level Required: compiler + +Command Syntax: + + - )compile + - )compile fileName + - )compile fileName.spad + - )compile directory/fileName.spad + - )compile fileName )quiet + - )compile fileName )noquiet + - )compile fileName )break + - )compile fileName )nobreak + - )compile fileName )library + - )compile fileName )nolibrary + - )compile fileName )vartrace + - )compile fileName )constructor nameOrAbbrev + +Command Description: + +You use this command to invoke the AXIOM library compiler. This +compiles files with file extension .spad with the AXIOM system +compiler. The command first looks in the standard system directories +for files with extension .spad. + +Should you not want the )library command automatically invoked, call )compile +with the )nolibrary option. For example, + +)compile mycode )nolibrary + +By default, the )library system command exposes all domains and categories it +processes. This means that the AXIOM intepreter will consider those domains +and categories when it is trying to resolve a reference to a function. +Sometimes domains and categories should not be exposed. For example, a domain +may just be used privately by another domain and may not be meant for +top-level use. The )library command should still be used, though, so that the +code will be loaded on demand. In this case, you should use the )nolibrary +option on )compile and the )noexpose option in the )library command. For +example, + +)compile mycode.spad )nolibrary +)library mycode )noexpose + +Once you have established your own collection of compiled code, you may find +it handy to use the )dir option on the )library command. This causes )library +to process all compiled code in the specified directory. For example, + +)library )dir /u/jones/as/quantum + +You must give an explicit directory after )dir, even if you want all compiled +code in the current working directory processed. + +)library )dir . + +You can compile category, domain, and package constructors contained in files +with file extension .spad. You can compile individual constructors or every +constructor in a file. + +The full filename is remembered between invocations of this command and )edit +commands. The sequence of commands + +)compile matrix.spad +)edit +)compile + +will call the compiler, edit, and then call the compiler again on the file +matrix.spad. If you do not specify a directory, the working current directory +(see description of command )cd ) is searched for the file. If the file is +not found, the standard system directories are searched. + +If you do not give any options, all constructors within a file are compiled. +Each constructor should have an )abbreviation command in the file in which it +is defined. We suggest that you place the )abbreviation commands at the top +of the file in the order in which the constructors are defined. The list of +commands serves as a table of contents for the file. + +The )library option causes directories containing the compiled code for each +constructor to be created in the working current directory. The name of such +a directory consists of the constructor abbreviation and the .NRLIB file +extension. For example, the directory containing the compiled code for the +MATRIX constructor is called MATRIX.NRLIB. The )nolibrary option says that +such files should not be created. + +The )vartrace option causes the compiler to generate extra code for the +constructor to support conditional tracing of variable assignments. (see +description of command )trace ). Without this option, this code is suppressed +and one cannot use the )vars option for the trace command. + +The )constructor option is used to specify a particular constructor to +compile. All other constructors in the file are ignored. The constructor name +or abbreviation follows )constructor. Thus either + +)compile matrix.spad )constructor RectangularMatrix + +or + +)compile matrix.spad )constructor RMATRIX + +compiles the RectangularMatrix constructor defined in matrix.spad. + +The )break and )nobreak options determine what the compiler does +when it encounters an error. )break is the default and it indicates that +processing should stop at the first error. The value of the )set break +variable then controls what happens. + +Also See: +o )abbreviation +o )edit +o )library + +\end{chunk} +\footnote{ +\fnref{abbreviation} +\fnref{edit} +\fnref{library}} + +\defvar{/editfile} +\begin{chunk}{initvars} +(defvar /editfile nil) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{copyright} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{copyright.help} +The term Axiom, in the field of computer algebra software, +along with AXIOM and associated images are common-law +trademarks. While the software license allows copies, the +trademarks may only be used when referring to this project. + +Axiom is distributed under terms of the Modified BSD license. +Axiom was released under this license as of September 3, 2002. +Source code is freely available at: +http://savannah.nongnu.org/projects/axiom +Copyrights remain with the original copyright holders. +Use of this material is by permission and/or license. +Individual files contain reference to these applicable copyrights. +The copyright and license statements are collected here for reference. + +Portions Copyright (c) 2003- The Axiom Team + +The Axiom Team is the collective name for the people who have +contributed to this project. Where no other copyright statement +is noted in a file this copyright will apply. + +Portions Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + - Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + - Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + + - Neither the name of The Numerical ALgorithms Group Ltd. nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +Portions Copyright (C) 1989-95 GROUPE BULL + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to +deal in the Software without restriction, including without limitation the +rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +sell copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +GROUPE BULL BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN +AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +Except as contained in this notice, the name of GROUPE BULL shall not be +used in advertising or otherwise to promote the sale, use or other dealings +in this Software without prior written authorization from GROUPE BULL. + +Portions Copyright (C) 2002, Codemist Ltd. All rights reserved. +acn@codemist.co.uk + + + CCL Public License 1.0 + ====================== + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +(1) Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +(2) Redistributions in binary form must reproduce the above copyright +notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +(3) Neither the name of Codemist nor the names of other contributors may +be used to endorse or promote products derived from this software without +specific prior written permission. + +(4) If you distribute a modified form or either source or binary code + (a) you must make the source form of these modification available + to Codemist; + (b) you grant Codemist a royalty-free license to use, modify + or redistribute your modifications without limitation; + (c) you represent that you are legally entitled to grant these rights + and that you are not providing Codemist with any code that violates + any law or breaches any contract. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED +TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +Portions Copyright (C) 1995-1997 Eric Young (eay@mincom.oz.au) +All rights reserved. + +This package is an SSL implementation written +by Eric Young (eay@mincom.oz.au). +The implementation was written so as to conform with Netscapes SSL. + +This library is free for commercial and non-commercial use as long as +the following conditions are aheared to. The following conditions +apply to all code found in this distribution, be it the RC4, RSA, +lhash, DES, etc., code; not just the SSL code. The SSL documentation +included with this distribution is covered by the same copyright terms +except that the holder is Tim Hudson (tjh@mincom.oz.au). + +Copyright remains Eric Young's, and as such any Copyright notices in +the code are not to be removed. +If this package is used in a product, Eric Young should be given attribution +as the author of the parts of the library used. +This can be in the form of a textual message at program startup or +in documentation (online or textual) provided with the package. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. All advertising materials mentioning features or use of this software + must display the following acknowledgement: + "This product includes cryptographic software written by + Eric Young (eay@mincom.oz.au)" + The word 'cryptographic' can be left out if the rouines from the library + being used are not cryptographic related :-). +4. If you include any Windows specific code (or a derivative thereof) from + the apps directory (application code) you must include an acknowledgement: + "This product includes software written by Tim Hudson (tjh@mincom.oz.au)" + +THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. + +The licence and distribution terms for any publically available version or +derivative of this code cannot be changed. i.e. this code cannot simply be +copied and put under another distribution licence +[including the GNU Public Licence.] + +Portions Copyright (C) 1988 by Leslie Lamport. + +Portions Copyright (c) 1998 Free Software Foundation, Inc. + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, distribute with modifications, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, +DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR +OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR +THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +Except as contained in this notice, the name(s) of the above copyright +holders shall not be used in advertising or otherwise to promote the +sale, use or other dealings in this Software without prior written +authorization. + +Portions Copyright 1989-2000 by Norman Ramsey. All rights reserved. + +Noweb is protected by copyright. It is not public-domain +software or shareware, and it is not protected by a ``copyleft'' +agreement like the one used by the Free Software Foundation. + +Noweb is available free for any use in any field of endeavor. You may +redistribute noweb in whole or in part provided you acknowledge its +source and include this COPYRIGHT file. You may modify noweb and +create derived works, provided you retain this copyright notice, but +the result may not be called noweb without my written consent. + +You may sell noweb if you wish. For example, you may sell a CD-ROM +including noweb. + +You may sell a derived work, provided that all source code for your +derived work is available, at no additional charge, to anyone who buys +your derived work in any form. You must give permisson for said +source code to be used and modified under the terms of this license. +You must state clearly that your work uses or is based on noweb and +that noweb is available free of change. You must also request that +bug reports on your work be reported to you. + +Portions Copyright (c) 1987 The RAND Corporation. All rights reserved. + +Portions Copyright 1988-1995 by Stichting Mathematisch Centrum, Amsterdam, The +Netherlands. + + All Rights Reserved + +Permission to use, copy, modify, and distribute this software and its +documentation for any purpose and without fee is hereby granted, +provided that the above copyright notice appear in all copies and that +both that copyright notice and this permission notice appear in +supporting documentation, and that the names of Stichting Mathematisch +Centrum or CWI not be used in advertising or publicity pertaining to +distribution of the software without specific, written prior permission. + +STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO +THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE +FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT +OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + +Portions Copyright (c) Renaud Rioboo and the University Paris 6. + +Portions Copyright (c) 2003-2010 Jocelyn Guidry + +Portions Copyright (c) 2001-2010 Timothy Daly + +\end{chunk} +\defun{copyright}{copyright} +\calls{copyright}{obey} +\calls{copyright}{concat} +\calls{copyright}{getenviron} +\begin{chunk}{defun copyright} +(defun |copyright| () + (obey (concat "cat " (getenviron "AXIOM") "/doc/spadhelp/copyright.help"))) + +\end{chunk} +\defun{trademark}{trademark} +\begin{chunk}{defun trademark 0} +(defun |trademark| () + (format t "The term Axiom, in the field of computer algebra software, ~%") + (format t "along with AXIOM and associated images are common-law ~%") + (format t "trademarks. While the software license allows copies, the ~%") + (format t "trademarks may only be used when referring to this project ~%")) + +\end{chunk} + +This command is in the list of \verb|$noParseCommands| +\ref{noParseCommands} which means that its arguments are passed +verbatim. This will eventually result in a call to the function +\verb|handleNoParseCommands| \ref{handleNoParseCommands} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{credits} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +\defun{credits}{credits} +\uses{credits}{credits} +\begin{chunk}{defun credits 0} +(defun |credits| () + (declare (special credits)) + (mapcar #'(lambda (x) (princ x) (terpri)) creditlist)) + +\end{chunk} + +This command is in the list of \verb|$noParseCommands| +\ref{noParseCommands} which means that its arguments are passed +verbatim. This will eventually result in a call to the function +\verb|handleNoParseCommands| \ref{handleNoParseCommands} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{describe} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{describe.help} +==================================================================== + )describe +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )describe categoryName + - )describe domainName + - )describe packageName + +Command Description: + +This command is used to display the comments for the operation, category, +domain or package. The comments are part of the algebra source code. + +The commands + +)describe [internal] +)describe [internal] +)describe [internal] + +will show a properly formatted version of the "Description:" keyword +from the comments in the algebra source for the category, domain, +or package requested. + +If 'internal' is requested, then the internal format of the domain or +package is described. Categories do not have an internal representation. + +\end{chunk} + +\defdollar{describeOptions} +The current value of \$describeOptions is +\begin{chunk}{initvars} +(defvar $describeOptions '(|category| |domain| |package|)) + +\end{chunk} + +\defun{describe}{Print comment strings from algebra libraries} +This trivial function satisfies the standard pattern of making a +user command match the name of the function which implements the +command. That command immediatly invokes a ``Spad2Cmd'' version. +\calls{describe}{describespad2cmd} +\begin{chunk}{defun describe} +(defun |describe| (l) + (describeSpad2Cmd l)) + +\end{chunk} + +\defun{describeSpad2Cmd}{describeSpad2Cmd} +The describe command prints cleaned-up comment strings from the algebra +libraries. It can print strings associated with a category, domain, package, +or by operation. + +This implements command line options of the form: +\begin{verbatim} + )describe categoryName [internal] + )describe domainName [internal] + )describe packageName [internal] +\end{verbatim} +The describeInternal function will either call the ``dc'' function +to describe the internal representation of the argument or it will +print a cleaned up version of the text for the "Description" keyword +in the Category, Domain, or Package source code. + +\calls{describeSpad2Cmd}{selectOptionLC} +\calls{describeSpad2Cmd}{flatten} +\calls{describeSpad2Cmd}{cleanline} +\calls{describeSpad2Cmd}{getdatabase} +\calls{describeSpad2Cmd}{sayMessage} +\usesdollar{describeSpad2Cmd}{e} +\usesdollar{describeSpad2Cmd}{EmptyEnvironment} +\usesdollar{describeSpad2Cmd}{describeOptions} +\begin{chunk}{defun describeSpad2Cmd} +(defun describeSpad2Cmd (l) + (labels ( + (fullname (arg) + "Convert abbreviations to the full constructor name" + (let ((abb (getdatabase arg 'abbreviation))) + (if abb arg (getdatabase arg 'constructor)))) + (describeInternal (cdp internal?) + (if internal? + (progn + (unless (eq (getdatabase cdp 'constructorkind) '|category|) (|dc| cdp)) + (showdatabase cdp)) + (mapcar #'(lambda (x) (if (stringp x) (cleanline x))) + (flatten (car (getdatabase (fullname cdp) 'documentation))))))) + (let ((|$e| |$EmptyEnvironment|) (opt (second l))) + (declare (special |$e| |$EmptyEnvironment| $describeOptions)) + (if (and (consp l) (not (eq opt '?))) + (describeInternal (first l) (second l)) + (|sayMessage| + (append + '(" )describe keyword arguments are") + (mapcar #'(lambda (x) (format nil "~% ~a" x)) $describeOptions) + (format nil "~% or abbreviations thereof"))))))) + +\end{chunk} + +\defun{cleanline}{cleanline} +\begin{chunk}{defun cleanline} +(defun cleanline (line) + (labels ( + (replaceInLine (thing other line) + (do ((mark (search thing line) (search thing line))) + ((null mark) line) + (setq line + (concatenate 'string (subseq line 0 mark) other + (subseq line (+ mark (length thing))))))) + + (removeFromLine (thing line) (replaceInLine thing "" line)) + + (removeKeyword (str line) + (do ((mark (search str line) (search str line))) + ((null mark) line) + (let (left point mid right) + (setq left (subseq line 0 mark)) + (setq point (search "}" line :start2 mark)) + (setq mid (subseq line (+ mark (length str)) point)) + (setq right (subseq line (+ point 1))) + (setq line (concatenate 'string left mid right))))) + + (addSpaces (str line) + (do ((mark (search str line) (search str line)) (cnt)) + ((null mark) line) + (let (left point mid right) + (setq left (subseq line 0 mark)) + (setq point (search "}" line :start2 mark)) + (setq mid (subseq line (+ mark (length str)) point)) + (if (setq cnt (parse-integer mid :junk-allowed t)) + (setq mid (make-string cnt :initial-element #\ )) + (setq mid "")) + (setq right (subseq line (+ point 1))) + (setq line (concatenate 'string left mid right))))) + + (splitAtNewline (line) + (do ((mark (search "~%" line) (search "~%" line)) (lines)) + ((null mark) + (push " " lines) + (push line lines) + (nreverse lines)) + (push (subseq line 0 mark) lines) + (setq line (subseq line (+ mark 2))))) + + (wrapOneLine (line margin result) + (if (null line) + (nreverse result) + (if (< (length line) margin) + (wrapOneLine nil margin (append (list line) result)) + (let (oneline spill aspace) + (setq aspace (position #\space (subseq line 0 margin) :from-end t)) + (setq oneline (string-trim '(#\space) (subseq line 0 aspace))) + (setq spill (string-trim '(#\space) (subseq line aspace))) + (wrapOneLine spill margin (append (list oneline) result)))))) + + (reflowParagraph (line) + (let (lst1) + (setq lst1 (splitAtNewLine line)) + (dolist (x lst1) + (mapcar #'(lambda(y) (format t "~a~%" y)) + (wrapOneLine x 70 nil)))))) + + (setq line (removeFromLine "{}" line)) + (setq line (replaceInLine "\\blankline" "~%~%" line)) + (setq line (replaceInLine "\\br" "~%" line)) + (setq line (removeFromLine "\\" line)) + (dolist (str '("spad{" "spadtype{" "spadop{" "spadfun{" "spadatt{" + "axiom{" "axiomType{" "spadignore{" "axiomFun{" + "centerline{" "inputbitmap{" "axiomOp{" "spadgloss{")) + (setq line (removeKeyword str line))) + (setq line (replaceInLine "{e.g.}" "e.g." line)) + (dolist (str '("tab{" "indented{" )) + (setq line (addSpaces str line))) + (reflowParagraph line))) + +\end{chunk} + +\defun{flatten}{flatten} +\begin{chunk}{defun flatten 0} +(defun flatten (x) + (labels ( + (rec (x acc) + (cond + ((null x) acc) + ((atom x) (cons x acc)) + (t (rec (car x) (rec (cdr x) acc)))))) + (rec x nil))) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{display} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{display.help} +==================================================================== +A.8. )display +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )display all + - )display properties + - )display properties all + - )display properties [obj1 [obj2 ...] ] + - )display value all + - )display value [obj1 [obj2 ...] ] + - )display mode all + - )display mode [obj1 [obj2 ...] ] + - )display names + - )display operations opName + +Command Description: + +This command is used to display the contents of the workspace and signatures +of functions with a given name. (A signature gives the argument and return +types of a function.) + +The command + +)display names + +lists the names of all user-defined objects in the workspace. This is useful +if you do not wish to see everything about the objects and need only be +reminded of their names. + +The commands + +)display all +)display properties +)display properties all + +all do the same thing: show the values and types and declared modes of all +variables in the workspace. If you have defined functions, their signatures +and definitions will also be displayed. + +To show all information about a particular variable or user functions, for +example, something named d, issue + +)display properties d + +To just show the value (and the type) of d, issue + +)display value d + +To just show the declared mode of d, issue + +)display mode d + +All modemaps for a given operation may be displayed by using )display +operations. A modemap is a collection of information about a particular +reference to an operation. This includes the types of the arguments and the +return value, the location of the implementation and any conditions on the +types. The modemap may contain patterns. The following displays the modemaps +for the operation FromcomplexComplexCategory: + +)d op complex + +Also See: +o )clear +o )history +o )set +o )show +o )what + +\end{chunk} +\footnote{ +\fnref{clear} +\fnref{history} +\fnref{set} +\fnref{show} +\fnref{what}} + +\defdollar{displayOptions} +The current value of \$displayOptions is +\begin{chunk}{initvars} +(defvar |$displayOptions| + '(|abbreviations| |all| |macros| |modes| |names| |operations| + |properties| |types| |values|)) + +\end{chunk} + +\defun{display}{display} +This trivial function satisfies the standard pattern of making a +user command match the name of the function which implements the +command. That command immediatly invokes a ``Spad2Cmd'' version. +\calls{display}{displayspad2cmd} +\begin{chunk}{defun display} +(defun |display| (l) + (displaySpad2Cmd l)) + +\end{chunk} + +\subsection{displaySpad2Cmd} +We process the options to the command and call the appropriate +display function. There are really only 4 display functions. +All of the other options are just subcases. + +There is a slight mismatch between the \$displayOptions list of +symbols and the options this command accepts so we have a cond +branch to clean up the option variable. This allows for the options +to be plural. + +If we fall all the way thru we use the \$displayOptions list +to construct a list of strings for the sayMessage function +and tell the user what options are available. +\calls{displaySpad2Cmd}{abbQuery} +\calls{displaySpad2Cmd}{opOf} +\calls{displaySpad2Cmd}{listConstructorAbbreviations} +\calls{displaySpad2Cmd}{displayOperations} +\calls{displaySpad2Cmd}{displayMacros} +\calls{displaySpad2Cmd}{displayWorkspaceNames} +\calls{displaySpad2Cmd}{displayProperties} +\calls{displaySpad2Cmd}{selectOptionLC} +\calls{displaySpad2Cmd}{sayMessage} +\usesdollar{displaySpad2Cmd}{e} +\usesdollar{displaySpad2Cmd}{EmptyEnvironment} +\usesdollar{displaySpad2Cmd}{displayOptions} +\begin{chunk}{defun displaySpad2Cmd} +(defun displaySpad2Cmd (l) + (let ((|$e| |$EmptyEnvironment|) (opt (car l)) (vl (cdr l)) option) + (declare (special |$e| |$EmptyEnvironment| |$displayOptions|)) + (if (and (consp l) (not (eq opt '?))) + (progn + (setq option (|selectOptionLC| opt |$displayOptions| '|optionError|)) + (cond + ((eq option '|all|) + (setq l (list '|properties|)) + (setq option '|properties|)) + ((or (eq option '|modes|) (eq option '|types|)) + (setq l (cons '|type| vl)) + (setq option '|type|)) + ((eq option '|values|) + (setq l (cons '|value| vl)) + (setq option '|value|))) + (cond + ((eq option '|abbreviations|) + (if (null vl) + (|listConstructorAbbreviations|) + (dolist (v vl) (|abbQuery| (|opOf| v))))) + ((eq option '|operations|) (|displayOperations| vl)) + ((eq option '|macros|) (|displayMacros| vl)) + ((eq option '|names|) (|displayWorkspaceNames|)) + (t (|displayProperties| option l)))) + (|sayMessage| + (append + '(" )display keyword arguments are") + (mapcar #'(lambda (x) (format nil "~% ~a" x)) |$displayOptions|) + (format nil "~% or abbreviations thereof")))))) + +\end{chunk} + +\defun{abbQuery}{abbQuery} +\calls{abbQuery}{getdatabase} +\calls{abbQuery}{sayKeyedMsg} +\begin{chunk}{defun abbQuery} +(defun |abbQuery| (x) + (let (abb) + (cond + ((setq abb (getdatabase x 'abbreviation)) + (|sayKeyedMsg| 's2iz0001 (list abb (getdatabase x 'constructorkind) x))) + ((setq abb (getdatabase x 'constructor)) + (|sayKeyedMsg| 's2iz0001 (list x (getdatabase abb 'constructorkind) abb))) + (t + (|sayKeyedMsg| 's2iz0003 (list x)))))) + +\end{chunk} +\defun{displayOperations}{displayOperations} +This function takes a list of operation names. If the list is null +we query the user to see if they want all operations printed. Otherwise +we print the information for the requested symbols. + +\calls{displayOperations}{reportOpSymbol} +\calls{displayOperations}{yesanswer} +\calls{displayOperations}{sayKeyedMsg} +\begin{chunk}{defun displayOperations} +(defun |displayOperations| (l) + (if l + (dolist (op l) (|reportOpSymbol| op)) + (if (yesanswer) + (dolist (op (|allOperations|)) (|reportOpSymbol| op)) + (|sayKeyedMsg| 's2iz0059 nil)))) + +\end{chunk} +\defun{yesanswer}{yesanswer} +This is a trivial function to simplify the logic of displaySpad2Cmd. +If the user didn't supply an argument to the )display op command +we ask if they wish to have all information about all Axiom operations +displayed. If the answer is either Y or YES we return true else nil. + +\calls{yesanswer}{string2id-n} +\calls{yesanswer}{upcase} +\calls{yesanswer}{queryUserKeyedMsg} +\begin{chunk}{defun yesanswer} +(defun yesanswer () + (member + (string2id-n (upcase (|queryUserKeyedMsg| 's2iz0058 nil)) 1) '(y yes))) + +\end{chunk} + +\defun{displayMacros}{displayMacros} +\calls{displayMacros}{getInterpMacroNames} +\calls{displayMacros}{getParserMacroNames} +\calls{displayMacros}{remdup} +\calls{displayMacros}{sayBrightly} +\calls{displayMacros}{member} +\calls{displayMacros}{displayParserMacro} +\calls{displayMacros}{seq} +\calls{displayMacros}{exit} +\calls{displayMacros}{displayMacro} +\begin{chunk}{defun displayMacros} +(defun |displayMacros| (names) + (let (imacs pmacs macros first) + (setq imacs (|getInterpMacroNames|)) + (setq pmacs (|getParserMacroNames|)) + (if names + (setq macros names) + (setq macros (append imacs pmacs))) + (setq macros (remdup macros)) + (cond + ((null macros) (|sayBrightly| " There are no Axiom macros.")) + (t + (setq first t) + (do ((t0 macros (cdr t0)) (macro nil)) + ((or (atom t0) (progn (setq macro (car t0)) nil)) nil) + (seq + (exit + (cond + ((|member| macro pmacs) + (cond + (first (|sayBrightly| + (cons '|%l| (cons "User-defined macros:" nil))) (setq first nil))) + (|displayParserMacro| macro)) + ((|member| macro imacs) '|iterate|) + (t (|sayBrightly| + (cons " " + (cons '|%b| + (cons macro + (cons '|%d| (cons " is not a known Axiom macro." nil))))))))))) + (setq first t) + (do ((t1 macros (cdr t1)) (macro nil)) + ((or (atom t1) (progn (setq macro (car t1)) nil)) nil) + (seq + (exit + (cond + ((|member| macro imacs) + (cond + ((|member| macro pmacs) '|iterate|) + (t + (cond + (first + (|sayBrightly| + (cons '|%l| + (cons "System-defined macros:" nil))) (setq first nil))) + (|displayMacro| macro)))) + ((|member| macro pmacs) '|iterate|))))) + nil)))) + +\end{chunk} + +\defun{sayExample}{sayExample} +This function expects 2 arguments, the documentation string and +the name of the operation. It searches the documentation string for +\verb|++X| lines. These lines are examples lines for functions. +They look like ordinary \verb|++| comments and fit into the ordinary +comment blocks. So, for example, in the plot.spad.pamphlet file we +find the following function signature: +\begin{verbatim} + plot: (F -> F,R) -> % + ++ plot(f,a..b) plots the function \spad{f(x)} + ++ on the interval \spad{[a,b]}. + ++ + ++X fp:=(t:DFLOAT):DFLOAT +-> sin(t) + ++X plot(fp,-1.0..1.0)$PLOT +\end{verbatim} +This function splits out and prints the lines that begin with \verb|++X|. + +A minor complication of printing the examples is that the lines have +been processed into internal compiler format. Thus the lines that read: +\begin{verbatim} + ++X fp:=(t:DFLOAT):DFLOAT +-> sin(t) + ++X plot(fp,-1.0..1.0)$PLOT +\end{verbatim} +are actually stored as one long line containing the example lines +\begin{verbatim} +"\\indented{1}{plot(\\spad{f},{}a..\\spad{b}) plots the function + \\spad{f(x)}} \\indented{1}{on the interval \\spad{[a,{}b]}.} + \\blankline + \\spad{X} fp:=(t:DFLOAT):DFLOAT +-> sin(\\spad{t}) + \\spad{X} plot(\\spad{fp},{}\\spad{-1}.0..1.0)\\$PLOT" +\end{verbatim} + +So when we have an example line starting with ++X, it gets +converted to the compiler to \verb|\spad{X}|. So each +example line is delimited by \verb|\spad{X}|. + +The compiler also removes the newlines so +if there is a subsequent \verb|\spad{X}| in the docstring +then it implies multiple example lines and we loop over them, +splitting them up at the delimiter. + +If there is only one then we clean it up and print it. + +\calls{sayexample}{cleanupline} +\calls{sayexample}{sayNewLine} +\begin{chunk}{defun sayExample} +(defun sayExample (docstring) + (let (line point) + (when (setq point (search "spad{X}" docstring)) + (setq line (subseq docstring (+ point 8))) + (do ((mark (search "spad{X}" line) (search "spad{X}" line))) + ((null mark)) + (princ (cleanupLine (subseq line 0 mark))) + (|sayNewLine|) + (setq line (subseq line (+ mark 8)))) + (princ (cleanupLine line)) + (|sayNewLine|) + (|sayNewLine|)))) + +\end{chunk} + +\defun{cleanupLine}{cleanupLine} +This function expects example lines in internal format that has been +partially processed to remove the prefix. Thus we get lines that look +like: +\begin{verbatim} + fp:=(t:DFLOAT):DFLOAT +-> sin(\\spad{t}) + plot(\\spad{fp},{}\\spad{-1}.0..1.0)\\$PLOT +\end{verbatim} + +It removes all instances of \verb|{}|, and \verb|\|, and unwraps the +\verb|spad{}| call, leaving only the argument. + +We return lines that look like: +\begin{verbatim} + fp:=(t:DFLOAT):DFLOAT +-> sin(t) + plot(fp,-1.0..1.0)$PLOT +\end{verbatim} +which is hopefully exactly what the user wrote. + +The compiler inserts \verb|{}| as a space so we remove it. +We remove all of the \verb|\| characters. +We remove all of the \verb|spad{...}| delimiters which will +occur around other spad variables. Technically we should +search recursively for the matching delimiter rather than the +next brace but the problem does not arise in practice. +\begin{chunk}{defun cleanupLine 0} +(defun cleanupLine (line) + (do ((mark (search "{}" line) (search "{}" line))) + ((null mark)) + (setq line + (concatenate 'string (subseq line 0 mark) (subseq line (+ mark 2))))) + (do ((mark (search "\\" line) (search "\\" line))) + ((null mark)) + (setq line + (concatenate 'string (subseq line 0 mark) (subseq line (+ mark 1))))) + (do ((mark (search "spad{" line) (search "spad{" line))) + ((null mark)) + (let (left point mid right) + (setq left (subseq line 0 mark)) + (setq point (search "}" line :start2 mark)) + (setq mid (subseq line (+ mark 5) point)) + (setq right (subseq line (+ point 1))) + (setq line (concatenate 'string left mid right)))) + line) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{edit} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{edit.help} +==================================================================== +A.9. )edit +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )edit [filename] + +Command Description: + +This command is used to edit files. It works in conjunction with the )read +and )compile commands to remember the name of the file on which you are +working. By specifying the name fully, you can edit any file you wish. Thus + +)edit /u/julius/matrix.input + +will place you in an editor looking at the file /u/julius/matrix.input. By +default, the editor is vi, but if you have an EDITOR shell environment +variable defined, that editor will be used. When AXIOM is running under the X +Window System, it will try to open a separate xterm running your editor if it +thinks one is necessary. For example, under the Korn shell, if you issue + +export EDITOR=emacs + +then the emacs editor will be used by )edit. + +If you do not specify a file name, the last file you edited, read or compiled +will be used. If there is no ``last file'' you will be placed in the editor +editing an empty unnamed file. + +It is possible to use the )system command to edit a file directly. For +example, + +)system emacs /etc/rc.tcpip + +calls emacs to edit the file. + +Also See: +o )system +o )compile +o )read + +\end{chunk} +\footnote{ +\fnref{system} +\fnref{read}} + +\defun{edit}{edit} +\calls{edit}{editSpad2Cmd} +\begin{chunk}{defun edit} +(defun |edit| (l) (|editSpad2Cmd| l)) + +\end{chunk} + +\defun{editSpad2Cmd}{editSpad2Cmd} +\calls{editSpad2Cmd}{pathname} +\calls{editSpad2Cmd}{pathnameDirectory} +\calls{editSpad2Cmd}{pathnameType} +\callsdollar{editSpad2Cmd}{FINDFILE} +\calls{editSpad2Cmd}{pathnameName} +\calls{editSpad2Cmd}{editFile} +\calls{editSpad2Cmd}{updateSourceFiles} +\uses{editSpad2Cmd}{/editfile} +\begin{chunk}{defun editSpad2Cmd} +(defun |editSpad2Cmd| (l) + (let (olddir filetypes ll rc) + (declare (special /editfile)) + (setq l (cond ((null l) /editfile) (t (car l)))) + (setq l (|pathname| l)) + (setq olddir (|pathnameDirectory| l)) + (setq filetypes + (cond + ((|pathnameType| l) (list (|pathnameType| l))) + ((eq |$UserLevel| '|interpreter|) '("input" "INPUT" "spad" "SPAD")) + ((eq |$UserLevel| '|compiler|) '("input" "INPUT" "spad" "SPAD")) + (t '("input" "INPUT" "spad" "SPAD" "boot" "BOOT" + "lisp" "LISP" "meta" "META")))) + (setq ll + (cond + ((string= olddir "") + (|pathname| ($findfile (|pathnameName| l) filetypes))) + (t l))) + (setq l (|pathname| ll)) + (setq /editfile l) + (setq rc (|editFile| l)) + (|updateSourceFiles| l) + rc)) + +\end{chunk} + +\defun{editFile}{Implement the )edit command} +\calls{editFile}{strconc} +\calls{editFile}{namestring} +\calls{editFile}{pathname} +\calls{editFile}{obey} +\begin{chunk}{defun editFile} +(defun |editFile| (file) + (cond + ((member (intern "WIN32" (find-package 'keyword)) *features*) + (obey (strconc "notepad " (|namestring| (|pathname| file))))) + (t + (obey + (strconc "$AXIOM/lib/SPADEDIT " (|namestring| (|pathname| file))))))) + +\end{chunk} + +\subsubsection{The SPADEDIT command} +Axiom execute a shell script called SPADEDIT to open a file using +the user's chosen editor. That editor name is, by convention, in +the EDITOR shell variable. If that variable is not set we default +to the 'vi' editor. +\begin{chunk}{spadedit} +#!/bin/sh +# this script is invoked by the spad )edit command +# can be replaced by users favorite editor +# optional second argument should be character offset in file + +thefile=$1 +if [ ! -f $1 ] ; then + thefile=$AXIOM/../../src/algebra/$1 +else + thefile=$1 +fi + + +if [ $# = 2 ] ; then + START=`grep -n \^$2\( $thefile | awk -F: '{print $1}'` +else + START=1 +fi + +if [ ! "$EDITOR" ] ; then + EDITOR=vi +fi + +if [ "$DISPLAY" ] ; then + if [ "$EDITOR" = "emacs" ] ; then + emacs +$START $thefile & + elif [ "$EDITOR" = "vi" ] ; then + xterm -e vi +$START $thefile & + else + xterm -e $EDITOR $thefile & + fi +else + $EDITOR $thefile +fi +\end{chunk} + +\defun{updateSourceFiles}{updateSourceFiles} +\calls{updateSourceFiles}{pathname} +\calls{updateSourceFiles}{pathnameName} +\calls{updateSourceFiles}{pathnameType} +\calls{updateSourceFiles}{makeInputFilename} +\calls{updateSourceFiles}{member} +\calls{updateSourceFiles}{pathnameTypeId} +\calls{updateSourceFiles}{insert} +\usesdollar{updateSourceFiles}{sourceFiles} +\begin{chunk}{defun updateSourceFiles} +(defun |updateSourceFiles| (arg) + (declare (special |$sourceFiles|)) + (setq arg (|pathname| arg)) + (setq arg (|pathname| (list (|pathnameName| arg) (|pathnameType| arg) "*"))) + (when (and (makeInputFilename arg) + (|member| (|pathnameTypeId| arg) '(boot lisp meta))) + (setq |$sourceFiles| (|insert| arg |$sourceFiles|))) + arg) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{fin} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{fin.help} +==================================================================== +A.10. )fin +==================================================================== + +User Level Required: development + +Command Syntax: + + - )fin + +Command Description: + +This command is used by AXIOM developers to leave the AXIOM system and return +to the underlying Lisp system. To return to AXIOM, issue the ``(spad)'' +function call to Lisp. + +Also See: +o )pquit +o )quit + +\end{chunk} +\footnote{ +\fnref{pquit} +\fnref{quit}} + +\defun{fin}{Exit from the interpreter to lisp} +\throws{fin}{spad-reader} +\uses{fin}{eof} +\begin{chunk}{defun fin 0} +(defun |fin| () + (setq *eof* t) + (throw 'spad_reader nil)) + +\end{chunk} + +This command is in the list of \verb|$noParseCommands| +\ref{noParseCommands} which means that its arguments are passed +verbatim. This will eventually result in a call to the function +\verb|handleNoParseCommands| \ref{handleNoParseCommands} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{help} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{help.help} +==================================================================== +A.12. )help +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )help + - )help commandName + - )help syntax + +Command Description: + +This command displays help information about system commands. If you issue + +)help + +then this very text will be shown. You can also give the name or abbreviation +of a system command to display information about it. For example, + +)help clear + +will display the description of the )clear system command. + +The command + +)help syntax + +will give further information about the Axiom language syntax. + +All this material is available in the AXIOM User Guide and in HyperDoc. In +HyperDoc, choose the Commands item from the Reference menu. + +==================================================================== +A.1. Introduction +==================================================================== + + +System commands are used to perform AXIOM environment management. Among the +commands are those that display what has been defined or computed, set up +multiple logical AXIOM environments (frames), clear definitions, read files +of expressions and commands, show what functions are available, and terminate +AXIOM. + +Some commands are restricted: the commands + +)set userlevel interpreter +)set userlevel compiler +)set userlevel development + +set the user-access level to the three possible choices. All commands are +available at development level and the fewest are available at interpreter +level. The default user-level is interpreter. In addition to the )set command +(discussed in description of command )set ) you can use the HyperDoc settings +facility to change the user-level. Click on [Settings] here to immediately go +to the settings facility. + +Each command listing begins with one or more syntax pattern descriptions plus +examples of related commands. The syntax descriptions are intended to be easy +to read and do not necessarily represent the most compact way of specifying +all possible arguments and options; the descriptions may occasionally be +redundant. + +All system commands begin with a right parenthesis which should be in the +first available column of the input line (that is, immediately after the +input prompt, if any). System commands may be issued directly to AXIOM or be +included in .input files. + +A system command argument is a word that directly follows the command name +and is not followed or preceded by a right parenthesis. A system command +option follows the system command and is directly preceded by a right +parenthesis. Options may have arguments: they directly follow the option. +This example may make it easier to remember what is an option and what is an +argument: + + )syscmd arg1 arg2 )opt1 opt1arg1 opt1arg2 )opt2 opt2arg1 ... + +In the system command descriptions, optional arguments and options are +enclosed in brackets (``['' and ``]''). If an argument or option name is in +italics, it is meant to be a variable and must have some actual value +substituted for it when the system command call is made. For example, the +syntax pattern description + +)read fileName [)quietly] + +would imply that you must provide an actual file name for fileName but need +not use the )quietly option. Thus + +)read matrix.input + +is a valid instance of the above pattern. + +System command names and options may be abbreviated and may be in upper or +lower case. The case of actual arguments may be significant, depending on the +particular situation (such as in file names). System command names and +options may be abbreviated to the minimum number of starting letters so that +the name or option is unique. Thus + +)s Integer + +is not a valid abbreviation for the )set command, because both )set and )show +begin with the letter ``s''. Typically, two or three letters are sufficient +for disambiguating names. In our descriptions of the commands, we have used +no abbreviations for either command names or options. + +In some syntax descriptions we use a vertical line ``|'' to indicate that you +must specify one of the listed choices. For example, in + +)set output fortran on | off + +only on and off are acceptable words for following boot. We also sometimes +use ``...'' to indicate that additional arguments or options of the listed +form are allowed. Finally, in the syntax descriptions we may also list the +syntax of related commands. + +==================================================================== +Other help topics +==================================================================== +Available help topics are: + +abbreviations assignment blocks browse boot cd +clear clef close collection compile describe +display edit fin for frame help +history if iterate leave library lisp +load ltrace parallel pquit quit read +repeat savesystem set show spool suchthat +synonym system syntax trace undo what +while + +Available algebra help topics are: + +\end{chunk} + +\defunsec{help}{The top level help command} +\calls{help}{helpSpad2Cmd} +\begin{chunk}{defun help} +(defun |help| (l) + "The top level help command" + (|helpSpad2Cmd| l)) + +\end{chunk} + +\defunsec{helpSpad2Cmd}{The top level help command handler} +\calls{helpSpad2Cmd}{newHelpSpad2Cmd} +\calls{helpSpad2Cmd}{sayKeyedMsg} +\begin{chunk}{defun helpSpad2Cmd} +(defun |helpSpad2Cmd| (args) + "The top level help command handler" + (unless (|newHelpSpad2Cmd| args) + (|sayKeyedMsg| 's2iz0025 (cons args nil)))) + +\end{chunk} + +\defun{newHelpSpad2Cmd}{newHelpSpad2Cmd} +\calls{newHelpSpad2Cmd}{makeInputFilename} +\calls{newHelpSpad2Cmd}{obey} +\calls{newHelpSpad2Cmd}{concat} +\calls{newHelpSpad2Cmd}{namestring} +\calls{newHelpSpad2Cmd}{make-instream} +\calls{newHelpSpad2Cmd}{say} +\calls{newHelpSpad2Cmd}{abbreviation?} +\calls{newHelpSpad2Cmd}{poundsign} +\calls{newHelpSpad2Cmd}{sayKeyedMsg} +\calls{newHelpSpad2Cmd}{pname} +\calls{newHelpSpad2Cmd}{selectOptionLC} +\usesdollar{newHelpSpad2Cmd}{syscommands} +\usesdollar{newHelpSpad2Cmd}{useFullScreenHelp} +\begin{chunk}{defun newHelpSpad2Cmd} +(defun |newHelpSpad2Cmd| (args) + (let (sarg arg narg helpfile filestream line unabbrev) + (declare (special $syscommands |$useFullScreenHelp|)) + (when (null args) (setq args (list '?))) + (if (> (|#| args) 1) + (|sayKeyedMsg| 's2iz0026 nil) + (progn + (setq sarg (pname (car args))) + (cond + ((string= sarg "?") (setq args (list '|help|))) + ((string= sarg "%") (setq args (list '|history|))) + ((string= sarg "%%") (setq args (list '|history|))) + (t nil)) + (setq arg (|selectOptionLC| (car args) $syscommands nil)) + (cond ((null arg) (setq arg (car args)))) + (setq narg (pname arg)) + ; expand abbreviations to full constructor names + (when + (setq unabbrev (|abbreviation?| (intern narg))) + (setq narg (symbol-name unabbrev))) + (cond + ; if the help file does not exist, exit + ((null (setq helpfile (makeInputFilename (list narg "help")))) + nil) + ; if we expect to use full screen help, call SPADEDIT + (|$useFullScreenHelp| + (obey (concat "$AXIOM/lib/SPADEDIT " (|namestring| helpfile))) t) + ; otherwise dump the help file to the console + (t + (setq filestream (make-instream helpfile)) + (do ((line (|read-line| filestream nil) (|read-line| filestream nil))) + ((null line) (shut filestream)) + (say line)))))))) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{history} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{history.help} +==================================================================== +A.13. )history +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )history )on + - )history )off + - )history )write historyInputFileName + - )history )show [n] [both] + - )history )save savedHistoryName + - )history )restore [savedHistoryName] + - )history )reset + - )history )change n + - )history )memory + - )history )file + - % + - %%(n) + - )set history on | off + +Command Description: + +The history facility within AXIOM allows you to restore your environment to +that of another session and recall previous computational results. Additional +commands allow you to review previous input lines and to create an .input +file of the lines typed to AXIOM. + +AXIOM saves your input and output if the history facility is turned on (which +is the default). This information is saved if either of + +)set history on +)history )on + +has been issued. Issuing either + +)set history off +)history )off + +will discontinue the recording of information. + +Whether the facility is disabled or not, the value of % in AXIOM always +refers to the result of the last computation. If you have not yet entered +anything, % evaluates to an object of type Variable('%). The function %% may +be used to refer to other previous results if the history facility is +enabled. In that case, %%(n) is the output from step n if n > 0. If n < 0, +the step is computed relative to the current step. Thus %%(-1) is also the +previous step, %%(-2), is the step before that, and so on. If an invalid step +number is given, AXIOM will signal an error. + +The environment information can either be saved in a file or entirely in +memory (the default). Each frame ( description of command )frame ) has its +own history database. When it is kept in a file, some of it may also be kept +in memory for efficiency. When the information is saved in a file, the name +of the file is of the form FRAME.axh where ``FRAME'' is the name of the +current frame. The history file is placed in the current working directory +(see description of command )cd ). Note that these history database files are +not text files (in fact, they are directories themselves), and so are not in +human-readable format. + +The options to the )history command are as follows: + + )change n + will set the number of steps that are saved in memory to n. This option + only has effect when the history data is maintained in a file. If you + have issued )history )memory (or not changed the default) there is no + need to use )history )change. + + )on + will start the recording of information. If the workspace is not empty, + you will be asked to confirm this request. If you do so, the workspace + will be cleared and history data will begin being saved. You can also + turn the facility on by issuing )set history on. + + )off + will stop the recording of information. The )history )show command will + not work after issuing this command. Note that this command may be issued + to save time, as there is some performance penalty paid for saving the + environment data. You can also turn the facility off by issuing )set + history off. + + )file + indicates that history data should be saved in an external file on disk. + + )memory + indicates that all history data should be kept in memory rather than + saved in a file. Note that if you are computing with very large objects + it may not be practical to kept this data in memory. + + )reset + will flush the internal list of the most recent workspace calculations so + that the data structures may be garbage collected by the underlying Lisp + system. Like )history )change, this option only has real effect when + history data is being saved in a file. + + )restore [savedHistoryName] + completely clears the environment and restores it to a saved session, if + possible. The )save option below allows you to save a session to a file + with a given name. If you had issued )history )save jacobi the command + )history )restore jacobi would clear the current workspace and load the + contents of the named saved session. If no saved session name is + specified, the system looks for a file called last.axh. + + )save savedHistoryName + is used to save a snapshot of the environment in a file. This file is + placed in the current working directory (see description of command )cd + ). Use )history )restore to restore the environment to the state + preserved in the file. This option also creates an input file containing + all the lines of input since you created the workspace frame (for + example, by starting your AXIOM session) or last did a )clear all or + )clear completely. + + )show [n] [both] + can show previous input lines and output results. )show will display up + to twenty of the last input lines (fewer if you haven't typed in twenty + lines). )show n will display up to n of the last input lines. )show both + will display up to five of the last input lines and output results. )show + n both will display up to n of the last input lines and output results. + + )write historyInputFile + creates an .input file with the input lines typed since the start of the + session/frame or the last )clear all or )clear completely. If + historyInputFileName does not contain a period (``.'') in the filename, + .input is appended to it. For example, )history )write chaos and )history + )write chaos.input both write the input lines to a file called + chaos.input in your current working directory. If you issued one or more + )undo commands, )history )write eliminates all input lines backtracked + over as a result of )undo. You can edit this file and then use )read to + have AXIOM process the contents. + +Also See: +o )frame +o )read +o )set +o )undo + +\end{chunk} +\footnote{ +\fnref{frame} +\fnref{read} +\fnref{set} +\fnref{undo}} + +History recording is done in two different ways: +\begin{itemize} +\item all changes in variable bindings (i.e. previous values) are +written to \verb|$HistList|, which is a circular list +\item all new bindings (including the binding to \verb|%|) are written to a +file called histFileName() +one older session is accessible via the file \verb|$oldHistFileName()| +\end{itemize} + +\section{Initialized history variables} +The following global variables are used: +\begin{list}{} +\item \verb|$HistList|, \verb|$HistListLen| and \verb|$HistListAct| + which is the actual number of ``undoable'' steps) +\item \verb|$HistRecord| collects the input line, all variable bindings + and the output of a step, before it is written to the file + histFileName(). +\item \verb|$HiFiAccess| is a flag, which is reset by )history )off +\end{list} + +The result of step n can be accessed by \verb|%n|, which is translated +into a call of fetchOutput(n). The updateHist is called after every +interpreter step. The putHist function records all changes in the +environment to \verb|$HistList| and \verb|$HistRecord|. + +\defdollar{oldHistoryFileName} +\begin{chunk}{initvars} +(defvar |$oldHistoryFileName| '|last| "vm/370 filename name component") + +\end{chunk} +\defdollar{historyFileType} +\begin{chunk}{initvars} +(defvar |$historyFileType| '|axh| "vm/370 filename type component") + +\end{chunk} +\defdollar{historyDirectory} +\begin{chunk}{initvars} +(defvar |$historyDirectory| 'A "vm/370 filename disk component") + +\end{chunk} +\defdollar{useInternalHistoryTable} +\begin{chunk}{initvars} +(defvar |$useInternalHistoryTable| t "t means keep history in core") + +\end{chunk} + +\defun{makeHistFileName}{makeHistFileName} +\calls{makeHistFileName}{makePathname} +\begin{chunk}{defun makeHistFileName} +(defun |makeHistFileName| (fname) + (|makePathname| fname |$historyFileType| |$historyDirectory|)) + +\end{chunk} +\defun{oldHistFileName}{oldHistFileName} +\calls{oldHistFileName}{makeHistFileName} +\usesdollar{oldHistFileName}{oldHistoryFileName} +\begin{chunk}{defun oldHistFileName} +(defun |oldHistFileName| () + (declare (special |$oldHistoryFileName|)) + (|makeHistFileName| |$oldHistoryFileName|)) + +\end{chunk} +\defun{histFileName}{histFileName} +\calls{histFileName}{makeHistFileName} +\usesdollar{histFileName}{interpreterFrameName} +\begin{chunk}{defun histFileName} +(defun |histFileName| () + (declare (special |$interpreterFrameName|)) + (|makeHistFileName| |$interpreterFrameName|)) + +\end{chunk} +\defun{histInputFileName}{histInputFileName} +\calls{histInputFileName}{makePathname} +\usesdollar{histInputFileName}{interpreterFrameName} +\usesdollar{histInputFileName}{historyDirectory} +\begin{chunk}{defun histInputFileName} +(defun |histInputFileName| (fn) + (declare (special |$interpreterFrameName| |$historyDirectory|)) + (if (null fn) + (|makePathname| |$interpreterFrameName| 'input |$historyDirectory|) + (|makePathname| fn 'input |$historyDirectory|))) + +\end{chunk} + +\defun{initHist}{initHist} +\calls{initHist}{initHistList} +\calls{initHist}{oldHistFileName} +\calls{initHist}{histFileName} +\calls{initHist}{histFileErase} +\calls{initHist}{makeInputFilename} +\callsdollar{initHist}{replace} +\usesdollar{initHist}{useInternalHistoryTable} +\usesdollar{initHist}{HiFiAccess} +\begin{chunk}{defun initHist} +(defun |initHist| () + (let (oldFile newFile) + (declare (special |$useInternalHistoryTable| |$HiFiAccess|)) + (if |$useInternalHistoryTable| + (|initHistList|) + (progn + (setq oldFile (|oldHistFileName|)) + (setq newFile (|histFileName|)) + (|histFileErase| oldFile) + (when (makeInputFilename newFile) (replaceFile oldFile newFile)) + (setq |$HiFiAccess| t) + (|initHistList|))))) + +\end{chunk} +\defun{initHistList}{initHistList} +\usesdollar{initHistList}{HistListLen} +\usesdollar{initHistList}{HistList} +\usesdollar{initHistList}{HistListAct} +\usesdollar{initHistList}{HistRecord} +\begin{chunk}{defun initHistList} +(defun |initHistList| () + (let (li) + (declare (special |$HistListLen| |$HistList| |$HistListAct| |$HistRecord|)) + (setq |$HistListLen| 20) + (setq |$HistList| (list nil)) + (setq li |$HistList|) + (do ((i 1 (1+ i))) + ((> i |$HistListLen|) nil) + (setq li (cons nil li))) + (rplacd |$HistList| li) + (setq |$HistListAct| 0) + (setq |$HistRecord| nil))) + +\end{chunk} +\defunsec{history}{The top level history command} +\calls{history}{sayKeyedMsg} +\calls{history}{historySpad2Cmd} +\usesdollar{history}{options} +\begin{chunk}{defun history} +(defun |history| (l) + "The top level history command" + (declare (special |$options|)) + (if (or l (null |$options|)) + (|sayKeyedMsg| 's2ih0006 nil) ; syntax error + (|historySpad2Cmd|))) + +\end{chunk} +\defunsec{historySpad2Cmd}{The top level history command handler} +\calls{historySpad2Cmd}{selectOptionLC} +\calls{historySpad2Cmd}{member} +\calls{historySpad2Cmd}{sayKeyedMsg} +\calls{historySpad2Cmd}{initHistList} +\calls{historySpad2Cmd}{upcase} +\calls{historySpad2Cmd}{queryUserKeyedMsg} +\calls{historySpad2Cmd}{string2id-n} +\calls{historySpad2Cmd}{histFileErase} +\calls{historySpad2Cmd}{histFileName} +\calls{historySpad2Cmd}{clearSpad2Cmd} +\calls{historySpad2Cmd}{disableHist} +\calls{historySpad2Cmd}{setHistoryCore} +\calls{historySpad2Cmd}{resetInCoreHist} +\calls{historySpad2Cmd}{saveHistory} +\calls{historySpad2Cmd}{showHistory} +\calls{historySpad2Cmd}{changeHistListLen} +\calls{historySpad2Cmd}{restoreHistory} +\calls{historySpad2Cmd}{writeInputLines} +\calls{historySpad2Cmd}{seq} +\calls{historySpad2Cmd}{exit} +\usesdollar{historySpad2Cmd}{options} +\usesdollar{historySpad2Cmd}{HiFiAccess} +\usesdollar{historySpad2Cmd}{IOindex} +\begin{chunk}{defun historySpad2Cmd} +(defun |historySpad2Cmd| () + "The top level history command handler" + (let (histOptions opts opt optargs x) + (declare (special |$options| |$HiFiAccess| |$IOindex|)) + (setq histOptions + '(|on| |off| |yes| |no| |change| |reset| |restore| |write| + |save| |show| |file| |memory|)) + (setq opts + (prog (tmp1) + (setq tmp1 nil) + (return + (do ((tmp2 |$options| (cdr tmp2)) (tmp3 nil)) + ((or (atom tmp2) + (progn + (setq tmp3 (car tmp2)) + nil) + (progn + (progn + (setq opt (car tmp3)) + (setq optargs (cdr tmp3)) + tmp3) + nil)) + (nreverse0 tmp1)) + (setq tmp1 + (cons + (cons + (|selectOptionLC| opt histOptions '|optionError|) + optargs) + tmp1)))))) + (do ((tmp4 opts (cdr tmp4)) (tmp5 nil)) + ((or (atom tmp4) + (progn + (setq tmp5 (car tmp4)) + nil) + (progn + (progn + (setq opt (car tmp5)) + (setq optargs (cdr tmp5)) + tmp5) + nil)) + nil) + (seq + (exit + (cond + ((|member| opt '(|on| |yes|)) + (cond + (|$HiFiAccess| + (|sayKeyedMsg| 'S2IH0007 nil)) ; history already on + ((eql |$IOindex| 1) + (setq |$HiFiAccess| t) + (|initHistList|) + (|sayKeyedMsg| 'S2IH0008 nil)) ; history now on + (t + (setq x ; really want to turn history on? + (upcase (|queryUserKeyedMsg| 'S2IH0009 nil))) + (cond + ((member (string2id-n x 1) '(Y YES)) + (|histFileErase| (|histFileName|)) + (setq |$HiFiAccess| t) + (setq |$options| nil) + (|clearSpad2Cmd| '(|all|)) + (|sayKeyedMsg| 'S2IH0008 nil) ; history now on + (|initHistList|)) + (t + (|sayKeyedMsg| 'S2IH0010 nil)))))) ; history still off + ((|member| opt '(|off| |no|)) + (cond + ((null |$HiFiAccess|) + (|sayKeyedMsg| 'S2IH0011 nil)) ; history already off + (t + (setq |$HiFiAccess| nil) + (|disableHist|) + (|sayKeyedMsg| 'S2IH0012 nil)))) ; history now off + ((eq opt '|file|) (|setHistoryCore| nil)) + ((eq opt '|memory|) (|setHistoryCore| t)) + ((eq opt '|reset|) (|resetInCoreHist|)) + ((eq opt '|save|) (|saveHistory| optargs)) + ((eq opt '|show|) (|showHistory| optargs)) + ((eq opt '|change|) (|changeHistListLen| (car optargs))) + ((eq opt '|restore|) (|restoreHistory| optargs)) + ((eq opt '|write|) (|writeInputLines| optargs 1)))))) + '|done|)) + +\end{chunk} + +\defun{showHistory}{showHistory} +\calls{showHistory}{sayKeyedMsg} +\calls{showHistory}{selectOptionLC} +\calls{showHistory}{sayMSG} +\calls{showHistory}{concat} +\calls{showHistory}{bright} +\calls{showHistory}{showInOut} +\calls{showHistory}{setIOindex} +\calls{showHistory}{showInput} +\usesdollar{showHistory}{printTimeSum} +\usesdollar{showHistory}{evalTimePrint} +\begin{chunk}{defun showHistory} +(defun |showHistory| (arg) + (let (|$printTimeSum| |$evalTimePrint| maxi mini arg2 arg1 + nset n showInputOrBoth) + (declare (special |$printTimeSum| |$evalTimePrint| |$HiFiAccess|)) + (setq |$evalTimePrint| 0) + (setq |$printTimeSum| 0) + (cond + ((null |$HiFiAccess|) (|sayKeyedMsg| 'S2IH0026 (list '|show|))) + (t + (setq showInputOrBoth '|input|) + (setq n 20) + (when arg + (setq arg1 (car arg)) + (when (integerp arg1) + (setq n arg1) + (setq nset t) + (cond + ((ifcdr arg) (setq arg1 (cadr arg))) + (t (setq arg1 nil)))) + (when arg1 + (setq arg2 (|selectOptionLC| arg1 '(|input| |both|) nil)) + (cond + (arg2 + (cond + ((and (eq (setq showInputOrBoth arg2) '|both|) + (null nset)) + (setq n 5)))) + (t + (|sayMSG| + (|concat| " " (|bright| arg1) "is an invalid argument.")))))) + (cond ((not (< n |$IOindex|)) (setq n (- |$IOindex| 1)))) + (setq mini (- |$IOindex| n)) + (setq maxi (- |$IOindex| 1)) + (cond + ((eq showInputOrBoth '|both|) + (unwind-protect + (|showInOut| mini maxi) + (|setIOindex| (+ maxi 1)))) + (t (|showInput| mini maxi))))))) +\end{chunk} + +\defun{setHistoryCore}{setHistoryCore} +We case on the inCore argument value +\begin{list}{} +\item If history is already on and is kept in the same location as requested +(file or memory) then complain. +\item If history is not in use then start using the file or memory as +requested. This is done by simply setting the \verb|$useInternalHistoryTable| +to the requested value, where T means use memory and NIL means +use a file. We tell the user. +\item If history should be in memory, that is inCore is not NIL, +and the history file already contains information we read the information +from the file, store it in memory, and erase the history file. We modify +\verb|$useInternalHistoryTable| to T to indicate that we're maintining +the history in memory and tell the user. +\item Otherwise history must be on and in memory. We erase any old history +file and then write the in-memory history to a new file +\end{list} +\calls{setHistoryCore}{boot-equal} +\calls{setHistoryCore}{sayKeyedMsg} +\calls{setHistoryCore}{rkeyids} +\calls{setHistoryCore}{histFileName} +\calls{setHistoryCore}{readHiFi} +\calls{setHistoryCore}{disableHist} +\calls{setHistoryCore}{histFileErase} +\calls{setHistoryCore}{rdefiostream} +\calls{setHistoryCore}{spadrwrite} +\calls{setHistoryCore}{object2Identifier} +\calls{setHistoryCore}{rshut} +\usesdollar{setHistoryCore}{useInternalHistoryTable} +\usesdollar{setHistoryCore}{internalHistoryTable} +\usesdollar{setHistoryCore}{HiFiAccess} +\usesdollar{setHistoryCore}{IOindex} +\begin{chunk}{defun setHistoryCore} +(defun |setHistoryCore| (inCore) + (let (l vec str n rec) + (declare (special |$useInternalHistoryTable| |$internalHistoryTable| + |$HiFiAccess| |$IOindex|)) + (cond + ((boot-equal inCore |$useInternalHistoryTable|) + (if inCore + (|sayKeyedMsg| 's2ih0030 nil) ; memory history already in use + (|sayKeyedMsg| 's2ih0029 nil))) ; file history already in use + ((null |$HiFiAccess|) + (setq |$useInternalHistoryTable| inCore) + (if inCore + (|sayKeyedMsg| 's2ih0032 nil) ; use memory history + (|sayKeyedMsg| 's2ih0031 nil))) ; use file history + (inCore + (setq |$internalHistoryTable| nil) + (cond + ((not (eql |$IOindex| 0)) + (setq l (length (rkeyids (|histFileName|)))) + (do ((i 1 (1+ i))) + ((> i l) nil) + (setq vec (unwind-protect (|readHiFi| i) (|disableHist|))) + (setq |$internalHistoryTable| + (cons (cons i vec) |$internalHistoryTable|))) + (|histFileErase| (|histFileName|)))) + (setq |$useInternalHistoryTable| t) + (|sayKeyedMsg| 'S2IH0032 nil)) ; use memory history + (t + (setq |$HiFiAccess| nil) + (|histFileErase| (|histFileName|)) + (setq str + (rdefiostream + (cons + '(mode . output) + (cons + (cons 'file (|histFileName|)) + nil)))) + (do ((tmp0 (reverse |$internalHistoryTable|) (cdr tmp0)) + (tmp1 nil)) + ((or (atom tmp0) + (progn + (setq tmp1 (car tmp0)) + nil) + (progn + (progn + (setq n (car tmp1)) + (setq rec (cdr tmp1)) + tmp1) + nil)) + nil) + (spadrwrite (|object2Identifier| n) rec str)) + (rshut str) + (setq |$HiFiAccess| t) + (setq |$internalHistoryTable| nil) + (setq |$useInternalHistoryTable| nil) + (|sayKeyedMsg| 's2ih0031 nil))))) ; use file history + +\end{chunk} +\defdollar{underbar} +Also used in the output routines. +\begin{chunk}{initvars} +(defvar underbar "_") + +\end{chunk} + +\defun{writeInputLines}{writeInputLines} +\calls{writeInputLines}{sayKeyedMsg} +\calls{writeInputLines}{throwKeyedMsg} +\calls{writeInputLines}{size} +\calls{writeInputLines}{spaddifference} +\calls{writeInputLines}{concat} +\calls{writeInputLines}{substring} +\calls{writeInputLines}{readHiFi} +\calls{writeInputLines}{histInputFileName} +\calls{writeInputLines}{histFileErase} +\calls{writeInputLines}{defiostream} +\calls{writeInputLines}{namestring} +\calls{writeInputLines}{shut} +\uses{writeInputLines}{underbar} +\usesdollar{writeInputLines}{HiFiAccess} +\usesdollar{writeInputLines}{IOindex} +\begin{chunk}{defun writeInputLines} +(defun |writeInputLines| (fn initial) + (let (maxn breakChars vecl k svec done n lineList file inp) + (declare (special underbar |$HiFiAccess| |$IOindex|)) + (cond + ((null |$HiFiAccess|) (|sayKeyedMsg| 's2ih0013 nil)) ; history is not on + ((null fn) (|throwKeyedMsg| 's2ih0038 nil)) ; missing file name + (t + (setq maxn 72) + (setq breakChars (cons '| | (cons '+ nil))) + (do ((tmp0 (spaddifference |$IOindex| 1)) + (i initial (+ i 1))) + ((> i tmp0) nil) + (setq vecl (car (|readHiFi| i))) + (when (stringp vecl) (setq vecl (cons vecl nil))) + (dolist (vec vecl) + (setq n (size vec)) + (do () + ((null (> n maxn)) nil) + (setq done nil) + (do ((j 1 (1+ j))) + ((or (> j maxn) (null (null done))) nil) + (setq k (spaddifference (1+ maxn) j)) + (when (member (elt vec k) breakChars) + (setq svec (concat (substring vec 0 (1+ k)) underbar)) + (setq lineList (cons svec lineList)) + (setq done t) + (setq vec (substring vec (1+ k) nil)) + (setq n (size vec)))) + (when done (setq n 0))) + (setq lineList (cons vec lineList)))) + (setq file (|histInputFileName| fn)) + (|histFileErase| file) + (setq inp + (defiostream + (cons + '(mode . output) + (cons (cons 'file file) nil)) 255 0)) + (dolist (x (|removeUndoLines| (nreverse lineList))) + (write-line x inp)) + (cond + ((not (eq fn '|redo|)) + (|sayKeyedMsg| 's2ih0014 ; edit this file to see input lines + (list (|namestring| file))))) + (shut inp) + nil)))) + +\end{chunk} +\defun{resetInCoreHist}{resetInCoreHist} +\usesdollar{resetInCoreHist}{HistListAct} +\usesdollar{resetInCoreHist}{HistListLen} +\usesdollar{resetInCoreHist}{HistList} +\begin{chunk}{defun resetInCoreHist} +(defun |resetInCoreHist| () + (declare (special |$HistListAct| |$HistListLen| |$HistList|)) + (setq |$HistListAct| 0) + (do ((i 1 (1+ i))) + ((> i |$HistListLen|) nil) + (setq |$HistList| (cdr |$HistList|)) + (rplaca |$HistList| nil))) + +\end{chunk} +\defun{changeHistListLen}{changeHistListLen} +\calls{changeHistListLen}{sayKeyedMsg} +\calls{changeHistListLen}{spaddifference} +\usesdollar{changeHistListLen}{HistListLen} +\usesdollar{changeHistListLen}{HistList} +\usesdollar{changeHistListLen}{HistListAct} +\begin{chunk}{defun changeHistListLen} +(defun |changeHistListLen| (n) + (let (dif l) + (declare (special |$HistListLen| |$HistList| |$HistListAct|)) + (if (null (integerp n)) + (|sayKeyedMsg| 's2ih0015 (list n)) ; only positive integers + (progn + (setq dif (spaddifference n |$HistListLen|)) + (setq |$HistListLen| n) + (setq l (cdr |$HistList|)) + (cond + ((> dif 0) + (do ((i 1 (1+ i))) + ((> i dif) nil) + (setq l (cons nil l)))) + ((minusp dif) + (do ((tmp0 (spaddifference dif)) + (i 1 (1+ i))) + ((> i tmp0) nil) + (setq l (cdr l))) + (cond + ((> |$HistListAct| n) (setq |$HistListAct| n)) + (t nil)))) + (rplacd |$HistList| l) + '|done|)))) + +\end{chunk} +\defun{updateHist}{updateHist} +\calls{updateHist}{startTimingProcess} +\calls{updateHist}{updateInCoreHist} +\calls{updateHist}{writeHiFi} +\calls{updateHist}{disableHist} +\calls{updateHist}{updateCurrentInterpreterFrame} +\calls{updateHist}{stopTimingProcess} +\usesdollar{updateHist}{IOindex} +\usesdollar{updateHist}{HiFiAccess} +\usesdollar{updateHist}{HistRecord} +\usesdollar{updateHist}{mkTestInputStack} +\usesdollar{updateHist}{currentLine} +\begin{chunk}{defun updateHist} +(defun |updateHist| () + (declare (special |$IOindex| |$HiFiAccess| |$HistRecord| |$mkTestInputStack| + |$currentLine|)) + (when |$IOindex| + (|startTimingProcess| '|history|) + (|updateInCoreHist|) + (when |$HiFiAccess| + (unwind-protect (|writeHiFi|) (|disableHist|)) + (setq |$HistRecord| nil)) + (incf |$IOindex|) + (|updateCurrentInterpreterFrame|) + (setq |$mkTestInputStack| nil) + (setq |$currentLine| nil) + (|stopTimingProcess| '|history|))) + +\end{chunk} +\defun{updateInCoreHist}{updateInCoreHist} +\usesdollar{updateInCoreHist}{HistList} +\usesdollar{updateInCoreHist}{HistListLen} +\usesdollar{updateInCoreHist}{HistListAct} +\begin{chunk}{defun updateInCoreHist} +(defun |updateInCoreHist| () + (declare (special |$HistList| |$HistListLen| |$HistListAct|)) + (setq |$HistList| (cdr |$HistList|)) + (rplaca |$HistList| nil) + (when (> |$HistListLen| |$HistListAct|) + (setq |$HistListAct| (1+ |$HistListAct|)))) + +\end{chunk} +\defun{putHist}{putHist} +\calls{putHist}{recordOldValue} +\calls{putHist}{get} +\calls{putHist}{recordNewValue} +\calls{putHist}{putIntSymTab} +\usesdollar{putHist}{HiFiAccess} +\begin{chunk}{defun putHist} +(defun |putHist| (x prop val e) + (declare (special |$HiFiAccess|)) + (when (null (eq x '%)) (|recordOldValue| x prop (|get| x prop e))) + (when |$HiFiAccess| (|recordNewValue| x prop val)) + (|putIntSymTab| x prop val e)) + +\end{chunk} +\defun{recordNewValue}{recordNewValue} +\calls{recordNewValue}{startTimingProcess} +\calls{recordNewValue}{recordNewValue0} +\calls{recordNewValue}{stopTimingProcess} +\begin{chunk}{defun recordNewValue} +(defun |recordNewValue| (x prop val) + (|startTimingProcess| '|history|) + (|recordNewValue0| x prop val) + (|stopTimingProcess| '|history|)) + +\end{chunk} +\defun{recordNewValue0}{recordNewValue0} +\calls{recordNewValue0}{assq} +\usesdollar{recordNewValue0}{HistRecord} +\begin{chunk}{defun recordNewValue0} +(defun |recordNewValue0| (x prop val) + (let (p1 p2 p) + (declare (special |$HistRecord|)) + (if (setq p1 (assq x |$HistRecord|)) + (if (setq p2 (assq prop (cdr p1))) + (rplacd p2 val) + (rplacd p1 (cons (cons prop val) (cdr p1)))) + (progn + (setq p (cons x (list (cons prop val)))) + (setq |$HistRecord| (cons p |$HistRecord|)))))) + +\end{chunk} +\defun{recordOldValue}{recordOldValue} +\calls{recordOldValue}{startTimingProcess} +\calls{recordOldValue}{recordOldValue0} +\calls{recordOldValue}{stopTimingProcess} +\calls{recordOldValue0}{assq} +\begin{chunk}{defun recordOldValue} +(defun |recordOldValue| (x prop val) + (|startTimingProcess| '|history|) + (|recordOldValue0| x prop val) + (|stopTimingProcess| '|history|)) + +\end{chunk} +\defun{recordOldValue0}{recordOldValue0} +\usesdollar{recordOldValue0}{HistList} +\begin{chunk}{defun recordOldValue0} +(defun |recordOldValue0| (x prop val) + (let (p1 p) + (declare (special |$HistList|)) + (when (setq p1 (assq x (car |$HistList|))) + (when (null (assq prop (cdr p1))) + (rplacd p1 (cons (cons prop val) (cdr p1))))) + (setq p (cons x (list (cons prop val)))) + (rplaca |$HistList| (cons p (car |$HistList|))))) + +\end{chunk} +\defun{undoInCore}{undoInCore} +\calls{undoInCore}{undoChanges} +\calls{undoInCore}{spaddifference} +\calls{undoInCore}{readHiFi} +\calls{undoInCore}{disableHist} +\calls{undoInCore}{assq} +\calls{undoInCore}{sayKeyedMsg} +\calls{undoInCore}{putHist} +\calls{undoInCore}{updateHist} +\usesdollar{undoInCore}{HistList} +\usesdollar{undoInCore}{HistListLen} +\usesdollar{undoInCore}{IOindex} +\usesdollar{undoInCore}{HiFiAccess} +\usesdollar{undoInCore}{InteractiveFrame} +\begin{chunk}{defun undoInCore} +(defun |undoInCore| (n) + (let (li vec p p1 val) + (declare (special |$HistList| |$HistListLen| |$IOindex| |$HiFiAccess| + |$InteractiveFrame|)) + (setq li |$HistList|) + (do ((i n (+ i 1))) + ((> i |$HistListLen|) nil) + (setq li (cdr li))) + (|undoChanges| li) + (setq n (spaddifference (spaddifference |$IOindex| n) 1)) + (and + (> n 0) + (if |$HiFiAccess| + (progn + (setq vec (cdr (unwind-protect (|readHiFi| n) (|disableHist|)))) + (setq val + (and + (setq p (assq '% vec)) + (setq p1 (assq '|value| (cdr p))) + (cdr p1)))) + (|sayKeyedMsg| 's2ih0019 (cons n nil)))) ; no history file + (setq |$InteractiveFrame| (|putHist| '% '|value| val |$InteractiveFrame|)) + (|updateHist|))) + +\end{chunk} +\defun{undoChanges}{undoChanges} +\calls{undoChanges}{boot-equal} +\calls{undoChanges}{undoChanges} +\calls{undoChanges}{putHist} +\usesdollar{undoChanges}{HistList} +\usesdollar{undoChanges}{InteractiveFrame} +\begin{chunk}{defun undoChanges} +(defun |undoChanges| (li) + (let (x) + (declare (special |$HistList| |$InteractiveFrame|)) + (when (null (boot-equal (cdr li) |$HistList|)) (|undoChanges| (cdr li))) + (dolist (p1 (car li)) + (setq x (car p1)) + (dolist (p2 (cdr p1)) + (|putHist| x (car p2) (cdr p2) |$InteractiveFrame|))))) + +\end{chunk} +\defun{undoFromFile}{undoFromFile} +\calls{undoFromFile}{seq} +\calls{undoFromFile}{exit} +\calls{undoFromFile}{recordOldValue} +\calls{undoFromFile}{recordNewValue} +\calls{undoFromFile}{readHiFi} +\calls{undoFromFile}{disableHist} +\calls{undoFromFile}{putHist} +\calls{undoFromFile}{assq} +\calls{undoFromFile}{updateHist} +\usesdollar{undoFromFile}{InteractiveFrame} +\usesdollar{undoFromFile}{HiFiAccess} +\begin{chunk}{defun undoFromFile} +(defun |undoFromFile| (n) + (let (varl prop vec x p p1 val) + (declare (special |$InteractiveFrame| |$HiFiAccess|)) + (do ((tmp0 (caar |$InteractiveFrame|) (cdr tmp0)) (tmp1 nil)) + ((or (atom tmp0) + (progn (setq tmp1 (car tmp0)) nil) + (progn + (progn + (setq x (car tmp1)) + (setq varl (cdr tmp1)) + tmp1) + nil)) + nil) + (seq + (exit + (do ((tmp2 varl (cdr tmp2)) (p nil)) + ((or (atom tmp2) (progn (setq p (car tmp2)) nil)) nil) + (seq + (exit + (progn + (setq prop (car p)) + (setq val (cdr p)) + (when val + (progn + (when (null (eq x '%)) + (|recordOldValue| x prop val)) + (when |$HiFiAccess| + (|recordNewValue| x prop val)) + (rplacd p nil)))))))))) + (do ((i 1 (1+ i))) + ((> i n) nil) + (setq vec + (unwind-protect (cdr (|readHiFi| i)) (|disableHist|))) + (do ((tmp3 vec (cdr tmp3)) (p1 nil)) + ((or (atom tmp3) (progn (setq p1 (car tmp3)) nil)) nil) + (setq x (car p1)) + (do ((tmp4 (cdr p1) (cdr tmp4)) (p2 nil)) + ((or (atom tmp4) (progn (setq p2 (car tmp4)) nil)) nil) + (setq |$InteractiveFrame| + (|putHist| x (car p2) (CDR p2) |$InteractiveFrame|))))) + (setq val + (and + (setq p (assq '% vec)) + (setq p1 (assq '|value| (cdr p))) + (cdr p1))) + (setq |$InteractiveFrame| (|putHist| '% '|value| val |$InteractiveFrame|)) + (|updateHist|))) + +\end{chunk} +\defun{saveHistory}{saveHistory} +\calls{saveHistory}{sayKeyedMsg} +\calls{saveHistory}{makeInputFilename} +\calls{saveHistory}{histFileName} +\calls{saveHistory}{throwKeyedMsg} +\calls{saveHistory}{makeHistFileName} +\calls{saveHistory}{histInputFileName} +\calls{saveHistory}{writeInputLines} +\calls{saveHistory}{histFileErase} +\calls{saveHistory}{rdefiostream} +\calls{saveHistory}{spadrwrite0} +\calls{saveHistory}{object2Identifier} +\calls{saveHistory}{rshut} +\calls{saveHistory}{namestring} +\usesdollar{saveHistory}{seen} +\usesdollar{saveHistory}{HiFiAccess} +\usesdollar{saveHistory}{useInternalHistoryTable} +\usesdollar{saveHistory}{internalHistoryTable} +\begin{chunk}{defun saveHistory} +(defun |saveHistory| (fn) + (let (|$seen| savefile inputfile saveStr n rec val) + (declare (special |$seen| |$HiFiAccess| |$useInternalHistoryTable| + |$internalHistoryTable|)) + (setq |$seen| (make-hash-table :test #'eq)) + (cond + ((null |$HiFiAccess|) + (|sayKeyedMsg| 's2ih0016 nil)) ; the history file is not on + ((and (null |$useInternalHistoryTable|) + (null (makeInputFilename (|histFileName|)))) + (|sayKeyedMsg| 's2ih0022 nil)) ; no history saved yet + ((null fn) + (|throwKeyedMsg| 's2ih0037 nil)) ; need to specify a history filename + (t + (setq savefile (|makeHistFileName| fn)) + (setq inputfile (|histInputFileName| fn)) + (|writeInputLines| fn 1) + (|histFileErase| savefile) + (when |$useInternalHistoryTable| + (setq saveStr + (rdefiostream + (cons '(mode . output) + (cons (cons 'file savefile) nil)))) + (do ((tmp0 (reverse |$internalHistoryTable|) (cdr tmp0)) + (tmp1 nil)) + ((or (atom tmp0) + (progn (setq tmp1 (car tmp0)) nil) + (progn + (progn + (setq n (car tmp1)) + (setq rec (cdr tmp1)) + tmp1) + nil)) + nil) + (setq val (spadrwrite0 (|object2Identifier| n) rec saveStr)) + (when (eq val '|writifyFailed|) + (|sayKeyedMsg| 's2ih0035 ; can't save the value of step + (list n inputfile)))) + (rshut saveStr)) + (|sayKeyedMsg| 's2ih0018 ; saved history file is + (cons (|namestring| savefile) nil)) + nil)))) + +\end{chunk} +\defun{restoreHistory}{restoreHistory} +\calls{restoreHistory}{qcdr} +\calls{restoreHistory}{qcar} +\calls{restoreHistory}{identp} +\calls{restoreHistory}{throwKeyedMsg} +\calls{restoreHistory}{makeHistFileName} +\calls{restoreHistory}{putHist} +\calls{restoreHistory}{makeInputFilename} +\calls{restoreHistory}{sayKeyedMsg} +\calls{restoreHistory}{namestring} +\calls{restoreHistory}{clearSpad2Cmd} +\calls{restoreHistory}{histFileName} +\calls{restoreHistory}{histFileErase} +\callsdollar{restoreHistory}{fcopy} +\calls{restoreHistory}{rkeyids} +\calls{restoreHistory}{readHiFi} +\calls{restoreHistory}{disableHist} +\calls{restoreHistory}{updateInCoreHist} +\calls{restoreHistory}{get} +\calls{restoreHistory}{rempropI} +\calls{restoreHistory}{clearCmdSortedCaches} +\usesdollar{restoreHistory}{options} +\usesdollar{restoreHistory}{internalHistoryTable} +\usesdollar{restoreHistory}{HiFiAccess} +\usesdollar{restoreHistory}{e} +\usesdollar{restoreHistory}{useInternalHistoryTable} +\usesdollar{restoreHistory}{InteractiveFrame} +\usesdollar{restoreHistory}{oldHistoryFileName} +\begin{chunk}{defun restoreHistory} +(defun |restoreHistory| (fn) + (let (|$options| fnq restfile curfile l oldInternal vec line x a) + (declare (special |$options| |$internalHistoryTable| |$HiFiAccess| |$e| + |$useInternalHistoryTable| |$InteractiveFrame| |$oldHistoryFileName|)) + (cond + ((null fn) (setq fnq |$oldHistoryFileName|)) + ((and (consp fn) + (eq (qcdr fn) nil) + (progn + (setq fnq (qcar fn)) + t) + (identp fnq)) + (setq fnq fnq)) + (t (|throwKeyedMsg| 's2ih0023 (cons fnq nil)))) ; invalid filename + (setq restfile (|makeHistFileName| fnq)) + (if (null (makeInputFilename restfile)) + (|sayKeyedMsg| 's2ih0024 ; file does not exist + (cons (|namestring| restfile) nil)) + (progn + (setq |$options| nil) + (|clearSpad2Cmd| '(|all|)) + (setq curfile (|histFileName|)) + (|histFileErase| curfile) + ($fcopy restfile curfile) + (setq l (length (rkeyids curfile))) + (setq |$HiFiAccess| t) + (setq oldInternal |$useInternalHistoryTable|) + (setq |$useInternalHistoryTable| nil) + (when oldInternal (setq |$internalHistoryTable| nil)) + (do ((i 1 (1+ i))) + ((> i l) nil) + (setq vec (unwind-protect (|readHiFi| i) (|disableHist|))) + (when oldInternal + (setq |$internalHistoryTable| + (cons (cons i vec) |$internalHistoryTable|))) + (setq line (car vec)) + (dolist (p1 (cdr vec)) + (setq x (car p1)) + (do ((tmp1 (cdr p1) (cdr tmp1)) (p2 nil)) + ((or (atom tmp1) (progn (setq p2 (car tmp1)) nil)) nil) + (setq |$InteractiveFrame| + (|putHist| x + (car p2) (cdr p2) |$InteractiveFrame|)))) + (|updateInCoreHist|)) + (setq |$e| |$InteractiveFrame|) + (do ((tmp2 (caar |$InteractiveFrame|) (cdr tmp2)) (tmp3 nil)) + ((or (atom tmp2) + (progn + (setq tmp3 (car tmp2)) + nil) + (progn + (progn + (setq a (car tmp3)) + tmp3) + nil)) + nil) + (when (|get| a '|localModemap| |$InteractiveFrame|) + (|rempropI| a '|localModemap|) + (|rempropI| a '|localVars|) + (|rempropI| a '|mapBody|))) + (setq |$IOindex| (1+ l)) + (setq |$useInternalHistoryTable| oldInternal) + (|sayKeyedMsg| 'S2IH0025 ; workspace restored + (cons (|namestring| restfile) nil)) + (|clearCmdSortedCaches|) + nil)))) + +\end{chunk} + +\defun{setIOindex}{setIOindex} +\usesdollar{setIOindex}{IOindex} +\begin{chunk}{defun setIOindex} +(defun |setIOindex| (n) + (declare (special |$IOindex|)) + (setq |$IOindex| n)) + +\end{chunk} +\defun{showInput}{showInput} +\calls{showInput}{tab} +\calls{showInput}{readHiFi} +\calls{showInput}{disableHist} +\calls{showInput}{sayMSG} +\begin{chunk}{defun showInput} +(defun |showInput| (mini maxi) + (let (vec l) + (do ((|ind| mini (+ |ind| 1))) + ((> |ind| maxi) nil) + (setq vec (unwind-protect (|readHiFi| |ind|) (|disableHist|))) + (cond + ((> 10 |ind|) (tab 2)) + ((> 100 |ind|) (tab 1)) + (t nil)) + (setq l (car vec)) + (if (stringp l) + (|sayMSG| (list " [" |ind| "] " (car vec))) + (progn + (|sayMSG| (list " [" |ind| "] ")) + (do ((tmp0 l (cdr tmp0)) (ln nil)) + ((or (atom tmp0) (progn (setq ln (car tmp0)) nil)) nil) + (|sayMSG| (list " " ln)))))))) + +\end{chunk} +\defun{showInOut}{showInOut} +\calls{showInOut}{assq} +\calls{showInOut}{spadPrint} +\calls{showInOut}{objValUnwrap} +\calls{showInOut}{objMode} +\calls{showInOut}{readHiFi} +\calls{showInOut}{disableHist} +\calls{showInOut}{sayMSG} +\begin{chunk}{defun showInOut} +(defun |showInOut| (mini maxi) + (let (vec Alist triple) + (do ((ind mini (+ ind 1))) + ((> ind maxi) nil) + (setq vec (unwind-protect (|readHiFi| ind) (|disableHist|))) + (|sayMSG| (cons (car vec) nil)) + (cond + ((setq Alist (assq '% (cdr vec))) + (setq triple (cdr (assq '|value| (cdr Alist)))) + (setq |$IOindex| ind) + (|spadPrint| (|objValUnwrap| triple) (|objMode| triple))))))) + +\end{chunk} +\defun{fetchOutput}{fetchOutput} +\calls{fetchOutput}{boot-equal} +\calls{fetchOutput}{spaddifference} +\calls{fetchOutput}{getI} +\calls{fetchOutput}{throwKeyedMsg} +\calls{fetchOutput}{readHiFi} +\calls{fetchOutput}{disableHist} +\calls{fetchOutput}{assq} +\begin{chunk}{defun fetchOutput} +(defun |fetchOutput| (n) + (let (vec Alist val) + (cond + ((and (boot-equal n (spaddifference 1)) (setq val (|getI| '% '|value|))) + val) + (|$HiFiAccess| + (setq n + (cond + ((minusp n) (+ |$IOindex| n)) + (t n))) + (cond + ((>= n |$IOindex|) + (|throwKeyedMsg| 'S2IH0001 (cons n nil))) ; no step n yet + ((> 1 n) + (|throwKeyedMsg| 's2ih0002 (cons n nil))) ; only nonzero steps + (t + (setq vec (unwind-protect (|readHiFi| n) (|disableHist|))) + (cond + ((setq Alist (assq '% (cdr vec))) + (cond + ((setq val (cdr (assq '|value| (cdr Alist)))) + val) + (t + (|throwKeyedMsg| 's2ih0003 (cons n nil))))) ; no step value + (t (|throwKeyedMsg| 's2ih0003 (cons n nil))))))) ; no step value + (t (|throwKeyedMsg| 's2ih0004 nil))))) ; history not on + +\end{chunk} +\defunsec{readHiFi}{Read the history file using index n} +\calls{readHiFi}{assoc} +\calls{readHiFi}{keyedSystemError} +\calls{readHiFi}{qcdr} +\calls{readHiFi}{rdefiostream} +\calls{readHiFi}{histFileName} +\calls{readHiFi}{spadrread} +\calls{readHiFi}{object2Identifier} +\calls{readHiFi}{rshut} +\usesdollar{readHiFi}{useInternalHistoryTable} +\usesdollar{readHiFi}{internalHistoryTable} +\begin{chunk}{defun readHiFi} +(defun |readHiFi| (n) + "Read the history file using index n" + (let (pair HiFi vec) + (declare (special |$useInternalHistoryTable| |$internalHistoryTable|)) + (if |$useInternalHistoryTable| + (progn + (setq pair (|assoc| n |$internalHistoryTable|)) + (if (atom pair) + (|keyedSystemError| 's2ih0034 nil) ; missing element + (setq vec (qcdr pair)))) + (progn + (setq HiFi + (rdefiostream + (cons + '(mode . input) + (cons + (cons 'file (|histFileName|)) nil)))) + (setq vec (spadrread (|object2Identifier| n) HiFi)) + (rshut HiFi))) + vec)) + +\end{chunk} +\defunsec{writeHiFi}{Write information of the current step to history file} +\calls{writeHiFi}{rdefiostream} +\calls{writeHiFi}{histFileName} +\calls{writeHiFi}{spadrwrite} +\calls{writeHiFi}{object2Identifier} +\calls{writeHiFi}{rshut} +\usesdollar{writeHiFi}{useInternalHistoryTable} +\usesdollar{writeHiFi}{internalHistoryTable} +\usesdollar{writeHiFi}{IOindex} +\usesdollar{writeHiFi}{HistRecord} +\usesdollar{writeHiFi}{currentLine} +\begin{chunk}{defun writeHiFi} +(defun |writeHiFi| () + "Writes information of the current step to history file" + (let (HiFi) + (declare (special |$useInternalHistoryTable| |$internalHistoryTable| + |$IOindex| |$HistRecord| |$currentLine|)) + (if |$useInternalHistoryTable| + (setq |$internalHistoryTable| + (cons + (cons |$IOindex| + (cons |$currentLine| |$HistRecord|)) + |$internalHistoryTable|)) + (progn + (setq HiFi + (rdefiostream + (cons + '(mode . output) + (cons (cons 'file (|histFileName|)) nil)))) + (spadrwrite (|object2Identifier| |$IOindex|) + (cons |$currentLine| |$HistRecord|) HiFi) + (rshut HiFi))))) + +\end{chunk} +\defunsec{disableHist}{Disable history if an error occurred} +\calls{disableHist}{histFileErase} +\calls{disableHist}{histFileName} +\usesdollar{disableHist}{HiFiAccess} +\begin{chunk}{defun disableHist} +(defun |disableHist| () + "Disable history if an error occurred" + (declare (special |$HiFiAccess|)) + (cond + ((null |$HiFiAccess|) + (|histFileErase| (|histFileName|))) + (t nil))) + +\end{chunk} +\defun{writeHistModesAndValues}{writeHistModesAndValues} +\calls{writeHistModesAndValues}{get} +\calls{writeHistModesAndValues}{putHist} +\usesdollar{writeHistModesAndValues}{InteractiveFrame} +\begin{chunk}{defun writeHistModesAndValues} +(defun |writeHistModesAndValues| () + (let (a x) + (declare (special |$InteractiveFrame|)) + (do ((tmp0 (caar |$InteractiveFrame|) (cdr tmp0)) (tmp1 nil)) + ((or (atom tmp0) + (progn + (setq tmp1 (car tmp0)) + nil) + (progn + (progn + (setq a (car tmp1)) + tmp1) + nil)) + nil) + (cond + ((setq x (|get| a '|value| |$InteractiveFrame|)) + (|putHist| a '|value| x |$InteractiveFrame|)) + ((setq x (|get| a '|mode| |$InteractiveFrame|)) + (|putHist| a '|mode| x |$InteractiveFrame|)))))) + +\end{chunk} + +Lisplib output transformations + +Some types of objects cannot be saved by LISP/VM in lisplibs. +These functions transform an object to a writable form and back. +\defun{spadrwrite0}{spadrwrite0} +\calls{spadrwrite0}{safeWritify} +\calls{spadrwrite0}{rwrite} +\begin{chunk}{defun spadrwrite0} +(defun spadrwrite0 (vec item stream) + (let (val) + (setq val (|safeWritify| item)) + (if (eq val '|writifyFailed|) + val + (progn + (|rwrite| vec val stream) + item)))) + +\end{chunk} + +\defun{rwrite}{Random write to a stream} +\calls{rwrite}{rwrite} +\calls{rwrite}{pname} +\calls{rwrite}{identp} +\begin{chunk}{defun rwrite} +(defun |rwrite| (key val stream) + (when (identp key) (setq key (pname key))) + (rwrite key val stream)) + +\end{chunk} + +\defun{spadrwrite}{spadrwrite} +\calls{spadrwrite}{spadrwrite0} +\calls{spadrwrite}{throwKeyedMsg} +\begin{chunk}{defun spadrwrite} +(defun spadrwrite (vec item stream) + (let (val) + (setq val (spadrwrite0 vec item stream)) + (if (eq val '|writifyFailed|) + (|throwKeyedMsg| 's2ih0036 nil) ; cannot save value to file + item))) + +\end{chunk} +\defun{spadrread}{spadrread} +\calls{SPADRREAD}{dewritify} +\calls{SPADRREAD}{rread} +\begin{chunk}{defun spadrread} +(defun spadrread (vec stream) + (|dewritify| (|rread| vec stream nil))) + +\end{chunk} + +\defun{rread}{Random read a key from a stream} +RREAD takes erroval to return if key is missing + +\calls{rread}{rread} +\calls{rwrite}{identp} +\calls{rwrite}{pname} +\begin{chunk}{defun rread} +(defun |rread| (key rstream errorval) + (when (identp key) (setq key (pname key))) + (rread key rstream errorval)) + +\end{chunk} + +\defun{unwritable?}{unwritable?} +\calls{unwritable?}{vecp} +\calls{unwritable?}{placep} +\begin{chunk}{defun unwritable?} +(defun |unwritable?| (ob) + (cond + ((or (consp ob) (vecp ob)) nil) + ((or (compiled-function-p ob) (hash-table-p ob)) t) + ((or (placep ob) (readtablep ob)) t) + ((floatp ob) t) + (t nil))) + +\end{chunk} +\defun{writifyComplain}{writifyComplain} +Create a full isomorphic object to be saved in a lisplib. Note +that {\tt dewritify(writify(x))} preserves UEQUALity of hashtables. +HASHTABLEs go both ways. READTABLEs cannot presently be transformed +back. +\calls{writifyComplain}{sayKeyedMsg} +\usesdollar{writifyComplain}{writifyComplained} +\begin{chunk}{defun writifyComplain} +(defun |writifyComplain| (s) + (declare (special |$writifyComplained|)) + (unless |$writifyComplained| + (setq |$writifyComplained| t) + (|sayKeyedMsg| 's2ih0027 (list s)))) ; cannot save value + +\end{chunk} +\defun{safeWritify}{safeWritify} +\catches{safeWritify}{writifyTag} +\calls{safeWritify}{writify} +\begin{chunk}{defun safeWritify} +(defun |safeWritify| (ob) + (catch '|writifyTag| (|writify| ob))) + +\end{chunk} +\defun{writify,writifyInner}{writify,writifyInner} +\throws{writify,writifyInner}{writifyTag} +\calls{writify,writifyInner}{seq} +\calls{writify,writifyInner}{exit} +\calls{writify,writifyInner}{hget} +\calls{writify,writifyInner}{qcar} +\calls{writify,writifyInner}{qcdr} +\calls{writify,writifyInner}{spadClosure?} +\calls{writify,writifyInner}{writify,writifyInner} +\calls{writify,writifyInner}{hput} +\calls{writify,writifyInner}{qrplaca} +\calls{writify,writifyInner}{qrplacd} +\calls{writify,writifyInner}{vecp} +\calls{writify,writifyInner}{isDomainOrPackage} +\calls{writify,writifyInner}{mkEvalable} +\calls{writify,writifyInner}{devaluate} +\calls{writify,writifyInner}{qvmaxindex} +\calls{writify,writifyInner}{qsetvelt} +\calls{writify,writifyInner}{qvelt} +\calls{writify,writifyInner}{constructor?} +\calls{writify,writifyInner}{hkeys} +\calls{writify,writifyInner}{hashtable-class} +\calls{writify,writifyInner}{placep} +\calls{writify,writifyInner}{boot-equal} +\usesdollar{writify,writifyInner}{seen} +\usesdollar{writify,writifyInner}{NonNullStream} +\usesdollar{writify,writifyInner}{NullStream} +\begin{chunk}{defun writify,writifyInner} +(defun |writify,writifyInner| (ob) + (prog (e name tmp1 tmp2 tmp3 x qcar qcdr d n keys nob) + (declare (special |$seen| |$NonNullStream| |$NullStream|)) + (return + (seq + (when (null ob) (exit nil)) + (when (setq e (hget |$seen| ob)) (exit e)) + (when (consp ob) + (exit + (seq + (setq qcar (qcar ob)) + (setq qcdr (qcdr ob)) + (when (setq name (|spadClosure?| ob)) + (exit + (seq + (setq d (|writify,writifyInner| (qcdr ob))) + (setq nob + (cons 'writified!! + (cons 'spadclosure + (cons d (cons name nil))))) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (exit nob)))) + (when + (and + (and (consp ob) + (eq (qcar ob) 'lambda-closure) + (progn + (setq tmp1 (qcdr ob)) + (and (consp tmp1) + (progn + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (progn + (setq tmp3 (qcdr tmp2)) + (and (consp tmp3) + (progn + (setq x (qcar tmp3)) + t)))))))) x) + (exit + (throw '|writifyTag| '|writifyFailed|))) + (setq nob (cons qcar qcdr)) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (setq qcar (|writify,writifyInner| qcar)) + (setq qcdr (|writify,writifyInner| qcdr)) + (qrplaca nob qcar) + (qrplacd nob qcdr) + (exit nob)))) + (when (vecp ob) + (exit + (seq + (when (|isDomainOrPackage| ob) + (setq d (|mkEvalable| (|devaluate| ob))) + (setq nob (list 'writified!! 'devaluated (|writify,writifyInner| d))) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (exit nob)) + (setq n (qvmaxindex ob)) + (setq nob (make-array (1+ n))) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (do ((i 0 (=! i))) + ((> i n) nil) + (qsetvelt nob i (|writify,writifyInner| (qvelt ob i)))) + (exit nob)))) + (when (eq ob 'writified!!) + (exit + (cons 'writified!! (cons 'self nil)))) + (when (|constructor?| ob) + (exit ob)) + (when (compiled-function-p ob) + (exit + (throw '|writifyTag| '|writifyFailed|))) + (when (hash-table-p ob) + (setq nob (cons 'writified!! nil)) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (setq keys (hkeys ob)) + (qrplacd nob + (cons + 'hashtable + (cons + (hashtable-class ob) + (cons + (|writify,writifyInner| keys) + (cons + (prog (tmp0) + (setq tmp0 nil) + (return + (do ((tmp1 keys (cdr tmp1)) (k nil)) + ((or (atom tmp1) + (progn + (setq k (car tmp1)) + nil)) + (nreverse0 tmp0)) + (setq tmp0 + (cons (|writify,writifyInner| (hget ob k)) tmp0))))) + nil))))) + (exit nob)) + (when (placep ob) + (setq nob (cons 'writified!! (cons 'place nil))) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (exit nob)) + (when (readtablep ob) + (exit + (throw '|writifyTag| '|writifyFailed|))) + (when (stringp ob) + (exit + (seq + (when (eq ob |$NullStream|) + (exit + (cons 'writified!! (cons 'nullstream nil)))) + (when (eq ob |$NonNullStream|) + (exit + (cons 'writified!! (cons 'nonnullstream nil)))) + (exit ob)))) + (when (floatp ob) + (exit + (seq + (when (boot-equal ob (read-from-string (princ-to-string ob))) + (exit ob)) + (exit + (cons 'writified!! + (cons 'float + (cons ob + (multiple-value-list (integer-decode-float ob))))))))) + (exit ob))))) + +\end{chunk} +\defun{writify}{writify} +\calls{writify}{ScanOrPairVec} +\calls{writify}{function} +\calls{writify}{writify,writifyInner} +\usesdollar{writify}{seen} +\usesdollar{writify}{writifyComplained} +\begin{chunk}{defun writify} +(defun |writify| (ob) + (let (|$seen| |$writifyComplained|) + (declare (special |$seen| |$writifyComplained|)) + (if (null (|ScanOrPairVec| #'|unwritable?| ob)) + ob + (progn + (setq |$seen| (make-hash-table :test #'eq)) + (setq |$writifyComplained| nil) + (|writify,writifyInner| ob))))) + +\end{chunk} +\defun{spadClosure?}{spadClosure?} +\calls{spadClosure?}{qcar} +\calls{spadClosure?}{bpiname} +\calls{spadClosure?}{qcdr} +\calls{spadClosure?}{vecp} +\begin{chunk}{defun spadClosure?} +(defun |spadClosure?| (ob) + (let (fun name vec) + (setq fun (qcar ob)) + (if (null (setq name (bpiname fun))) + nil + (progn + (setq vec (qcdr ob)) + (if (null (vecp vec)) + nil + name))))) + +\end{chunk} + +\defdollar{NonNullStream} +\begin{chunk}{initvars} +(defvar |$NonNullStream| "NonNullStream") + +\end{chunk} + +\defdollar{NullStream} +\begin{chunk}{initvars} +(defvar |$NullStream| "NullStream") + +\end{chunk} + +\defun{dewritify,dewritifyInner}{dewritify,dewritifyInner} +\calls{dewritify,dewritifyInner}{seq} +\calls{dewritify,dewritifyInner}{exit} +\calls{dewritify,dewritifyInner}{hget} +\calls{dewritify,dewritifyInner}{intp} +\calls{dewritify,dewritifyInner}{gensymmer} +\calls{dewritify,dewritifyInner}{error} +\calls{dewritify,dewritifyInner}{poundsign} +\calls{dewritify,dewritifyInner}{hput} +\calls{dewritify,dewritifyInner}{dewritify,dewritifyInner} +\calls{dewritify,dewritifyInner}{concat} +\calls{dewritify,dewritifyInner}{vmread} +\calls{dewritify,dewritifyInner}{make-instream} +\calls{dewritify,dewritifyInner}{spaddifference} +\calls{dewritify,dewritifyInner}{qcar} +\calls{dewritify,dewritifyInner}{qcdr} +\calls{dewritify,dewritifyInner}{qrplaca} +\calls{dewritify,dewritifyInner}{qrplacd} +\calls{dewritify,dewritifyInner}{vecp} +\calls{dewritify,dewritifyInner}{qvmaxindex} +\calls{dewritify,dewritifyInner}{qsetvelt} +\calls{dewritify,dewritifyInner}{qvelt} +\usesdollar{dewritify,dewritifyInner}{seen} +\usesdollar{dewritify,dewritifyInner}{NullStream} +\usesdollar{dewritify,dewritifyInner}{NonNullStream} +\begin{chunk}{defun dewritify,dewritifyInner} +(defun |dewritify,dewritifyInner| (ob) + (prog (e type oname f vec name tmp1 signif expon sign fval qcar qcdr n nob) + (declare (special |$seen| |$NullStream| |$NonNullStream|)) + (return + (seq + (when (null ob) + (exit nil)) + (when (setq e (hget |$seen| ob)) + (exit e)) + (when (and (consp ob) (eq (car ob) 'writified!!)) + (exit + (seq + (setq type (elt ob 1)) + (when (eq type 'self) + (exit 'writified!!)) + (when (eq type 'bpi) + (exit + (seq + (setq oname (elt ob 2)) + (setq f + (seq + (when (integerp oname) (exit (eval (gensymmer oname)))) + (exit (symbol-function oname)))) + (when (null (compiled-function-p f)) + (exit (|error| "A required BPI does not exist."))) + (when (and (> (|#| ob) 3) (not (equal (sxhash f) (elt ob 3)))) + (exit (|error| "A required BPI has been redefined."))) + (hput |$seen| ob f) + (exit f)))) + (when (eq type 'hashtable) + (exit + (seq + (setq nob (make-hash-table :test #'equal)) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (do ((tmp0 (elt ob 3) (cdr tmp0)) + (k nil) + (tmp1 (elt ob 4) (cdr tmp1)) + (e nil)) + ((or (atom tmp0) + (progn + (setq k (car tmp0)) + nil) + (atom tmp1) + (progn + (setq e (car tmp1)) + nil)) + nil) + (seq + (exit + (hput nob (|dewritify,dewritifyInner| k) + (|dewritify,dewritifyInner| e))))) + (exit nob)))) + (when (eq type 'devaluated) + (exit + (seq + (setq nob (eval (|dewritify,dewritifyInner| (elt ob 2)))) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (exit nob)))) + (when (eq type 'spadclosure) + (exit + (seq + (setq vec (|dewritify,dewritifyInner| (elt ob 2))) + (setq name (ELT ob 3)) + (when (null (fboundp name)) + (exit + (|error| + (concat "undefined function: " (symbol-name name))))) + (setq nob (cons (symbol-function name) vec)) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (exit nob)))) + (when (eq type 'place) + (exit + (seq + (setq nob (vmread (make-instream nil))) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (exit nob)))) + (when (eq type 'readtable) + (exit (|error| "Cannot de-writify a read table."))) + (when (eq type 'nullstream) + (exit |$NullStream|)) + (when (eq type 'nonnullstream) + (exit |$NonNullStream|)) + (when (eq type 'float) + (exit + (seq + (progn + (setq tmp1 (cddr ob)) + (setq fval (car tmp1)) + (setq signif (cadr tmp1)) + (setq expon (caddr tmp1)) + (setq sign (cadddr tmp1)) + tmp1) + (setq fval (scale-float (float signif fval) expon)) + (when (minusp sign) + (exit (spaddifference fval))) + (exit fval)))) + (exit (|error| "Unknown type to de-writify."))))) + (when (consp ob) + (exit + (seq + (setq qcar (qcar ob)) + (setq qcdr (qcdr ob)) + (setq nob (cons qcar qcdr)) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (qrplaca nob (|dewritify,dewritifyInner| qcar)) + (qrplacd nob (|dewritify,dewritifyInner| qcdr)) + (exit nob)))) + (when (vecp ob) + (exit + (seq + (setq n (qvmaxindex ob)) + (setq nob (make-array (1+ n))) + (hput |$seen| ob nob) + (hput |$seen| nob nob) + (do ((i 0 (1+ i))) + ((> i n) nil) + (seq + (exit + (qsetvelt nob i + (|dewritify,dewritifyInner| (qvelt ob i)))))) + (exit nob)))) + (exit ob))))) + +\end{chunk} + +\defun{dewritify}{dewritify} +\calls{dewritify}{ScanOrPairVec} +\calls{dewritify}{function} +\calls{dewritify}{dewritify,dewritifyInner} +\usesdollar{dewritify}{seen} +\begin{chunk}{defun dewritify} +(defun |dewritify| (ob) + (let (|$seen|) + (declare (special |$seen|)) + (if (null (|ScanOrPairVec| #'(lambda (a) (eq a 'writified!!)) ob)) + ob + (progn + (setq |$seen| (make-hash-table :test #'eq)) + (|dewritify,dewritifyInner| ob))))) + +\end{chunk} + +\defun{ScanOrPairVec,ScanOrInner}{ScanOrPairVec,ScanOrInner} +\throws{ScanOrPairVec,ScanOrInner}{ScanOrPairVecAnswer} +\calls{ScanOrPairVec,ScanOrInner}{hget} +\calls{ScanOrPairVec,ScanOrInner}{hput} +\calls{ScanOrPairVec,ScanOrInner}{ScanOrPairVec,ScanOrInner} +\calls{ScanOrPairVec,ScanOrInner}{qcar} +\calls{ScanOrPairVec,ScanOrInner}{qcdr} +\calls{ScanOrPairVec,ScanOrInner}{vecp} +\usesdollar{ScanOrPairVec,ScanOrInner}{seen} +\begin{chunk}{defun ScanOrPairVec,ScanOrInner} +(defun |ScanOrPairVec,ScanOrInner| (f ob) + (declare (special |$seen|)) + (when (hget |$seen| ob) nil) + (when (consp ob) + (hput |$seen| ob t) + (|ScanOrPairVec,ScanOrInner| f (qcar ob)) + (|ScanOrPairVec,ScanOrInner| f (qcdr ob))) + (when (vecp ob) + (hput |$seen| ob t) + (do ((tmp0 (spaddifference (|#| ob) 1)) (i 0 (1+ i))) + ((> i tmp0) nil) + (|ScanOrPairVec,ScanOrInner| f (elt ob i)))) + (when (funcall f ob) (throw '|ScanOrPairVecAnswer| t)) + nil) + +\end{chunk} + +\defun{ScanOrPairVec}{ScanOrPairVec} +\catches{ScanOrPairVec}{ScanOrPairVecAnswer} +\calls{ScanOrPairVec}{ScanOrPairVec,ScanOrInner} +\usesdollar{ScanOrPairVec}{seen} +\begin{chunk}{defun ScanOrPairVec} +(defun |ScanOrPairVec| (f ob) + (let (|$seen|) + (declare (special |$seen|)) + (setq |$seen| (make-hash-table :test #'eq)) + (catch '|ScanOrPairVecAnswer| (|ScanOrPairVec,ScanOrInner| f ob)))) + +\end{chunk} +\defun{gensymInt}{gensymInt} +\calls{gensymInt}{gensymp} +\calls{gensymInt}{error} +\calls{gensymInt}{pname} +\calls{gensymInt}{charDigitVal} +\begin{chunk}{defun gensymInt} +(defun |gensymInt| (g) + (let (p n) + (if (null (gensymp g)) + (|error| "Need a GENSYM") + (progn + (setq p (pname g)) + (setq n 0) + (do ((tmp0 (spaddifference (|#| p) 1)) (i 2 (1+ i))) + ((> i tmp0) nil) + (setq n (+ (* 10 n) (|charDigitVal| (elt p i))))) + n)))) + +\end{chunk} +\defun{charDigitVal}{charDigitVal} +\calls{charDigitVal}{spaddifference} +\calls{charDigitVal}{error} +\begin{chunk}{defun charDigitVal} +(defun |charDigitVal| (c) + (let (digits n) + (setq digits "0123456789") + (setq n (spaddifference 1)) + (do ((tmp0 (spaddifference (|#| digits) 1)) (i 0 (1+ i))) + ((or (> i tmp0) (null (minusp n))) nil) + (if (char= c (elt digits i)) + (setq n i) + nil)) + (if (minusp n) + (|error| "Character is not a digit") + n))) + +\end{chunk} +\defun{histFileErase}{histFileErase} +\begin{chunk}{defun histFileErase} +(defun |histFileErase| (file) + (when (probe-file file) (delete-file file))) + +\end{chunk} + +\begin{chunk}{History File Messages} +S2IH0001 + You have not reached step %1b yet, and so its value cannot be + supplied. +S2IH0002 + Cannot supply value for step %1b because 1 is the first step. +S2IH0003 + Step %1b has no value. +S2IH0004 + The history facility is not on, so you cannot use %b %% %d . +S2IH0006 + You have not used the correct syntax for the %b history %d command. + Issue %b )help history %d for more information. +S2IH0007 + The history facility is already on. +S2IH0008 + The history facility is now on. +S2IH0009 + Turning on the history facility will clear the contents of the + workspace. + Please enter %b y %d or %b yes %d if you really want to do this: +S2IH0010 + The history facility is still off. +S2IH0011 + The history facility is already off. +S2IH0012 + The history facility is now off. +S2IH0013 + The history facility is not on, so the .input file containing your user input + cannot be created. +S2IH0014 + Edit %b %1 %d to see the saved input lines. +S2IH0015 + The argument %b n %d for %b )history )change n must be a nonnegative + integer and your argument, %1b , is not one. +S2IH0016 + The history facility is not on, so no information can be saved. +S2IH0018 + The saved history file is %1b . +S2IH0019 + There is no history file, so value of step %1b is + undefined. +S2IH0022 + No history information had been saved yet. +S2IH0023 + %1b is not a valid filename for the history file. +S2IH0024 + History information cannot be restored from %1b because the file does + not exist. +S2IH0025 + The workspace has been successfully restored from the history file + %1b . +S2IH0026 + The history facility command %1b cannot be performed because the + history facility is not on. +S2IH0027 + A value containing a %1b is being saved in a history file or a + compiled input file INLIB. This type + is not yet usable in other history operations. You might want to issue + %b )history )off %d +S2IH0029 + History information is already being maintained in an external file + (and not in memory). +S2IH0030 + History information is already being maintained in memory (and not + in an external file). +S2IH0031 + When the history facility is active, history information will be + maintained in a file (and not in an internal table). +S2IH0032 + When the history facility is active, history information will be + maintained in memory (and not in an external file). +S2IH0034 + Missing element in internal history table. +S2IH0035 + Can't save the value of step number %1b. You can re-generate this value + by running the input file %2b. +S2IH0036 + The value specified cannot be saved to a file. +S2IH0037 + You must specify a file name to the history save command +S2IH0038 + You must specify a file name to the history write command +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{include} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{include.help} + +User Level Required: interpreter + +Command Syntax: + + )include filename + +Command Description: + +The )include command can be used in .input files to place the contents +of another file inline with the current file. The path can be an +absolute or relative pathname. + +\end{chunk} + +\defun{ncloopInclude1}{ncloopInclude1} +\calls{ncloopInclude1}{ncloopIncFileName} +\calls{ncloopInclude1}{ncloopInclude} +\begin{chunk}{defun ncloopInclude1} +(defun |ncloopInclude1| (name n) + (let (a) + (if (setq a (|ncloopIncFileName| name)) + (|ncloopInclude| a n) + n))) + +\end{chunk} +\defunsec{ncloopIncFileName} +{Returns the first non-blank substring of the given string} +\calls{ncloopIncFileName}{incFileName} +\calls{ncloopIncFileName}{concat} +\begin{chunk}{defun ncloopIncFileName} +(defun |ncloopIncFileName| (string) + "Returns the first non-blank substring of the given string" + (let (fn) + (unless (setq fn (|incFileName| string)) + (write-line (concat string " not found"))) + fn)) + +\end{chunk} + +\defunsec{ncloopInclude}{Open the include file and read it in} +The ncloopInclude0 function is part +of the parser and lives in int-top.boot. + +\calls{ncloopInclude}{ncloopInclude0} +\begin{chunk}{defun ncloopInclude} +(defun |ncloopInclude| (name n) + "Open the include file and read it in" + (with-open-file (st name) (|ncloopInclude0| st name n))) + +\end{chunk} + +\defunsec{incFileName}{Return the include filename} +Given a string we return the first token from the string which is +the first non-blank substring. +\calls{incFileName}{incBiteOff} +\begin{chunk}{defun incFileName} +(defun |incFileName| (x) + "Return the include filename" + (car (|incBiteOff| x))) + +\end{chunk} + +\defunsec{incBiteOff}{Return the next token} +Takes a sequence and returns the a list of the first token and the +remaining string characters. If there are no remaining string characters +the second string is of length 0. Effectively it "bites off" the first +token in the string. If the string only 0 or more blanks it returns nil. +\begin{chunk}{defun incBiteOff} +(defun |incBiteOff| (x) + "Return the next token" + (let (blank nonblank) + (setq x (string x)) + (when (setq nonblank (position #\space x :test-not #'char=)) + (setq blank (position #\space x :start nonblank)) + (if blank + (list (subseq x nonblank blank) (subseq x blank)) + (list (subseq x nonblank) ""))))) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{library} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{library.help} +==================================================================== +A.14. )library +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )library libName1 [libName2 ...] + - )library )dir dirName + - )library )only objName1 [objlib2 ...] + - )library )noexpose + +Command Description: + +This command replaces the )load system command that was available in AXIOM +releases before version 2.0. The )library command makes available to AXIOM +the compiled objects in the libraries listed. + +For example, if you )compile dopler.spad in your home directory, issue )library +dopler to have AXIOM look at the library, determine the category and domain +constructors present, update the internal database with various properties of +the constructors, and arrange for the constructors to be automatically loaded +when needed. If the )noexpose option has not been given, the constructors +will be exposed (that is, available) in the current frame. + +If you compiled a file you will have an NRLIB present, for example, +DOPLER.NRLIB, where DOPLER is a constructor abbreviation. The command +)library DOPLER will then do the analysis and database updates as above. + +To tell the system about all libraries in a directory, use )library )dir +dirName where dirName is an explicit directory. You may specify ``.'' as the +directory, which means the current directory from which you started the +system or the one you set via the )cd command. The directory name is required. + +You may only want to tell the system about particular constructors within a +library. In this case, use the )only option. The command )library dopler +)only Test1 will only cause the Test1 constructor to be analyzed, autoloaded, +etc.. + +Finally, each constructor in a library are usually automatically exposed when +the )library command is used. Use the )noexpose option if you not want them +exposed. At a later time you can use )set expose add constructor to expose +any hidden constructors. + +Note for AXIOM beta testers: At various times this command was called )local +and )with before the name )library became the official name. + +Also See: +o )cd +o )compile +o )frame +o )set + +\end{chunk} +\footnote{ +\fnref{cd} +\fnref{frame} +\fnref{set}} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{lisp} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{lisp.help} +==================================================================== +A.15. )lisp +==================================================================== + +User Level Required: development + +Command Syntax: + + - )lisp [lispExpression] + +Command Description: + +This command is used by AXIOM system developers to have single expressions +evaluated by the Lisp system on which AXIOM is built. The lispExpression is +read by the Lisp reader and evaluated. If this expression is not complete +(unbalanced parentheses, say), the reader will wait until a complete +expression is entered. + +Since this command is only useful for evaluating single expressions, the )fin +command may be used to drop out of AXIOM into Lisp. + +Also See: +o )system +o )boot +o )fin + +\end{chunk} +\footnote{ +\fnref{system} +\fnref{boot} +\fnref{fin}} + +This command is in the list of \verb|$noParseCommands| +\ref{noParseCommands} which means that its arguments are passed +verbatim. This will eventually result in a call to the function +\verb|handleNoParseCommands| \ref{handleNoParseCommands} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{ltrace} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{ltrace.help} +==================================================================== +A.17. )ltrace +==================================================================== + +User Level Required: development + +Command Syntax: + +This command has the same arguments as options as the )trace command. + +Command Description: + +This command is used by AXIOM system developers to trace Lisp or BOOT +functions. It is not supported for general use. + +Also See: +o )boot +o )lisp +o )trace + +\end{chunk} +\footnote{ +\fnref{boot} +\fnref{lisp} +\fnref{trace}} + +\defun{ltrace}{The top level )ltrace function} +\calls{ltrace}{trace} +\begin{chunk}{defun ltrace} +(defun |ltrace| (arg) (|trace| arg)) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{pquit} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{pquit.help} +==================================================================== +A.18. )pquit +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )pquit + +Command Description: + +This command is used to terminate AXIOM and return to the operating system. +Other than by redoing all your computations or by using the )history )restore +command to try to restore your working environment, you cannot return to +AXIOM in the same state. + +)pquit differs from the )quit in that it always asks for confirmation that +you want to terminate AXIOM (the ``p'' is for ``protected''). When you enter +the )pquit command, AXIOM responds + + Please enter y or yes if you really want to leave the interactive + environment and return to the operating system: + +If you respond with y or yes, you will see the message + + You are now leaving the AXIOM interactive environment. + Issue the command axiom to the operating system to start a new session. + +and AXIOM will terminate and return you to the operating system (or the +environment from which you invoked the system). If you responded with +something other than y or yes, then the message + + You have chosen to remain in the AXIOM interactive environment. + +will be displayed and, indeed, AXIOM would still be running. + +Also See: +o )fin +o )history +o )close +o )quit +o )system + +\end{chunk} +\footnote{ +\fnref{fin} +\fnref{history} +\fnref{close} +\fnref{quit} +\fnref{system}} + +\defunsec{pquit}{The top level pquit command} +\calls{pquit}{pquitSpad2Cmd} +\begin{chunk}{defun pquit} +(defun |pquit| () + "The top level pquit command" + (|pquitSpad2Cmd|)) + +\end{chunk} + +\defunsec{pquitSpad2Cmd}{The top level pquit command handler} +\calls{pquitSpad2Cmd}{quitSpad2Cmd} +\usesdollar{pquitSpad2Cmd}{quitCommandType} +\begin{chunk}{defun pquitSpad2Cmd} +(defun |pquitSpad2Cmd| () + "The top level pquit command handler" + (let ((|$quitCommandType| '|protected|)) + (declare (special |$quitCommandType|)) + (|quitSpad2Cmd|))) + +\end{chunk} + +This command is in the list of \verb|$noParseCommands| +\ref{noParseCommands} which means that its arguments are passed +verbatim. This will eventually result in a call to the function +\verb|handleNoParseCommands| \ref{handleNoParseCommands} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{quit} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{quit.help} +==================================================================== +A.19. )quit +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )quit + - )set quit protected | unprotected + +Command Description: + +This command is used to terminate AXIOM and return to the operating system. +Other than by redoing all your computations or by using the )history )restore +command to try to restore your working environment, you cannot return to +AXIOM in the same state. + +)quit differs from the )pquit in that it asks for confirmation only if the +command + +)set quit protected + +has been issued. Otherwise, )quit will make AXIOM terminate and return you to +the operating system (or the environment from which you invoked the system). + +The default setting is )set quit protected so that )quit and )pquit behave in +the same way. If you do issue + +)set quit unprotected + +we suggest that you do not (somehow) assign )quit to be executed when you +press, say, a function key. + +Also See: +o )fin +o )history +o )close +o )pquit +o )system + +\end{chunk} +\footnote{ +\fnref{fin} +\fnref{history} +\fnref{close} +\fnref{pquit} +\fnref{system}} + +\defunsec{quit}{The top level quit command} +\calls{quit}{quitSpad2Cmd} +\begin{chunk}{defun quit} +(defun |quit| () + "The top level quit command" + (|quitSpad2Cmd|)) + +\end{chunk} +\defunsec{quitSpad2Cmd}{The top level quit command handler} +\calls{quitSpad2Cmd}{upcase} +\calls{quitSpad2Cmd}{queryUserKeyedMsg} +\calls{quitSpad2Cmd}{string2id-n} +\calls{quitSpad2Cmd}{leaveScratchpad} +\calls{quitSpad2Cmd}{sayKeyedMsg} +\calls{quitSpad2Cmd}{tersyscommand} +\usesdollar{quitSpad2Cmd}{quitCommandType} +\begin{chunk}{defun quitSpad2Cmd} +(defun |quitSpad2Cmd| () + "The top level quit command handler" + (declare (special |$quitCommandType|)) + (if (eq |$quitCommandType| '|protected|) + (let (x) + (setq x (upcase (|queryUserKeyedMsg| 's2iz0031 nil))) + (when (member (string2id-n x 1) '(y yes)) (|leaveScratchpad|)) + (|sayKeyedMsg| 's2iz0032 nil) + (tersyscommand)) + (|leaveScratchpad|))) + +\end{chunk} + +\defunsec{leaveScratchpad}{Leave the Axiom interpreter} +\begin{chunk}{defun leaveScratchpad} +(defun |leaveScratchpad| () + "Leave the Axiom interpreter" + (bye)) + +\end{chunk} + +This command is in the list of \verb|$noParseCommands| +\ref{noParseCommands} which means that its arguments are passed +verbatim. This will eventually result in a call to the function +\verb|handleNoParseCommands| \ref{handleNoParseCommands} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{read} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{read.help} +==================================================================== +A.20. )read +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )read [fileName] + - )read [fileName] [)quiet] [)ifthere] + +Command Description: + +This command is used to read .input files into AXIOM. The command + +)read matrix.input + +will read the contents of the file matrix.input into AXIOM. The ``.input'' +file extension is optional. See the AXIOM User Guide index for more +information about .input files. + +This command remembers the previous file you edited, read or compiled. If you +do not specify a file name, the previous file will be read. + +The )ifthere option checks to see whether the .input file exists. If it does +not, the )read command does nothing. If you do not use this option and the +file does not exist, you are asked to give the name of an existing .input +file. + +The )quiet option suppresses output while the file is being read. + +Also See: +o )compile +o )edit +o )history + +\end{chunk} +\footnote{ +\fnref{edit} +\fnref{history}} + +\defun{read}{The )read command} +\calls{read}{readSpad2Cmd} +\begin{chunk}{defun read} +(defun |read| (arg) (|readSpad2Cmd| arg)) + +\end{chunk} + +\defun{readSpad2Cmd}{Implement the )read command} +\calls{readSpad2Cmd}{selectOptionLC} +\calls{readSpad2Cmd}{optionError} +\calls{readSpad2Cmd}{pathname} +\calls{readSpad2Cmd}{pathnameTypeId} +\calls{readSpad2Cmd}{makePathname} +\calls{readSpad2Cmd}{pathnameName} +\calls{readSpad2Cmd}{mergePathnames} +\calls{readSpad2Cmd}{findfile} +\calls{readSpad2Cmd}{throwKeyedMsg} +\calls{readSpad2Cmd}{namestring} +\calls{readSpad2Cmd}{upcase} +\calls{readSpad2Cmd}{member} +\calls{readSpad2Cmd}{/read} +\usesdollar{readSpad2Cmd}{InteractiveMode} +\usesdollar{readSpad2Cmd}{findfile} +\usesdollar{readSpad2Cmd}{UserLevel} +\usesdollar{readSpad2Cmd}{options} +\uses{readSpad2Cmd}{/editfile} +\begin{chunk}{defun readSpad2Cmd} +(defun |readSpad2Cmd| (arg) + (prog (|$InteractiveMode| fullopt ifthere quiet ef devFTs fileTypes + ll ft upft fs) + (declare (special |$InteractiveMode| $findfile |$UserLevel| |$options| + /editfile)) + (setq |$InteractiveMode| t) + (dolist (opt |$options|) + (setq fullopt + (|selectOptionLC| (car opt) '(|quiet| |test| |ifthere|) '|optionError|)) + (cond + ((eq fullopt '|ifthere|) (setq ifthere t)) + ((eq fullopt '|quiet|) (setq quiet t)))) + (setq ef (|pathname| /editfile)) + (when (eq (|pathnameTypeId| ef) 'spad) + (setq ef (|makePathname| (|pathnameName| ef) "*" "*"))) + (if arg + (setq arg (|mergePathnames| (|pathname| arg) ef)) + (setq arg ef)) + (setq devFTs '("input" "INPUT" "boot" "BOOT" "lisp" "LISP")) + (setq fileTypes + (cond + ((eq |$UserLevel| '|interpreter|) '("input" "INPUT")) + ((eq |$UserLevel| '|compiler|) '("input" "INPUT")) + (t devFTs))) + (setq ll ($findfile arg fileTypes)) + (unless ll + (if ifthere + (return nil) + (|throwKeyedMsg| 'S2IL0003 (list (|namestring| arg))))) + (setq ll (|pathname| ll)) + (setq ft (|pathnameType| ll)) + (setq upft (upcase ft)) + (cond + ((null (|member| upft fileTypes)) + (setq fs (|namestring| arg)) + (if (|member| upft devFTs) + (|throwKeyedMsg| 'S2IZ0033 (list fs)) + (|throwKeyedMsg| 'S2IZ0034 (list fs)))) + (t + (setq /editfile ll) + (when (string= upft "BOOT") (setq |$InteractiveMode| nil)) + (/read ll quiet))))) + +\end{chunk} + +\defun{/read}{/read} +\seebook{/read}{/rf}{9} +\seebook{/read}{/rq}{9} +\uses{/read}{/editfile} +\begin{chunk}{defun /read} +(defun /read (l q) + (declare (special /editfile)) + (setq /editfile l) + (cond + (q (/rq)) + (t (/rf)) ) + (flag |boot-NewKEY| 'key) + (|terminateSystemCommand|) + (|spadPrompt|)) + + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{regress} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{regress.help} +==================================================================== +A.18. )regress +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )regress fileName + +Command Description: + +The regress command will run the regress function that was compiled +as part of the lisp image build process. This function expects an +input filename, possibly containing a path prefix. + +If the filename contains a period then we consider it a fully formed +filename, otherwise we append ``.output'', which is the default file +extension. + + )regress matrix + )regress matrix.output + )regress /path/to/file/matrix + )regress /path/to/file/matrix.output + +will test the contents of the file matrix.output. + +The idea behind regression testing is to check that the results +we currently get match the results we used to get. In order to +do that we create input files with a special comment format that +contains the prior results. These are easy to create as all you +need to do is run the Axiom function, capture the results, and +turn them input specially formed comments using the -- comment. + +A regression file caches the result of an Axiom function so we +can automate the testing process. It is a file of many tests, +each with their own output. + +The regression file format uses the Axiom -- comment syntax to keep +a copy of the expected output from an Axiom command. This expected +output is compared character by character against the actual output. + +The regression file is broken into numbered blocks, delimited by +a --S for the beginning and a --E for the end. The total number of +blocks is also given so missing or failed tests also raise an error. + +There are 4 special kinds of -- comments in regression files: + + --S n of M this is test n of M tests in this file + --E n this marks the end of test n + --R any output this marks the actual expected output line + --I any output this line is compared but ignored + +A regression test file looks like: + + )set break resume + )spool foo.output + )set message type off + )clear all + + --S 1 of 3 + 2+3 + --R this is the exact Axiom output + --R (1) 5 + --E 1 + + --S 2 of 3 + 2+3 + --R this should fail to match + --R (2) 7 + --E 2 + + --S 3 of 3 + 2+3 + --R this fails to match but we + --I (3) 7 use --I to ignore this line + --E 3 + +We can now run this file with + + )read foo.input + +Note that when this file is run it will create a spool file called +"foo.output" because of the lines: + + )spool foo.output + )spool + +The "foo.output" file contains the console image of the result. +It will look like: + + Starts dribbling to foo.output (2012/2/28, 12:25:7). + )set message type off + )clear all + + --S 1 of 3 + 2+3 + + (1) 5 + --R + --R (1) 5 + --E 1 + + --S 2 of 3 + 2+3 + + (2) 5 + --R + --R (2) 7 + --E 2 + + --S 3 of 3 + 2+3 + + (3) 5 + --R + --I (3) 7 + --E 3 + + )spool + +This "foo.output" file can now be checked using the )regress command. + +When we run the )regress foo.output we see; + + testing foo + passed foo 1 of 3 + MISMATCH + expected:" (2) 7" + got:" (2) 5" + FAILED foo 2 of 2 + passed foo 3 of 3 + regression result FAILED 1 of 3 stanzas file foo + +Tests either pass or fail. A passing test generates the message: + + passed foo 1 of 3 + +A failing test will give a reversed printout of the expected vs +actual output as well as a FAILED message, as in: + + MISMATCH + expected:" (2) 7" + got:" (2) 5" + FAILED foo 2 of 3 + +The last line of output is a summary: + + regression result FAILED 1 of 3 stanzas file foo + + +\end{chunk} + +\begin{chunk}{defun regress command} +(defun |regress| (arg) + (let (|$InteractiveMode| namestring dot1 outfile (extension "output")) + (declare (special |$InteractiveMode|)) + (setq |$InteractiveMode| t) + (setq namestring (symbol-name (car arg))) + (setq dot1 (position #\. namestring)) + (unless dot1 + (setq outfile (concatenate 'string (subseq namestring 0) "." extension))) + (if (probe-file outfile) + (regress outfile) + (format t (concatenate 'string outfile "~% file not found"))))) + +\end{chunk} + +\subsection{The regress function details} +This is the regression test mechanism. The input files have been +rewritten to have a standard structure. This fixed format identifies +the tests within a file. Each test is run and any mismatch between +the actual and expected results is reported. + +In order to regression test axiom results we created a standard +file format. This format has 3 kinds of markers: +\begin{itemize} +\item ``--S'' marker which must have a integer test number +\item ``--R'' marker lines, one per expected output from axiom +\item ``--E'' marker which has an integer matching the preceeding ``--S'' +\item ``--I'' marker ignores the line, useful for gensyms and random +\end{itemize} +Because these markers use Axiom's standard comment prefix they +are valid lines in input files and are ignored by the ``)read'' +command. They are simply copied to the output file. This allows +us to include the expected output in the output file so we can +compare what Axiom computes with what it should compute. + +To create these regression files all you need to do is create an +input file and run it through Axiom. Then, for each test case in +the file you mark it up by putting a ``--S number'' {\bf before} +the Axiom input line. You put ``--R'' prefixes on each line of +Axiom output, including the blank lines. Then you put a ``--E number'' +line after the last output line, usually the {\tt Type:} line. +This newly marked-up input file is now a regression test. + +To actually run the regression test you simply include the +marked up the input file in the {\tt src/input} subdirectory. +This file will automatically be run at build time and any failing +tests will be marked. This code will ignore any input that does +not contain proper regression markups. + +Ideally the regression test files should be pamphlet files that +explain the content and purpose of each regression test case. + +Thus you run the marked-up input file {\tt foo.input} +and spool the result to {\tt foo.output} and then run the +lisp function\\ +{\tt (regress ``foo.output'')} + +If the file does not contain proper regression markups it is +ignored. Comments or any other commands in the file that are not +surrounded by ``--S'' and ``--E'' boundaries are ignored. + +\defvar{*all-tests-ran*} +This variable is used to check whether all of the tests actually +ran. This is needed to see if the execution ended early. +\begin{chunk}{initvars} +(defvar *all-tests-ran* nil "true implies that all tests ran") + +\end{chunk} + +\defun{regress}{Scan a spool output file for failures} +This function takes an output file which has been created by the +Axiom {\tt )spool} command and looks for regression test markups. +Each regression test is checked against the actual result and any +failures are marked. + +\calls{regress}{getspoolname} +\calls{regress}{findnexttest} +\calls{regress}{testpassed} +\uses{regress}{*all-tests-ran*} +\begin{chunk}{defun regress} +(defun regress (infile) + (let (name comment test (count 0) (passed 0) (failed 0)) + (declare (special *all-tests-ran*)) + (setq *all-tests-ran* nil) + (with-open-file (stream infile :direction :input) + (setq name (getspoolname stream)) + (when name + (format t "testing ~a~%" name) + (loop + (setq *ok* nil) + (multiple-value-setq (comment test) (findnexttest stream)) + (unless comment (return)) + (setq count (+ count 1)) + (if (testpassed test) + (progn + (setq passed (+ passed 1)) + (format t "passed ~a ~a~%" name comment)) + (progn + (setq failed (+ failed 1)) + (format t "FAILED ~a ~a~%" name comment)))) + (if (= failed 0) + (format t "regression result passed ~a of ~a stanzas ~Tfile ~a~%" + passed count name) + (format t "regression result FAILED ~a of ~a stanzas ~Tfile ~a~%" + failed count name)) + (unless *all-tests-ran* + (format t "regression result FAILED early exit in file ~a?~%" name)))))) + +\end{chunk} + +\defun{getspoolname}{Parse test name from the spool command} +We need to parse out the name of the test. The ``)spool'' command +writes a line into the output file containing the name of the test. +We parse out the name of the test from this line. +\begin{chunk}{defun getspoolname 0} +(defun getspoolname (stream) + (let (line point) + (setq line (read-line stream)) + (setq point (position #\. line)) + (if (or (null point) + (< (length line) 30) + (not (string= (subseq line (+ point 1) (+ point 7)) "output"))) + nil + (subseq line 20 point)))) + +\end{chunk} + +\defun{findnexttest}{Find the next --S marker} +We need to break the file into separate test cases. This routine +looks for the ``--S'' line which indicates a test is starting. It +collects up input lines until it encounters the ``--E'' line marking +the end of the test case. These lines are returned as a list of strings. + +\calls{findnexttest}{testnumberp} +\begin{chunk}{defun findnexttest} +(defun findnexttest (stream) + (let (teststart result) + (do ((line (read-line stream nil 'done) (read-line stream nil 'done))) + ((or (eq line 'done) (endedp line)) + (values (if line teststart) result)) + (if teststart + (push line result) + (setq teststart (testnumberp line)))))) + +\end{chunk} + +\defun{testnumberp}{Parse out the test number from --S lines} +The ``--S'' line has a test number on the line. We parse out the +test number for printing. +\calls{testnumberp}{startp} +\begin{chunk}{defun testnumberp} +(defun testnumberp (oneline) + (when (startp oneline) (subseq oneline 3))) + +\end{chunk} + +\defvar{*ok*} +We can mark a test as always ok by putting the word ``ok'' anywhere +on the start line. The regress function resets this value. The startp +function checks the --S line for the word ``ok''. If found, it sets +this value to true which causes a failing test to be considered as +passed. +\begin{chunk}{initvars} +(defvar *ok* nil "did we mark this test as always ok?") + +\end{chunk} + +\defun{testpassed}{Compare the computed and expected results} +This routine takes the test input, passes it to split to clean up +and break into two lists, and then compares the resulting lists +element by element, complaining about any mismatches. The result +is either true if everything passes or false if a mismatch occurs. + +A test line can also be considered at passing if the expected line +is the string ``ignore''. + +The ok variable allows us to mark failing tests as ``ok'' because +we expect the test might fail due to random values or testing known +bugs against expected output. We filter these tests marked ``ok'' +so they do not count as ``real'' failures. + +\calls{testpassed}{split} +\uses{testpassed}{*ok*} +\begin{chunk}{defun testpassed} +(defun testpassed (test) + (let (answer expected (passed t) mismatchedLines) + (declare (special *ok*)) + (multiple-value-setq (answer expected) (split test)) + (dotimes (i (length answer)) + (unless + (or (string= (first expected) "ignore") + (string= (first expected) (first answer))) + (unless *ok* (setq passed nil)) + (push (cons (first expected) (first answer)) mismatchedLines)) + (pop answer) + (pop expected)) + (when mismatchedLines + (dolist (pair mismatchedLines) + (format t "expected:~s~% got:~s~%" (car pair) (cdr pair)))) + passed)) + +\end{chunk} + +\defun{split}{Split the calculated and expect results into lists} +We have a list containing all of the lines in a test. The input is of +the form: +\begin{verbatim} +("--R Type: List Integer" + "--R (1) [1,4,2,- 6,0,3,5,4,2,3]" + "--R" + "--R " + " Type: List Integer" + " (1) [1,4,2,- 6,0,3,5,4,2,3]" + "" + " " + "l := [1,4,2,-6,0,3,5,4,2,3]") +\end{verbatim} +It removes the ``--R'' prefix from the result strings +and generates two hopefully equal-length lists, thus: +\begin{verbatim} +(" Type: List Integer" + " (1) [1,4,2,- 6,0,3,5,4,2,3]" + "" + " ") +(" Type: List Integer" + " (1) [1,4,2,- 6,0,3,5,4,2,3]" + "" + " ")) +\end{verbatim} +Thus the first line is the start line, the second line is the Axiom +input line, followed by the Axiom output. Then we have the lines marked +``--R'' which are the expected result. We split these into two separate +lists and throw way the lines that are the start and end lines. + +Once we have classified all of the lines we need to throw away the +input lines. By assumption there will be more answer lines than +expected lines because the input lines are included. And given the way +we process the file these input lines are on the top of the answer +stack. Since the number of answer lines should equal the number of +expected lines we pop the stack until the numbers are equal. + +Each element of the answer list should +be {\tt string=} to the corresponding element of the result list. + +If the input line starts with ``--I'' we push the string ``ignore''. +This is useful for handling random results or gensym symbols. + +\calls{split}{startp} +\calls{split}{endedp} +\calls{split}{ignorep} +\calls{split}{resultp} +\begin{chunk}{defun split} +(defun split (test) + (let (answer (acnt 0) expected (ecnt 0)) + (dolist (oneline test) + (cond + ((startp oneline)) + ((endedp oneline)) + ((ignorep oneline) + (setq ecnt (+ ecnt 1)) + (push "ignore" expected)) + ((resultp oneline) + (setq ecnt (+ ecnt 1)) + (push (subseq oneline 3) expected)) + (t + (setq acnt (+ acnt 1)) + (push oneline answer)))) + (dotimes (i (- acnt ecnt)) (pop answer)) + (values (nreverse answer) (nreverse expected)))) + +\end{chunk} + +\defun{startp}{Returns true on --S lines} +This test returns true if we have a ``start'' line. That is, a line +with a ``--S'' prefix. + +The *all-tests-ran* variable is true if the start line is of the form +"--S N of M" and N=M, that is, it checks that all tests were performed +since this should only occur on the last start line. This will detect +``premature exit'' in processing. + +If a test is failing because of random input values or we want the +test to fail but not to count toward failing values then put the +string ``ok'' somewhere on the ``--S'' line as in: +\begin{verbatim} +--S 29 of 42 fails due to random values but that is ok +\end{verbatim} + +\calls{startp}{lastcount} +\uses{startp}{*ok*} +\begin{chunk}{defun startp} +(defun startp (oneline) + (let (result) + (declare (special *ok*)) + (when + (setq result + (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--S"))) + (setq *ok* (search "ok" oneline)) + (setq *all-tests-ran* (lastcount oneline))) + result)) + +\end{chunk} + +\defun{endedp}{Returns true on --E lines} +This test returns true if we have a ``ended'' line. That is, a line +with a ``--E'' prefix. +\begin{chunk}{defun endedp 0} +(defun endedp (oneline) + (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--E"))) + +\end{chunk} + +\defun{resultp}{Returns true on --R lines} +This test returns true if we have a ``results'' line. That is, a line +with a ``--R'' prefix. +\begin{chunk}{defun resultp 0} +(defun resultp (oneline) + (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--R"))) + +\end{chunk} + +\defun{ignorep}{Returns true on --I lines} +This test returns true if we have an ``ignore'' line. That is, a line +with a ``--I'' prefix. +\begin{chunk}{defun ignorep 0} +(defun ignorep (oneline) + (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--I"))) + +\end{chunk} + +\defun{lastcount}{Check the last --S line ran} +If the ``--S'' line has the format ``--S n of m'' we return true if +n=m, false otherwise. +Thus, +\begin{verbatim} + "--S" => nil + "--S 1 of 4" => nil + "--S 10 of 40" => nil + "--S 4 of 4" => t + "--S 40 of 40" => t + "--S 1 of a" => nil +\end{verbatim} +This is used as a final end check to make sure that all of the +tests actually ran rather than having the regression test exit +early and quietly. This will be false on all but the last test +and will be false if the ``--S'' line does not contain the optional +count marker. It is not required but is highly recommended. + +\begin{chunk}{defun lastcount 0} +(defun lastcount (oneline) + (let ((n :done) (m :done) next somemore isof) + (when (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--S")) + (setq somemore (string-trim " " (subseq oneline 3))) + (when somemore + (multiple-value-setq (n next) (read-from-string somemore nil :done)) + (when (integerp n) + (setq somemore (string-trim " " (subseq somemore next))) + (multiple-value-setq (isof next) (read-from-string somemore nil :done)) + (when (string= isof "OF") + (setq somemore (string-trim " " (subseq somemore next))) + (multiple-value-setq (m next) (read-from-string somemore nil :done)))))) + (and (integerp m) (integerp n) (= m n)))) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{savesystem} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{savesystem.help} +==================================================================== +A.8. )savesystem +==================================================================== + +User Level Required: interpreter + + +Command Syntax: + + - )savesystem filename + +Command Description: + + This command is used to save an AXIOM image to disk. This creates an +executable file which, when started, has everything loaded into it +that was there when the image was saved. Thus, after executing commands +which cause the loading of some packages, the command: + +)savesystem /tmp/savesys + +will create an image that can be restarted with the UNIX command: + +axiom -ws /tmp/savesys + +This new system will not need to reload the packages and domains that +were already loaded when the system was saved. + +There is currently a restriction that only systems started with the +command "AXIOMsys" may be saved. + + axiom + (1) -> t1:=4 + (1) -> )savesystem foo + +and Axiom exits. Then do + + ./foo + (1) -> t1 + 4 + +\end{chunk} + +\defun{savesystem}{The )savesystem command} +\calls{savesystem}{helpSpad2Cmd} +\calls{savesystem}{spad-save} +\begin{chunk}{defun savesystem} +(defun |savesystem| (arg) + (if (or (not (eql (|#| arg) 1)) (null (symbolp (car arg)))) + (|helpSpad2Cmd| '(|savesystem|)) + (spad-save (symbol-name (car arg))))) + +\end{chunk} + +\newpage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\cmdhead{set} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\begin{chunk}{set.help} +==================================================================== +A.21. )set +==================================================================== + +User Level Required: interpreter + +Command Syntax: + + - )set + - )set label1 [... labelN] + - )set label1 [... labelN] newValue + +Command Description: + +The )set command is used to view or set system variables that control what +messages are displayed, the type of output desired, the status of the history +facility, the way AXIOM user functions are cached, and so on. Since this +collection is very large, we will not discuss them here. Rather, we will show +how the facility is used. We urge you to explore the )set options to +familiarize yourself with how you can modify your AXIOM working environment. +There is a HyperDoc version of this same facility available from the main +HyperDoc menu. Click [here] to go to it. + +The )set command is command-driven with a menu display. It is +tree-structured. To see all top-level nodes, issue )set by itself. + +)set + +Variables with values have them displayed near the right margin. Subtrees of +selections have ``...'' displayed in the value field. For example, there are +many kinds of messages, so issue )set message to see the choices. + +)set message + +The current setting for the variable that displays whether computation times +are displayed is visible in the menu displayed by the last command. To see +more information, issue + +)set message time + +This shows that time printing is on now. To turn it off, issue + +)set message time off + +As noted above, not all settings have so many qualifiers. For example, to +change the )quit command to being unprotected (that is, you will not be +prompted for verification), you need only issue + +)set quit unprotected + +Also See: +o )quit + +\end{chunk} +\footnote{\fnref{quit}} + +\subsection{Overview} +This section contains tree of information used to initialize the {\bf )set} +command in the interpreter. The current list is: +\begin{verbatim} + +Variable Description Current Value +----------------------------------------------------------------- +compile Library compiler options ... +breakmode execute break processing on error break +expose control interpreter constructor exposure ... +functions some interpreter function options ... +fortran view and set options for FORTRAN output ... +kernel library functions built into the kernel for + efficiency ... +hyperdoc options in using HyperDoc ... +help view and set some help options ... +history save workspace values in a history file on +messages show messages for various system features ... +naglink options for NAGLink ... +output view and set some output options ... +quit protected or unprotected quit unprotected +streams set some options for working with streams ... +system set some system development variables ... +userlevel operation access level of system user development + +Variables with current values of ... have further sub-options. +For example, issue )set system to see what the options are +for system. For more information, issue )help set . + +\end{verbatim} + +\defunsec{initializeSetVariables}{Initialize the set variables} +The argument settree is initially the \verb|$setOption| variable. +The fourth element is a union-style switch symbol. +The fifth element is usually a variable to set. +The sixth element is a subtree to recurse for the TREE switch. +The seventh element is usually the default value. For more detailed +explanations see the list structure section \ref{Theliststructure}. +\calls{initializeSetVariables}{sayMSG} +\calls{initializeSetVariables}{literals} +\calls{initializeSetVariables}{translateYesNo2TrueFalse} +\calls{initializeSetVariables}{tree} +\calls{initializeSetVariables}{initializeSetVariables} +\begin{chunk}{defun initializeSetVariables} +(defun |initializeSetVariables| (settree) + "Initialize the set variables" + (dolist (setdata settree) + (case (fourth setdata) + (function + (if (canFuncall? (fifth setdata)) + (funcall (fifth setdata) '|%initialize%|) + (|sayMSG| (concatenate 'string " Function not implemented. " + (package-name *package*) ":" (string (fifth setdata)))))) + (integer (set (fifth setdata) (seventh setdata))) + (string (set (fifth setdata) (seventh setdata))) + (literals + (set (fifth setdata) (|translateYesNo2TrueFalse| (seventh setdata)))) + (tree (|initializeSetVariables| (sixth setdata)))))) + +\end{chunk} + +\defunsec{resetWorkspaceVariables}{Reset the workspace variables} +\calls{resetWorkspaceVariables}{copy} +\calls{resetWorkspaceVariables}{initializeSetVariables} +\uses{resetWorkspaceVariables}{/countlist} +\uses{resetWorkspaceVariables}{/editfile} +\uses{resetWorkspaceVariables}{/sourcefiles} +\uses{resetWorkspaceVariables}{/pretty} +\uses{resetWorkspaceVariables}{/spacelist} +\uses{resetWorkspaceVariables}{/timerlist} +\usesdollar{resetWorkspaceVariables}{sourceFiles} +\usesdollar{resetWorkspaceVariables}{existingFiles} +\usesdollar{resetWorkspaceVariables}{functionTable} +\usesdollar{resetWorkspaceVariables}{boot} +\usesdollar{resetWorkspaceVariables}{compileMapFlag} +\usesdollar{resetWorkspaceVariables}{echoLineStack} +\usesdollar{resetWorkspaceVariables}{operationNameList} +\usesdollar{resetWorkspaceVariables}{slamFlag} +\usesdollar{resetWorkspaceVariables}{CommandSynonymAlist} +\usesdollar{resetWorkspaceVariables}{InitialCommandSynonymAlist} +\usesdollar{resetWorkspaceVariables}{UserAbbreviationsAlist} +\usesdollar{resetWorkspaceVariables}{msgAlist} +\usesdollar{resetWorkspaceVariables}{msgDatabase} +\usesdollar{resetWorkspaceVariables}{msgDatabaseName} +\usesdollar{resetWorkspaceVariables}{dependeeClosureAlist} +\usesdollar{resetWorkspaceVariables}{IOindex} +\usesdollar{resetWorkspaceVariables}{coerceIntByMapCounter} +\usesdollar{resetWorkspaceVariables}{e} +\usesdollar{resetWorkspaceVariables}{env} +\usesdollar{resetWorkspaceVariables}{setOptions} +\begin{chunk}{defun resetWorkspaceVariables} +(defun |resetWorkspaceVariables| () + "Reset the workspace variables" + (declare (special /countlist /editfile /sourcefiles |$sourceFiles| /pretty + /spacelist /timerlist |$existingFiles| |$functionTable| $boot + |$compileMapFlag| |$echoLineStack| |$operationNameList| |$slamFlag| + |$CommandSynonymAlist| |$InitialCommandSynonymAlist| + |$UserAbbreviationsAlist| |$msgAlist| |$msgDatabase| |$msgDatabaseName| + |$dependeeClosureAlist| |$IOindex| |$coerceIntByMapCounter| |$e| |$env| + |$setOptions|)) + (setq /countlist nil) + (setq /editfile nil) + (setq /sourcefiles nil) + (setq |$sourceFiles| nil) + (setq /pretty nil) + (setq /spacelist nil) + (setq /timerlist nil) + (setq |$existingFiles| (make-hash-table :test #'equal)) + (setq |$functionTable| nil) + (setq $boot nil) + (setq |$compileMapFlag| nil) + (setq |$echoLineStack| nil) + (setq |$operationNameList| nil) + (setq |$slamFlag| nil) + (setq |$CommandSynonymAlist| (copy |$InitialCommandSynonymAlist|)) + (setq |$UserAbbreviationsAlist| nil) + (setq |$msgAlist| nil) + (setq |$msgDatabase| nil) + (setq |$msgDatabaseName| nil) + (setq |$dependeeClosureAlist| nil) + (setq |$IOindex| 1) + (setq |$coerceIntByMapCounter| 0) + (setq |$e| (cons (cons nil nil) nil)) + (setq |$env| (cons (cons nil nil) nil)) + (|initializeSetVariables| |$setOptions|)) + +\end{chunk} + +\defunsec{displaySetOptionInformation}{Display the set option information} +\calls{displaySetOptionInformation}{displaySetVariableSettings} +\calls{displaySetOptionInformation}{centerAndHighlight} +\calls{displaySetOptionInformation}{concat} +\calls{displaySetOptionInformation}{object2String} +\calls{displaySetOptionInformation}{specialChar} +\calls{displaySetOptionInformation}{sayBrightly} +\calls{displaySetOptionInformation}{bright} +\calls{displaySetOptionInformation}{sayMSG} +\calls{displaySetOptionInformation}{boot-equal} +\calls{displaySetOptionInformation}{sayMessage} +\calls{displaySetOptionInformation}{eval} +\calls{displaySetOptionInformation}{literals} +\calls{displaySetOptionInformation}{translateTrueFalse2YesNo} +\usesdollar{displaySetOptionInformation}{linelength} +\begin{chunk}{defun displaySetOptionInformation} +(defun |displaySetOptionInformation| (arg setdata) + "Display the set option information" + (let (current) + (declare (special $linelength)) + (cond + ((eq (fourth setdata) 'tree) + (|displaySetVariableSettings| (sixth setdata) (first setdata))) + (t + (|centerAndHighlight| + (concat "The " (|object2String| arg) " Option") + $linelength (|specialChar| '|hbar|)) + (|sayBrightly| + `(|%l| ,@(|bright| "Description:") ,(second setdata))) + (case (fourth setdata) + (function + (terpri) + (if (canFuncall? (fifth setdata)) + (funcall (fifth setdata) '|%describe%|) + (|sayMSG| " Function not implemented."))) + (integer + (|sayMessage| + `(" The" ,@(|bright| arg) "option" + " may be followed by an integer in the range" + ,@(|bright| (elt (sixth setdata) 0)) "to" + |%l| ,@(|bright| (elt (sixth setdata) 1)) "inclusive." + " The current setting is" ,@(|bright| (|eval| (fifth setdata)))))) + (string + (|sayMessage| + `(" The" ,@(|bright| arg) "option" + " is followed by a string enclosed in double quote marks." + '|%l| " The current setting is" + ,@(|bright| (list '|"| (|eval| (fifth setdata)) '|"|))))) + (literals + (|sayMessage| + `(" The" ,@(|bright| arg) "option" + " may be followed by any one of the following:")) + (setq current + (|translateTrueFalse2YesNo| (|eval| (fifth setdata)))) + (dolist (name (sixth setdata)) + (if (boot-equal name current) + (|sayBrightly| `( " ->" ,@(|bright| (|object2String| name)))) + (|sayBrightly| (list " " (|object2String| name))))) + (|sayMessage| " The current setting is indicated."))))))) + +\end{chunk} + +\defunsec{displaySetVariableSettings}{Display the set variable settings} +\calls{displaySetVariableSettings}{concat} +\calls{displaySetVariableSettings}{object2String} +\calls{displaySetVariableSettings}{centerAndHighlight} +\calls{displaySetVariableSettings}{sayBrightly} +\calls{displaySetVariableSettings}{say} +\calls{displaySetVariableSettings}{fillerSpaces} +\calls{displaySetVariableSettings}{specialChar} +\calls{displaySetVariableSettings}{concat} +\calls{displaySetVariableSettings}{satisfiesUserLevel} +\calls{displaySetVariableSettings}{spaddifference} +\calls{displaySetVariableSettings}{poundsign} +\calls{displaySetVariableSettings}{eval} +\calls{displaySetVariableSettings}{bright} +\calls{displaySetVariableSettings}{literals} +\calls{displaySetVariableSettings}{translateTrueFalse2YesNo} +\calls{displaySetVariableSettings}{tree} +\usesdollar{displaySetVariableSettings}{linelength} +\begin{chunk}{defun displaySetVariableSettings} +(defun |displaySetVariableSettings| (settree label) + "Display the set variable settings" + (let (setoption opt subtree subname) + (declare (special $linelength)) + (if (eq label '||) + (setq label ")set") + (setq label (concat " " (|object2String| label) " "))) + (|centerAndHighlight| + (concat "Current Values of" label " Variables") $linelength '| |) + (terpri) + (|sayBrightly| + (list "Variable " "Description " + "Current Value" )) + (say (|fillerSpaces| $linelength (|specialChar| '|hbar|))) + (setq subtree nil) + (dolist (setdata settree) + (when (|satisfiesUserLevel| (third setdata)) + (setq setoption (|object2String| (first setdata))) + (setq setoption + (concat setoption + (|fillerSpaces| (spaddifference 13 (|#| setoption)) " ") + (second setdata))) + (setq setoption + (concat setoption + (|fillerSpaces| (spaddifference 55 (|#| setoption)) " "))) + (case (fourth setdata) + (function + (setq opt + (if (canFuncall? (fifth setdata)) + (funcall (fifth setdata) '|%display%|) + "unimplemented")) + (cond + ((consp opt) + (setq opt + (do ((t2 opt (cdr t2)) t1 (o nil)) + ((or (atom t2) (progn (setq o (car t2)) nil)) t1) + (setq t1 (append t1 (cons o (cons " " nil)))))))) + (|sayBrightly| (|concat| setoption '|%b| opt '|%d|))) + (string + (setq opt (|object2String| (|eval| (fifth setdata)))) + (|sayBrightly| `(,setoption ,@(|bright| opt)))) + (integer + (setq opt (|object2String| (|eval| (fifth setdata)))) + (|sayBrightly| `(,setoption ,@(|bright| opt)))) + (literals + (setq opt (|object2String| + (|translateTrueFalse2YesNo| (|eval| (fifth setdata))))) + (|sayBrightly| `(,setoption ,@(|bright| opt)))) + (TREE + (|sayBrightly| `(,setoption ,@(|bright| "..."))) + (setq subtree t) + (setq subname (|object2String| (first setdata))))))) + (terpri) + (when subtree + (|sayBrightly| + `("Variables with current values of" ,@(|bright| "...") + "have further sub-options. For example,")) + (|sayBrightly| + `("issue" ,@(|bright| ")set ") ,subname + " to see what the options are for" ,@(|bright| subname) "." + |%l| "For more information, issue" ,@(|bright| ")help set") "."))))) + +\end{chunk} + +\defunsec{translateYesNo2TrueFalse}{Translate options values to t or nil} +\calls{translateYesNo2TrueFalse}{member} +\begin{chunk}{defun translateYesNo2TrueFalse} +(defun |translateYesNo2TrueFalse| (x) + "Translate options values to t or nil" + (cond + ((|member| x '(|yes| |on|)) t) + ((|member| x '(|no| |off|)) nil) + (t x))) + +\end{chunk} + +\defunsec{translateTrueFalse2YesNo}{Translate t or nil to option values} +\begin{chunk}{defun translateTrueFalse2YesNo} +(defun |translateTrueFalse2YesNo| (x) + "Translate t or nil to option values" + (cond + ((eq x t) '|on|) + ((null x) '|off|) + (t x))) + +\end{chunk} +\subsection{The list structure} +\label{Theliststructure} +The structure of each list item consists of 7 items. Consider this +example: +\begin{verbatim} + (userlevel + "operation access level of system user" + interpreter + LITERALS + $UserLevel + (interpreter compiler development) + development) +\end{verbatim} +The list contains (the names in bold are accessor names that can be +found in {\bf property.lisp.pamphlet}. Look for "setName".): +\begin{list}{} +\item {\bf 1} {\sl Name} the keyword the user will see. In this example +the user would say "{\bf )set output userlevel}". +\item {\bf 2} {\sl Label} the message the user will see. In this example +the user would see "operation access level of system user". +\item {\bf 3} {\sl Level} the level where the command will be +accepted. There are three levels: interpreter, compiler, development. +These commands are restricted to keep the user from causing damage. +\item {\bf 4} {\sl Type} a symbol, one of {\bf FUNCTION}, {\bf INTEGER}, +{\bf STRING}, {\bf LITERALS}, {\bf FILENAME} or {\bf TREE}. +\item {\bf 5} {\sl Var} +\begin{list}{} +\item FUNCTION is the function to call +\item INTEGER is the variable holding the current user setting. +\item STRING is the variable holding the current user setting. +\item LITERALS variable which holds the current user setting. +\item FILENAME is the variable that holds the current user setting. +\item TREE +\end{list} +\item {\bf 6} {\sl Leaf} +\begin{list}{} +\item FUNCTION is the list of all possible values +\item INTEGER is the range of possible values +\item STRING is a list of all possible values +\item LITERALS is a list of all of the possible values +\item FILENAME is the function to check the filename +\item TREE +\end{list} +\item {\bf 7} {\sl Def} is the default value +\begin{list}{} +\item FUNCTION is the default setting +\item INTEGER is the default setting +\item STRING is the default setting +\item LITERALS is the default setting +\item FILENAME is the default value +\item TREE +\end{list} +\end{list} + +\section{\enspace{}set breakmode} +\begin{verbatim} +-------------------- The breakmode Option --------------------- + + Description: execute break processing on error + + The breakmode option may be followed by any one of the + following: + + nobreak + -> break + query + resume + fastlinks + quit + + The current setting is indicated. + +\end{verbatim} +\defdollar{BreakMode} +\begin{chunk}{initvars} +(defvar |$BreakMode| '|nobreak| "execute break processing on error") + +\end{chunk} +\begin{chunk}{breakmode} + (|breakmode| + "execute break processing on error" + |interpreter| + LITERALS + |$BreakMode| + (|nobreak| |break| |query| |resume| |fastlinks| |quit|) + |nobreak|) ; needed to avoid possible startup looping +\end{chunk} + +\section{\enspace{}set debug} +\begin{verbatim} + Current Values of debug Variables + +Variable Description Current Value +----------------------------------------------------------------- +lambdatype Show type information for #1 syntax off +dalymode Interpret leading open paren as lisp off + +\end{verbatim} +\begin{chunk}{debug} + (|debug| + "debug options" + |interpreter| + TREE + |novar| + ( +\getchunk{debuglambdatype} +\getchunk{debugdalymode} + )) +\end{chunk} + +\subsection{set debug lambdatype} +\begin{verbatim} +---------------------- The lambdatype Option ---------------------- + + Description: Show type information for #1 syntax + +\end{verbatim} +\defdollar{lambdatype} +\begin{chunk}{initvars} +(defvar $lambdatype nil "show type information for #1 syntax") + +\end{chunk} + +\begin{chunk}{debuglambdatype} + (|lambdatype| + "show type information for #1 syntax" + |interpreter| + LITERALS + $lambdatype + (|on| |off|) + |off|) +\end{chunk} + +\section{\enspace{}set compiler} +\begin{verbatim} + Current Values of compiler Variables + +Variable Description Current Value +----------------------------------------------------------------- +output library in which to place compiled code +input controls libraries from which to load compiled code + +\end{verbatim} +\begin{chunk}{compile} + (|compiler| + "Library compiler options" + |interpreter| + TREE + |novar| + ( +\getchunk{compileoutput} +\getchunk{compileinput} + )) +\end{chunk} + +\subsection{set compiler output} +\begin{verbatim} +---------------------- The output Option ---------------------- + + Description: library in which to place compiled code + +\end{verbatim} +\begin{chunk}{compileoutput} + (|output| + "library in which to place compiled code" + |interpreter| + FUNCTION + |setOutputLibrary| + NIL + |htSetOutputLibrary| + ) +\end{chunk} + +\defunsec{setOutputLibrary}{The set output command handler} +\calls{setOutputLibrary}{poundsign} +\calls{setOutputLibrary}{describeOutputLibraryArgs} +\calls{setOutputLibrary}{filep} +\calls{setOutputLibrary}{openOutputLibrary} +\usesdollar{setOutputLibrary}{outputLibraryName} +\begin{chunk}{defun setOutputLibrary} +(defun |setOutputLibrary| (arg) + "The set output command handler" + (let (fn) + (declare (special |$outputLibraryName|)) + (cond + ((eq arg '|%initialize%|) (setq |$outputLibraryName| nil)) + ((eq arg '|%display%|) (or |$outputLibraryName| "user.lib")) + ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?) (/= (|#| arg) 1)) + (|describeOutputLibraryArgs|)) + (t + (when (probe-file (setq fn (princ-to-string (car arg)))) + (setq fn (truename fn))) + (|openOutputLibrary| (setq |$outputLibraryName| fn)))))) + +\end{chunk} + +\defunsec{describeOutputLibraryArgs}{Describe the set output library arguments} +\calls{describeOutputLibraryArgs}{sayBrightly} +\begin{chunk}{defun describeOutputLibraryArgs} +(defun |describeOutputLibraryArgs| () + "Describe the set output library arguments" + (|sayBrightly| (list + '|%b| ")set compile output library" + '|%d| "is used to tell the compiler where to place" + '|%l| "compiled code generated by the library compiler. By default it goes" + '|%l| "in a file called" + '|%b| "user.lib" + '|%d| "in the current directory."))) + +\end{chunk} + +\defvar{output-library} +\begin{chunk}{initvars} +(defvar output-library nil) + +\end{chunk} + +\defunsec{openOutputLibrary}{Open the output library} +The input-libraries and output-library are now truename based. + +\calls{openOutputLibrary}{dropInputLibrary} +\uses{openOutputLibrary}{output-library} +\uses{openOutputLibrary}{input-libraries} +\begin{chunk}{defun openOutputLibrary} +(defun |openOutputLibrary| (lib) + "Open the output library" + (declare (special output-library input-libraries)) + (|dropInputLibrary| lib) + (setq output-library (truename lib)) + (push output-library input-libraries)) + +\end{chunk} + +\subsection{set compiler input} +\begin{verbatim} +---------------------- The input Option ----------------------- + + Description: controls libraries from which to load compiled code + + )set compile input add library is used to tell AXIOM to add + library to the front of the path which determines where + compiled code is loaded from. + )set compile input drop library is used to tell AXIOM to remove + library from this path. +\end{verbatim} +\begin{chunk}{compileinput} + (|input| + "controls libraries from which to load compiled code" + |interpreter| + FUNCTION + |setInputLibrary| + NIL + |htSetInputLibrary|) +\end{chunk} + + +\defunsec{setInputLibrary}{The set input library command handler} +The input-libraries is now maintained as a list of truenames. + +\calls{setInputLibrary}{describeInputLibraryArgs} +\calls{setInputLibrary}{qcar} +\calls{setInputLibrary}{qcdr} +\calls{setInputLibrary}{selectOptionLC} +\calls{setInputLibrary}{addInputLibrary} +\calls{setInputLibrary}{dropInputLibrary} +\calls{setInputLibrary}{setInputLibrary} +\uses{setInputLibrary}{input-libraries} +\begin{chunk}{defun setInputLibrary} +(defun |setInputLibrary| (arg) + "The set input library command handler" + (declare (special input-libraries)) + (let (tmp1 filename act) + (cond + ((eq arg '|%initialize%|) t) + ((eq arg '|%display%|) (mapcar #'namestring input-libraries)) + ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?)) + (|describeInputLibraryArgs|)) + ((and (consp arg) + (progn + (setq act (qcar arg)) + (setq tmp1 (qcdr arg)) + (and (consp tmp1) + (eq (qcdr tmp1) nil) + (progn (setq filename (qcar tmp1)) t))) + (setq act (|selectOptionLC| act '(|add| |drop|) nil))) + (cond + ((eq act '|add|) + (|addInputLibrary| (truename (princ-to-string filename)))) + ((eq act '|drop|) + (|dropInputLibrary| (truename (princ-to-string filename)))))) + (t (|setInputLibrary| nil))))) + +\end{chunk} + +\defunsec{describeInputLibraryArgs}{Describe the set input library arguments} +\calls{describeInputLibraryArgs}{sayBrightly} +\begin{chunk}{defun describeInputLibraryArgs} +(defun |describeInputLibraryArgs| () + "Describe the set input library arguments" + (|sayBrightly| (list + '|%b| ")set compile input add library" + '|%d| "is used to tell AXIOM to add" + '|%b| "library" + '|%d| "to" + '|%l| "the front of the path used to find compile code." + '|%l| + '|%b| ")set compile input drop library" + '|%d| "is used to tell AXIOM to remove" + '|%b| "library" + '|%d| + '|%l| "from this path."))) \end{chunk} -\defdollar{localExposureData} -\begin{chunk}{initvars} -(defvar |$localExposureData| (copy-seq |$localExposureDataDefault|)) +\defunsec{addInputLibrary}{Add the input library to the list} +The input-libraries variable is now maintained as a list of truenames. +\calls{addInputLibrary}{dropInputLibrary} +\uses{addInputLibrary}{input-libraries} +\begin{chunk}{defun addInputLibrary} +(defun |addInputLibrary| (lib) + "Add the input library to the list" + (declare (special input-libraries)) + (|dropInputLibrary| lib) + (push (truename lib) input-libraries)) \end{chunk} -\defunsec{setExpose}{The top level set expose command handler} -\calls{setExpose}{displayExposedGroups} -\calls{setExpose}{sayMSG} -\calls{setExpose}{displayExposedConstructors} -\calls{setExpose}{displayHiddenConstructors} -\calls{setExpose}{sayKeyedMsg} -\calls{setExpose}{namestring} -\calls{setExpose}{pathname} -\calls{setExpose}{qcar} -\calls{setExpose}{qcdr} -\calls{setExpose}{selectOptionLC} -\calls{setExpose}{setExposeAdd} -\calls{setExpose}{setExposeDrop} -\calls{setExpose}{setExpose} -\begin{chunk}{defun setExpose} -(defun |setExpose| (arg) - "The top level set expose command handler" - (let (fnargs fn) - (cond - ((eq arg '|%initialize%|)) - ((eq arg '|%display%|) "...") - ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?)) - (|displayExposedGroups|) - (|sayMSG| " ") - (|displayExposedConstructors|) - (|sayMSG| " ") - (|displayHiddenConstructors|) - (|sayMSG| " ")) - ((and (consp arg) - (progn (setq fn (qcar arg)) (setq fnargs (qcdr arg)) t) - (setq fn (|selectOptionLC| fn '(|add| |drop|) nil))) - (cond - ((eq fn '|add|) (|setExposeAdd| fnargs)) - ((eq fn '|drop|) (|setExposeDrop| fnargs)) - (t nil))) - (t (|setExpose| nil))))) +\defvar{input-libraries} +\begin{chunk}{initvars} +(defvar input-libraries nil) \end{chunk} -\defunsec{setExposeAdd}{The top level set expose add command handler} -\calls{setExposeAdd}{centerAndHighlight} -\calls{setExposeAdd}{specialChar} -\calls{setExposeAdd}{displayExposedGroups} -\calls{setExposeAdd}{sayMSG} -\calls{setExposeAdd}{displayExposedConstructors} -\calls{setExposeAdd}{sayKeyedMsg} -\calls{setExposeAdd}{qcar} -\calls{setExposeAdd}{qcdr} -\calls{setExposeAdd}{selectOptionLC} -\calls{setExposeAdd}{setExposeAddGroup} -\calls{setExposeAdd}{setExposeAddConstr} -\calls{setExposeAdd}{setExposeAdd} -\usesdollar{setExposeAdd}{linelength} -\begin{chunk}{defun setExposeAdd} -(defun |setExposeAdd| (arg) - "The top level set expose add command handler" - (declare (special $linelength)) - (let (fnargs fn) - (cond - ((null arg) - (|centerAndHighlight| - '|The add Option| $linelength (|specialChar| '|hbar|)) - (|displayExposedGroups|) - (|sayMSG| " ") - (|displayExposedConstructors|) - (|sayMSG| " ") - (|sayKeyedMsg| 's2iz0049e nil)) - ((and (consp arg) - (progn (setq fn (qcar arg)) (setq fnargs (qcdr arg)) t) - (setq fn (|selectOptionLC| fn '(|group| |constructor|) nil))) - (cond - ((eq fn '|group|) (|setExposeAddGroup| fnargs)) - ((eq fn '|constructor|) (|setExposeAddConstr| fnargs)) - (t nil))) - (t (|setExposeAdd| nil))))) +\defunsec{dropInputLibrary}{Drop an input library from the list} +\uses{dropInputLibrary}{input-libraries} +\begin{chunk}{defun dropInputLibrary} +(defun |dropInputLibrary| (lib) + "Drop an input library from the list" + (declare (special input-libraries)) + (setq input-libraries (delete (truename lib) input-libraries :test #'equal))) \end{chunk} -\defunsec{setExposeAddGroup}{Expose a group} -Note that \verb|$localExposureData| is a vector of lists. -It consists of [exposed groups,exposed constructors,hidden constructors] - -\calls{setExposeAddGroup}{object2String} -\calls{setExposeAddGroup}{qcar} -\calls{setExposeAddGroup}{setelt} -\calls{setExposeAddGroup}{displayExposedGroups} -\calls{setExposeAddGroup}{sayMSG} -\calls{setExposeAddGroup}{displayExposedConstructors} -\calls{setExposeAddGroup}{displayHiddenConstructors} -\calls{setExposeAddGroup}{clearClams} -\calls{setExposeAddGroup}{getalist} -\calls{setExposeAddGroup}{sayKeyedMsg} -\calls{setExposeAddGroup}{member} -\calls{setExposeAddGroup}{msort} -\calls{setExposeAddGroup}{centerAndHighlight} -\calls{setExposeAddGroup}{specialChar} -\calls{setExposeAddGroup}{namestring} -\calls{setExposeAddGroup}{pathname} -\calls{setExposeAddGroup}{sayAsManyPerLineAsPossible} -\usesdollar{setExposeAddGroup}{globalExposureGroupAlist} -\usesdollar{setExposeAddGroup}{localExposureData} -\usesdollar{setExposeAddGroup}{interpreterFrameName} -\usesdollar{setExposeAddGroup}{linelength} -\begin{chunk}{defun setExposeAddGroup} -(defun |setExposeAddGroup| (arg) - "Expose a group" - (declare (special |$globalExposureGroupAlist| |$localExposureData| - |$interpreterFrameName| $linelength)) - (if (null arg) - (progn - (|centerAndHighlight| - '|The group Option| $linelength (|specialChar| '|hbar|)) - (|displayExposedGroups|) - (|sayMSG| " ") - (|sayAsManyPerLineAsPossible| - (mapcar #'(lambda (x) (|object2String| (first x))) - |$globalExposureGroupAlist|))) - (dolist (x arg) - (when (consp x) (setq x (qcar x))) - (cond - ((eq x '|all|) - (setelt |$localExposureData| 0 - (mapcar #'first |$globalExposureGroupAlist|)) - (setelt |$localExposureData| 1 nil) - (setelt |$localExposureData| 2 nil) - (|displayExposedGroups|) - (|sayMSG| " ") - (|displayExposedConstructors|) - (|sayMSG| " ") - (|displayHiddenConstructors|) - (|clearClams|)) - ((null (getalist |$globalExposureGroupAlist| x)) - (|sayKeyedMsg| 's2iz0049h (cons x nil))) - ((|member| x (elt |$localExposureData| 0)) - (|sayKeyedMsg| 's2iz0049i (list x |$interpreterFrameName|))) - (t - (setelt |$localExposureData| 0 - (msort (cons x (elt |$localExposureData| 0)))) - (|sayKeyedMsg| 's2iz0049r (list x |$interpreterFrameName|)) - (|clearClams|)))))) - -\end{chunk} +\section{\enspace{}set debug dalymode} +The \verb|$dalymode| variable is used in a case statement in +intloopReadConsole. This variable can be set to any non-nil +value. When not nil the interpreter will send any line that begins +with an ``('' to be sent to the underlying lisp. This is useful +for debugging Axiom. The normal value of this variable is NIL. -\defunsec{setExposeAddConstr}{The top level set expose add constructor handler} -\calls{setExposeAddConstr}{unabbrev} -\calls{setExposeAddConstr}{qcar} -\calls{setExposeAddConstr}{getdatabase} -\calls{setExposeAddConstr}{sayKeyedMsg} -\calls{setExposeAddConstr}{member} -\calls{setExposeAddConstr}{setelt} -\calls{setExposeAddConstr}{delete} -\calls{setExposeAddConstr}{msort} -\calls{setExposeAddConstr}{clearClams} -\calls{setExposeAddConstr}{centerAndHighlight} -\calls{setExposeAddConstr}{specialChar} -\calls{setExposeAddConstr}{displayExposedConstructors} -\usesdollar{setExposeAddConstr}{linelength} -\usesdollar{setExposeAddConstr}{localExposureData} -\usesdollar{setExposeAddConstr}{interpreterFrameName} -\begin{chunk}{defun setExposeAddConstr} -(defun |setExposeAddConstr| (arg) - "The top level set expose add constructor handler" - (declare (special $linelength |$localExposureData| |$interpreterFrameName|)) - (if (null arg) - (progn - (|centerAndHighlight| - '|The constructor Option| $linelength (|specialChar| '|hbar|)) - (|displayExposedConstructors|)) - (dolist (x arg) - (setq x (|unabbrev| x)) - (when (consp x) (setq x (qcar x))) - (cond - ((null (getdatabase x 'constructorkind)) - (|sayKeyedMsg| 's2iz0049j (list x))) - ((|member| x (elt |$localExposureData| 1)) - (|sayKeyedMsg| 's2iz0049k (list x |$interpreterFrameName| ))) - (t - (when (|member| x (elt |$localExposureData| 2)) - (setelt |$localExposureData| 2 - (|delete| x (elt |$localExposureData| 2)))) - (setelt |$localExposureData| 1 - (msort (cons x (elt |$localExposureData| 1)))) - (|clearClams|) - (|sayKeyedMsg| 's2iz0049p (list x |$interpreterFrameName| ))))))) +This variable was created as an alternative to prefixing every lisp +command with )lisp. When doing a lot of debugging this is tedious +and error prone. This variable was created to shortcut that process. +Clearly it breaks some semantics of the language accepted by the +interpreter as parens are used for grouping expressions. -\end{chunk} +\begin{verbatim} +---------------------- The dalymode Option ---------------------- -\defunsec{setExposeDrop}{The top level set expose drop handler} -\calls{setExposeDrop}{centerAndHighlight} -\calls{setExposeDrop}{specialChar} -\calls{setExposeDrop}{displayHiddenConstructors} -\calls{setExposeDrop}{sayMSG} -\calls{setExposeDrop}{sayKeyedMsg} -\calls{setExposeDrop}{qcar} -\calls{setExposeDrop}{qcdr} -\calls{setExposeDrop}{selectOptionLC} -\calls{setExposeDrop}{setExposeDropGroup} -\calls{setExposeDrop}{setExposeDropConstr} -\calls{setExposeDrop}{setExposeDrop} -\usesdollar{setExposeDrop}{linelength} -\begin{chunk}{defun setExposeDrop} -(defun |setExposeDrop| (arg) - "The top level set expose drop handler" - (declare (special $linelength)) - (let (fnargs fn) - (cond - ((null arg) - (|centerAndHighlight| - '|The drop Option| $linelength (|specialChar| '|hbar|)) - (|displayHiddenConstructors|) - (|sayMSG| " ") - (|sayKeyedMsg| 's2iz0049f nil)) - ((and (consp arg) - (progn (setq fn (qcar arg)) (setq fnargs (qcdr arg)) t) - (setq fn (|selectOptionLC| fn '(|group| |constructor|) nil))) - (cond - ((eq fn '|group|) (|setExposeDropGroup| fnargs)) - ((eq fn '|constructor|) (|setExposeDropConstr| fnargs)) - (t nil))) - (t (|setExposeDrop| nil))))) + Description: Interpret leading open paren as lisp -\end{chunk} +\end{verbatim} -\defunsec{setExposeDropGroup}{The top level set expose drop group handler} -\calls{setExposeDropGroup}{qcar} -\calls{setExposeDropGroup}{setelt} -\calls{setExposeDropGroup}{displayExposedGroups} -\calls{setExposeDropGroup}{sayMSG} -\calls{setExposeDropGroup}{displayExposedConstructors} -\calls{setExposeDropGroup}{displayHiddenConstructors} -\calls{setExposeDropGroup}{clearClams} -\calls{setExposeDropGroup}{member} -\calls{setExposeDropGroup}{delete} -\calls{setExposeDropGroup}{sayKeyedMsg} -\calls{setExposeDropGroup}{getalist} -\calls{setExposeDropGroup}{centerAndHighlight} -\calls{setExposeDropGroup}{specialChar} -\usesdollar{setExposeDropGroup}{linelength} -\usesdollar{setExposeDropGroup}{localExposureData} -\usesdollar{setExposeDropGroup}{interpreterFrameName} -\usesdollar{setExposeDropGroup}{globalExposureGroupAlist} -\begin{chunk}{defun setExposeDropGroup} -(defun |setExposeDropGroup| (arg) - "The top level set expose drop group handler" - (declare (special $linelength |$localExposureData| |$interpreterFrameName| - |$globalExposureGroupAlist|)) - (if (null arg) - (progn - (|centerAndHighlight| - '|The group Option| $linelength (|specialChar| '|hbar|)) - (|sayKeyedMsg| 's2iz0049l nil) - (|sayMSG| " ") - (|displayExposedGroups|)) - (dolist (x arg) - (when (consp x) (setq x (qcar x))) - (cond - ((eq x '|all|) - (setelt |$localExposureData| 0 nil) - (setelt |$localExposureData| 1 nil) - (setelt |$localExposureData| 2 nil) - (|displayExposedGroups|) - (|sayMSG| " ") - (|displayExposedConstructors|) - (|sayMSG| " ") - (|displayHiddenConstructors|) - (|clearClams|)) - ((|member| x (elt |$localExposureData| 0)) - (setelt |$localExposureData| 0 - (|delete| x (elt |$localExposureData| 0))) - (|clearClams|) - (|sayKeyedMsg| 's2iz0049s (list x |$interpreterFrameName| ))) - ((getalist |$globalExposureGroupAlist| x) - (|sayKeyedMsg| 's2iz0049i (list x |$interpreterFrameName| ))) - (t (|sayKeyedMsg| 's2iz0049h (list x ))))))) +\defvar{dalymode} +\begin{chunk}{initvars} +(defvar $dalymode nil "Interpret leading open paren as lisp") \end{chunk} -\defunsec{setExposeDropConstr} -{The top level set expose drop constructor handler} -\calls{setExposeDropConstr}{unabbrev} -\calls{setExposeDropConstr}{qcar} -\calls{setExposeDropConstr}{getdatabase} -\calls{setExposeDropConstr}{sayKeyedMsg} -\calls{setExposeDropConstr}{member} -\calls{setExposeDropConstr}{setelt} -\calls{setExposeDropConstr}{delete} -\calls{setExposeDropConstr}{msort} -\calls{setExposeDropConstr}{clearClams} -\calls{setExposeDropConstr}{centerAndHighlight} -\calls{setExposeDropConstr}{specialChar} -\calls{setExposeDropConstr}{sayMSG} -\calls{setExposeDropConstr}{displayExposedConstructors} -\calls{setExposeDropConstr}{displayHiddenConstructors} -\usesdollar{setExposeDropConstr}{linelength} -\usesdollar{setExposeDropConstr}{localExposureData} -\usesdollar{setExposeDropConstr}{interpreterFrameName} -\begin{chunk}{defun setExposeDropConstr} -(defun |setExposeDropConstr| (arg) - "The top level set expose drop constructor handler" - (declare (special $linelength |$localExposureData| |$interpreterFrameName|)) - (if (null arg) - (progn - (|centerAndHighlight| - '|The constructor Option| $linelength (|specialChar| '|hbar|)) - (|sayKeyedMsg| 's2iz0049n nil) - (|sayMSG| " ") - (|displayExposedConstructors|) - (|sayMSG| " ") - (|displayHiddenConstructors|)) - (dolist (x arg) - (setq x (|unabbrev| x)) - (when (consp x) (setq x (qcar x))) - (cond - ((null (getdatabase x 'constructorkind)) - (|sayKeyedMsg| 's2iz0049j (list x))) - ((|member| x (elt |$localExposureData| 2)) - (|sayKeyedMsg| 's2iz0049o (list x |$interpreterFrameName|))) - (t - (when (|member| x (elt |$localExposureData| 1)) - (setelt |$localExposureData| 1 - (|delete| x (elt |$localExposureData| 1)))) - (setelt |$localExposureData| 2 - (msort (cons x (elt |$localExposureData| 2)))) - (|clearClams|) - (|sayKeyedMsg| 's2iz0049q (list x |$interpreterFrameName|))))))) +\begin{chunk}{debugdalymode} + (|dalymode| + "Interpret leading open paren as lisp" + |interpreter| + LITERALS + $dalymode + (|on| |off|) + |off|) \end{chunk} -\defunsec{displayExposedGroups}{Display exposed groups} -\calls{displayExposedGroups}{sayKeyedMsg} -\calls{displayExposedGroups}{centerAndHighlight} -\usesdollar{displayExposedGroups}{interpreterFrameName} -\usesdollar{displayExposedGroups}{localExposureData} -\begin{chunk}{defun displayExposedGroups} -(defun |displayExposedGroups| () - "Display exposed groups" - (declare (special |$interpreterFrameName| |$localExposureData|)) - (|sayKeyedMsg| 's2iz0049a (list |$interpreterFrameName|)) - (if (null (elt |$localExposureData| 0)) - (|centerAndHighlight| "there are no exposed groups") - (dolist (c (elt |$localExposureData| 0)) - (|centerAndHighlight| c)))) +\section{\enspace{}set expose} +\begin{verbatim} +---------------------- The expose Option ---------------------- -\end{chunk} + Description: control interpreter constructor exposure -\defunsec{displayExposedConstructors}{Display exposed constructors} -\calls{displayExposedConstructors}{sayKeyedMsg} -\calls{displayExposedConstructors}{centerAndHighlight} -\usesdollar{displayExposedConstructors}{localExposureData} -\begin{chunk}{defun displayExposedConstructors} -(defun |displayExposedConstructors| () - "Display exposed constructors" - (declare (special |$localExposureData|)) - (|sayKeyedMsg| 's2iz0049b nil) - (if (null (elt |$localExposureData| 1)) - (|centerAndHighlight| "there are no explicitly exposed constructors") - (dolist (c (elt |$localExposureData| 1)) - (|centerAndHighlight| c)))) + The following groups are explicitly exposed in the current + frame (called initial ): + basic + categories + naglink + anna + + The following constructors are explicitly exposed in the + current frame: + there are no explicitly exposed constructors + + The following constructors are explicitly hidden in the + current frame: + there are no explicitly hidden constructors + + When )set expose is followed by no arguments, the information + you now see is displayed. When followed by the initialize + argument, the exposure group data in the file interp.exposed + is read and is then available. The arguments add and drop are + used to add or drop exposure groups or explicit constructors + from the local frame exposure data. Issue + )set expose add or )set expose drop + for more information. +\end{verbatim} +\begin{chunk}{expose} + (|expose| + "control interpreter constructor exposure" + |interpreter| + FUNCTION + |setExpose| + NIL + |htSetExpose|) \end{chunk} -\defunsec{displayHiddenConstructors}{Display hidden constructors} -\calls{displayHiddenConstructors}{sayKeyedMsg} -\calls{displayHiddenConstructors}{centerAndHighlight} -\usesdollar{displayHiddenConstructors}{localExposureData} -\begin{chunk}{defun displayHiddenConstructors} -(defun |displayHiddenConstructors| () - "Display hidden constructors" - (declare (special |$localExposureData|)) - (|sayKeyedMsg| 's2iz0049c nil) - (if (null (elt |$localExposureData| 2)) - (|centerAndHighlight| "there are no explicitly hidden constructors") - (dolist (c (elt |$localExposureData| 2)) - (|centerAndHighlight| c)))) - -\end{chunk} \subsection{functions} \begin{verbatim} Current Values of functions Variables @@ -33318,6 +33458,7 @@ naglink show NAGLink messages on \end{chunk} \subsection{set message frame} +\label{setmessageframe} \begin{verbatim} ---------------------- The frame Option ----------------------- @@ -59754,6 +59895,7 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun Delay 0} \getchunk{defun desiredMsg 0} \getchunk{defun DirToString 0} +\getchunk{defun displayFrameNames 0} \getchunk{defun divide2 0} \getchunk{defun dqAppend 0} \getchunk{defun dqToList 0} @@ -59769,6 +59911,7 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun fnameName 0} \getchunk{defun fnameReadable? 0} \getchunk{defun fnameType 0} +\getchunk{defun frameNames 0} \getchunk{defun From 0} \getchunk{defun FromTo 0} @@ -60254,7 +60397,6 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun displayCondition} \getchunk{defun displayExposedConstructors} \getchunk{defun displayExposedGroups} -\getchunk{defun displayFrameNames} \getchunk{defun displayHiddenConstructors} \getchunk{defun displayMacro} \getchunk{defun displayMacros} @@ -61721,67 +61863,6 @@ If no changes are found for former, no special entry is given. This is part of the undo mechanism. -\subsection{\$HiFiAccess} -The \verb|$HiFiAccess| is set by initHist to T. It is a flag -used by the history mechanism to record whether the history function -is currently on. It can be reset by using the axiom -command -\begin{verbatim} - )history off -\end{verbatim} -It appears that the name means ``History File Access''. - -The \verb|$HiFiAccess| variable is used by historySpad2Cmd to check -whether history is turned on. T means it is, NIL means it is not. - -\subsection{\$HistList} -Thie \verb|$HistList| variable is set by initHistList to an initial -value of NIL elements. The last element of the list is smashed to -point to the first element to make the list circular. -This is a circular list of length \verb|$HistListLen|. - -\subsection{\$HistListAct} -The \verb|$HistListAct| variable is set by initHistList to 0. -This variable holds the actual number of elements in the history list. -This is the number of ``undoable'' steps. - -\subsection{\$HistListLen} -The \verb|$HistListLen| variable is set by initHistList to 20. -This is the length of a circular list maintained in the variable -\verb|$HistList|. - -\subsection{\$HistRecord} -The \verb|$HistRecord| variable is set by initHistList to NIL. -\verb|$HistRecord| collects the input line, all variable bindings -and the output of a step, before it is written to the file named by -the function histFileName. - -\subsection{\$historyFileType} -The \verb|$historyFileType| is set at load time by a call to -initvars to a value of ``axh''. It appears that this -is intended to be used as a filetype extension. -It is part of the history mechanism. It is used in makeHistFileName -as part of the history file name. - -\subsection{\$internalHistoryTable} -The \verb|$internalHistoryTable| variable is set at load time by a call to -initvars to a value of NIL. -It is part of the history mechanism. - -\subsection{\$interpreterFrameName} -The \verb|$interpreterFrameName| variable, set in -initializeInterpreterFrameRing to the constant -initial to indicate that this is the initial (default) frame. - -Frames are structures that capture all of the variables defined in a -session. There can be multiple frames and the user can freely switch -between them. Frames are kept in a ring data structure so you can -move around the ring. - -\subsection{\$interpreterFrameRing} -The \verb|$interpreterFrameRing| is set to a pair whose car is set to -the result of emptyInterpreterFrame - \subsection{\$intRestart} The \verb|$intRestart| variable is used in intloop but has no value. This is probably a bug. While the variable's value is unchanged the diff --git a/changelog b/changelog index b50f8dc..ebf1294 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20150105 tpd src/axiom-website/patches.html 20150105.01.tpd.patch +20150105 tpd books/bookvol5 literate programming changes +20150105 tpd books/axiom.sty add \Defun for better TOC 20150104 tpd src/axiom-website/patches.html 20150104.01.tpd.patch 20150104 tpd book/timeline correct Ralf Stephan participation 20150103 tpd src/axiom-website/patches.html 20150103.01.tpd.patch diff --git a/patch b/patch index dc27d70..6571ee1 100644 --- a/patch +++ b/patch @@ -1,7 +1,3 @@ -book/timeline correct Ralf Stephan participation - -February 2007 247 13655 -25 Ralf Stephan (2007-03) - - +books/bookvol5 literate programming changes +Rearrange code and begin explanation of the frame mechanism diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index cc7171f..a35d871 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -4892,6 +4892,8 @@ books/bookvol5 merge, rewrite and remove some browser functions
books/bookvol5 merge, rewrite and remove some browser functions
20150104.01.tpd.patch book/timeline correct Ralf Stephan participation
+20150105.01.tpd.patch +books/bookvol5 literate programming changes