diff --git a/changelog b/changelog index ac8b7b8..5069ea7 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,11 @@ +20090212 tpd src/axiom-website/patches.html 20090212.01.tpd.patch +20090212 tpd src/interp/interp-proclaims.lisp update proclaims for changes +20090212 tpd src/interp/sockio.lisp remove unused code +20090212 tpd src/interp/database.boot remove unused code +20090212 tpd src/interp/bootlex.lisp remove unused code +20090212 tpd src/interp/bookvol5 removed +20090211 tpd src/axiom-website/patches.html 20090211.01.tpd.patch +20090211 tpd books/bookvol10.4.pamphlet add exports 20090210 tpd src/axiom-website/patches.html 20090210.01.tpd.patch 20090210 tpd books/bookvol10.4.pamphlet add exports 20090209 tpd src/axiom-website/patches.html 20090209.02.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 7ffc958..2fbdca2 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -939,5 +939,9 @@ bookvol10.4 add packages
bookvol10.4 add packages
20090210.01.tpd.patch bookvol10.4 add exports
+20090211.01.tpd.patch +bookvol10.4 add exports
+20090212.01.tpd.patch +remove unused code
diff --git a/src/interp/bookvol5.pamphlet b/src/interp/bookvol5.pamphlet deleted file mode 100644 index f8fb4a2..0000000 --- a/src/interp/bookvol5.pamphlet +++ /dev/null @@ -1,6360 +0,0 @@ -\documentclass{book} -\usepackage{axiom} -\usepackage{graphicx} -% struggle with latex figure-floating behavior -\renewcommand\floatpagefraction{.9} -\renewcommand\topfraction{.9} -\renewcommand\bottomfraction{.9} -\renewcommand\textfraction{.1} -\setcounter{totalnumber}{50} -\setcounter{topnumber}{50} -\setcounter{bottomnumber}{50} - -\begin{document} -\begin{titlepage} -\center{\includegraphics{ps/axiomfront.ps}} -\vskip 0.1in -\includegraphics{ps/bluebayou.ps}\\ -\vskip 0.1in -{\Huge{The 30 Year Horizon}} -\vskip 0.1in -$$ -\begin{array}{lll} -Manuel\ Bronstein & William\ Burge & Timothy\ Daly \\ -James\ Davenport & Michael\ Dewar & Martin\ Dunstan \\ -Albrecht\ Fortenbacher & Patrizia\ Gianni & Johannes\ Grabmeier \\ -Jocelyn\ Guidry & Richard\ Jenks & Larry\ Lambe \\ -Michael\ Monagan & Scott\ Morrison & William\ Sit \\ -Jonathan\ Steinbach & Robert\ Sutor & Barry\ Trager \\ -Stephen\ Watt & Jim\ Wen & Clifton\ Williamson -\end{array} -$$ -\center{\large{VOLUME 5: THE AXIOM INTERPRETER}} -\end{titlepage} -\pagenumbering{roman} -\begin{verbatim} -The Blue Bayou image Copyright (c) 2004 Jocelyn Guidry - -Portions Copyright (c) 2004 Martin Dunstan - -Portions Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -All rights reserved. - -This book and the Axiom software is licensed as follows: - -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. - -\end{verbatim} -\tableofcontents -\vfill -\eject -\setlength{\parindent}{0em} -\setlength{\parskip}{1ex} -{\Large{\bf New Foreword}} -\vskip .25in - -On October 1, 2001 Axiom was withdrawn from the market and ended -life as a commercial product. -On September 3, 2002 Axiom was released under the Modified BSD -license, including this document. -On August 27, 2003 Axiom was released as free and open source -software available for download from the Free Software Foundation's -website, Savannah. - -Work on Axiom has had the generous support of the Center for -Algorithms and Interactive Scientific Computation (CAISS) at -City College of New York. Special thanks go to Dr. Gilbert -Baumslag for his support of the long term goal. - -The online version of this documentation is roughly 1000 pages. -In order to make printed versions we've broken it up into three -volumes. The first volume is tutorial in nature. The second volume -is for programmers. The third volume is reference material. We've -also added a fourth volume for developers. All of these changes -represent an experiment in print-on-demand delivery of documentation. -Time will tell whether the experiment succeeded. - -Axiom has been in existence for over thirty years. It is estimated to -contain about three hundred man-years of research and has, as of -September 3, 2003, 143 people listed in the credits. All of these -people have contributed directly or indirectly to making Axiom -available. Axiom is being passed to the next generation. I'm looking -forward to future milestones. - -With that in mind I've introduced the theme of the ``30 year horizon''. -We must invent the tools that support the Computational Mathematician -working 30 years from now. How will research be done when every bit of -mathematical knowledge is online and instantly available? What happens -when we scale Axiom by a factor of 100, giving us 1.1 million domains? -How can we integrate theory with code? How will we integrate theorems -and proofs of the mathematics with space-time complexity proofs and -running code? What visualization tools are needed? How do we support -the conceptual structures and semantics of mathematics in effective -ways? How do we support results from the sciences? How do we teach -the next generation to be effective Computational Mathematicians? - -The ``30 year horizon'' is much nearer than it appears. - -\vskip .25in -%\noindent -Tim Daly\\ -CAISS, City College of New York\\ -November 10, 2003 ((iHy)) -\vfill -\eject -\pagenumbering{arabic} -\setcounter{chapter}{0} % Chapter 1 -\chapter{The Interpreter} -\section{Star Global Variables} -\begin{tabular}{lll} -NAME & SET & USE \\ -*default-pathname-defaults* & reroot & restart \\ -*eof* & ncTopLevel & \\ -*features* & & restart \\ -*package* & & restart \\ -*standard-input* & & ncIntLoop \\ -*standard-output* & & ncIntLoop \\ -*top-level-hook* & set-restart-hook & \\ -\end{tabular} -\subsection{*default-pathname-defaults*} -The [[*default-pathname-defaults*]] variable is set by -[[make-absolute-filename]] called on the empty string. This has -the effect of setting the value to the [[AXIOM]] variable as this -function just concatenates the [[AXIOM]] variable onto the given string. -We pass this string to the common lisp [[pathname]] function to set it -to a real pathname. - -The [[*default-pathname-defaults*]] defaults common lisp variable is -set in [[restart]] to the current directory in most cases. If we are -working in Lucid Common Lisp ([[:lucid]]) on an IBM/370 mainframe -([[:ibm/370]]) then it is set to the empty string. Using Lucid on a -mainframe seems to use the variable [[vmlisp::$current-directory]]. - -\subsection{*eof*} -The [[*eof*]] variable is set to [[NIL]] in [[ncTopLevel]]. -\subsection{*features*} -The [[*features*]] variable from common lisp is tested for the presence -of the [[:unix]] keyword. Apparently this controls the use of Saturn, -a previous Axiom frontend. The Saturn frontend was never released as -open source and so this test and the associated variables are probably -not used. - -\subsection{*package*} -The [[*package*]] variable, from common lisp, is set in [[restart]] -to the [[BOOT]] package where the intepreter lives. -\subsection{*standard-input*} -The [[*standard-input*]] common lisp variable is used to set the -[[curinstream]] variable in [[ncIntLoop]]. - -This variable is an argument to [[serverReadLine]] in -the [[intloopReadConsole]] function. - -\subsection{*standard-output*} -The [[*standard-output*]] common lisp variable is used to set the -[[curoutstream]] variable in [[ncIntLoop]]. - -\subsection{*top-level-hook*} -The [[*top-level-hook*]] common lisp variable contains the name of -a function to invoke when an image is started. In our case it is -called [[restart]]. This is the entry point to the Axiom interpreter. - -\section{Dollar Global Variables} -\begin{tabular}{lll} -NAME & SET & USE \\ -\$boot & ncTopLevel & \\ -coerceFailure & & runspad \\ -curinstream & ncIntLoop & \\ -curoutstream & ncIntLoop & \\ -vmlisp::\$current-directory & restart & \\ - & reroot & \\ -\$currentLine & restart & removeUndoLines \\ -\$dalymode & & intloopReadConsole \\ -\$defaultMsgDatabaseName & reroot & \\ -\$directory-list & reroot & \\ -\$displayStartMsgs & & restart \\ -\$e & ncTopLevel & \\ -\$erMsgToss & SpadInterpretStream & \\ -\$fn & SpadInterpretStream & \\ -\$frameRecord & initvars & \\ - & clearFrame & \\ - & undoSteps & undoSteps \\ - & recordFrame & recordFrame \\ -\$HiFiAccess & initHist & historySpad2Cmd \\ - & historySpad2Cmd & \\ - & & setHistoryCore \\ -\$HistList & initHist & \\ -\$HistListAct & initHist & \\ -\$HistListLen & initHistList & \\ -\$HistRecord & initHistList & \\ -\$historyDirectory & & makeHistFileName \\ - & & makeHistFileName \\ -\$historyFileType & initvars & histInputFileName \\ -\$inclAssertions & SpadInterpretStream & \\ -\$inLispVM & spad & \\ -\$InteractiveFrame & restart & ncTopLevel \\ - & undo & recordFrame \\ - & undoSteps & undoSteps \\ - & & reportUndo \\ -\$InteractiveMode & ncTopLevel & \\ -\$internalHistoryTable & initvars & \\ -\$interpreterFrameName & initializeInterpreterFrameRing & \\ -\$interpreterFrameRing & initializeInterpreterFrameRing & \\ -\$InitialModemapFrame & & makeInitialModemapFrame \\ -\$intRestart & & intloop \\ -\$intTopLevel & intloop & \\ -\$IOindex & restart & historySpad2Cmd \\ - & removeUndoLines & undoCount \\ -\$genValue & bookvol5 & i-toplev \\ - & & i-analy \\ - & & i-syscmd \\ - & & i-spec1 \\ - & & i-spec2 \\ - & & i-map \\ -\$lastPos & SpadInterpretStream & \\ -\$libQuiet & SpadInterpretStream & \\ -\$library-directory-list & reroot & \\ -\$msgDatabaseName & reroot * \\ -\$ncMsgList & SpadInterpretStream & \\ -\$newcompErrorCount & SpadInterpretStream & \\ -\$newcompMode & SpadInterpretStream & \\ -\$newspad & ncTopLevel & \\ -\$nopos & & SpadInterpretStream \\ -\$okToExecuteMachineCode & SpadInterpretStream & \\ -\$oldHistoryFileName & initvars & oldHistFileName \\ -\$openServerIfTrue & restart & restart \\ - & spad-save & \\ - & initvars & \\ -\$options & & history \\ - & historySpad2Cmd & historySpad2Cmd \\ - & & undo \\ -\$previousBindings & initvars & \\ - & clearFrame & \\ - & recordFrame & recordFrame \\ -\$printLoadMsgs & restart & \\ -\$PrintCompilerMessageIfTrue & spad & \\ -\$promptMsg & SpadInterpretStream & \\ -\$relative-directory-list & & reroot \\ -\$relative-library-directory-list & & reroot \\ -\$reportUndo & initvars & diffAlist \\ -\$shoeReadLineFunction & SpadInterpretStream & \\ -\$spad & ncTopLevel & \\ -\$spadroot & reroot & initroot \\ - & & make-absolute-filename \\ - & & reroot \\ -\$SpadServer & restart & \\ -\$SpadServerName & initvars & restart \\ -\$systemCommandFunction & SpadInterpretStream & \\ -top\_level & & runspad \\ -\$quitTag & & runspad \\ -\$useInternalHistoryTable & initvars & initHist \\ - & setHistoryCore & setHistoryCore \\ -\$undoFlag & initvars & recordFrame \\ -\end{tabular} - -\subsection{\$boot} -The [[$boot]] variable is set to [[NIL]] in [[ncTopLevel]]. - -\subsection{coerceFailure} -The [[coerceFailure]] symbol is a catch tag used in [[runspad]] -to catch an exit from [[ncTopLevel]]. - -\subsection{curinstream} -The [[curinstream]] variable is set to the value of the -[[*standard-input*]] common lisp -variable in [[ncIntLoop]]. While not using the -``dollar'' convention this variable is still ``global''. - -\subsection{curinstream} -The [[curoutstream]] variable is set to the value of the -[[*standard-output*]] common lisp variable in [[ncIntLoop]]. -While not using the ``dollar'' convention this variable is still ``global''. - -\subsection{vmlisp::\$current-directory} -When running in Lucid Common Lisp ([[:lucid]]) on an IBM/370 mainframe -([[:ibm/370]]) this variable is used in place of the -[[*default-pathname-defaults*]] common lisp variable. -Otherwise this variable is -set to the empty string in [[restart]]. - -The [[reroot]] function sets this variable to the value of -[[$spadroot]] which itself has the value of the argument to the -[[reroot]] function. Since the argument to the [[reroot]] function is -an string which represents an absolute pathname pointing to AXIOM the -net result is that the [[$current-directory]] is set to point to the -shell [[AXIOM]] variable. - -So during execute both [[$current-directory]] and [[$spadroot]] reflect -the value of the [[AXIOM]] shell variable. - -\subsection{\$currentLine} -The [[$currentLine]] line is set to [[NIL]] in [[restart]]. -It is used in [[removeUndoLines]] in the undo mechanism. - -\subsection{\$dalymode} -The [[$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. - -\subsection{\$defaultMsgDatabaseName} -The [[$defaultMsgDatabaseName]] is the absolute path to the -[[s2-us.msgs]] file which contains all of the english language -messages output by the system. - -\subsection{\$directory-list} -The [[$directory-list]] is a list of absolute directory names. -These names are made absolute by mapping the [[make-absolute-filename]] -over the variable [[$relative-directory-list]]. - -\subsection{\$displayStartMsgs} -The [[$displayStartMsgs]] variable is used in [[restart]] but is not -set so this is likely a bug. - -\subsection{\$e} -The [[$e]] variable is set to the value of -[[$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 [[$InitialModemapFrame]]. - -Thus [[$e]] is a copy of the variable [[$InitialModemapFrame]]. - -This variable is used in the undo mechanism. - -\subsection{\$erMsgToss} -The [[$erMsgToss]] variable is set to [[NIL]] in [[SpadInterpretStream]]. - -\subsection{\$fn} -The [[$fn]] variable is set in [[SpadInterpretStream]]. It is set to -the second argument which is a list. It appears that this list has the -same structure as an argument to the LispVM [[rdefiostream]] function. - -\subsection{\$frameRecord} -[[$frameRecord = [delta1, delta2,... ] ]] where -[[delta(i)]] contains changes in the ``backwards'' direction. -Each [[delta(i)]] has the form [[((var . proplist)...)]] where -proplist denotes an ordinary proplist. For example, an entry -of the form [[((x (value) (mode (Integer)))...)]] indicates that -to undo 1 step, [[x]]'s value is cleared and its mode should be set -to [[(Integer)]]. - -A [[delta(i)]] of the form [[(systemCommand . delta)]] is a special -delta indicating changes due to system commands executed between -the last command and the current command. By recording these deltas -separately, it is possible to undo to either BEFORE or AFTER -the command. These special [[delta(i)]]s are given ONLY when a -a system command is given which alters the environment. - -Note: [[recordFrame('system)]] is called before a command is executed, and -[[recordFrame('normal)]] is called after (see processInteractive1). -If no changes are found for former, no special entry is given. - -This is part of the undo mechanism. - -\subsection{\$genValue} -If the [[$genValue]] variable is true then evaluate generated code, -otherwise leave code unevaluated. If [[$genValue]] is false then we -are compiling. This variable is only defined and used locally. -<>= -(defvar |$genValue| nil "evaluate generated code if true") - -@ - -\subsection{\$HiFiAccess} -The [[$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 [[$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 [[$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 [[$HistListLen]]. - -\subsection{\$HistListAct} -The [[$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 [[$HistListLen]] variable is set by [[initHistList]] to [[20]]. -This is the length of a circular list maintained in the variable -[[$HistList]]. - -\subsection{\$HistRecord} -The [[$HistRecord]] variable is set by [[initHistList]] to [[NIL]]. -[[$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 [[$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{\$inclAssertions} -The [[$inclAssertions]] is set -in the function [[SpadInterpretStream]] to the list [[(aix |CommonLisp|)]] - -\subsection{\$internalHistoryTable} -The [[$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 [[$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 [[$interpreterFrameRing]] is set to a pair whose car is set to -the result of [[emptyInterpreterFrame]] - -\subsection{\$InitialModemapFrame} -This variable is copied and returned by the function -[[makeInitialModemapFrame]]. There is no initial value so this -is probably a bug. - -\subsection{\$inLispVM} -The [[$inLispVM]] is set to [[NIL]] in [[spad]]. LispVM is a -non-common lisp that runs on IBM/370 mainframes. This is probably dead -code. It appears that this list has the same structure as an argument -to the LispVM [[rdefiostream]] function. - -\subsection{\$InteractiveFrame} -The [[$InteractiveFrame]] is set in [[restart]] to the value of the -call to the [[makeInitialModemapFrame]] function. This function simply -returns a copy of the variable [[$InitialModemapFrame]] - -\subsection{\$InteractiveMode} -The [[$InteractiveMode]] is set to [[T]] in [[ncTopLevel]]. - -\subsection{\$intRestart} -The [[$intRestart]] variable is used in [[intloop]] but has no value. -This is probably a bug. While the variable's value is unchanged the -system will continually reenter the [[SpadInterpretStream]] function. - -\subsection{\$intTopLevel} -The [[$intTopLevel]] is a catch tag. Throwing to this tags which is -caught in the [[intloop]] will -restart the [[SpadInterpretStream]] function. - -\subsection{\$IOindex} -The [[$IOindex]] index variable is set to [[1]] in [[restart]]. -This variable is used in the [[historySpad2Cmd]] function in the -history mechanism. It is set in the [[removeUndoLines]] function -in the undo mechanism. - -This is used in the undo mechanism in function [[undoCount]] -to compute the number of undos. You can't undo more actions then -have already happened. - -\subsection{\$lastPos} -The [[$lastPos]] variable is set in [[SpadInterpretStream]] -to the value of the [[$nopos]] variable. -Since [[$nopos]] appears to have no value -this is likely a bug. - -\subsection{\$libQuiet} -The [[$libQuiet]] variable is set to the third argument of the -[[SpadInterpretStream]] function. This is passed from [[intloop]] -with the value of [[T]]. This variable appears to be intended to -control the printing of library loading messages which would need -to be suppressed if input was coming from a file. - -\subsection{\$library-directory-list} -The [[$library-directory-list]] variable is set by [[reroot]] by -mapping the function [[make-absolute-filename]] across the -[[$relative-library-directory-list]] variable which is not yet set so this -is probably a bug. - -\subsection{\$msgDatabaseName} -The [[$msgDatabaseName]] is set to [[NIL]] in [[reroot]]. - -\subsection{\$ncMsgList} -The [[$ncMsgList]] is set to [[NIL]] in [[SpadInterpretStream]]. - -\subsection{\$newcompErrorCount} -The [[$newcompErrorCount]] is set to [[0]] in [[SpadInterpretStream]]. - -\subsection{\$newcompMode} -The [[$newcompMode]] is set to [[NIL]] in [[SpadInterpretStream]]. - -\subsection{\$newspad} -The [[$newspad]] is set to [[T]] in [[ncTopLevel]]. - -\subsection{\$nopos} -The [[$nopos]] variable is used in [[SpadInterpretStream]] but does -not appear to have a value and is likely a bug. - -\subsection{\$oldHistoryFileName} -The [[$oldHistoryFileName]] is set at load time by a call to -[[initvars]] to a value of ``[[last]]''. -It is part of the history mechanism. It is used in the function -[[oldHistFileName]] and [[restoreHistory]]. - -\subsection{\$okToExecuteMachineCode} -The [[$okToExecuteMachineCode]] is set to [[T]] in [[SpadInterpretStream]]. - -\subsection{\$options} -The [[$options]] variable is tested by the [[history]] function. -If it is [[NIL]] then output the message -\begin{verbatim} - You have not used the correct syntax for the history command. - Issue )help history for more information. -\end{verbatim} - -The [[$options]] variable is tested in the [[historySpad2Cmd]] function. -It appears to record the options that were given to a spad command on -the input line. The function [[selectOptionLC]] appears to take a list -off options to scan. - -This variable is not yet set and is probably a bug. - -\subsection{\$previousBindings} -The [[$previousBindings]] is a copy of the -[[CAAR $InteractiveFrame]]. This is used to -compute the [[delta(i)]]s stored in [[$frameRecord]]. -This is part of the undo mechanism. - -\subsection{\$printLoadMsgs} -The [[$printLoadMsgs]] variable is set to [[T]] in [[restart]]. - -\subsection{\$PrintCompilerMessageIfTrue} -The [[$PrintCompilerMessageIfTrue]] variable is set to [[NIL]] in [[spad]]. - -\subsection{\$openServerIfTrue} -The [[$openServerIfTrue]] is tested in [[restart]] before it has been -set (and is thus a bug). 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]] - -\subsection{\$promptMsg} -The [[$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. - -\subsection{\$relative-directory-list} -The [[$relative-directory-list]] is used in [[reroot]] to create -[[$directory-list]] which is a list of absolute directory names. -It is not yet set and is probably a bug. - -\subsection{\$relative-library-directory-list} -The [[$relative-library-directory-list]] is used in [[reroot]] to create -a list of absolute directory names from [[$library-directory-list]] (which is -It is not yet set and is probably a bug). - -\subsection{\$reportUndo} -The [[$reportUndo]] variable is used in [[diffAlist]]. It was not normally -bound but has been set to [[T]] in [[initvars]]. If the variable is set -to [[T]] then we call [[reportUndo]]. - -It is part of the undo mechanism. - -\subsection{\$shoeReadLineFunction} -The [[$shoeReadLineFunction]] is set in [[SpadInterpretStream]] -to point to the -[[serverReadLine]] - -\subsection{\$spadroot} -The [[$spadroot]] variable is the internal name for the [[AXIOM]] -shell variable. - -The [[$spadroot]] variable is set in [[reroot]] to the value of the -argument. The argument is expected to be a directory name. - -The [[$spadroot]] variable is tested in [[initroot]]. - -The [[$spadroot]] variable is used by the function -[[make-absolute-filename]]. It concatenates this variable to the -front of a relative pathname to make it absolute. -\subsection{\$spad} -The [[$spad]] variable is set to [[T]] in [[ncTopLevel]]. - -\subsection{\$SpadServer} -If an open server is not requested then this variable to [[T]]. -It has no value before this time (and is thus a bug). - -\subsection{\$SpadServerName} -The [[$SpadServerName]] is passed to the [[openServer]] function, if the -function exists. - -\subsection{\$systemCommandFunction} -The [[$systemCommandFunction]] is set in [[SpadInterpretStream]] -to point to the function -[[InterpExecuteSpadSystemCommand]]. - -\subsection{top\_level} -The [[top\_level]] symbol is a catch tag used in [[runspad]] -to catch an exit from [[ncTopLevel]]. - -\subsection{\$quitTag} -The [[$quitTag]] is used as a variable in a [[catch]] block. -It appears that it can be thrown somewhere below [[ncTopLevel]]. - -\subsection{\$useInternalHistoryTable} -The [[$useInternalHistoryTable]] variable is set at load time by a call to -[[initvars]] to a value of [[NIL]]. It is part of the history mechanism. - -\subsection{\$undoFlag} -The [[$undoFlag]] is used in [[recordFrame]] to decide whether to do -undo recording. It is initially set to [[T]] in [[initvars]]. -This is part of the undo mechanism. - -\chapter{Starting Axiom} -Axiom starts by invoking a function value of the lisp symbol -[[*top-level-hook*]]. The function invocation path to from this -point until the prompt is approximates (skipping initializations): -\begin{verbatim} - lisp -> restart - -> |spad| - -> |runspad| - -> |ncTopLevel| - -> |ncIntLoop| - -> |intloop| - -> |SpadInterpretStream| - -> |intloopReadConsole| -\end{verbatim} -The [[|intloopReadConsole|]] function does tail-recursive calls to -itself (don't break this) and never exits. -\section{Variables Used} -\section{Data Structures} -\section{Functions} -\subsection{defun set-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. -<>= -(defun set-restart-hook () - #+KCL (setq system::*top-level-hook* 'restart) - #+Lucid (setq boot::restart-hook 'restart) - 'restart - ) - -@ -\subsection{defun restart} -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. It sets the -current package to be the ``BOOT'' package which is the standard -package in which the interpreter runs. It calls initroot \cite{1} -to set the \$spadroot variable (usually the \$AXIOM variable). - -The [[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 [[compiler::*suppress-compiler-warnings*]] flag has been set to t. -We do not care that certain generated variables are not used. - -The [[compiler::*suppress-compiler-notes*]] flag has been set to t. -We do not care that tail recursion occurs. -<>= -(defun restart () -#+:akcl - (init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8 - :array 400 :string 500 :cfun 100 :cpages 3000 :rpages 1000 :hole 2000) -#+:akcl (setq compiler::*compile-verbose* nil) -#+:akcl (setq compiler::*suppress-compiler-warnings* t) -#+:akcl (setq compiler::*suppress-compiler-notes* t) -#-:CCL - (in-package "BOOT") -#+:CCL - (setq *package* (find-package "BOOT")) -#+:CCL (setpchar "") ;; Turn off CCL read prompts -#+(OR :akcl :CCL) (initroot) -#+:akcl (system:gbc-time 0) -#+:akcl - (when (and $openServerIfTrue (fboundp '|openServer|)) - (prog (os) - (setq os (|openServer| $SpadServerName)) - (if (zerop os) - (progn - (setq $openServerIfTrue nil) - (setq |$SpadServer| t))))) -;; We do the following test at runtime to allow us to use the same images -;; with Saturn and Sman. MCD 30-11-95 -#+:CCL - (when - (and (memq :unix *features*) $openServerIfTrue (fboundp '|openServer|)) - (prog (os) - (setq os (|openServer| $SpadServerName)) - (if (zerop os) - (progn - (setq $openServerIfTrue nil) - (setq |$SpadServer| t))))) - (setq |$IOindex| 1) - (setq |$InteractiveFrame| (|makeInitialModemapFrame|)) - (setq |$printLoadMsgs| t) -#+(and :lucid :ibm/370) - (setq *default-pathname-defaults* "") -#+:CCL - (setq *default-pathname-defaults* (get-current-directory)) -#-(or :CCL (and :lucid :ibm/370)) - (setq *default-pathname-defaults* (probe-file "./")) -#+(and :lucid :ibm/370) - (setq vmlisp::$current-directory "") -#-(and :lucid :ibm/370) - (setq vmlisp::$current-directory - (make-directory *default-pathname-defaults*)) - (|loadExposureGroupData|) - (|statisticsInitialization|) - (|initHist|) - (|initializeInterpreterFrameRing|) - - (when |$displayStartMsgs| - (|spadStartUpMsgs|)) - (setq |$currentLine| nil) - (restart0) - (|readSpadProfileIfThere|) - (|spad|)) - -@ -\subsection{defun spad} -\begin{verbatim} -spad() == - -- starts the interpreter but does not read in profiles, etc. - $PrintCompilerMessageIfTrue: local - $inLispVM : local := nil - setOutputAlgebra "%initialize%" - runspad() - 'EndOfSpad -\end{verbatim} -<>= -(defun |spad| () - (prog (|$PrintCompilerMessageIfTrue| |$inLispVM|) - (declare (special |$PrintCompilerMessageIfTrue| |$inLispVM|)) - (return - (progn - (spadlet |$PrintCompilerMessageIfTrue| nil) - (spadlet |$inLispVM| nil) - (|setOutputAlgebra| '|%initialize%|) - (|runspad|) - '|EndOfSpad|)))) - -@ -\subsection{defun runspad} -\begin{verbatim} -runspad() == - mode:='restart - while mode='restart repeat - resetStackLimits() - CATCH($quitTag, CATCH('coerceFailure, - mode:=CATCH('top__level, ncTopLevel()))) -\end{verbatim} -<>= -(defun |runspad| () - (prog (mode) - (return - (seq - (progn - (spadlet mode '|restart|) - (do () - ((null (boot-equal mode '|restart|)) NIL) - (seq - (exit - (progn - (|resetStackLimits|) - (catch |$quitTag| - (catch '|coerceFailure| - (spadlet mode (catch '|top_level| (|ncTopLevel|)))))))))))))) - -@ -\subsection{defun ncTopLevel} -\begin{verbatim} -ncTopLevel() == --- Top-level read-parse-eval-print loop for the interpreter. Uses --- the Bill Burge's parser. - IN_-STREAM: fluid := CURINSTREAM - _*EOF_*: fluid := NIL - $InteractiveMode :fluid := true - $BOOT: fluid := NIL - $NEWSPAD: fluid := true - $SPAD: fluid := true - $e:fluid := $InteractiveFrame - ncIntLoop() -\end{verbatim} -<>= -(defun |ncTopLevel| () - (prog (|$e| $spad $newspad $boot |$InteractiveMode| *eof* in-stream) - (declare (special |$e| $spad $newspad $boot |$InteractiveMode| *eof* - in-stream |$InteractiveFrame|)) - (return - (progn - (setq in-stream curinstream) - (setq *eof* nil) - (setq |$InteractiveMode| t) - (setq $boot nil) - (setq $newspad t) - (setq $spad t) - (setq |$e| |$InteractiveFrame|) - (|ncIntLoop|))))) - -@ -\subsection{defun ncIntLoop} -<>= -(defun |ncIntLoop| () - (let ((curinstream *standard-output*) - (curoutstream *standard-input*)) - (declare (special curinstream curoutstream)) - (|intloop|))) - -@ -\subsection{defun 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. -\begin{verbatim} -intloop () == - mode := $intRestart - while mode = $intRestart repeat - resetStackLimits() - mode := CATCH($intTopLevel, - SpadInterpretStream(1, ["TIM", "DALY", "?"], true)) - -\end{verbatim} -<>= -(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))))))))))))) - -@ -\subsection{defun 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 [[(tim daly ?)]]. -\item [[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} -\begin{verbatim} -SpadInterpretStream(str, source, interactive?) == - $fn : local := source - pile? := not interactive? - $libQuiet : local := not interactive? - $newcompMode : local := false --- following seems useless and causes ccl package problems --- $InteractiveMode : local := false - - $newcompErrorCount: local := 0 -- SMW Feb 2/90. - -- Used in highComplete, ncHardError etc. - - $okToExecuteMachineCode: local := true -- set false on error - $inclAssertions: local := ["AIX", "CommonLisp"] -- Jan 28/90 - - - $lastPos : local := $nopos ------------>!!! - $erMsgToss : local := false --------------->!!! - $ncMsgList : local := nil - - $systemCommandFunction : local := function InterpExecuteSpadSystemCommand - $shoeReadLineFunction : local := function serverReadLine - $promptMsg : local := 'S2CTP023 - - interactive? => - PRINC(MKPROMPT()) - intloopReadConsole('"", str) - [] - intloopInclude (source,0) - [] - - ----------------------------------------------------------------- -\end{verbatim} -<>= -(defun |SpadInterpretStream| (str source interactive?) - (prog (|$promptMsg| |$shoeReadLineFunction| |$systemCommandFunction| - |$ncMsgList| |$erMsgToss| |$lastPos| |$inclAssertions| - |$okToExecuteMachineCode| |$newcompErrorCount| |$newcompMode| - |$libQuiet| |$fn|) - (declare (special |$promptMsg| |$shoeReadLineFunction| - |$systemCommandFunction| |$ncMsgList| |$erMsgToss| |$lastPos| - |$inclAssertions| |$okToExecuteMachineCode| |$newcompErrorCount| - |$newcompMode| |$libQuiet| |$fn| |$nopos|)) - (return - (progn - (setq |$fn| source) - (setq |$libQuiet| (null interactive?)) - (setq |$newcompMode| nil) - (setq |$newcompErrorCount| 0) - (setq |$okToExecuteMachineCode| t) - (setq |$inclAssertions| (list 'aix '|CommonLisp|)) - (setq |$lastPos| |$nopos|) - (setq |$erMsgToss| nil) - (setq |$ncMsgList| nil) - (setq |$systemCommandFunction| #'|InterpExecuteSpadSystemCommand|) - (setq |$shoeReadLineFunction| #'|serverReadLine|) - (setq |$promptMsg| 'S2CTP023) - (cond - (interactive? - (progn - (princ (mkprompt)) - (|intloopReadConsole| "" str) - nil)) - (t - (progn - (|intloopInclude| source 0) - nil))))))) - -@ -\section{The Read-Eval-Print Loop} -\subsection{defun 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. -<>= -(defun |intloopReadConsole| (b n) - (declare (special $dalymode)) - (let (c d pfx input) - (setq input (|serverReadLine| *standard-input*)) - (when (null (stringp input)) (|leaveScratchpad|)) - (when (eql (length input) 0) - (princ (mkprompt)) - (|intloopReadConsole| "" n)) - (when (and $dalymode (|intloopPrefix?| "(" input)) - (|intnplisp| input) - (princ (mkprompt)) - (|intloopReadConsole| "" n)) - (setq pfx (|intloopPrefix?| ")fi" input)) - (when (and pfx (or (string= pfx ")fi") (string= pfx ")fin"))) - (throw '|top_level| nil)) - (when (and (equal b "") (setq d (|intloopPrefix?| ")" input))) - (|setCurrentLine| d) - (setq c (|ncloopCommand| d n)) - (princ (mkprompt)) - (|intloopReadConsole| "" c)) - (setq input (concat b input)) - (when (|ncloopEscaped| input) - (|intloopReadConsole| (subseq input 0 (- (length input) 1)) n)) - (setq c (|intloopProcessString| input n)) - (princ (mkprompt)) - (|intloopReadConsole| "" c))) - -@ -\section{Helper Functions} -\subsection{defun getenviron} -<>= -(defun getenviron (shellvar) - #+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) - ) -@ - -\subsection{defun 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. -<>= -(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) - -@ - -\subsection{defun initroot} -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. -<>= -(defun initroot (&optional (newroot (BOOT::|getEnv| "AXIOM"))) - (reroot (or newroot $spadroot (error "setenv AXIOM or (setq $spadroot)")))) - -@ - -\subsection{defun intloopPrefix?} -If the prefix string is the same as the whole string initial characters -(ignoring spaces in the whole string) then we return the whole string -minus any leading spaces. -<>= -(defun |intloopPrefix?| (prefix whole) - (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)))) - -@ -\subsection{defun loadExposureGroupData} -<>= -#+:AKCL -(defun |loadExposureGroupData| () - (cond - ((load "./exposed" :verbose nil :if-does-not-exist nil) - '|done|) - ((load (concat (system:getenv "AXIOM") "/algebra/exposed") - :verbose nil :if-does-not-exist nil) - '|done|) - (t '|failed|) )) - -#+:CCL -(defun |loadExposureGroupData| () - (cond - ((load "./exposed.lsp" :verbose NIL :if-does-not-exist NIL) '|done|) - ((load (concat (BOOT::|getEnv| "AXIOM") "/../../src/algebra/exposed.lsp") - :verbose nil :if-does-not-exist nil) '|done|) - (t nil) )) - -@ - -\subsection{make-absolute-filename} -Prefix a filename with the {\bf AXIOM} shell variable. -<>= -(defun make-absolute-filename (name) - (concatenate 'string $spadroot name)) - -@ - -\subsection{defun makeInitialModemapFrame} -\begin{verbatim} -makeInitialModemapFrame() == COPY $InitialModemapFrame -\end{verbatim} -<>= -(defun |makeInitialModemapFrame| () - (copy |$InitialModemapFrame|)) - -@ - -\subsection{defun 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. -<>= -(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))))) - -@ - -\subsection{defun reclaim} -Call the garbage collector on various platforms. -<>= -#+abcl -(defun reclaim () (ext::gc)) -#+:allegro -(defun reclaim () (excl::gc t)) -#+:CCL -(defun reclaim () (gc)) -#+clisp -(defun reclaim () (#+lisp=cl ext::gc #-lisp=cl lisp::gc)) -#+(or :cmulisp :cmu) -(defun reclaim () (ext:gc)) -#+cormanlisp -(defun reclaim () (cl::gc)) -#+(OR IBCL KCL GCL) -(defun reclaim () (si::gbc t)) -#+lispworks -(defun reclaim () (hcl::normal-gc)) -#+Lucid -(defun reclaim () (lcl::gc)) -#+sbcl -(defun reclaim () (sb-ext::gc)) -@ - -\subsection{defun 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 [[${SYS}]] variable is the same one set at build time. -<>= -(defun reroot (dir) - (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 *default-pathname-defaults* - (pathname (make-absolute-filename ""))) - (setq $current-directory $spadroot)) - -@ - -\subsection{defun 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} -Note I suspect the last two cases do not occur in practice since -they result in a dotted pair if the input is not a cons. However, -this is what the current code does so I won't change it. -<>= -(defun |setCurrentLine| (s) - (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|) - -@ - -\subsection{defun statisticsInitialization} -<>= -(defun |statisticsInitialization| () - "initialize the garbage collection timer" - #+:akcl (system:gbc-time 0) - nil) - -@ -\chapter{System Command Handling} -\section{Variables Used} -\subsection{defvar \$systemCommands} -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. -<>= -(defvar |$systemCommands| nil) - -(eval-when (eval load) - (setq |$systemCommands| - '( - (|abbreviations| . |compiler| ) - (|boot| . |development|) - (|browse| . |development|) - (|cd| . |interpreter|) - (|clear| . |interpreter|) - (|close| . |interpreter|) - (|compiler| . |compiler| ) - (|copyright| . |interpreter|) - (|credits| . |interpreter|) - (|display| . |interpreter|) - (|edit| . |interpreter|) - (|fin| . |development|) - (|frame| . |interpreter|) - (|help| . |interpreter|) - (|history| . |interpreter|) -;; (|input| . |interpreter|) - (|lisp| . |development|) - (|library| . |interpreter|) - (|load| . |interpreter|) - (|ltrace| . |interpreter|) - (|pquit| . |interpreter|) - (|quit| . |interpreter|) - (|read| . |interpreter|) - (|savesystem| . |interpreter|) - (|set| . |interpreter|) - (|show| . |interpreter|) - (|spool| . |interpreter|) - (|summary| . |interpreter|) - (|synonym| . |interpreter|) - (|system| . |interpreter|) - (|trace| . |interpreter|) - (|undo| . |interpreter|) - (|what| . |interpreter|) - (|with| . |interpreter|) - (|workfiles| . |development|) - (|zsystemdevelopment| . |interpreter|) - ))) - -@ - -\subsection{defvar \$SYSCOMMANDS} -This table is used to look up a symbol to see if it might be a command. -<>= -(defvar $SYSCOMMANDS nil) -(eval-when (eval load) - (setq $SYSCOMMANDS (mapcar #'car |$systemCommands|))) - -@ -\subsection{defvar \$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. -<>= -(defvar |$noParseCommands| nil) -(eval-when (eval load) - (setq |$noParseCommands| - '( |boot| - |copyright| - |credits| - |fin| - |lisp| - |pquit| - |quit| - |suspend| - |synonym| - |system| - ))) - -@ -\subsection{defvar \$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. -<>= -(defvar |$tokenCommands| nil) -(eval-when (eval load) - (setq |$tokenCommands| - '( |abbreviations| - |cd| - |clear| - |close| - |compiler| - |depends| - |display| - |edit| - |frame| - |frame| - |help| - |history| - |input| - |library| - |load| - |ltrace| - |read| - |savesystem| - |set| - |spool| - |undo| - |what| - |with| - |workfiles| - |zsystemdevelopment| - ))) - -@ - -\subsection{defvar \$InitialCommandSynonymAlist} -Axiom can create ``synonyms'' for commands. We create an initial table -of synonyms which are in common use. -<>= -(defvar |$InitialCommandSynonymAlist| nil) -(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 *yearweek*") - (|w| . "what") - (|wc| . "what categories") - (|wd| . "what domains") - (|who| . "lisp (pprint credits)") - (|wp| . "what packages") - (|ws| . "what synonyms") -))) - -@ -\subsection{defvar \$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. -<>= -(defvar |$CommandSynonymAlist| nil) -(eval-when (eval load) - (setq |$CommandSynonymAlist| (copy-alist |$InitialCommandSynonymAlist|))) - -@ -\section{Functions} -\subsection{defun ncloopCommand} -The \$systemCommandFunction is set in SpadInterpretStream -to point to the function InterpExecuteSpadSystemCommand. -<>= -(defun |ncloopCommand| (line n) - (declare (special |$systemCommandFunction|)) - (let (a) - (cond - ((setq a (|ncloopPrefix?| ")include" line)) - (|ncloopInclude1| a n)) - (t - (funcall |$systemCommandFunction| line) - n)))) - -@ -\subsection{defun ncloopPrefix?} -If we find the prefix string in the whole string starting at position zero -we return the remainder of the string without the leading prefix. -<>= -(defun |ncloopPrefix?| (prefix whole) - (when (eql (search prefix whole) 0) - (subseq whole (length prefix)))) - -@ -\subsection{defun ncloopInclude1} -<>= -(defun |ncloopInclude1| (name n) - (let (a) - (if (setq a (|ncloopIncFileName| name)) - (|ncloopInclude| a n) - n))) - -@ -\subsection{defun ncloopIncFileName} -Returns the first non-blank substring of the given string. -<>= -(defun |ncloopIncFileName| (string) - (let (fn) - (unless (setq fn (|incFileName| string)) - (write-line (concat string " not found"))) - fn)) - -@ - -\subsection{defun ncloopInclude} -Open the file and read it in. The ncloopInclude0 function is part -of the parser and lives in int-top.boot. -<>= -(defun |ncloopInclude| (name n) - (with-open-file (st name) (|ncloopInclude0| st name n))) - -@ - -\subsection{defun incFileName} -Given a string we return the first token from the string which is -the first non-blank substring. -<>= -(defun |incFileName| (x) - (car (|incBiteOff| x))) - -@ - -\subsection{defun incBiteOff} -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. -<>= -(defun |incBiteOff| (x) - (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) ""))))) - -@ -\chapter{The Display Command} -\section{)display} -\begin{verbatim} - )display abbreviations - )display abbreviations [obj] - )display all - )display macros - )display mode all - )display mode [obj1 [obj2 ...]] - )display names - )display operations opname - )display properties - )display properties all - )display properties [obj1 [obj2 ...]] - )display value all - )display value [obj1 [obj2 ...]] -\end{verbatim} - -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 -\begin{verbatim} - )display abbreviations - )display abbreviations [obj] -\end{verbatim} -will show all of the abbreviations in the current workspace. - -The command -\begin{verbatim} - )display all -\end{verbatim} -is equivalent to -\begin{verbatim} - )display properties -\end{verbatim} - -The command -\begin{verbatim} - )display macros -\end{verbatim} -will show all of the macros in the current workspace. - - -The command -\begin{verbatim} - )display names -\end{verbatim} -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. - -To just show the declared mode of ``d'', issue -\begin{verbatim} - )display mode d -\end{verbatim} - -All modemaps for a given operation may be displayed by using -\begin{verbatim} - )display operations -\end{verbatim} - -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 {\bf complex}: -\begin{verbatim} - )d op complex -\end{verbatim} - -In addition to the modemaps for an operation the request to display -an operation will be followed by examples of the operation from each -domain. - -The commands -\begin{verbatim} - )display all - )display properties - )display properties all -\end{verbatim} -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 -\begin{verbatim} - )display properties d -\end{verbatim} - -To just show the value (and the type) of ``d'', issue -\begin{verbatim} - )display value d -\end{verbatim} -\section{Variables Used} -\subsection{defvar \$displayOptions} -The current value of \$displayOptions is - -<>= -(defvar |$displayOptions| - '(|abbreviations| |all| |macros| |modes| |names| |operations| - |properties| |types| |values|)) - -@ - -\section{Data Structures} -\section{Functions} -\subsection{defun 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. -<>= -(defun |display| (l) - (displaySpad2Cmd l)) - -@ - -\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. - -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. -<>= -(defun displaySpad2Cmd (l) - (declare (special |$e|)) - (let ((|$e| |$EmptyEnvironment|) (opt (car l)) (vl (cdr l)) - option optList msg) - (if (and (pairp 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")))))) - -@ -\subsection{defun displayOperations} -This function takes a list of operation names. If the list is null -we query the user to see if they want all operations printed. Otherwise -we print the information for the requested symbols. -<>= -(defun |displayOperations| (l) - (if l - (dolist (op l) (|reportOpSymbol| op)) - (if (yesanswer) - (dolist (op (|allOperations|)) (|reportOpSymbol| op)) - (|sayKeyedMsg| 's2iz0059 nil)))) - -@ -\subsection{defun 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. -<>= -(defun yesanswer () - (memq (string2id-n (upcase (|queryUserKeyedMsg| 's2iz0058 nil)) 1) '(y yes))) - -@ - -\subsection{defun displayMacros} -;displayMacros names == -; imacs := getInterpMacroNames() -; pmacs := getParserMacroNames() -; macros := -; null names => APPEND (imacs, pmacs) -; names -; macros := REMDUP macros -; null macros => sayBrightly '" There are no Axiom macros." -; -- first do user defined ones -; first := true -; for macro in macros repeat -; macro in pmacs => -; if first then -; sayBrightly ['%l,'"User-defined macros:"] -; first := NIL -; displayParserMacro macro -; macro in imacs => 'iterate -; sayBrightly ([" ",'%b, macro, '%d, " is not a known Axiom macro."]) -; -- now system ones -; first := true -; for macro in macros repeat -; macro in imacs => -; macro in pmacs => 'iterate -; if first then -; sayBrightly ['%l,'"System-defined macros:"] -; first := NIL -; displayMacro macro -; macro in pmacs => 'iterate -; NIL -<>= -(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)))) - -@ -\chapter{The History Mechanism} -\section{)history} -\index{ugSysCmdhistory} - -\index{history} - - -\par\noindent{\bf User Level Required:} interpreter - -\par\noindent{\bf Command Syntax:} -\begin{list}{} -\item{\tt )history )on} -\item{\tt )history )off} -\item{\tt )history )write} {\it historyInputFileName} -\item{\tt )history )show [{\it n}] [both]} -\item{\tt )history )save} {\it savedHistoryName} -\item{\tt )history )restore} [{\it savedHistoryName}] -\item{\tt )history )reset} -\item{\tt )history )change} {\it n} -\item{\tt )history )memory} -\item{\tt )history )file} -\item{\tt \%} -\item{\tt \%\%({\it n})} -\item{\tt )set history on | off} -\end{list} - -\par\noindent{\bf Command Description:} - -The {\it 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 {\bf .input} file of the lines typed to -\index{file!input} -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 -\begin{verbatim} -)set history on -)history )on -\end{verbatim} -has been issued. -Issuing either -\begin{verbatim} -)set history off -)history )off -\end{verbatim} -will discontinue the recording of information. -\index{history )on} -\index{set history on} -\index{set history off} -\index{history )off} - -Whether the facility is disabled or not, -the value of {\tt \%} in Axiom always -refers to the result of the last computation. -If you have not yet entered anything, -{\tt \%} evaluates to an object of type -{\tt Variable('\%)}. -The function {\tt \%\%} may be used to refer -to other previous results if the history facility is enabled. -In that case, -{\tt \%\%(n)} is the output from step {\tt n} if {\tt n > 0}. -If {\tt n < 0}, the step is computed relative to the current step. -Thus {\tt \%\%(-1)} is also the previous step, -{\tt \%\%(-2)}, is the step before that, and so on. -If an invalid step number is given, Axiom will signal an error. - -The {\it environment} information can either be saved in a file or entirely in -memory (the default). -Each frame -(\ref{ugSysCmdframe} on page~\pageref{ugSysCmdframe}) -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 {\bf FRAME.axh} where ``{\bf FRAME}'' is the name of the -current frame. -The history file is placed in the current working directory -(see \ref{ugSysCmdcd} on page~\pageref{ugSysCmdcd}). -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 {\tt )history} command are as follows: - -\begin{description} -\item[{\tt )change} {\it n}] -will set the number of steps that are saved in memory to {\it n}. -This option only has effect when the history data is maintained in a -file. -If you have issued {\tt )history )memory} (or not changed the default) -there is no need to use {\tt )history )change}. -\index{history )change} - -\item[{\tt )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 {\tt )set history on}. - -\item[{\tt )off}] -will stop the recording of information. -The {\tt )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 {\tt )set history off}. - -\item[{\tt )file}] -indicates that history data should be saved in an external file on disk. - -\item[{\tt )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. - -\item[{\tt )reset}] -will flush the internal list of the most recent workspace calculations -so that the data structures may be garbage collected by the underlying -Common Lisp system. -Like {\tt )history )change}, this option only has real effect when -history data is being saved in a file. - -\item[{\tt )restore} [{\it savedHistoryName}]] -completely clears the environment and restores it to a saved session, if -possible. -The {\tt )save} option below allows you to save a session to a file -with a given name. If you had issued -{\tt )history )save jacobi} -the command -{\tt )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 {\bf last.axh}. - -\item[{\tt )save} {\it savedHistoryName}] -is used to save a snapshot of the environment in a file. -This file is placed in the current working directory -(see \ref{ugSysCmdcd} on page~\pageref{ugSysCmdcd}). -Use {\tt )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 {\tt )clear all} or -{\tt )clear completely}. - -\item[{\tt )show} [{\it n}] [{\tt both}]] -can show previous input lines and output results. -{\tt )show} will display up to twenty of the last input lines -(fewer if you haven't typed in twenty lines). -{\tt )show} {\it n} will display up to {\it n} of the last input lines. -{\tt )show both} will display up to five of the last input lines and -output results. -{\tt )show} {\it n} {\tt both} will display up to {\it n} of the last -input lines and output results. - -\item[{\tt )write} {\it historyInputFile}] -creates an {\bf .input} file with the input lines typed since the start -of the session/frame or the last {\tt )clear all} or {\tt )clear -completely}. -If {\it historyInputFileName} does not contain a period (``.'') in the filename, -{\bf .input} is appended to it. -For example, -{\tt )history )write chaos} -and -{\tt )history )write chaos.input} -both write the input lines to a file called {\bf chaos.input} in your -current working directory. -If you issued one or more {\tt )undo} commands, -{\tt )history )write} -eliminates all -input lines backtracked over as a result of {\tt )undo}. -You can edit this file and then use {\tt )read} to have Axiom process -the contents. -\end{description} - -\par\noindent{\bf Also See:} -{\tt )frame} \index{ugSysCmdframe}, -{\tt )read} \index{ugSysCmdread}, -{\tt )set} \index{ugSysCmdset}, and -{\tt )undo} \index{ugSysCmdundo}. - - -History recording is done in two different ways: -\begin{itemize} -\item all changes in variable bindings (i.e. previous values) are - written to [[$HistList]], which is a circular list -\item all new bindings (including the binding to [[%]]) are written to a - file called [[histFileName()]] - one older session is accessible via the file [[$oldHistFileName()]] -\end{itemize} - -\section{Variables Used} -The following global variables are used: -\begin{list}{} -\item [[$HistList]], [[$HistListLen]] and [[$HistListAct]] which is the - actual number of ``undoable'' steps) -\item [[$HistRecord]] collects the input line, all variable bindings - and the output of a step, before it is written to the file - [[histFileName()]]. -\item [[$HiFiAccess]] is a flag, which is reset by [[)history )off]] -\end{list} -The result of step n can be accessed by [[%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 [[$HistList]] - and [[$HistRecord]] - -\subsection{Initialized history variables} -<>= -(defvar |$oldHistoryFileName| '|last| "vm/370 filename name component") -(defvar |$historyFileType| '|axh| "vm/370 filename type component") -(defvar |$historyDirectory| 'A "vm/370 filename disk component") -(defvar |$HiFiAccess| t "t means turn on history mechanism") -(defvar |$useInternalHistoryTable| t "t means keep history in core") - -@ -\section{Data Structures} -\section{Functions} -\subsection{defun makeHistFileName} -\begin{verbatim} -makeHistFileName(fname) == - makePathname(fname,$historyFileType,$historyDirectory) -\end{verbatim} -<>= -(defun |makeHistFileName| (fname) - (|makePathname| fname |$historyFileType| |$historyDirectory|)) - -@ -\subsection{defun oldHistFileName} -\begin{verbatim} -oldHistFileName() == - makeHistFileName($oldHistoryFileName) -\end{verbatim} -<>= -(defun |oldHistFileName| () - (|makeHistFileName| |$oldHistoryFileName|)) - -@ -\subsection{defun histFileName} -\begin{verbatim} -histFileName() == - makeHistFileName($interpreterFrameName) -\end{verbatim} -<>= -(defun |histFileName| () - (|makeHistFileName| |$interpreterFrameName|)) - -@ -\subsection{defun histInputFileName} -\begin{verbatim} -histInputFileName(fn) == - null fn => - makePathname($interpreterFrameName,'INPUT,$historyDirectory) - makePathname(fn,'INPUT,$historyDirectory) -\end{verbatim} -<>= -(defun |histInputFileName| (fn) - (if (null fn) - (|makePathname| |$interpreterFrameName| 'input |$historyDirectory|) - (|makePathname| fn 'input |$historyDirectory|))) -@ - -\subsection{defun initHist} -\begin{verbatim} -initHist() == - $useInternalHistoryTable => initHistList() - oldFile := oldHistFileName() - newFile := histFileName() - -- see if history directory is writable - histFileErase oldFile - if MAKE_-INPUT_-FILENAME newFile then $REPLACE(oldFile,newFile) - $HiFiAccess:= 'T - initHistList() -\end{verbatim} -<>= -(defun |initHist| () - (prog (oldFile newFile) - (return - (cond - (|$useInternalHistoryTable| - (|initHistList|)) - (t - (spadlet oldFile (|oldHistFileName|)) - (spadlet newFile (|histFileName|)) - (|histFileErase| oldFile) - (when (make-input-filename newFile) - ($replace oldFile newFile)) - (spadlet |$HiFiAccess| t) - (|initHistList|)))))) - -@ -\subsection{defun initHistList} -\begin{verbatim} -initHistList() == - -- creates $HistList as a circular list of length $HistListLen - -- and $HistRecord - $HistListLen:= 20 - $HistList:= LIST NIL - li:= $HistList - for i in 1..$HistListLen repeat li:= CONS(NIL,li) - RPLACD($HistList,li) - $HistListAct:= 0 - $HistRecord:= NIL -\end{verbatim} -<>= -(defun |initHistList| () - (prog (li) - (return - (seq - (progn - (spadlet |$HistListLen| 20) - (spadlet |$HistList| (list nil)) - (spadlet li |$HistList|) - (do ((|i| 1 (qsadd1 |i|))) - ((qsgreaterp |i| |$HistListLen|) nil) - (seq - (exit - (spadlet li (cons nil li))))) - (rplacd |$HistList| li) - (spadlet |$HistListAct| 0) - (spadlet |$HistRecord| NIL)))))) - -@ -\subsection{defun history} -\begin{verbatim} -history l == - l or null $options => sayKeyedMsg("S2IH0006",NIL) - historySpad2Cmd() -\end{verbatim} -<>= -(defun |history| (l) - (cond - ((or l (null |$options|)) - (|sayKeyedMsg| 'S2IH0006 nil)) ; syntax error - (t - (|historySpad2Cmd|)))) - -@ -\subsection{defun historySpad2Cmd} -\begin{verbatim} -historySpad2Cmd() == - -- history is a system command which can call resetInCoreHist - -- and changeHistListLen, and restore last session - histOptions:= - '(on off yes no change reset restore write save show file memory) - opts:= [ [selectOptionLC(opt,histOptions,'optionError),:optargs] - for [opt,:optargs] in $options] - for [opt,:optargs] in opts repeat - opt in '(on yes) => - $HiFiAccess => sayKeyedMsg("S2IH0007",NIL) - $IOindex = 1 => -- haven't done anything yet - $HiFiAccess:= 'T - initHistList() - sayKeyedMsg("S2IH0008",NIL) - x := UPCASE queryUserKeyedMsg("S2IH0009",NIL) - MEMQ(STRING2ID_-N(x,1),'(Y YES)) => - histFileErase histFileName() - $HiFiAccess:= 'T - $options := nil - clearSpad2Cmd '(all) - sayKeyedMsg("S2IH0008",NIL) - initHistList() - sayKeyedMsg("S2IH0010",NIL) - opt in '(off no) => - null $HiFiAccess => sayKeyedMsg("S2IH0011",NIL) - $HiFiAccess:= NIL - disableHist() - sayKeyedMsg("S2IH0012",NIL) - opt = 'file => setHistoryCore NIL - opt = 'memory => setHistoryCore true - opt = 'reset => resetInCoreHist() - opt = 'save => saveHistory optargs - opt = 'show => showHistory optargs - opt = 'change => changeHistListLen first optargs - opt = 'restore => restoreHistory optargs - opt = 'write => writeInputLines(optargs,1) - 'done -\end{verbatim} -<>= -(defun |historySpad2Cmd| () - (prog (histOptions opts opt optargs x) - (return - (seq - (progn - (spadlet histOptions - '(|on| |off| |yes| |no| |change| |reset| |restore| |write| - |save| |show| |file| |memory|)) - (spadlet opts - (prog (tmp1) - (spadlet tmp1 nil) - (return - (do ((tmp2 |$options| (cdr tmp2)) (tmp3 NIL)) - ((or (atom tmp2) - (progn - (setq tmp3 (car tmp2)) - nil) - (progn - (progn - (spadlet opt (car tmp3)) - (spadlet optargs (cdr tmp3)) - tmp3) - nil)) - (nreverse0 tmp1)) - (seq - (exit - (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 - (spadlet opt (car tmp5)) - (spadlet optargs (cdr tmp5)) - tmp5) - nil)) - nil) - (seq - (exit - (cond - ((|member| opt '(|on| |yes|)) - (cond - (|$HiFiAccess| - (|sayKeyedMsg| 'S2IH0007 nil)) ; history already on - ((eql |$IOindex| 1) - (spadlet |$HiFiAccess| t) - (|initHistList|) - (|sayKeyedMsg| 'S2IH0008 nil)) ; history now on - (t - (spadlet x ; really want to turn history on? - (upcase (|queryUserKeyedMsg| 'S2IH0009 nil))) - (cond - ((memq (string2id-n x 1) '(Y YES)) - (|histFileErase| (|histFileName|)) - (spadlet |$HiFiAccess| t) - (spadlet |$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 - (spadlet |$HiFiAccess| nil) - (|disableHist|) - (|sayKeyedMsg| 'S2IH0012 nil)))) ; history now off - ((boot-equal opt '|file|) - (|setHistoryCore| nil)) - ((boot-equal opt '|memory|) - (|setHistoryCore| t)) - ((boot-equal opt '|reset|) - (|resetInCoreHist|)) - ((boot-equal opt '|save|) - (|saveHistory| optargs)) - ((boot-equal opt '|show|) - (|showHistory| optargs)) - ((boot-equal opt '|change|) - (|changeHistListLen| (CAR optargs))) - ((boot-equal opt '|restore|) - (|restoreHistory| optargs)) - ((boot-equal opt '|write|) - (|writeInputLines| optargs 1)))))) - '|done|))))) - -@ -\subsection{defun 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 [[$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 -[[$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} -\begin{verbatim} -setHistoryCore inCore == - inCore = $useInternalHistoryTable => - sayKeyedMsg((inCore => "S2IH0030"; "S2IH0029"),NIL) - not $HiFiAccess => - $useInternalHistoryTable := inCore - inCore => sayKeyedMsg("S2IH0032",NIL) - sayKeyedMsg("S2IH0031",NIL) - inCore => - $internalHistoryTable := NIL - if $IOindex ^= 0 then - -- actually put something in there - l := LENGTH RKEYIDS histFileName() - for i in 1..l repeat - vec:= UNWIND_-PROTECT(readHiFi(i),disableHist()) - $internalHistoryTable := CONS([i,:vec],$internalHistoryTable) - histFileErase histFileName() - $useInternalHistoryTable := true - sayKeyedMsg("S2IH0032",NIL) - $HiFiAccess:= 'NIL - histFileErase histFileName() - str := RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:histFileName()]] - for [n,:rec] in reverse $internalHistoryTable repeat - SPADRWRITE(object2Identifier n,rec,str) - RSHUT str - $HiFiAccess:= 'T - $internalHistoryTable := NIL - $useInternalHistoryTable := NIL - sayKeyedMsg("S2IH0031",NIL) -\end{verbatim} -<>= -(defun |setHistoryCore| (inCore) - (prog (l vec str n rec) - (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|) - (spadlet |$useInternalHistoryTable| inCore) - (if inCore - (|sayKeyedMsg| 'S2IH0032 NIL) ; use memory history - (|sayKeyedMsg| 'S2IH0031 NIL))) ; use file history - (inCore - (spadlet |$internalHistoryTable| nil) - (cond - ((nequal |$IOindex| 0) - (spadlet l (length (rkeyids (|histFileName|)))) - (do ((|i| 1 (qsadd1 |i|))) - ((qsgreaterp |i| l) NIL) - (seq - (exit - (progn - (spadlet vec (unwind-protect (|readHiFi| |i|) (|disableHist|))) - (spadlet |$internalHistoryTable| - (cons (cons |i| vec) |$internalHistoryTable|)))))) - (|histFileErase| (|histFileName|)))) - (spadlet |$useInternalHistoryTable| t) - (|sayKeyedMsg| 'S2IH0032 nil)) ; use memory history - (t - (spadlet |$HiFiAccess| nil) - (|histFileErase| (|histFileName|)) - (spadlet 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 - (spadlet n (car tmp1)) - (spadlet rec (cdr tmp1)) - tmp1) - nil)) - nil) - (seq - (exit - (spadrwrite (|object2Identifier| n) rec str)))) - (rshut str) - (spadlet |$HiFiAccess| t) - (spadlet |$internalHistoryTable| nil) - (spadlet |$useInternalHistoryTable| nil) - (|sayKeyedMsg| 'S2IH0031 NIL))))) ; use file history - -@ -\subsection{defun writeInputLines} -\begin{verbatim} -writeInputLines(fn,initial) == - -- writes all input lines into file histInputFileName() - not $HiFiAccess => sayKeyedMsg("S2IH0013",NIL) ; history not on - null fn => - throwKeyedMsg("S2IH0038", nil) ; missing file name - maxn := 72 - breakChars := [" ","+"] - for i in initial..$IOindex - 1 repeat - vecl := CAR readHiFi i - if STRINGP vecl then vecl := [vecl] - for vec in vecl repeat - n := SIZE vec - while n > maxn repeat - -- search backwards for a blank - done := nil - for j in 1..maxn while ^done repeat - k := 1 + maxn - j - MEMQ(vec.k,breakChars) => - svec := STRCONC(SUBSTRING(vec,0,k+1),UNDERBAR) - lineList := [svec,:lineList] - done := true - vec := SUBSTRING(vec,k+1,NIL) - n := SIZE vec - -- in case we can't find a breaking point - if ^done then n := 0 - lineList := [vec,:lineList] - file := histInputFileName(fn) - histFileErase file - inp:= DEFIOSTREAM(['(MODE . OUTPUT),['FILE,:file]],255,0) - for x in removeUndoLines NREVERSE lineList repeat WRITE_-LINE(x,inp) - -- see file "undo" for definition of removeUndoLines - if fn ^= 'redo then sayKeyedMsg("S2IH0014",[namestring file]) - SHUT inp - NIL -\end{verbatim} -<>= -(defun |writeInputLines| (fn initial) - (prog (maxn breakChars vecl k svec done vec n lineList file inp) - (return - (seq - (cond - ((null |$HiFiAccess|) - (|sayKeyedMsg| 'S2IH0013 nil)) ; history is not on - ((null fn) - (|throwKeyedMsg| 'S2IH0038 nil)) ; missing file name - (t - (spadlet maxn 72) - (spadlet breakChars (cons '| | (cons '+ nil))) - (do ((tmp0 (spaddifference |$IOindex| 1)) - (|i| initial (+ |i| 1))) - ((> |i| tmp0) nil) - (seq - (exit - (progn - (spadlet vecl (car (|readHiFi| |i|))) - (cond - ((stringp vecl) (spadlet vecl (cons vecl nil)))) - (do ((tmp1 vecl (cdr tmp1)) (vec nil)) - ((or (atom tmp1) (progn (setq vec (car tmp1)) nil)) nil) - (seq - (exit - (progn - (spadlet n (size vec)) - (do () - ((null (> n maxn)) nil) - (seq - (exit - (progn - (spadlet done nil) - (do ((|j| 1 (qsadd1 |j|))) - ((or (qsgreaterp |j| maxn) (null (null done))) nil) - (seq - (exit - (progn - (spadlet k (spaddifference (plus 1 maxn) |j|)) - (cond - ((memq (ELT vec k) breakChars) - (progn - (spadlet svec (strconc - (substring vec 0 (plus k 1)) underbar)) - (spadlet lineList (cons svec lineList)) - (spadlet done t) - (spadlet vec (substring vec (plus k 1) nil)) - (spadlet n (size vec))))))))) - (cond - ((null done) (spadlet n 0)) - (t nil)))))) - (spadlet lineList (cons vec lineList)))))))))) - (spadlet file (|histInputFileName| fn)) - (|histFileErase| file) - (spadlet inp - (defiostream - (cons - '(mode . output) - (cons (cons 'file file) nil)) 255 0)) - (do ((tmp2 (|removeUndoLines| (nreverse lineList)) (cdr tmp2)) - (x nil)) - ((or (atom tmp2) - (progn - (setq x (car tmp2)) - nil)) - nil) - (seq - (exit - (write-line x inp)))) - (cond - ((nequal fn '|redo|) - (|sayKeyedMsg| 'S2IH0014 ; edit this file to see input lines - (cons (|namestring| file) nil)))) - (shut inp) - nil)))))) - -@ -\subsection{defun resetInCoreHist} -\begin{verbatim} -resetInCoreHist() == - -- removes all pointers from $HistList - $HistListAct:= 0 - for i in 1..$HistListLen repeat - $HistList:= CDR $HistList - RPLACA($HistList,NIL) -\end{verbatim} -<>= -(defun |resetInCoreHist| () - (seq - (progn - (spadlet |$HistListAct| 0) - (do ((|i| 1 (qsadd1 |i|))) - ((qsgreaterp |i| |$HistListLen|) nil) - (seq - (exit - (progn - (spadlet |$HistList| (cdr |$HistList|)) - (rplaca |$HistList| nil)))))))) - -@ -\subsection{defun changeHistListLen} -\begin{verbatim} -changeHistListLen(n) == - -- changes the length of $HistList. n must be nonnegative - NULL INTEGERP n => sayKeyedMsg("S2IH0015",[n]) - dif:= n-$HistListLen - $HistListLen:= n - l:= CDR $HistList - if dif > 0 then - for i in 1..dif repeat l:= CONS(NIL,l) - if dif < 0 then - for i in 1..-dif repeat l:= CDR l - if $HistListAct > n then $HistListAct:= n - RPLACD($HistList,l) - 'done -\end{verbatim} -<>= -(defun |changeHistListLen| (n) - (prog (dif l) - (return - (seq - (cond - ((null (integerp n)) - (|sayKeyedMsg| 'S2IH0015 (cons n nil))) ; only positive integers - (t - (spadlet dif (spaddifference n |$HistListLen|)) - (spadlet |$HistListLen| n) - (spadlet l (cdr |$HistList|)) - (cond - ((> dif 0) - (do ((|i| 1 (qsadd1 |i|))) - ((qsgreaterp |i| dif) nil) - (seq - (exit - (spadlet l (cons nil l))))))) - (cond - ((minusp dif) - (do ((tmp0 (spaddifference dif)) - (|i| 1 (qsadd1 |i|))) - ((qsgreaterp |i| tmp0) nil) - (seq - (exit - (spadlet l (cdr l))))) - (cond - ((> |$HistListAct| n) (spadlet |$HistListAct| n)) - (t nil)))) - (rplacd |$HistList| l) - '|done|)))))) - -@ -\subsection{defun updateHist} -\begin{verbatim} -updateHist() == - -- updates the history file and calls updateInCoreHist - null $IOindex => nil - startTimingProcess 'history - updateInCoreHist() - if $HiFiAccess then - UNWIND_-PROTECT(writeHiFi(),disableHist()) - $HistRecord:= NIL - $IOindex:= $IOindex+1 - updateCurrentInterpreterFrame() - $mkTestInputStack := nil - $currentLine := nil - stopTimingProcess 'history -\end{verbatim} -<>= -(defun |updateHist| () - (cond - ((null |$IOindex|) nil) - (t - (|startTimingProcess| '|history|) - (|updateInCoreHist|) - (when |$HiFiAccess| - (unwind-protect (|writeHiFi|) (|disableHist|)) - (spadlet |$HistRecord| nil)) - (spadlet |$IOindex| (plus |$IOindex| 1)) - (|updateCurrentInterpreterFrame|) - (spadlet |$mkTestInputStack| nil) - (spadlet |$currentLine| nil) - (|stopTimingProcess| '|history|)))) - -@ -\subsection{defun updateInCoreHist} -\begin{verbatim} -updateInCoreHist() == - -- updates $HistList and $IOindex - $HistList:= CDR($HistList) - RPLACA($HistList,NIL) - if $HistListAct < $HistListLen then $HistListAct:= $HistListAct+1 -\end{verbatim} -<>= -(defun |updateInCoreHist| () - (progn - (spadlet |$HistList| (cdr |$HistList|)) - (rplaca |$HistList| nil) - (COND - ((> |$HistListLen| |$HistListAct|) - (spadlet |$HistListAct| (plus |$HistListAct| 1))) - (t nil)))) - -@ -\subsection{defun putHist} -\begin{verbatim} -putHist(x,prop,val,e) == - -- records new value to $HistRecord and old value to $HistList - -- then put is called with e - if not (x='%) then recordOldValue(x,prop,get(x,prop,e)) - if $HiFiAccess then recordNewValue(x,prop,val) - putIntSymTab(x,prop,val,e) -\end{verbatim} -<>= -(defun |putHist| (x prop val e) - (progn - (when (null (boot-equal x '%)) - (|recordOldValue| x prop (|get| x prop e))) - (when |$HiFiAccess| - (|recordNewValue| x prop val)) - (|putIntSymTab| x prop val e))) - -@ -\subsection{defun recordNewValue} -\begin{verbatim} -recordNewValue(x,prop,val) == - startTimingProcess 'history - recordNewValue0(x,prop,val) - stopTimingProcess 'history -\end{verbatim} -<>= -(defun |recordNewValue| (x prop val) - (progn - (|startTimingProcess| '|history|) - (|recordNewValue0| x prop val) - (|stopTimingProcess| '|history|))) - -@ -\subsection{defun recordNewValue0} -\begin{verbatim} -recordNewValue0(x,prop,val) == - -- writes (prop . val) into $HistRecord - -- updateHist writes this stuff out into the history file - p1:= ASSQ(x,$HistRecord) => - p2:= ASSQ(prop,CDR p1) => - RPLACD(p2,val) - RPLACD(p1,CONS(CONS(prop,val),CDR p1)) - p:= CONS(x,list CONS(prop,val)) - $HistRecord:= CONS(p,$HistRecord) -\end{verbatim} -<>= -(defun |recordNewValue0| (x prop val) - (prog (p1 p2 p) - (return - (cond - ((spadlet p1 (ASSQ x |$HistRecord|)) - (cond - ((spadlet p2 (assq prop (cdr p1))) (rplacd p2 val)) - (t (rplacd p1 (cons (cons prop val) (cdr p1)))))) - (t - (spadlet p (cons x (list (cons prop val)))) - (spadlet |$HistRecord| (cons p |$HistRecord|))))))) - -@ -\subsection{defun recordOldValue} -\begin{verbatim} -recordOldValue(x,prop,val) == - startTimingProcess 'history - recordOldValue0(x,prop,val) - stopTimingProcess 'history -\end{verbatim} -<>= -(defun |recordOldValue| (x prop val) - (progn - (|startTimingProcess| '|history|) - (|recordOldValue0| x prop val) - (|stopTimingProcess| '|history|))) - -@ -\subsection{defun recordOldValue0} -\begin{verbatim} -recordOldValue0(x,prop,val) == - -- writes (prop . val) into $HistList - p1:= ASSQ(x,CAR $HistList) => - not ASSQ(prop,CDR p1) => - RPLACD(p1,CONS(CONS(prop,val),CDR p1)) - p:= CONS(x,list CONS(prop,val)) - RPLACA($HistList,CONS(p,CAR $HistList)) -\end{verbatim} -<>= -(defun |recordOldValue0| (x prop val) - (prog (p1 p) - (return - (seq - (when (spadlet p1 (assq x (car |$HistList|))) - (exit - (when (null (assq prop (cdr p1))) - (exit - (rplacd p1 (cons (cons prop val) (cdr p1))))))) - (spadlet p (cons x (list (cons prop val)))) - (rplaca |$HistList| (cons p (car |$HistList|))))))) - -@ -\subsection{defun undoInCore} -\begin{verbatim} -undoInCore(n) == - -- undoes the last n>0 steps using $HistList - -- resets $InteractiveFrame - li:= $HistList - for i in n..$HistListLen repeat li:= CDR li - undoChanges(li) - n:= $IOindex-n-1 - n>0 and - $HiFiAccess => - vec:= CDR UNWIND_-PROTECT(readHiFi(n),disableHist()) - val:= ( p:= ASSQ('%,vec) ) and ( p1:= ASSQ('value,CDR p) ) and - CDR p1 - sayKeyedMsg("S2IH0019",[n]) - $InteractiveFrame:= putHist('%,'value,val,$InteractiveFrame) - updateHist() -\end{verbatim} -<>= -(defun |undoInCore| (n) - (prog (li vec p p1 val) - (return - (seq - (progn - (spadlet li |$HistList|) - (do ((i n (+ i 1))) - ((> i |$HistListLen|) nil) - (seq - (exit - (spadlet li (cdr li))))) - (|undoChanges| li) - (spadlet n (spaddifference (spaddifference |$IOindex| n) 1)) - (and - (> n 0) - (cond - (|$HiFiAccess| - (spadlet vec - (cdr (unwind-protect (|readHiFi| n) (|disableHist|)))) - (spadlet val - (and - (spadlet p (assq '% vec)) - (spadlet p1 (assq '|value| (cdr p))) - (cdr p1)))) - (t - (|sayKeyedMsg| 'S2IH0019 (cons n nil))))) ; no history file - (spadlet |$InteractiveFrame| - (|putHist| '% '|value| val |$InteractiveFrame|)) - (|updateHist|)))))) - -@ -\subsection{defun undoChanges} -\begin{verbatim} -undoChanges(li) == - -- undoes all changes of list 'li' - if not CDR li = $HistList then undoChanges CDR li - for p1 in CAR li repeat - x:= CAR p1 - for p2 in CDR p1 repeat - putHist(x,CAR p2,CDR p2,$InteractiveFrame) -\end{verbatim} -<>= -(defun |undoChanges| (li) - (prog (x) - (return - (seq - (progn - (when (null (boot-equal (cdr li) |$HistList|)) - (|undoChanges| (cdr li))) - (do ((tmp0 (car li) (cdr tmp0)) (p1 NIL)) - ((or (atom tmp0) (progn (setq p1 (car tmp0)) nil)) nil) - (seq - (exit - (progn - (spadlet x (car p1)) - (do ((tmp1 (cdr p1) (cdr tmp1)) (p2 nil)) - ((or (atom tmp1) (progn (setq p2 (car tmp1)) nil)) nil) - (seq - (exit - (|putHist| x (car p2) (cdr p2) |$InteractiveFrame|) - )))))))))))) - -@ -\subsection{defun undoFromFile} -\begin{verbatim} -undoFromFile(n) == - -- makes a clear and redoes all the assignments until step n - for [x,:varl] in CAAR $InteractiveFrame repeat - for p in varl repeat - [prop,:val]:= p - val => - if not (x='%) then recordOldValue(x,prop,val) - if $HiFiAccess then recordNewValue(x,prop,val) - RPLACD(p,NIL) - for i in 1..n repeat - vec:= UNWIND_-PROTECT(CDR readHiFi(i),disableHist()) - for p1 in vec repeat - x:= CAR p1 - for p2 in CDR p1 repeat - $InteractiveFrame:= putHist(x,CAR p2,CDR p2,$InteractiveFrame) - val:= ( p:= ASSQ('%,vec) ) and ( p1:= ASSQ('value,CDR p) ) and CDR p1 - $InteractiveFrame:= putHist('%,'value,val,$InteractiveFrame) - updateHist() -\end{verbatim} -<>= -(defun |undoFromFile| (n) - (prog (varl prop vec x p p1 val) - (return - (seq - (progn - (do ((tmp0 (caar |$InteractiveFrame|) (cdr tmp0)) (tmp1 nil)) - ((or (atom tmp0) - (progn (setq tmp1 (car tmp0)) nil) - (progn - (progn - (spadlet x (car tmp1)) - (spadlet 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 - (spadlet prop (car p)) - (spadlet val (cdr p)) - (when val - (progn - (when (null (boot-equal x '%)) - (|recordOldValue| x prop val)) - (when |$HiFiAccess| - (|recordNewValue| x prop val)) - (rplacd p nil)))))))))) - (do ((|i| 1 (qsadd1 |i|))) - ((qsgreaterp |i| n) nil) - (seq - (exit - (progn - (spadlet vec - (unwind-protect (cdr (|readHiFi| |i|)) (|disableHist|))) - (do ((tmp3 vec (cdr tmp3)) (p1 nil)) - ((or (atom tmp3) (progn (setq p1 (car tmp3)) nil)) nil) - (seq - (exit - (progn - (spadlet x (car p1)) - (do ((tmp4 (cdr p1) (cdr tmp4)) (p2 nil)) - ((or (atom tmp4) (progn (setq p2 (car tmp4)) nil)) nil) - (seq - (exit - (spadlet |$InteractiveFrame| - (|putHist| x (car p2) (CDR p2) |$InteractiveFrame|) - )))))))))))) - (spadlet val - (and - (spadlet p (assq '% vec)) - (spadlet p1 (assq '|value| (cdr p))) - (cdr p1))) - (spadlet |$InteractiveFrame| - (|putHist| '% '|value| val |$InteractiveFrame|)) - (|updateHist|)))))) - -@ -\subsection{defun saveHistory} -\begin{verbatim} -saveHistory(fn) == - $seen: local := MAKE_-HASHTABLE 'EQ - not $HiFiAccess => sayKeyedMsg("S2IH0016",NIL) - not $useInternalHistoryTable and - null MAKE_-INPUT_-FILENAME histFileName() => sayKeyedMsg("S2IH0022",NIL) - null fn => - throwKeyedMsg("S2IH0037", nil) - savefile := makeHistFileName(fn) - inputfile := histInputFileName(fn) - writeInputLines(fn,1) - histFileErase savefile - - if $useInternalHistoryTable - then - saveStr := RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:savefile]] - for [n,:rec] in reverse $internalHistoryTable repeat - val := SPADRWRITE0(object2Identifier n,rec,saveStr) - val = 'writifyFailed => - sayKeyedMsg("S2IH0035", [n, inputfile]) ; unable to save step - RSHUT saveStr - sayKeyedMsg("S2IH0018",[namestring(savefile)]) ; saved hist file named - nil -\end{verbatim} -<>= -(defun |saveHistory| (fn) - (prog (|$seen| savefile inputfile saveStr n rec val) - (declare (special |$seen|)) - (return - (seq - (progn - (spadlet |$seen| (make-hashtable 'eq)) - (cond - ((null |$HiFiAccess|) - (|sayKeyedMsg| 'S2IH0016 nil)) ; the history file is not on - ((and (null |$useInternalHistoryTable|) - (null (make-input-filename (|histFileName|)))) - (|sayKeyedMsg| 'S2IH0022 nil)) ; no history saved yet - ((null fn) - (|throwKeyedMsg| 'S2IH0037 nil)) ; need to specify a history filename - (t - (spadlet savefile (|makeHistFileName| fn)) - (spadlet inputfile (|histInputFileName| fn)) - (|writeInputLines| fn 1) - (|histFileErase| savefile) - (when |$useInternalHistoryTable| - (spadlet 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 - (spadlet n (car tmp1)) - (spadlet rec (cdr tmp1)) - tmp1) - nil)) - nil) - (seq - (exit - (progn - (spadlet val - (spadrwrite0 (|object2Identifier| n) rec saveStr)) - (when (boot-equal val '|writifyFailed|) - (|sayKeyedMsg| 'S2IH0035 ; can't save the value of step - (cons n (cons inputfile nil)))))))) - (rshut saveStr)) - (|sayKeyedMsg| 'S2IH0018 ; saved history file is - (cons (|namestring| savefile) nil)) - nil))))))) - -@ -\subsection{defun restoreHistory} -\begin{verbatim} -restoreHistory(fn) == - -- uses fn $historyFileType to recover an old session - -- if fn = NIL, then use $oldHistoryFileName - if null fn then fn' := $oldHistoryFileName - else if fn is [fn'] and IDENTP(fn') then fn' := fn' - else throwKeyedMsg("S2IH0023",[fn']) - restfile := makeHistFileName(fn') - null MAKE_-INPUT_-FILENAME restfile => - sayKeyedMsg("S2IH0024",[namestring(restfile)]) ; no history file - - -- if clear is changed to be undoable, this should be a reset-clear - $options: local := nil - clearSpad2Cmd '(all) - - curfile := histFileName() - histFileErase curfile - _$FCOPY(restfile,curfile) - - l:= LENGTH RKEYIDS curfile - $HiFiAccess:= 'T - oldInternal := $useInternalHistoryTable - $useInternalHistoryTable := NIL - if oldInternal then $internalHistoryTable := NIL - for i in 1..l repeat - vec:= UNWIND_-PROTECT(readHiFi(i),disableHist()) - if oldInternal then $internalHistoryTable := - CONS([i,:vec],$internalHistoryTable) - LINE:= CAR vec - for p1 in CDR vec repeat - x:= CAR p1 - for p2 in CDR p1 repeat - $InteractiveFrame:= putHist(x,CAR p2,CDR p2,$InteractiveFrame) - updateInCoreHist() - $e := $InteractiveFrame - for [a,:.] in CAAR $InteractiveFrame repeat - get(a,'localModemap,$InteractiveFrame) => - rempropI(a,'localModemap) - rempropI(a,'localVars) - rempropI(a,'mapBody) - $IOindex:= l+1 - $useInternalHistoryTable := oldInternal - sayKeyedMsg("S2IH0025",[namestring(restfile)]) - clearCmdSortedCaches() - nil -\end{verbatim} -<>= -(defun |restoreHistory| (fn) - (prog (|$options| fnq restfile curfile l oldInternal vec line x a) - (declare (special |$options|)) - (return - (seq - (progn - (cond - ((null fn) - (spadlet fnq |$oldHistoryFileName|)) - ((and (pairp fn) - (eq (qcdr fn) nil) - (progn - (spadlet fnq (qcar fn)) - t) - (identp fnq)) - (spadlet fnq fnq)) - (t (|throwKeyedMsg| 'S2IH0023 (cons fnq nil)))) ; invalid filename - (spadlet restfile (|makeHistFileName| fnq)) - (cond - ((null (make-input-filename restfile)) - (|sayKeyedMsg| 'S2IH0024 ; file does not exist - (cons (|namestring| restfile) nil))) - (t - (spadlet |$options| NIL) - (|clearSpad2Cmd| '(|all|)) - (spadlet curfile (|histFileName|)) - (|histFileErase| curfile) - ($fcopy restfile curfile) - (spadlet l (length (rkeyids curfile))) - (spadlet |$HiFiAccess| t) - (spadlet oldInternal |$useInternalHistoryTable|) - (spadlet |$useInternalHistoryTable| nil) - (when oldInternal - (spadlet |$internalHistoryTable| nil)) - (do ((|i| 1 (qsadd1 |i|))) - ((qsgreaterp |i| l) nil) - (seq - (exit - (progn - (spadlet vec (unwind-protect (|readHiFi| |i|) (|disableHist|))) - (when oldInternal - (spadlet |$internalHistoryTable| - (cons (cons |i| vec) |$internalHistoryTable|))) - (spadlet line (car vec)) - (do ((tmp0 (cdr vec) (cdr tmp0)) (p1 nil)) - ((or (atom tmp0) (progn (setq p1 (car tmp0)) nil)) nil) - (seq - (exit - (progn - (spadlet x (car p1)) - (do ((tmp1 (cdr p1) (cdr tmp1)) (p2 nil)) - ((or (atom tmp1) (progn (setq p2 (car tmp1)) nil)) nil) - (seq - (exit - (spadlet |$InteractiveFrame| - (|putHist| x - (car p2) (cdr p2) |$InteractiveFrame|))))))))) - (|updateInCoreHist|))))) - (spadlet |$e| |$InteractiveFrame|) - (seq - (do ((tmp2 (caar |$InteractiveFrame|) (cdr tmp2)) (tmp3 nil)) - ((or (atom tmp2) - (progn - (setq tmp3 (car tmp2)) - nil) - (progn - (progn - (spadlet a (car tmp3)) - tmp3) - nil)) - nil) - (seq - (exit - (when (|get| a '|localModemap| |$InteractiveFrame|) - (exit - (progn - (|rempropI| a '|localModemap|) - (|rempropI| a '|localVars|) - (|rempropI| a '|mapBody|))))))) - (spadlet |$IOindex| (plus l 1)) - (spadlet |$useInternalHistoryTable| oldInternal) - (|sayKeyedMsg| 'S2IH0025 ; workspace restored - (cons (|namestring| restfile) nil)) - (|clearCmdSortedCaches|) - nil)))))))) - -@ -\subsection{defun showHistory} -\begin{verbatim} --- the following used to be the show command when that was used to --- show history. -showHistory(arg) == - -- arg can be of form - -- NIL show at most last 20 input lines - -- (n) show at most last n input lines - -- (lit) where lit is an abbreviation for 'input or 'both - -- if 'input, same as NIL - -- if 'both, show last 5 input and outputs - -- (n lit) show last n input lines + last n output lines - -- if lit expands to 'both - $evalTimePrint: local:= 0 - $printTimeSum: local:= 0 - -- ugh!!! these are needed for timedEvaluateStream - -- displays the last n steps, default n=20 - not $HiFiAccess => sayKeyedMsg("S2IH0026",['show]) - showInputOrBoth := 'input - n := 20 - nset := nil - if arg then - arg1 := CAR arg - if INTEGERP arg1 then - n := arg1 - nset := true - KDR arg => arg1 := CADR arg - arg1 := NIL - arg1 => - arg2 := selectOptionLC(arg1,'(input both),nil) - if arg2 - then ((showInputOrBoth := arg2) = 'both) and (null nset) => n:= 5 - else sayMSG - concat('" ",bright arg1,'"is an invalid argument.") - if n >= $IOindex then n:= $IOindex-1 - mini:= $IOindex-n - maxi:= $IOindex-1 - showInputOrBoth = 'both => - UNWIND_-PROTECT(showInOut(mini,maxi),setIOindex(maxi+1)) - showInput(mini,maxi) -\end{verbatim} -<>= -(defun |showHistory| (arg) - (prog (|$evalTimePrint| |$printTimeSum| nset arg1 arg2 - showInputOrBoth n mini maxi) - (declare (special |$evalTimePrint| |$printTimeSum|)) - (return - (seq - (progn - (spadlet |$evalTimePrint| 0) - (spadlet |$printTimeSum| 0) - (cond - ((null |$HiFiAccess|) - (|sayKeyedMsg| 'S2IH0026 (cons '|show| nil))) ; history not on - (t - (spadlet showInputOrBoth '|input|) - (spadlet n 20) - (spadlet nset nil) - (when arg - (spadlet arg1 (car arg)) - (when (integerp arg1) - (spadlet n arg1) - (spadlet nset t) - (cond - ((kdr arg) (spadlet arg1 (cadr arg))) - (t (spadlet arg1 nil)))) - (when arg1 - (progn - (spadlet arg2 (|selectOptionLC| arg1 '(|input| |both|) nil)) - (seq - (cond - (arg2 - (when (and (boot-equal - (spadlet showInputOrBoth arg2) '|both|) - (null nset)) - (exit (spadlet n 5)))) - (t - (|sayMSG| - (|concat| - (makestring " ") - (|bright| arg1) - (makestring "is an invalid argument."))))))))) - (when (>= n |$IOindex|) - (spadlet n (spaddifference |$IOindex| 1))) - (spadlet mini (spaddifference |$IOindex| n)) - (spadlet maxi (spaddifference |$IOindex| 1)) - (cond - ((boot-equal showInputOrBoth '|both|) - (unwind-protect - (|showInOut| mini maxi) - (|setIOindex| (plus maxi 1)))) - (t (|showInput| mini maxi)))))))))) - -@ -\subsection{defun setIOindex} -\begin{verbatim} -setIOindex(n) == - -- set $IOindex to n - $IOindex:= n -\end{verbatim} -<>= -(defun |setIOindex| (n) - (spadlet |$IOindex| n)) - -@ -\subsection{defun showInput} -\begin{verbatim} -showInput(mini,maxi) == - -- displays all input lines from mini to maxi - for ind in mini..maxi repeat - vec:= UNWIND_-PROTECT(readHiFi(ind),disableHist()) - if ind<10 then TAB 2 else if ind<100 then TAB 1 - l := CAR vec - STRINGP l => - sayMSG ['" [",ind,'"] ",CAR vec] - sayMSG ['" [",ind,'"] " ] - for ln in l repeat - sayMSG ['" ", ln] -\end{verbatim} -<>= -(defun |showInput| (mini maxi) - (prog (vec l) - (return - (seq - (do ((|ind| mini (+ |ind| 1))) - ((> |ind| maxi) NIL) - (seq - (exit - (progn - (spadlet vec (unwind-protect (|readHiFi| |ind|) (|disableHist|))) - (cond - ((> 10 |ind|) (tab 2)) - ((> 100 |ind|) (tab 1)) - (t nil)) - (spadlet l (car vec)) - (cond - ((stringp l) - (|sayMSG| - (cons - (makestring " [") - (cons |ind| - (cons (makestring "] ") - (cons (car vec) nil)))))) - (t - (|sayMSG| - (cons (makestring " [") - (cons |ind| - (cons (makestring "] ") nil)))) - (do ((tmp0 l (cdr tmp0)) (|ln| nil)) - ((or (atom tmp0) (progn (setq |ln| (car tmp0)) nil)) nil) - (seq - (exit - (|sayMSG| - (cons (makestring " ") (cons |ln| nil)))))))))))))))) - -@ -\subsection{defun showInOut} -\begin{verbatim} -showInOut(mini,maxi) == - -- displays all steps from mini to maxi - for ind in mini..maxi repeat - vec:= UNWIND_-PROTECT(readHiFi(ind),disableHist()) - sayMSG [CAR vec] - Alist:= ASSQ('%,CDR vec) => - triple:= CDR ASSQ('value,CDR Alist) - $IOindex:= ind - spadPrint(objValUnwrap triple,objMode triple) -\end{verbatim} -<>= -(defun |showInOut| (mini maxi) - (prog (vec Alist triple) - (return - (seq - (do ((ind mini (+ ind 1))) - ((> ind maxi) nil) - (seq - (exit - (progn - (spadlet vec (unwind-protect (|readHiFi| ind) (|disableHist|))) - (|sayMSG| (cons (car vec) nil)) - (cond - ((spadlet Alist (assq '% (cdr vec))) - (progn - (spadlet triple (cdr (assq '|value| (cdr Alist)))) - (spadlet |$IOindex| ind) - (|spadPrint| - (|objValUnwrap| triple) (|objMode| triple))))))))))))) - -@ -\subsection{defun fetchOutput} -\begin{verbatim} -fetchOutput(n) == - -- result is the output of step n - (n = -1) and (val := getI("%",'value)) => val - $HiFiAccess => - n:= - n < 0 => $IOindex+n - n - n >= $IOindex => throwKeyedMsg("S2IH0001",[n]) - n < 1 => throwKeyedMsg("S2IH0002",[n]) - vec:= UNWIND_-PROTECT(readHiFi(n),disableHist()) - Alist:= ASSQ('%,CDR vec) => - val:= CDR ASSQ('value,CDR Alist) => val - throwKeyedMsg("S2IH0003",[n]) - throwKeyedMsg("S2IH0003",[n]) - throwKeyedMsg("S2IH0004",NIL) -\end{verbatim} -<>= -(defun |fetchOutput| (n) - (prog (vec Alist val) - (return - (cond - ((and (boot-equal n (spaddifference 1)) - (spadlet val (|getI| '% '|value|))) - val) - (|$HiFiAccess| - (spadlet n - (cond - ((minusp n) (plus |$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 - (spadlet vec (unwind-protect (|readHiFi| n) (|disableHist|))) - (cond - ((spadlet Alist (assq '% (cdr vec))) - (cond - ((spadlet 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 - -@ -\subsection{defun readHiFi} -\begin{verbatim} -readHiFi(n) == - -- reads the file using index n - if $useInternalHistoryTable - then - pair := assoc(n,$internalHistoryTable) - ATOM pair => keyedSystemError("S2IH0034",NIL) - vec := QCDR pair - else - HiFi:= RDEFIOSTREAM ['(MODE . INPUT),['FILE,:histFileName()]] - vec:= SPADRREAD(object2Identifier n,HiFi) - RSHUT HiFi - vec -\end{verbatim} -<>= -(defun |readHiFi| (n) - (prog (pair HiFi vec) - (return - (progn - (cond - (|$useInternalHistoryTable| - (spadlet pair (|assoc| n |$internalHistoryTable|)) - (cond - ((atom pair) - (|keyedSystemError| 'S2IH0034 nil)) ; missing element - (t - (spadlet vec (qcdr pair))))) - (t - (spadlet HiFi - (rdefiostream - (cons - '(mode . input) - (cons - (cons 'file (|histFileName|)) nil)))) - (spadlet vec (spadrread (|object2Identifier| n) HiFi)) - (rshut HiFi))) - vec)))) - -@ -\subsection{defun writeHiFi} -\begin{verbatim} -writeHiFi() == - -- writes the information of the current step out to history file - if $useInternalHistoryTable - then - $internalHistoryTable := CONS([$IOindex,$currentLine,:$HistRecord], - $internalHistoryTable) - else - HiFi:= RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:histFileName()]] - SPADRWRITE(object2Identifier $IOindex, CONS($currentLine,$HistRecord),HiFi) - RSHUT HiFi -\end{verbatim} -<>= -(defun |writeHiFi| () - (prog (HiFi) - (return - (cond - (|$useInternalHistoryTable| - (spadlet |$internalHistoryTable| - (cons - (cons |$IOindex| - (cons |$currentLine| |$HistRecord|)) - |$internalHistoryTable|))) - (t - (spadlet HiFi - (rdefiostream - (cons - '(mode . output) - (cons (cons 'file (|histFileName|)) nil)))) - (spadrwrite (|object2Identifier| |$IOindex|) - (cons |$currentLine| |$HistRecord|) HiFi) - (rshut HiFi)))))) - -@ -\subsection{defun disableHist} -\begin{verbatim} -disableHist() == - -- disables the history mechanism if an error occurred in the protected - -- piece of code - not $HiFiAccess => histFileErase histFileName() - NIL -\end{verbatim} -<>= -(defun |disableHist| () - (cond - ((null |$HiFiAccess|) - (|histFileErase| (|histFileName|))) - (t nil))) - -@ -\subsection{defun writeHistModesAndValues} -\begin{verbatim} -writeHistModesAndValues() == - for [a,:.] in CAAR $InteractiveFrame repeat - x := get(a,'value,$InteractiveFrame) => - putHist(a,'value,x,$InteractiveFrame) - x := get(a,'mode,$InteractiveFrame) => - putHist(a,'mode,x,$InteractiveFrame) - NIL -\end{verbatim} -<>= -(defun |writeHistModesAndValues| () - (prog (a x) - (return - (seq - (progn - (do ((tmp0 (caar |$InteractiveFrame|) (cdr tmp0)) (tmp1 nil)) - ((or (atom tmp0) - (progn - (setq tmp1 (car tmp0)) - nil) - (progn - (progn - (spadlet a (car tmp1)) - tmp1) - nil)) - nil) - (seq - (exit - (cond - ((spadlet x (|get| a '|value| |$InteractiveFrame|)) - (|putHist| a '|value| x |$InteractiveFrame|)) - ((spadlet x (|get| a '|mode| |$InteractiveFrame|)) - (|putHist| a '|mode| x |$InteractiveFrame|)))))) - nil))))) - -@ -\section{Lisplib output transformations} ---% 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. --- SMW -\subsection{defun SPADRWRITE0} -\begin{verbatim} -SPADRWRITE0(vec, item, stream) == - val := safeWritify item - val = 'writifyFailed => val - rwrite(vec, val, stream) - item -\end{verbatim} -<>= -(defun spadrwrite0 (vec item stream) - (prog (val) - (return - (progn - (spadlet val (|safeWritify| item)) - (cond - ((boot-equal val '|writifyFailed|) val) - (t (|rwrite| vec val stream) item)))))) - -@ -\subsection{defun SPADRWRITE} -\begin{verbatim} -SPADRWRITE(vec, item, stream) == - val := SPADRWRITE0(vec, item, stream) - val = 'writifyFailed => - throwKeyedMsg("S2IH0036", nil) ; cannot save value to file - item -\end{verbatim} -<>= -(defun spadrwrite (vec item stream) - (prog (val) - (return - (progn - (spadlet val (spadrwrite0 vec item stream)) - (cond - ((boot-equal val '|writifyFailed|) - (|throwKeyedMsg| 'S2IH0036 nil)) ; cannot save value to file - (t item)))))) - -@ -\subsection{defun SPADRREAD} -\begin{verbatim} -SPADRREAD(vec, stream) == - dewritify rread(vec, stream, nil) -\end{verbatim} -<>= -(defun spadrread (vec stream) - (|dewritify| (|rread| vec stream nil))) - -@ -\subsection{defun unwritable?} -\begin{verbatim} -unwritable? ob == - PAIRP ob or VECP ob => false -- first for speed - COMPILED_-FUNCTION_-P ob or HASHTABLEP ob => true - PLACEP ob or READTABLEP ob => true - FLOATP ob => true - false -\end{verbatim} -<>= -(defun |unwritable?| (ob) - (cond - ((or (pairp ob) (vecp ob)) nil) - ((or (compiled-function-p ob) (hashtablep ob)) t) - ((or (placep ob) (readtablep ob)) t) - ((floatp ob) t) - (t nil))) - -@ -\subsection{defun writifyComplain} -\begin{verbatim} --- Create a full isomorphic object which can be saved in a lisplib. --- Note that dewritify(writify(x)) preserves UEQUALity of hashtables. --- HASHTABLEs go both ways. --- READTABLEs cannot presently be transformed back. - -writifyComplain s == - $writifyComplained = true => nil - $writifyComplained := true - sayKeyedMsg("S2IH0027",[s]) -\end{verbatim} -<>= -(defun |writifyComplain| (s) - (cond - ((boot-equal |$writifyComplained| t) NIL) - (t - (spadlet |$writifyComplained| t) - (|sayKeyedMsg| 'S2IH0027 (cons s nil))))) ; cannot save value - -@ -\subsection{defun safeWritify} -\begin{verbatim} -safeWritify ob == - CATCH('writifyTag, writify ob) -\end{verbatim} -<>= -(defun |safeWritify| (ob) - (catch '|writifyTag| (|writify| ob))) - -@ -\subsection{defun writify} -\begin{verbatim} -writify ob == - not ScanOrPairVec(function(unwritable?), ob) => ob - $seen: local := MAKE_-HASHTABLE 'EQ - $writifyComplained: local := false - - writifyInner ob where - writifyInner ob == - null ob => nil - (e := HGET($seen, ob)) => e - - PAIRP ob => - qcar := QCAR ob - qcdr := QCDR ob - (name := spadClosure? ob) => - d := writifyInner QCDR ob - nob := ['WRITIFIED_!_!, 'SPADCLOSURE, d, name] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - nob - (ob is ['LAMBDA_-CLOSURE, ., ., x, :.]) and x => - THROW('writifyTag, 'writifyFailed) - nob := CONS(qcar, qcdr) - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - qcar := writifyInner qcar - qcdr := writifyInner qcdr - QRPLACA(nob, qcar) - QRPLACD(nob, qcdr) - nob - VECP ob => - isDomainOrPackage ob => - d := mkEvalable devaluate ob - nob := ['WRITIFIED_!_!, 'DEVALUATED, writifyInner d] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - nob - n := QVMAXINDEX ob - nob := MAKE_-VEC(n+1) - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - for i in 0..n repeat - QSETVELT(nob, i, writifyInner QVELT(ob,i)) - nob - ob = 'WRITIFIED_!_! => - ['WRITIFIED_!_!, 'SELF] - -- In CCL constructors are also compiled functions, so we - -- need this line: - constructor? ob => ob - COMPILED_-FUNCTION_-P ob => - THROW('writifyTag, 'writifyFailed) - HASHTABLEP ob => - nob := ['WRITIFIED_!_!] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - keys := HKEYS ob - QRPLACD(nob, - ['HASHTABLE, - HASHTABLE_-CLASS ob, - writifyInner keys, - [writifyInner HGET(ob,k) for k in keys]]) - nob - PLACEP ob => - nob := ['WRITIFIED_!_!, 'PLACE] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - nob - -- The next three types cause an error on de-writifying. - -- Create an object of the right shape, nonetheless. - READTABLEP ob => - THROW('writifyTag, 'writifyFailed) - -- Default case: return the object itself. - STRINGP ob => - EQ(ob, $NullStream) => ['WRITIFIED_!_!, 'NULLSTREAM] - EQ(ob, $NonNullStream) => ['WRITIFIED_!_!, 'NONNULLSTREAM] - ob - FLOATP ob => - ob = READ_-FROM_-STRING STRINGIMAGE ob => ob - ['WRITIFIED_!_!, 'FLOAT, ob,: - MULTIPLE_-VALUE_-LIST INTEGER_-DECODE_-FLOAT ob] - ob -\end{verbatim} -<>= -(defun |writify,writifyInner| (ob) - (prog (e name tmp1 tmp2 tmp3 x qcar qcdr d n keys nob) - (return - (seq - (when (null ob) - (exit nil)) - (when (spadlet e (hget |$seen| ob)) - (exit e)) - (when (pairp ob) - (exit - (seq - (spadlet qcar (qcar ob)) - (spadlet qcdr (qcdr ob)) - (when (spadlet name (|spadClosure?| ob)) - (exit - (seq - (spadlet d (|writify,writifyInner| (qcdr ob))) - (spadlet nob - (cons 'writified!! - (cons 'spadclosure - (cons d (cons name nil))))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)))) - (when - (and - (and (pairp ob) - (eq (qcar ob) 'lambda-closure) - (progn - (spadlet tmp1 (qcdr ob)) - (and (pairp tmp1) - (progn - (spadlet tmp2 (qcdr tmp1)) - (and - (pairp tmp2) - (progn - (spadlet tmp3 (qcdr tmp2)) - (and (pairp tmp3) - (progn - (spadlet x (qcar tmp3)) - t)))))))) x) - (exit - (throw '|writifyTag| '|writifyFailed|))) - (spadlet nob (cons qcar qcdr)) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (spadlet qcar (|writify,writifyInner| qcar)) - (spadlet qcdr (|writify,writifyInner| qcdr)) - (qrplaca nob qcar) - (qrplacd nob qcdr) - (exit nob)))) - (when (vecp ob) - (exit - (seq - (when (|isDomainOrPackage| ob) - (exit - (seq - (spadlet d (|mkEvalable| (|devaluate| ob))) - (spadlet nob - (cons 'writified!! - (cons 'devaluated - (cons (|writify,writifyInner| d) nil)))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)))) - (spadlet n (qvmaxindex ob)) - (spadlet nob (make-vec (plus n 1))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (do ((|i| 0 (qsadd1 |i|))) - ((qsgreaterp |i| n) NIL) - (seq - (exit - (qsetvelt nob |i| (|writify,writifyInner| (QVELT ob |i|)))))) - (exit nob)))) - (when (boot-equal ob 'writified!!) - (exit - (cons 'writified!! (cons 'self nil)))) - (when (|constructor?| ob) - (exit ob)) - (when (compiled-function-p ob) - (exit - (throw '|writifyTag| '|writifyFailed|))) - (when (hashtablep ob) - (exit - (seq - (spadlet nob (cons 'writified!! nil)) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (spadlet keys (hkeys ob)) - (qrplacd nob - (cons - 'hashtable - (cons - (hashtable-class ob) - (cons - (|writify,writifyInner| keys) - (cons - (prog (tmp0) - (spadlet tmp0 nil) - (return - (do ((tmp1 keys (cdr tmp1)) (k nil)) - ((or (atom tmp1) - (progn - (setq k (car tmp1)) - nil)) - (nreverse0 tmp0)) - (seq - (exit - (setq tmp0 - (cons - (|writify,writifyInner| (HGET ob k)) - tmp0))))))) - nil))))) - (exit nob)))) - (when (placep ob) - (exit - (seq - (spadlet 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 (stringimage ob))) - (exit ob)) - (exit - (cons 'writified!! - (cons 'float - (cons ob - (multiple-value-list (integer-decode-float ob))))))))) - (exit ob))))) - -@ -<>= -(defun |writify| (ob) - (prog (|$seen| |$writifyComplained|) - (declare (special |$seen| |$writifyComplained|)) - (return - (cond - ((null (|ScanOrPairVec| (|function| |unwritable?|) ob)) - ob) - (t - (spadlet |$seen| (make-hashtable 'eq)) - (spadlet |$writifyComplained| nil) - (|writify,writifyInner| ob)))))) - -@ -\subsection{defun spadClosure?} -\begin{verbatim} -spadClosure? ob == - fun := QCAR ob - not (name := BPINAME fun) => nil - vec := QCDR ob - not VECP vec => nil - name -\end{verbatim} -<>= -(defun |spadClosure?| (ob) - (prog (fun name vec) - (return - (progn - (spadlet fun (qcar ob)) - (cond - ((null (spadlet name (bpiname fun))) nil) - (t - (spadlet vec (qcdr ob)) - (cond - ((null (vecp vec)) nil) - (t name)))))))) - -@ -\subsection{defun dewritify} -\begin{verbatim} -dewritify ob == - (not ScanOrPairVec(function is?, ob) - where is? a == a = 'WRITIFIED_!_!) => ob - - $seen: local := MAKE_-HASHTABLE 'EQ - - dewritifyInner ob where - dewritifyInner ob == - null ob => nil - e := HGET($seen, ob) => e - - PAIRP ob and CAR ob = 'WRITIFIED_!_! => - type := ob.1 - type = 'SELF => - 'WRITIFIED_!_! - type = 'BPI => - oname := ob.2 - f := - INTP oname => EVAL GENSYMMER oname - SYMBOL_-FUNCTION oname - not COMPILED_-FUNCTION_-P f => - error '"A required BPI does not exist." - #ob > 3 and HASHEQ f ^= ob.3 => - error '"A required BPI has been redefined." - HPUT($seen, ob, f) - f - type = 'HASHTABLE => - nob := MAKE_-HASHTABLE ob.2 - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - for k in ob.3 for e in ob.4 repeat - HPUT(nob, dewritifyInner k, dewritifyInner e) - nob - type = 'DEVALUATED => - nob := EVAL dewritifyInner ob.2 - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - nob - type = 'SPADCLOSURE => - vec := dewritifyInner ob.2 - name := ob.3 - not FBOUNDP name => - error STRCONC('"undefined function: ", SYMBOL_-NAME name) - nob := CONS(SYMBOL_-FUNCTION name, vec) - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - nob - type = 'PLACE => - nob := READ MAKE_-INSTREAM NIL - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - nob - type = 'READTABLE => - error '"Cannot de-writify a read table." - type = 'NULLSTREAM => $NullStream - type = 'NONNULLSTREAM => $NonNullStream - type = 'FLOAT => - [fval, signif, expon, sign] := CDDR ob - fval := SCALE_-FLOAT( FLOAT(signif, fval), expon) - sign<0 => -fval - fval - error '"Unknown type to de-writify." - - PAIRP ob => - qcar := QCAR ob - qcdr := QCDR ob - nob := CONS(qcar, qcdr) - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - QRPLACA(nob, dewritifyInner qcar) - QRPLACD(nob, dewritifyInner qcdr) - nob - VECP ob => - n := QVMAXINDEX ob - nob := MAKE_-VEC(n+1) - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) - for i in 0..n repeat - QSETVELT(nob, i, dewritifyInner QVELT(ob,i)) - nob - -- Default case: return the object itself. - ob -\end{verbatim} -<>= -(defun |dewritify,is?| (a) - (boot-equal a 'writified!!)) - -@ -<>= -(defun |dewritify,dewritifyInner| (ob) - (prog (e type oname f vec name tmp1 signif expon sign fval qcar qcdr n nob) - (return - (seq - (when (null ob) - (exit nil)) - (when (spadlet e (hget |$seen| ob)) - (exit e)) - (when (and (pairp ob) (boot-equal (car ob) 'writified!!)) - (exit - (seq - (spadlet type (elt ob 1)) - (when (boot-equal type 'self) - (exit 'writified!!)) - (when (boot-equal type 'bpi) - (exit - (seq - (spadlet oname (elt ob 2)) - (spadlet f - (seq - (when (intp oname) (exit (eval (gensymmer oname)))) - (exit (symbol-function oname)))) - (when (null (compiled-function-p f)) - (exit (|error| (makestring "A required BPI does not exist.")))) - (when (and (> (|#| ob) 3) (nequal (hasheq f) (elt ob 3))) - (exit (|error| (makestring "A required BPI has been redefined.")))) - (hput |$seen| ob f) - (exit f)))) - (when (boot-equal type 'hashtable) - (exit - (seq - (spadlet nob (make-hashtable (elt ob 2))) - (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 (boot-equal type 'devaluated) - (exit - (seq - (spadlet nob (eval (|dewritify,dewritifyInner| (elt ob 2)))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)))) - (when (boot-equal type 'spadclosure) - (exit - (seq - (spadlet vec (|dewritify,dewritifyInner| (elt ob 2))) - (spadlet name (ELT ob 3)) - (when (null (fboundp name)) - (exit - (|error| - (strconc (makestring "undefined function: ") - (symbol-name name))))) - (spadlet nob (cons (symbol-function name) vec)) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)))) - (when (boot-equal type 'place) - (exit - (seq - (spadlet nob (vmread (make-instream nil))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (exit nob)))) - (when (boot-equal type 'readtable) - (exit (|error| (makestring "Cannot de-writify a read table.")))) - (when (boot-equal type 'nullstream) - (exit |$NullStream|)) - (when (boot-equal type 'nonnullstream) - (exit |$NonNullStream|)) - (when (boot-equal type 'float) - (exit - (seq - (progn - (spadlet tmp1 (cddr ob)) - (spadlet fval (car tmp1)) - (spadlet signif (cadr tmp1)) - (spadlet expon (caddr tmp1)) - (spadlet sign (cadddr tmp1)) - tmp1) - (spadlet fval (scale-float (float signif fval) expon)) - (when (minusp sign) - (exit (spaddifference fval))) - (exit fval)))) - (exit (|error| (makestring "Unknown type to de-writify.")))))) - (when (pairp ob) - (exit - (seq - (spadlet qcar (qcar ob)) - (spadlet qcdr (qcdr ob)) - (spadlet 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 - (spadlet n (qvmaxindex ob)) - (spadlet nob (make-vec (plus n 1))) - (hput |$seen| ob nob) - (hput |$seen| nob nob) - (do ((|i| 0 (qsadd1 |i|))) - ((qsgreaterp |i| n) nil) - (seq - (exit - (qsetvelt nob |i| - (|dewritify,dewritifyInner| (qvelt ob |i|)))))) - (exit nob)))) - (exit ob))))) - -@ -<>= -(defun |dewritify| (ob) - (prog (|$seen|) - (declare (special |$seen|)) - (return - (cond - ((null (|ScanOrPairVec| (|function| |dewritify,is?|) ob)) - ob) - (t - (spadlet |$seen| (make-hashtable 'EQ)) - (|dewritify,dewritifyInner| ob)))))) - -@ -\subsection{defun ScanOrPairVec} -\begin{verbatim} -ScanOrPairVec(f, ob) == - $seen: local := MAKE_-HASHTABLE 'EQ - - CATCH('ScanOrPairVecAnswer, ScanOrInner(f, ob)) where - ScanOrInner(f, ob) == - HGET($seen, ob) => nil - PAIRP ob => - HPUT($seen, ob, true) - ScanOrInner(f, QCAR ob) - ScanOrInner(f, QCDR ob) - nil - VECP ob => - HPUT($seen, ob, true) - for i in 0..#ob-1 repeat ScanOrInner(f, ob.i) - nil - FUNCALL(f, ob) => - THROW('ScanOrPairVecAnswer, true) - nil -\end{verbatim} -<>= -(defun |ScanOrPairVec,ScanOrInner| (f ob) - (seq - (when (hget |$seen| ob) - (exit nil)) - (when (pairp ob) - (exit - (seq - (hput |$seen| ob t) - (|ScanOrPairVec,ScanOrInner| f (qcar ob)) - (|ScanOrPairVec,ScanOrInner| f (qcdr ob)) - (exit nil)))) - (when (vecp ob) - (exit - (seq - (hput |$seen| ob t) - (do ((tmp0 (spaddifference (|#| ob) 1)) (|i| 0 (qsadd1 |i|))) - ((qsgreaterp |i| tmp0) nil) - (seq - (exit (|ScanOrPairVec,ScanOrInner| f (elt ob |i|))))) - (exit nil)))) - (when (funcall f ob) - (exit - (throw '|ScanOrPairVecAnswer| t))) - (exit nil))) - -(defun |ScanOrPairVec| (f ob) - (prog (|$seen|) - (declare (special |$seen|)) - (return - (progn - (spadlet |$seen| (make-hashtable 'eq)) - (catch '|ScanOrPairVecAnswer| (|ScanOrPairVec,ScanOrInner| f ob)))))) - -@ -\subsection{defun gensymInt} -\begin{verbatim} -gensymInt g == - not GENSYMP g => error '"Need a GENSYM" - p := PNAME g - n := 0 - for i in 2..#p-1 repeat n := 10 * n + charDigitVal p.i - n -\end{verbatim} -<>= -(defun |gensymInt| (g) - (prog (p n) - (return - (seq - (cond - ((null (gensymp g)) - (|error| (makestring "Need a GENSYM"))) - (t - (spadlet p (pname g)) - (spadlet n 0) - (do ((tmp0 (spaddifference (|#| p) 1)) (|i| 2 (qsadd1 |i|))) - ((qsgreaterp |i| tmp0) nil) - (seq - (exit - (spadlet n (plus (times 10 n) (|charDigitVal| (elt p |i|))))))) - n)))))) - -@ -\subsection{defun charDigitVal} -\begin{verbatim} -charDigitVal c == - digits := '"0123456789" - n := -1 - for i in 0..#digits-1 while n < 0 repeat - if c = digits.i then n := i - n < 0 => error '"Character is not a digit" - n -\end{verbatim} -<>= -(defun |charDigitVal| (c) - (prog (digits n) - (return - (seq - (progn - (spadlet digits (makestring "0123456789")) - (spadlet n (spaddifference 1)) - (do ((tmp0 (spaddifference (|#| digits) 1)) (|i| 0 (qsadd1 |i|))) - ((or (qsgreaterp |i| tmp0) (null (minusp n))) nil) - (seq - (exit - (cond - ((boot-equal c (elt digits |i|)) (spadlet n |i|)) - (t nil))))) - (cond - ((minusp n) (|error| (makestring "Character is not a digit"))) - (t n))))))) - -@ -\subsection{defun histFileErase} -\begin{verbatim} -histFileErase file == - --OBEY STRCONC('"rm -rf ", file) - PROBE_-FILE(file) and DELETE_-FILE(file) -\end{verbatim} -<>= -(defun |histFileErase| (file) - (when (probe-file file) - (delete-file file))) - -@ -\section{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 -@ - -\chapter{The Frame Mechanism} -\section{)frame} -%\label{ugSysCmdframe} -%\index{frame} -\par\noindent{\bf Command Syntax:} -\begin{list}{} -\item{\tt )frame new {\it frameName}} -\item{\tt )frame drop {\it [frameName]}} -\item{\tt )frame next} -\item{\tt )frame last} -\item{\tt )frame names} -\item{\tt )frame import {\it frameName} {\it [objectName1 [objectName2 ...]]}} -\item{\tt )set message frame on | off} -\item{\tt )set message prompt frame} -\end{list} - -\par\noindent{\bf Command Description:} - -A {\it 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 {\it step number}, {\it environment} and {\it history.} -You can have a variable named {\tt a} in one frame and it will -have nothing to do with anything that might be called {\tt 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. -\index{frame names} -To find out the names -of all frames, issue -\begin{verbatim} -)frame names -\end{verbatim} -It will indicate the name of the current frame. - -You create a new frame -\index{frame new} -``{\bf quark}'' by issuing -\begin{verbatim} -)frame new quark -\end{verbatim} -The history facility can be turned on by issuing either -{\tt )set history on} or {\tt )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 {\bf quark.axh} will -be created as you enter commands. -If you wish to go back to what -you were doing in the -\index{frame next} -``{\bf initial}'' frame, use -\index{frame last} -\begin{verbatim} -)frame next -\end{verbatim} -or -\begin{verbatim} -)frame last -\end{verbatim} -to cycle through the ring of available frames to get back to -``{\bf initial}''. - -If you want to throw -away a frame (say ``{\bf quark}''), issue -\begin{verbatim} -)frame drop quark -\end{verbatim} -If you omit the name, the current frame is dropped. -\index{frame drop} - -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. -\index{file!history} -These are directories, so you may want to issue a command like -{\tt rm -r quark.axh} to the operating system. - -You can bring things from another frame by using -\index{frame import} -{\tt )frame import}. -For example, to bring the {\tt f} and {\tt g} from the frame ``{\bf quark}'' -to the current frame, issue -\begin{verbatim} -)frame import quark f g -\end{verbatim} -If you want everything from the frame ``{\bf quark}'', issue -\begin{verbatim} -)frame import quark -\end{verbatim} -You will be asked to verify that you really want everything. - -There are two {\tt )set} flags -\index{set message frame} -to make it easier to tell where you are. -\begin{verbatim} -)set message frame on | off -\end{verbatim} -will print more messages about frames when it is set on. -By default, it is off. -\begin{verbatim} -)set message prompt frame -\end{verbatim} -will give a prompt -\index{set message prompt frame} -that looks like -\begin{verbatim} -initial (1) -> -\end{verbatim} -\index{prompt!with frame name} -when you start up. In this case, the frame name and step make up the -prompt. - -\par\noindent{\bf Also See:} -{\tt )history} \index{ugSysCmdhistory} and -{\tt )set} \index{ugSysCmdset}. - -\subsection{defun frameName} -\begin{verbatim} -frameName(frame) == CAR frame -\end{verbatim} -<>= -(defun |frameName| (frame) - (car frame)) - -@ -\section{Variables Used} -\section{Data Structures} -\section{Functions} -\subsection{defun frameNames} -\begin{verbatim} -frameNames() == [frameName f for f in $interpreterFrameRing] -\end{verbatim} -<>= -(defun |frameNames| () - (prog () - (return - (seq - (prog (tmp0) - (spadlet tmp0 nil) - (return - (do ((tmp1 |$interpreterFrameRing| (cdr tmp1)) (f nil)) - ((or (atom tmp1) - (progn (setq f (car tmp1)) nil)) - (nreverse0 tmp0)) - (seq - (exit - (setq tmp0 (cons (|frameName| f) tmp0))))))))))) - -@ -\subsection{defun frameEnvironment} -\begin{verbatim} -frameEnvironment fname == - -- extracts the environment portion of a frame - -- if fname is not a valid frame name then the empty environment - -- is returned - fname = frameName first $interpreterFrameRing => $InteractiveFrame - ifr := rest $interpreterFrameRing - e := LIST LIST NIL - while ifr repeat - [f,:ifr] := ifr - if fname = frameName f then - e := CADR f - ifr := NIL - e -\end{verbatim} -<>= -(defun |frameEnvironment| (fname) - (prog - (tmp1 f e ifr) - (return - (seq - (cond - ((boot-equal fname (|frameName| (CAR |$interpreterFrameRing|))) - |$InteractiveFrame|) - (t - (spadlet ifr (cdr |$interpreterFrameRing|)) - (spadlet e (list (list nil))) - (do () - ((null ifr) nil) - (seq - (exit - (progn - (spadlet tmp1 ifr) - (spadlet f (car tmp1)) - (spadlet ifr (cdr tmp1)) - (cond - ((boot-equal fname (|frameName| f)) - (spadlet e (cadr f)) - (spadlet ifr nil)) - (t nil)))))) e)))))) - -@ -\subsection{defun emptyInterpreterFrame} -\begin{verbatim} -emptyInterpreterFrame(name) == - LIST(name, -- frame name - LIST LIST NIL, -- environment - 1, -- $IOindex - $HiFiAccess, -- $HiFiAccess - $HistList, -- $HistList - $HistListLen, -- $HistListLen - $HistListAct, -- $HistListAct - $HistRecord, -- $HistRecord - NIL, -- $internalHistoryTable - COPY_-SEQ $localExposureDataDefault -- $localExposureData - ) -\end{verbatim} -<>= -(defun |emptyInterpreterFrame| (name) - (list name - (list (list nil)) - 1 - |$HiFiAccess| - |$HistList| - |$HistListLen| - |$HistListAct| - |$HistRecord| - nil - (copy-seq |$localExposureDataDefault|))) - -@ -\subsection{defun createCurrentInterpreterFrame} -\begin{verbatim} -createCurrentInterpreterFrame() == - LIST($interpreterFrameName, -- frame name - $InteractiveFrame, -- environment - $IOindex, -- $IOindex - $HiFiAccess, -- $HiFiAccess - $HistList, -- $HistList - $HistListLen, -- $HistListLen - $HistListAct, -- $HistListAct - $HistRecord, -- $HistRecord - $internalHistoryTable, -- $internalHistoryTable - $localExposureData -- $localExposureData - ) -\end{verbatim} -<>= -(defun |createCurrentInterpreterFrame| () - (list - |$interpreterFrameName| - |$InteractiveFrame| - |$IOindex| - |$HiFiAccess| - |$HistList| - |$HistListLen| - |$HistListAct| - |$HistRecord| - |$internalHistoryTable| - |$localExposureData|)) - -@ -\subsection{defun updateFromCurrentInterpreterFrame} -\begin{verbatim} -updateFromCurrentInterpreterFrame() == - [$interpreterFrameName, _ - $InteractiveFrame, _ - $IOindex, _ - $HiFiAccess, _ - $HistList, _ - $HistListLen, _ - $HistListAct, _ - $HistRecord, _ - $internalHistoryTable, _ - $localExposureData _ - ] := first $interpreterFrameRing - if $frameMessages then - sayMessage ['" Current interpreter frame is called",:bright - $interpreterFrameName] - NIL -\end{verbatim} -<>= -(defun |updateFromCurrentInterpreterFrame| () - (prog (tmp1) - (return - (progn - (spadlet tmp1 (CAR |$interpreterFrameRing|)) - (spadlet |$interpreterFrameName| (car tmp1)) - (spadlet |$InteractiveFrame| (cadr tmp1)) - (spadlet |$IOindex| (caddr tmp1)) - (spadlet |$HiFiAccess| (cadddr tmp1)) - (spadlet |$HistList| (car (cddddr tmp1))) - (spadlet |$HistListLen| (cadr (cddddr tmp1))) - (spadlet |$HistListAct| (caddr (cddddr tmp1))) - (spadlet |$HistRecord| (cadddr (cddddr tmp1))) - (spadlet |$internalHistoryTable| (car (cddddr (cddddr tmp1)))) - (spadlet |$localExposureData| (cadr (cddddr (cddddr tmp1)))) - (when |$frameMessages| - (|sayMessage| - (cons - (makestring " Current interpreter frame is called") - (|bright| |$interpreterFrameName|)))) - nil)))) - -@ -\subsection{defun findFrameInRing} -\begin{verbatim} -findFrameInRing(name) == - val := NIL - for frame in $interpreterFrameRing repeat - CAR frame = name => - val := frame - return frame - val -\end{verbatim} -<>= -(defun |findFrameInRing| (name) - (prog (val) - (return - (seq - (progn - (spadlet val nil) - (seq - (do ((tmp0 |$interpreterFrameRing| (cdr tmp0)) (frame nil)) - ((or (atom tmp0) - (progn (setq frame (car tmp0)) nil)) - nil) - (seq - (exit - (when (boot-equal (CAR frame) name) - (exit - (progn - (spadlet val frame) - (return frame))))))) - (exit val))))))) - -@ -\subsection{defun updateCurrentInterpreterFrame} -\begin{verbatim} -updateCurrentInterpreterFrame() == - RPLACA($interpreterFrameRing,createCurrentInterpreterFrame()) - updateFromCurrentInterpreterFrame() - NIL -\end{verbatim} -<>= -(defun |updateCurrentInterpreterFrame| () - (progn - (rplaca |$interpreterFrameRing| (|createCurrentInterpreterFrame|)) - (|updateFromCurrentInterpreterFrame|) - nil)) - -@ -\subsection{defun initializeInterpreterFrameRing} -\begin{verbatim} -initializeInterpreterFrameRing() == - $interpreterFrameName := 'initial - $interpreterFrameRing := [emptyInterpreterFrame($interpreterFrameName)] - updateFromCurrentInterpreterFrame() - NIL -\end{verbatim} -<>= -(defun |initializeInterpreterFrameRing| () - (progn - (spadlet |$interpreterFrameName| '|initial|) - (spadlet |$interpreterFrameRing| - (cons (|emptyInterpreterFrame| |$interpreterFrameName|) nil)) - (|updateFromCurrentInterpreterFrame|) nil)) - -@ -\subsection{defun nextInterpreterFrame} -\begin{verbatim} -nextInterpreterFrame() == - updateCurrentInterpreterFrame() - null rest $interpreterFrameRing => NIL -- nothing to do - $interpreterFrameRing := - NCONC2(rest $interpreterFrameRing,[first $interpreterFrameRing]) - updateFromCurrentInterpreterFrame() -\end{verbatim} -<>= -(defun |nextInterpreterFrame| () - (progn - (|updateCurrentInterpreterFrame|) - (cond - ((null (cdr |$interpreterFrameRing|)) - nil) - (t - (spadlet |$interpreterFrameRing| - (nconc2 - (cdr |$interpreterFrameRing|) - (cons - (car |$interpreterFrameRing|) nil))) - (|updateFromCurrentInterpreterFrame|))))) - -@ -\subsection{defun changeToNamedInterpreterFrame} -\begin{verbatim} -changeToNamedInterpreterFrame(name) == - updateCurrentInterpreterFrame() - frame := findFrameInRing(name) - null frame => NIL - $interpreterFrameRing := [frame,:NREMOVE($interpreterFrameRing, frame)] - updateFromCurrentInterpreterFrame() -\end{verbatim} -<>= -(defun |changeToNamedInterpreterFrame| (name) - (prog (frame) - (return - (progn - (|updateCurrentInterpreterFrame|) - (spadlet frame (|findFrameInRing| name)) - (cond - ((null frame) - nil) - (t - (spadlet |$interpreterFrameRing| - (cons frame (nremove |$interpreterFrameRing| frame))) - (|updateFromCurrentInterpreterFrame|))))))) - -@ -\subsection{defun previousInterpreterFrame} -\begin{verbatim} -previousInterpreterFrame() == - updateCurrentInterpreterFrame() - null rest $interpreterFrameRing => NIL -- nothing to do - [:b,l] := $interpreterFrameRing - $interpreterFrameRing := NCONC2([l],b) - updateFromCurrentInterpreterFrame() -\end{verbatim} -<>= -(defun |previousInterpreterFrame| () - (prog (tmp1 l b) - (return - (progn - (|updateCurrentInterpreterFrame|) - (cond - ((null (cdr |$interpreterFrameRing|)) - nil) - (t - (spadlet tmp1 (reverse |$interpreterFrameRing|)) - (spadlet l (car tmp1)) - (spadlet b (nreverse (cdr tmp1))) - (spadlet |$interpreterFrameRing| (nconc2 (cons l nil) b)) - (|updateFromCurrentInterpreterFrame|))))))) - -@ -\subsection{defun addNewInterpreterFrame} -\begin{verbatim} -addNewInterpreterFrame(name) == - null name => throwKeyedMsg("S2IZ0018",NIL) - updateCurrentInterpreterFrame() - -- see if we already have one by that name - for f in $interpreterFrameRing repeat - name = frameName(f) => throwKeyedMsg("S2IZ0019",[name]) - initHistList() - $interpreterFrameRing := CONS(emptyInterpreterFrame(name), - $interpreterFrameRing) - updateFromCurrentInterpreterFrame() - _$ERASE histFileName() -\end{verbatim} -<>= -(defun |addNewInterpreterFrame| (name) - (seq - (cond - ((null name) - (|throwKeyedMsg| 'S2IZ0018 nil)) ; you must provide a name for new frame - (t - (|updateCurrentInterpreterFrame|) - (seq - (do ((tmp0 |$interpreterFrameRing| (cdr tmp0)) (f nil)) - ((or (atom tmp0) - (progn (setq f (car tmp0)) nil)) - nil) - (seq - (exit - (when (boot-equal name (|frameName| f)) - (exit - (|throwKeyedMsg| 'S2IZ0019 ; existing frame with same name - (cons name nil))))))) - (|initHistList|) - (spadlet |$interpreterFrameRing| - (cons (|emptyInterpreterFrame| name) |$interpreterFrameRing|)) - (|updateFromCurrentInterpreterFrame|) - ($erase (|histFileName|))))))) - -@ -\subsection{defun closeInterpreterFrame} -\begin{verbatim} -closeInterpreterFrame(name) == - -- if name = NIL then it means the current frame - null rest $interpreterFrameRing => - name and (name ^= $interpreterFrameName) => - throwKeyedMsg("S2IZ0020",[$interpreterFrameName]) - throwKeyedMsg("S2IZ0021",NIL) - if null name then $interpreterFrameRing := rest $interpreterFrameRing - else -- find the frame - found := nil - ifr := NIL - for f in $interpreterFrameRing repeat - found or (name ^= frameName(f)) => ifr := CONS(f,ifr) - found := true - not found => throwKeyedMsg("S2IZ0022",[name]) - _$ERASE makeHistFileName(name) - $interpreterFrameRing := nreverse ifr - updateFromCurrentInterpreterFrame() -\end{verbatim} -<>= -(defun |closeInterpreterFrame| (name) - (prog (ifr found) - (return - (seq - (cond - ((null (cdr |$interpreterFrameRing|)) - (cond - ((and name (nequal name |$interpreterFrameName|)) - (|throwKeyedMsg| 'S2IZ0020 ; 1 frame left. not the correct name. - (cons |$interpreterFrameName| nil))) - (t (|throwKeyedMsg| 'S2IZ0021 nil)))) ; only 1 frame left, not closed - (t - (cond - ((null name) - (spadlet |$interpreterFrameRing| (cdr |$interpreterFrameRing|))) - (t - (spadlet found nil) - (spadlet ifr nil) - (do ((tmp0 |$interpreterFrameRing| (cdr tmp0)) (f nil)) - ((or (atom tmp0) (progn (setq f (car tmp0)) nil)) nil) - (seq - (exit - (cond - ((or found (nequal name (|frameName| f))) - (spadlet ifr (cons f ifr))) - (t - (spadlet found t)))))) - (cond - ((null found) - (|throwKeyedMsg| 'S2IZ0022 (cons name nil))) - (t - ($erase (|makeHistFileName| name)) - (spadlet |$interpreterFrameRing| (nreverse ifr)))))) - (|updateFromCurrentInterpreterFrame|))))))) - -@ -\subsection{defun displayFrameNames} -\begin{verbatim} -displayFrameNames() == - fs := "append"/[ ['%l,'" ",:bright frameName f] for f in - $interpreterFrameRing] - sayKeyedMsg("S2IZ0024",[fs]) -\end{verbatim} -<>= -(defun |displayFrameNames| () - (prog (fs) - (return - (seq - (progn - (spadlet fs - (prog (tmp0) - (spadlet tmp0 NIL) - (return - (do ((tmp1 |$interpreterFrameRing| (cdr tmp1)) (f nil)) - ((or (atom tmp1) - (progn (setq f (car tmp1)) nil)) - tmp0) - (seq - (exit - (setq tmp0 - (append tmp0 (cons '|%l| - (cons (makestring " ") (|bright| (|frameName| f)))))))))))) - (|sayKeyedMsg| 'S2IZ0024 (cons fs nil))))))) ; frame names are ... - -@ -\subsection{defun importFromFrame} -\begin{verbatim} -importFromFrame args == - -- args should have the form [frameName,:varNames] - if args and atom args then args := [args] - null args => throwKeyedMsg("S2IZ0073",NIL) - [fname,:args] := args - not member(fname,frameNames()) => - throwKeyedMsg("S2IZ0074",[fname]) - fname = frameName first $interpreterFrameRing => - throwKeyedMsg("S2IZ0075",NIL) - fenv := frameEnvironment fname - null args => - x := UPCASE queryUserKeyedMsg("S2IZ0076",[fname]) - MEMQ(STRING2ID_-N(x,1),'(Y YES)) => - vars := NIL - for [v,:props] in CAAR fenv repeat - v = "--macros" => - for [m,:.] in props repeat vars := cons(m,vars) - vars := cons(v,vars) - importFromFrame [fname,:vars] - sayKeyedMsg("S2IZ0077",[fname]) - for v in args repeat - plist := GETALIST(CAAR fenv,v) - plist => - -- remove anything with the same name in the current frame - clearCmdParts ['propert,v] - for [prop,:val] in plist repeat - putHist(v,prop,val,$InteractiveFrame) - (m := get("--macros--",v,fenv)) => - putHist("--macros--",v,m,$InteractiveFrame) - sayKeyedMsg("S2IZ0079",[v,fname]) - sayKeyedMsg("S2IZ0078",[fname]) -\end{verbatim} -<>= -(defun |importFromFrame| (args) - (prog (temp1 fname fenv x v props vars plist prop val m) - (return - (seq - (progn - (when (and args (atom args)) - (spadlet args (cons args nil))) - (cond - ((null args) - (|throwKeyedMsg| 'S2IZ0073 nil)) ; missing frame name - (t - (spadlet temp1 args) - (spadlet fname (car temp1)) - (spadlet 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 - (spadlet fenv (|frameEnvironment| fname)) - (cond - ((null args) - (spadlet x - (upcase (|queryUserKeyedMsg| 'S2IZ0076 (cons fname nil)))) - ; import everything? - (cond - ((memq (string2id-n x 1) '(y yes)) - (spadlet vars nil) - (do ((tmp0 (caar fenv) (cdr tmp0)) (tmp1 nil)) - ((or (atom tmp0) - (progn (setq tmp1 (car tmp0)) nil) - (progn - (progn - (spadlet v (car tmp1)) - (spadlet props (cdr tmp1)) - tmp1) - nil)) - nil) - (seq - (exit - (cond - ((boot-equal v '|--macros|) - (do ((tmp2 props (cdr tmp2)) - (tmp3 nil)) - ((or (atom tmp2) - (progn (setq tmp3 (car tmp2)) nil) - (progn - (progn (spadlet m (car tmp3)) tmp3) - nil)) - nil) - (seq - (exit - (spadlet vars (cons m vars)))))) - (t (spadlet 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 - (spadlet 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 - (spadlet prop (car tmp6)) - (spadlet val (cdr tmp6)) - tmp6) - nil)) - nil) - (seq - (exit (|putHist| v prop val |$InteractiveFrame|))))) - ((spadlet 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))))))))))))) - -@ -\subsection{defun frame} -\begin{verbatim} --- the system command - -frame l == frameSpad2Cmd l -\end{verbatim} -<>= -(defun |frame| (l) - (|frameSpad2Cmd| l)) - -@ -\subsection{defun frameSpad2Cmd} -\begin{verbatim} -frameSpad2Cmd args == - frameArgs := '(drop import last names new next) - $options => throwKeyedMsg("S2IZ0016",['")frame"]) - null(args) => helpSpad2Cmd ['frame] - arg := selectOptionLC(first args,frameArgs,'optionError) - args := rest args - if args is [a] then args := a - if ATOM args then args := object2Identifier args - arg = 'drop => - args and PAIRP(args) => throwKeyedMsg("S2IZ0017",[args]) - closeInterpreterFrame(args) - arg = 'import => importFromFrame args - arg = 'last => previousInterpreterFrame() - arg = 'names => displayFrameNames() - arg = 'new => - args and PAIRP(args) => throwKeyedMsg("S2IZ0017",[args]) - addNewInterpreterFrame(args) - arg = 'next => nextInterpreterFrame() - - NIL -\end{verbatim} -<>= -(defun |frameSpad2Cmd| (args) - (prog (frameArgs arg a) - (return - (progn - (spadlet frameArgs '(|drop| |import| |last| |names| |new| |next|)) - (cond - (|$options| - (|throwKeyedMsg| 'S2IZ0016 ; frame command does not take options - (cons (makestring ")frame") nil))) - ((null args) - (|helpSpad2Cmd| (cons '|frame| nil))) - (t - (spadlet arg - (|selectOptionLC| (car args) frameArgs '|optionError|)) - (spadlet args (cdr args)) - (cond - ((and (pairp args) - (eq (qcdr args) nil) - (progn (spadlet a (qcar args)) t)) - (spadlet args a))) - (when (atom args) - (spadlet args (|object2Identifier| args))) - (cond - ((boot-equal arg '|drop|) - (cond - ((and args (pairp args)) - (|throwKeyedMsg| 'S2IZ0017 ; not a valid frame name - (cons args nil))) - (t (|closeInterpreterFrame| args)))) - ((boot-equal arg '|import|) - (|importFromFrame| args)) - ((boot-equal arg '|last|) - (|previousInterpreterFrame|)) - ((boot-equal arg '|names|) - (|displayFrameNames|)) - ((boot-equal arg '|new|) - (cond - ((and args (pairp args)) - (|throwKeyedMsg| 'S2IZ0017 ; not a valid frame name - (cons args nil))) - (t - (|addNewInterpreterFrame| args)))) - ((boot-equal arg '|next|) - (|nextInterpreterFrame|)) - (t nil)))))))) - -@ -\section{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. -@ -\chapter{The Undo Mechanism} -\section{)undo} -\index{ugSysCmdundo} - -\index{undo} - - -\par\noindent{\bf User Level Required:} interpreter - -\par\noindent{\bf Command Syntax:} -\begin{list}{} -\item{\tt )undo} -\item{\tt )undo} {\it integer} -\item{\tt )undo} {\it integer [option]} -\item{\tt )undo} {\tt )redo} -\end{list} -% -where {\it option} is one of -% -\begin{list}{} -\item{\tt )after} -\item{\tt )before} -\end{list} - -\par\noindent{\bf Command Description:} - -This command is used to -restore the state of the user environment to an earlier -point in the interactive session. -The argument of an {\tt )undo} is an integer which must designate some -step number in the interactive session. - -\begin{verbatim} -)undo n -)undo n )after -\end{verbatim} -These commands return the state of the interactive -environment to that immediately after step {\tt n}. -If {\tt n} is a positive number, then {\tt n} refers to step nummber -{\tt n}. If {\tt n} is a negative number, it refers to the \tt n-th -previous command (that is, undoes the effects of the last $-n$ -commands). - -A {\tt )clear all} resets the {\tt )undo} facility. -Otherwise, an {\tt )undo} undoes the effect of {\tt )clear} with -options {\tt properties}, {\tt value}, and {\tt mode}, and -that of a previous {\tt undo}. -If any such system commands are given between steps $n$ and -$n + 1$ ($n > 0$), their effect is undone -for {\tt )undo m} for any $0 < m \leq n$.. - -The command {\tt )undo} is equivalent to {\tt )undo -1} (it undoes -the effect of the previous user expression). -The command {\tt )undo 0} undoes any of the above system commands -issued since the last user expression. - -\begin{verbatim} -)undo n )before -\end{verbatim} -This command returns the state of the interactive -environment to that immediately before step {\tt n}. -Any {\tt )undo} or {\tt )clear} system commands -given before step {\tt n} will not be undone. - -\begin{verbatim} -)undo )redo -\end{verbatim} -This command reads the file {\tt redo.input}. -created by the last {\tt )undo} command. -This file consists of all user input lines, excluding those -backtracked over due to a previous {\tt )undo}. - -\par\noindent{\bf Also See:} -{\tt )history} \index{ugSysCmdhistory}. -The command {\tt )history )write} will eliminate the ``undone'' command -lines of your program. -\section{Variables Used} -\section{Data Structures} -[[$frameRecord = [delta1, delta2,... ] ]] where -[[delta(i)]] contains changes in the ``backwards'' direction. -Each [[delta(i)]] has the form [[((var . proplist)...)]] where -proplist denotes an ordinary proplist. For example, an entry -of the form [[((x (value) (mode (Integer)))...)]] indicates that -to undo 1 step, [[x]]'s value is cleared and its mode should be set -to [[(Integer)]]. - -A [[delta(i)]] of the form [[(systemCommand . delta)]] is a special -delta indicating changes due to system commands executed between -the last command and the current command. By recording these deltas -separately, it is possible to undo to either BEFORE or AFTER -the command. These special [[delta(i)]]s are given ONLY when a -a system command is given which alters the environment. - -Note: [[recordFrame('system)]] is called before a command is executed, and -[[recordFrame('normal)]] is called after (see processInteractive1). -If no changes are found for former, no special entry is given. - -The [[$previousBindings]] is a copy of the -[[CAAR $InteractiveFrame]]. This is used to -compute the [[delta(i)]]s stored in [[$frameRecord]]. -\section{Functions} -\subsection{Initial Undo Variables} -\begin{verbatim} -$undoFlag := true --Default setting for undo is "on" -$frameRecord := nil --Initial setting for frame record -$previousBindings := nil -\end{verbatim} -<>= -(defvar |$undoFlag| t "t means we record undo information") -(defvar |$frameRecord| nil "a list of value changes") -(defvar |$previousBindings| nil "a copy of Interactive Frame info for undo") -(defvar |$reportUndo| nil "t means we report the steps undo takes") -@ -\subsection{defun undo} -\begin{verbatim} -undo(l) == ---undo takes one option ")redo" which simply reads "redo.input", --- a file created by every normal )undo command (see below) - undoWhen := 'after - if $options is [[key]] then - stringPrefix?(s := PNAME key,'"redo") => - $options := nil --clear $options so that "read" won't see them - read '(redo_.input) - not stringPrefix?(s,'"before") => - userError '"only option to undo is _")redo_"" - undoWhen := 'before - n := - null l => -1 - first l - if IDENTP n then - n := PARSE_-INTEGER PNAME n - if not FIXP n then userError '"undo argument must be an integer" - $InteractiveFrame := undoSteps(undoCount n,undoWhen) - nil -\end{verbatim} -<>= -(defun |undo| (l) - (prog (tmp1 key s undoWhen n) - (return - (progn - (spadlet undoWhen '|after|) - (when - (and (pairp |$options|) - (eq (qcdr |$options|) nil) - (progn - (spadlet tmp1 (qcar |$options|)) - (and (pairp tmp1) - (eq (qcdr tmp1) nil) - (progn (spadlet key (qcar tmp1)) t))) - (cond - ((|stringPrefix?| (spadlet s (pname key)) (makestring "redo")) - (spadlet |$options| nil) - (|read| '(|redo.input|))) - ((null (|stringPrefix?| s (makestring "before"))) - (|userError| (makestring "only option to undo is \")redo\""))) - (t - (spadlet undoWhen '|before|))))) - (if (null l) - (spadlet n (spaddifference 1)) - (spadlet n (car l))) - (when (identp n) - (spadlet n (parse-integer (pname n))) - (cond - ((null (fixp n)) - (|userError| (makestring "undo argument must be an integer"))) - (t - nil))) - (spadlet |$InteractiveFrame| (|undoSteps| (|undoCount| n) undoWhen)) - nil)))) - -@ -\subsection{defun recordFrame} -\begin{verbatim} -recordFrame(systemNormal) == - null $undoFlag => nil --do nothing if facility is turned off - currentAlist := KAR $frameRecord - delta := diffAlist(CAAR $InteractiveFrame,$previousBindings) - if systemNormal = 'system then - null delta => return nil --do not record - delta := ['systemCommand,:delta] - $frameRecord := [delta,:$frameRecord] - $previousBindings := --copy all but the individual properties - [CONS(CAR x,[CONS(CAR y,CDR y) for y in CDR x]) for x in CAAR $InteractiveFrame] - first $frameRecord -\end{verbatim} -<>= -(defun |recordFrame| (systemNormal) - (prog (currentAlist delta) - (return - (seq - (cond - ((null |$undoFlag|) nil) - (t - (spadlet currentAlist (kar |$frameRecord|)) - (spadlet delta - (|diffAlist| (caar |$InteractiveFrame|) |$previousBindings|)) - (cond - ((boot-equal systemNormal '|system|) - (cond - ((null delta) - (return nil)) - (t - (spadlet delta (cons '|systemCommand| delta)))))) - (spadlet |$frameRecord| (cons delta |$frameRecord|)) - (spadlet |$previousBindings| - (prog (tmp0) - (spadlet tmp0 nil) - (return - (do ((tmp1 (caar |$InteractiveFrame|) (cdr tmp1)) (x nil)) - ((or (atom tmp1) - (progn (setq x (car tmp1)) nil)) - (nreverse0 tmp0)) - (seq - (exit - (setq tmp0 - (cons - (cons - (car x) - (prog (tmp2) - (spadlet tmp2 nil) - (return - (do ((tmp3 (cdr x) (cdr tmp3)) (|y| nil)) - ((or (atom tmp3) - (progn (setq |y| (car tmp3)) nil)) - (nreverse0 tmp2)) - (seq - (exit - (setq tmp2 (cons (cons (car |y|) (cdr |y|)) tmp2)))))))) - tmp0)))))))) - (car |$frameRecord|))))))) - -@ -\subsection{defun diffAlist} -\begin{verbatim} -diffAlist(new,old) == ---record only those properties which are different - for (pair := [name,:proplist]) in new repeat - -- name has an entry both in new and old world - -- (1) if the old world had no proplist for that variable, then - -- record NIL as the value of each new property - -- (2) if the old world does have a proplist for that variable, then - -- a) for each property with a value: give the old value - -- b) for each property missing: give NIL as the old value - oldPair := ASSQ(name,old) => - null (oldProplist := CDR oldPair) => - --record old values of new properties as NIL - acc := [[name,:[[prop] for [prop,:.] in proplist]],:acc] - deltas := nil - for (propval := [prop,:val]) in proplist repeat - null (oldPropval := ASSOC(prop,oldProplist)) => --missing property - deltas := [[prop],:deltas] - EQ(CDR oldPropval,val) => 'skip - deltas := [oldPropval,:deltas] - deltas => acc := [[name,:NREVERSE deltas],:acc] - acc := [[name,:[[prop] for [prop,:.] in proplist]],:acc] ---record properties absent on new list (say, from a )cl all) - for (oldPair := [name,:r]) in old repeat - r and null LASSQ(name,new) => - acc := [oldPair,:acc] - -- name has an entry both in new and old world - -- (1) if the new world has no proplist for that variable - -- (a) if the old world does, record the old proplist - -- (b) if the old world does not, record nothing - -- (2) if the new world has a proplist for that variable, it has - -- been handled by the first loop. - res := NREVERSE acc - if BOUNDP '$reportUndo and $reportUndo then reportUndo res - res -\end{verbatim} -<>= -(defun |diffAlist| (new old) - (prog (proplist oldPair oldProplist val oldPropval deltas prop name r acc res) - (return - (seq - (progn - (do ((tmp0 new (cdr tmp0)) (pair nil)) - ((or (atom tmp0) - (progn (setq pair (car tmp0)) nil) - (progn - (progn - (spadlet name (car pair)) - (spadlet proplist (cdr pair)) - pair) - nil)) - nil) - (seq - (exit - (cond - ((spadlet oldPair (assq name old)) - (cond - ((null (spadlet oldProplist (cdr oldPair))) - (spadlet acc - (cons - (cons - name - (prog (tmp1) - (spadlet tmp1 nil) - (return - (do ((tmp2 proplist (cdr tmp2)) (tmp3 nil)) - ((or (atom tmp2) - (progn (setq tmp3 (car tmp2)) nil) - (progn - (progn (spadlet prop (car tmp3)) tmp3) - nil)) - (nreverse0 tmp1)) - (seq - (exit - (setq tmp1 (cons (cons prop nil) tmp1)))))))) - acc))) - (t - (spadlet deltas nil) - (do ((tmp4 proplist (cdr tmp4)) (|propval| nil)) - ((or (atom tmp4) - (progn (setq |propval| (car tmp4)) nil) - (progn - (progn - (spadlet prop (car |propval|)) - (spadlet val (cdr |propval|)) - |propval|) - nil)) - nil) - (seq - (exit - (cond - ((null (spadlet oldPropval (|assoc| prop oldProplist))) - (spadlet deltas (cons (cons prop nil) deltas))) - ((eq (cdr oldPropval) val) '|skip|) - (t (spadlet deltas (cons oldPropval deltas))))))) - (when deltas - (spadlet acc - (cons (cons name (nreverse deltas)) acc)))))) - (t - (spadlet acc - (cons - (cons - name - (prog (tmp5) - (spadlet tmp5 nil) - (return - (do ((tmp6 proplist (cdr tmp6)) (tmp7 nil)) - ((or (atom tmp6) - (progn (setq tmp7 (CAR tmp6)) nil) - (progn - (progn (spadlet prop (CAR tmp7)) tmp7) - nil)) - (nreverse0 tmp5)) - (seq - (exit - (setq tmp5 (cons (cons prop nil) tmp5)))))))) - acc))))))) - (seq - (do ((tmp8 old (cdr tmp8)) (oldPair nil)) - ((or (atom tmp8) - (progn (setq oldPair (car tmp8)) nil) - (progn - (progn - (spadlet name (car oldPair)) - (spadlet r (cdr oldPair)) - oldPair) - nil)) - nil) - (seq - (exit - (cond - ((and r (null (lassq name new))) - (exit - (spadlet acc (cons oldPair acc)))))))) - (spadlet res (nreverse acc)) - (cond - ((and (boundp '|$reportUndo|) |$reportUndo|) - (|reportUndo| res))) - (exit res))))))) - -@ -\subsection{defun reportUndo} -This function is enabled by setting [[|$reportUndo]] to a non-nil value. -An example of the output generated is: -\begin{verbatim} -r := binary(22/7) - - - ___ - (1) 11.001 - Type: BinaryExpansion -Properties of % :: - value was: NIL - value is: ((|BinaryExpansion|) WRAPPED . #(1 (1 1) NIL (0 0 1))) -Properties of r :: - value was: NIL - value is: ((|BinaryExpansion|) WRAPPED . #(1 (1 1) NIL (0 0 1))) - -\end{verbatim} - -\begin{verbatim} -reportUndo acc == - for [name,:proplist] in acc repeat - sayBrightly STRCONC("Properties of ",PNAME name,'" ::") - curproplist := LASSOC(name,CAAR $InteractiveFrame) - for [prop,:value] in proplist repeat - sayBrightlyNT ['" ",prop,'" was: "] - pp value - sayBrightlyNT ['" ",prop,'" is: "] - pp LASSOC(prop,curproplist) -\end{verbatim} -<>= -(defun |reportUndo| (acc) - (prog (name proplist curproplist prop value) - (return - (seq - (do ((tmp0 acc (cdr tmp0)) (tmp1 nil)) - ((or (atom tmp0) - (progn (setq tmp1 (car tmp0)) nil) - (progn - (progn - (spadlet name (car tmp1)) - (spadlet proplist (cdr tmp1)) - tmp1) - nil)) - nil) - (seq - (exit - (progn - (|sayBrightly| - (strconc '|Properties of | (pname name) (makestring " ::"))) - (spadlet curproplist (lassoc name (caar |$InteractiveFrame|))) - (do ((tmp2 proplist (cdr tmp2)) (tmp3 nil)) - ((or (atom tmp2) - (progn (setq tmp3 (car tmp2)) nil) - (progn - (progn - (spadlet prop (car tmp3)) - (spadlet value (cdr tmp3)) - tmp3) - nil)) - nil) - (seq - (exit - (progn - (|sayBrightlyNT| - (cons - (makestring " ") - (cons prop (cons (makestring " was: ") nil)))) - (|pp| value) - (|sayBrightlyNT| - (cons - (makestring " ") - (cons prop (cons (makestring " is: ") nil)))) - (|pp| (lassoc prop curproplist)))))))))))))) - -@ -\subsection{defun clearFrame} -\begin{verbatim} -clearFrame() == - clearCmdAll() - $frameRecord := nil - $previousBindings := nil -\end{verbatim} -<>= -(defun |clearFrame| () - (progn - (|clearCmdAll|) - (spadlet |$frameRecord| nil) - (spadlet |$previousBindings| nil))) - -@ -\subsection{defun undoCount} -\begin{verbatim} ---======================================================================= --- Undoing previous m commands ---======================================================================= -undoCount(n) == --computes the number of undo's, given $IOindex ---pp ["IOindex = ",$IOindex] - m := - n >= 0 => $IOindex - n - 1 - -n - m >= $IOindex => userError STRCONC('"Magnitude of undo argument must be less than step number (",STRINGIMAGE $IOindex,'").") - m -\end{verbatim} -<>= -(defun |undoCount| (n) - (prog (m) - (return - (progn - (spadlet m - (cond - ((>= n 0) (spaddifference (spaddifference |$IOindex| n) 1)) - (t (spaddifference n)))) - (cond - ((>= m |$IOindex|) - (|userError| - (strconc - (makestring - "Magnitude of undo argument must be less than step number (") - (stringimage |$IOindex|) (makestring ").")))) - (t m)))))) - -@ -\subsection{defun undoSteps} -\begin{verbatim} -undoSteps(m,beforeOrAfter) == --- undoes m previous commands; if )before option, then undo one extra at end ---Example: if $IOindex now is 6 and m = 2 then general layout of $frameRecord, --- after the call to recordFrame below will be: --- ( --- ( --- ( --- ( --- --- ) where system --- command entries are optional and identified by (systemCommand . change). --- For a ")undo 3 )after", m = 2 and undoStep swill restore the environment --- up to, but not including . --- An "undo 3 )before" will additionally restore . --- Thus, the later requires one extra undo at the end. - writeInputLines('redo,$IOindex - m) - recordFrame('normal) --do NOT mark this as a system command change - --do this undo FIRST (i=0 case) - env := COPY CAAR $InteractiveFrame - for i in 0..m for framelist in tails $frameRecord repeat - env := undoSingleStep(first framelist,env) - framelist is [.,['systemCommand,:systemDelta],:.] => --- pp '"===============> AHA <=============" - framelist := rest framelist --undoing system commands given - env := undoSingleStep(systemDelta,env) -- before command line - lastTailSeen := framelist - if beforeOrAfter = 'before then --do one additional undo for )before - env := undoSingleStep(first rest lastTailSeen,env) - $frameRecord := rest $frameRecord --flush the effect of extra recordFrame - $InteractiveFrame := LIST LIST env -\end{verbatim} -<>= -(defun |undoSteps| (m beforeOrAfter) - (prog (tmp1 tmp2 systemDelta framelist lastTailSeen env) - (return - (seq - (progn - (|writeInputLines| '|redo| (spaddifference |$IOindex| m)) - (|recordFrame| '|normal|) - (spadlet env (copy (caar |$InteractiveFrame|))) - (do ((|i| 0 (qsadd1 |i|)) (framelist |$frameRecord| (cdr framelist))) - ((or (qsgreaterp |i| m) (atom framelist)) nil) - (seq - (exit - (progn - (spadlet env (|undoSingleStep| (CAR framelist) env)) - (cond - ((and (pairp framelist) - (progn - (spadlet tmp1 (qcdr framelist)) - (and (pairp tmp1) - (progn - (spadlet tmp2 (qcar tmp1)) - (and (pairp tmp2) - (eq (qcar tmp2) '|systemCommand|) - (progn - (spadlet systemDelta (qcdr tmp2)) - t)))))) - (spadlet framelist (cdr framelist)) - (spadlet env (|undoSingleStep| systemDelta env))) - (t (spadlet lastTailSeen framelist))))))) - (cond - ((boot-equal beforeOrAfter '|before|) - (spadlet env (|undoSingleStep| (car (cdr lastTailSeen)) env)))) - (spadlet |$frameRecord| (cdr |$frameRecord|)) - (spadlet |$InteractiveFrame| (list (list env)))))))) - -@ -\subsection{defun undoSingleStep} -\begin{verbatim} -undoSingleStep(changes,env) == ---Each change is a name-proplist pair. For each change: --- (1) if there exists a proplist in env, then for each prop-value change: --- (a) if the prop exists in env, RPLAC in the change value --- (b) otherwise, CONS it onto the front of prop-values for that name --- (2) add change to the front of env --- pp '"----Undoing 1 step--------" --- pp changes - for (change := [name,:changeList]) in changes repeat - if LASSOC('localModemap,changeList) then - changeList := undoLocalModemapHack changeList - pairlist := ASSQ(name,env) => - proplist := CDR pairlist => - for (pair := [prop,:value]) in changeList repeat - node := ASSQ(prop,proplist) => RPLACD(node,value) - RPLACD(proplist,[CAR proplist,:CDR proplist]) - RPLACA(proplist,pair) - RPLACD(pairlist,changeList) - env := [change,:env] - env -\end{verbatim} -<>= -(defun |undoSingleStep| (changes env) - (prog (name changeList pairlist proplist prop value node) - (return - (seq - (progn - (do ((tmp0 changes (cdr tmp0)) (|change| nil)) - ((or (atom tmp0) - (progn (setq |change| (car tmp0)) nil) - (progn - (progn - (spadlet name (car |change|)) - (spadlet changeList (cdr |change|)) - |change|) - nil)) - nil) - (seq - (exit - (progn - (when (lassoc '|localModemap| changeList) - (spadlet changeList (|undoLocalModemapHack| changeList))) - (cond - ((spadlet pairlist (assq name env)) - (cond - ((spadlet proplist (cdr pairlist)) - (do ((tmp1 changeList (cdr tmp1)) (pair nil)) - ((or (atom tmp1) - (progn (setq pair (car tmp1)) nil) - (progn - (progn - (spadlet prop (car pair)) - (spadlet value (cdr pair)) - pair) - nil)) - nil) - (seq - (exit - (cond - ((spadlet node (assq prop proplist)) - (rplacd node value)) - (t - (rplacd proplist - (cons (car proplist) (cdr proplist))) - (rplaca proplist pair))))))) - (t (rplacd pairlist changeList)))) - (t - (spadlet env (cons |change| env)))))))) - env))))) - -@ -\subsection{defun undoLocalModemapHack} -\begin{verbatim} -undoLocalModemapHack changeList == - [newPair for (pair := [name,:value]) in changeList | newPair] where newPair == - name = 'localModemap => [name] - pair -\end{verbatim} -<>= -(defun |undoLocalModemapHack| (changeList) - (prog (name value) - (return - (seq - (prog (tmp0) - (spadlet tmp0 NIL) - (return - (do ((tmp1 changeList (cdr tmp1)) (pair nil)) - ((or (atom tmp1) - (progn (setq pair (car tmp1)) nil) - (progn - (progn - (spadlet name (car pair)) - (spadlet value (cdr pair)) - pair) - nil)) - (nreverse0 tmp0)) - (seq - (exit - (cond - ((cond - ((boot-equal name '|localModemap|) (cons name nil)) - (t pair)) - (setq tmp0 - (cons - (cond - ((boot-equal name '|localModemap|) (cons name nil)) - (t pair)) tmp0))))))))))))) - -@ -\subsection{defun removeUndoLines} -Removing undo lines from [[)hist )write linelist]] -\begin{verbatim} -removeUndoLines u == --called by writeInputLines - xtra := - STRINGP $currentLine => [$currentLine] - REVERSE $currentLine - xtra := [x for x in xtra | not stringPrefix?('")history",x)] - u := [:u, :xtra] - not (or/[stringPrefix?('")undo",x) for x in u]) => u - --(1) reverse the list - --(2) walk down the (reversed) list: when >n appears remove: - -- (a) system commands - -- (b) if n > 0: (replace n by n-1; remove a command; repeat (a-b)) - savedIOindex := $IOindex --save value - $IOindex := 1 - for y in tails u repeat - (x := first y).0 = char '_) => - stringPrefix?('")undo",s := trimString x) => --parse "undo )option" - s1 := trimString SUBSTRING(s,5,nil) - if s1 ^= '")redo" then - m := charPosition(char '_),s1,0) - code := - m < MAXINDEX s1 => s1.(m + 1) - char 'a - s2 := trimString SUBSTRING(s1,0,m) - n := - s1 = '")redo" => 0 - s2 ^= '"" => undoCount PARSE_-INTEGER s2 - -1 - RPLACA(y,CONCAT('">",code,STRINGIMAGE n)) - nil - $IOindex := $IOindex + 1 --referenced by undoCount - acc := nil - for y in tails NREVERSE u repeat - (x := first y).0 = char '_> => - code := x . 1 --code = a,b, or r - n := PARSE_-INTEGER SUBSTRING(x,2,nil) --n = number of undo steps - y := rest y --kill >n line - while y repeat - c := first y - c.0 = char '_) or c.0 = char '_> => y := rest y --kill system commands - n = 0 => return nil --including undos - n := n - 1 - y := rest y --kill command - y and code^= char 'b => acc := [c,:acc] --add last unless )before - acc := [x,:acc] - $IOindex := savedIOindex - acc -\end{verbatim} -<>= -(defun |removeUndoLines| (u) - (prog (xtra savedIOindex s s1 m s2 x code c n y acc) - (return - (seq - (progn - (spadlet xtra - (cond - ((stringp |$currentLine|) (cons |$currentLine| nil)) - (t (reverse |$currentLine|)))) - (spadlet xtra - (prog (tmp0) - (spadlet tmp0 nil) - (return - (do ((tmp1 xtra (cdr tmp1)) (x nil)) - ((or (atom tmp1) - (progn (setq x (car tmp1)) nil)) - (nreverse0 tmp0)) - (seq - (exit - (cond - ((null (|stringPrefix?| (makestring ")history") x)) - (setq tmp0 (cons x tmp0)))))))))) - (spadlet u (append u xtra)) - (cond - ((null - (prog (tmp2) - (spadlet tmp2 nil) - (return - (do ((tmp3 nil tmp2) (tmp4 u (cdr tmp4)) (x nil)) - ((or tmp3 (atom tmp4) (progn (setq x (car tmp4)) nil)) tmp2) - (seq - (exit - (setq tmp2 - (or tmp2 (|stringPrefix?| (makestring ")undo") x))))))))) u) - (t - (spadlet savedIOindex |$IOindex|) - (spadlet |$IOindex| 1) - (do ((y u (cdr y))) - ((atom y) nil) - (seq - (exit - (cond - ((boot-equal (elt (spadlet x (car y)) 0) (|char| '|)|)) - (cond - ((|stringPrefix?| (makestring ")undo") - (spadlet s (|trimString| x))) - (spadlet s1 (|trimString| (substring s 5 nil))) - (cond - ((nequal s1 (makestring ")redo")) - (spadlet m (|charPosition| (|char| '|)|) s1 0)) - (spadlet code - (cond - ((> (maxindex s1) m) (elt s1 (plus m 1))) - (t (|char| '|a|)))) - (spadlet s2 (|trimString| (substring s1 0 m))))) - (spadlet n - (cond - ((boot-equal s1 (makestring ")redo")) - 0) - ((nequal s2 (makestring "")) - (|undoCount| (parse-integer s2))) - (t (spaddifference 1)))) - (rplaca y - (concat (makestring ">") code (stringimage n)))) - (t nil))) - (t (spadlet |$IOindex| (plus |$IOindex| 1))))))) - (spadlet acc nil) - (do ((y (nreverse u) (cdr y))) - ((atom y) nil) - (seq - (exit - (cond - ((boot-equal (elt (spadlet x (car y)) 0) (|char| '>)) - (spadlet code (elt x 1)) - (spadlet n (parse-integer (substring x 2 nil))) - (spadlet y (cdr y)) - (do () - ((null y) nil) - (seq - (exit - (progn - (spadlet c (car y)) - (cond - ((or (boot-equal (elt c 0) (|char| '|)|)) - (boot-equal (elt c 0) (|char| '>))) - (spadlet y (cdr y))) - ((eql n 0) - (return nil)) - (t - (spadlet n (spaddifference n 1)) - (spadlet y (cdr y)))))))) - (cond - ((and y (nequal code (|char| '|b|))) - (spadlet acc (cons c acc))))) - (t (spadlet acc (cons x acc))))))) - (spadlet |$IOindex| savedIOindex) - acc))))))) - -@ - -\chapter{The Spad Server Mechanism} -<>= -(defvar $openServerIfTrue t "t means try starting an open server") -(defconstant $SpadServerName "/tmp/.d" "the name of the spad server socket") -(defvar |$SpadServer| nil "t means Scratchpad acts as a remote server") - -@ - -\chapter{The Help Browser Mechanism} -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 XMLHttpRequest handling. 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{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. -<>= -(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)))) - -@ -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{The server support code} - -\chapter{Axiom Build-time Functions} -\subsection{defun spad-save} -The {\bf spad-save} function is just a cover function for more -lisp system specific save functions. There is no standard name -for saving a lisp image so we make one and conditionalize it -at compile time. - -This function is passed the name of an image that will be saved. -The saved image contains all of the loaded functions. - -This is used in the [[src/interp/Makefile.pamphlet]] in three places: -\begin{list}{} -\item creating depsys, an image for compiling axiom. - -Some of the Common Lisp code we compile uses macros which -are assumed to be available at compile time. The {\bf DEPSYS} -image is created to contain the compile time environment -and saved. We pipe compile commands into this environment -to compile from Common Lisp to machine dependent code. -\begin{verbatim} -DEPSYS= ${OBJ}/${SYS}/bin/depsys -\end{verbatim} - -\item creating savesys, an image for running axiom. - -Once we've compile all of the Common Lisp files we fire up -a clean lisp image called {\bf LOADSYS}, load all of the -final executable code and save it out as {\bf SAVESYS}. -The {\bf SAVESYS} image is copied to the [[${MNT}/${SYS}/bin]] -subdirectory and becomes the axiom executable image. -\begin{verbatim} -LOADSYS= ${OBJ}/${SYS}/bin/lisp -SAVESYS= ${OBJ}/${SYS}/bin/interpsys -AXIOMSYS= ${MNT}/${SYS}/bin/AXIOMsys -\end{verbatim} - - -\item creating debugsys, an image with all interpreted functions loaded. - -Occasionally we need to really get into the system internals. -The best way to do this is to run almost all of the lisp code -interpreted rather than compiled (note that cfuns.lisp and sockio.lisp -still need to be loaded in compiled form as they depend on the -loader to link with lisp internals). This image is nothing more -than a load of the file src/interp/debugsys.lisp.pamphlet. If -you need to make test modifications you can add code to that -file and it will show up here. -\begin{verbatim} -DEBUGSYS=${OBJ}/${SYS}/bin/debugsys -\end{verbatim} -\end{list} -<>= -(defun user::spad-save (save-file) - (setq |$SpadServer| nil) - (setq $openServerIfTrue t) -#+:AKCL - (system::save-system save-file) -#+:allegro - (if (fboundp 'boot::restart) - (excl::dumplisp :name save-file :restart-function #'boot::restart) - (excl::dumplisp :name save-file)) -#+Lucid - (if (fboundp 'boot::restart) - (sys::disksave save-file :restart-function #'boot::restart) - (sys::disksave save-file)) -#+:CCL - (preserve) -) - -@ - -\chapter{The Interpreter} -<>= -(in-package "BOOT") -<> - -<> - -<> - -<> -<> -<> -<> -<> -<> - -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> - -<> - -<> -<> -<> -<> -<> -<> -<> - -<> -<> - -<> -<> -<> -<> -<> - -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> - -<> - -<> -<> -<> - -<> -<> -<> -<> -<> -<> -<> -<> -<> - -<> - -<> -<> - -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> - -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> - -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> - -<> -<> -<> -<> -<> -<> - -<> - -@ -\chapter{Makefile.bookvol5} -<<*>>= -LATEX=/usr/bin/latex -LISP=${AXIOM}/obj/linux/bin/lisp -TANGLE=/usr/local/bin/NOTANGLE -WEAVE=/usr/local/bin/NOWEAVE -delay - -all: bookvol5 - @echo 0 done - -bookvol5: bookvol5.pamphlet - @echo 1 extracting the bookvol5reter - ${WEAVE} bookvol5.pamphlet >bookvol5.tex - ${LATEX} bookvol5.tex - ${LATEX} bookvol5.tex - ${TANGLE} -R"Interpreter" bookvol5.pamphlet >bookvol5.lisp - -remake: - @echo 2 rebuilding the makefile - @${TANGLE} bookvol5.pamphlet >Makefile.bookvol5 - -@ -\eject -\begin{thebibliography}{99} -\bibitem nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/bootlex.lisp.pamphlet b/src/interp/bootlex.lisp.pamphlet index 37ddf16..c281226 100644 --- a/src/interp/bootlex.lisp.pamphlet +++ b/src/interp/bootlex.lisp.pamphlet @@ -173,18 +173,14 @@ (*spad-input-file* nil) (*spad-output-file* nil) &aux - ;; (Echo-Meta *spad-input-file*) - ;; (*comp370-apply* (function print-and-eval-defun)) (*comp370-apply* (function print-defun)) (*fileactq-apply* (function print-defun)) - ;; (|$InteractiveMode| nil) ($SPAD T) ($BOOT nil) (XCape #\_) (OPTIONLIST nil) (*EOF* NIL) (File-Closed NIL) - ;; ($current-directory "/spad/libraries/") (/editfile *spad-input-file*) (|$noSubsumption| |$noSubsumption|) in-stream out-stream) diff --git a/src/interp/database.boot.pamphlet b/src/interp/database.boot.pamphlet index 383cf07..3c11489 100644 --- a/src/interp/database.boot.pamphlet +++ b/src/interp/database.boot.pamphlet @@ -582,46 +582,6 @@ dropPrefix(fn) == MEMBER(fn.0,[char "?",char "-",char "+"]) => SUBSTRING(fn,1,nil) fn ---moved to util.lisp ---++loadExposureGroupData() == ---++ egFile := ['interp,'exposed] ---++-- null MAKE_-INPUT_-FILENAME(egFile) => ---++-- throwKeyedMsg("S2IL0003",[namestring egFile]) ---++ stream:= DEFIOSTREAM(['(MODE . INPUT),['FILE,:egFile]],80,0) ---++ $globalExposureGroupAlist := NIL ---++ egName := NIL ---++ egFiles := NIL ---++ while (not PLACEP (x:= READ_-LINE stream)) repeat ---++ x := DROPTRAILINGBLANKS x ---++ SIZE(x) = 0 => 'iterate -- blank line ---++ (x.0 = char "#") or (x.0 = char "*") => 'iterate -- comment ---++ x.0 = char " " => ---++ -- possible exposure group member name and library name ---++ null egName => ---++ throwKeyedMsg("S2IZ0069A",[namestring egFile,x]) ---++ x := dropLeadingBlanks x ---++ -- should be two tokens on the line ---++ p := STRPOS('" ",x,1,NIL) ---++ NULL p => ---++ throwKeyedMsg("S2IZ0069B",[namestring egFile,x]) ---++ n := object2Identifier SUBSTRING(x,0,p) ---++ x := dropLeadingBlanks SUBSTRING(x,p+1,NIL) ---++ SIZE(x) = 0 => ---++ throwKeyedMsg("S2IZ0069B",[namestring egFile,x]) ---++ egFiles := [[n,:object2Identifier x],:egFiles] ---++ -- have a new group name ---++ if egName then $globalExposureGroupAlist := ---++ [[egName,:nreverse egFiles],:$globalExposureGroupAlist] ---++ egFiles := NIL ---++ STRPOS('" ",x,1,NIL) => ---++ throwKeyedMsg("S2IZ0069C",[namestring egFile,x]) ---++ egName := object2Identifier x ---++ if egFiles then $globalExposureGroupAlist := ---++ [[egName,:nreverse egFiles],:$globalExposureGroupAlist] ---++ SHUT stream ---++ $globalExposureGroupAlist := nreverse $globalExposureGroupAlist ---++ 'done - isExposedConstructor name == -- this function checks the local exposure data in the frame to -- see if the given constructor is exposed. The format of diff --git a/src/interp/interp-proclaims.lisp b/src/interp/interp-proclaims.lisp index 85867b2..3c9d854 100644 --- a/src/interp/interp-proclaims.lisp +++ b/src/interp/interp-proclaims.lisp @@ -56,7 +56,7 @@ BOOT::|compExpression| BOOT::|e02gafDefaultSolve| BOOT::|e02aefDefaultSolve| BOOT::|e02bbfDefaultSolve| BOOT::|asytranForm| BOOT::|asytranFormSpecial| - BOOT::|asytranApplySpecial| BOOT::SOCK-GET-STRING + BOOT::|asytranApplySpecial| BOOT::|sockGetString| BOOT::|showIt| BOOT::|pmPreparse,fn| BOOT::|pmPreparse,gn| BOOT::|dbSearchAbbrev| BOOT::|mkUpDownPattern,recurse| BOOT::|htMkPath| @@ -687,7 +687,7 @@ BOOT::|e02dff| BOOT::|e02def| BOOT::|e02ddf| BOOT::|e02dcf| BOOT::|e02daf| BOOT::|e02bef| BOOT::|e02bdf| BOOT::|minusInfinity| BOOT::|plusInfinity| - BOOT::SERVER-SWITCH BOOT::CLEARDATABASE BOOT::NBOOT-LEXPR + BOOT::CLEARDATABASE BOOT::NBOOT-LEXPR BOOT::BOOT-LEXPR BOOT::|executeQuietCommand| BOOT::|serverSwitch| BOOT::|scanS| BOOT::|sendNagmanErrorSignal| BOOT::|d01gbf| BOOT::|d01gaf| @@ -1060,12 +1060,11 @@ BOOT::|e02dafGen| BOOT::|e02bdfSolve| BOOT::|e02dffGen| BOOT::|e02akfSolve| BOOT::|asyJoinPart| BOOT::|printLine| BOOT::|sockSendWakeup| BOOT::|sockGetFloat| - BOOT::PRINT-LINE BOOT::SOCK-SEND-WAKEUP - BOOT::SOCK-GET-FLOAT BOOT::|/tb| BOOT::|/ry| BOOT::|/rx| + BOOT::|/tb| BOOT::|/ry| BOOT::|/rx| BOOT::|/cxd| BOOT::/FOOBAR BOOT::/CX BOOT::NEWNAMTRANS BOOT::|htMakeInputList| BOOT::SPAD-MODETRAN - BOOT::|popSatOutput| BOOT::|subrname| BOOT::SOCK-GET-INT - BOOT::OPEN-SERVER BOOT::|protectedEVAL| + BOOT::|popSatOutput| BOOT::|subrname| + BOOT::|protectedEVAL| BOOT::|setOutputTex| BOOT::|setOutputFortran| BOOT::|set| BOOT::|setLinkerArgs| BOOT::|protectSymbols| BOOT::|protectedSymbolsWarning| BOOT::|setStreamsCalculate| @@ -1122,7 +1121,7 @@ BOOT::|sayDisplayWidth| BOOT::INIT-LIB-FILE-GETTER BOOT::INIT-FILE-GETTER BOOT::|entryWidth| BOOT::FILE-RUNNER BOOT::|editFile| BOOT::|readForDoc| BOOT::|checkNumOfArgs| - BOOT::|openServer| BOOT::|removeBackslashes| + BOOT::OPENSERVER BOOT::|removeBackslashes| BOOT::|checkAddBackSlashes| BOOT::/RF-1 BOOT::|docreport| BOOT::|ExecuteInterpSystemCommand| BOOT::|pfFileName| BOOT::|InterpExecuteSpadSystemCommand| BOOT::|alistSize| @@ -2611,8 +2610,7 @@ BOOT::|e01dafDefaultSolve| BOOT::|replaceNamedHTPage| BOOT::|e02bafDefaultSolve| BOOT::|e02bdfDefaultSolve| BOOT::|e02defDefaultSolve| BOOT::|sockSendFloat| - BOOT::SOCK-SEND-SIGNAL BOOT::SOCK-SEND-FLOAT - BOOT::SOCK-SEND-STRING BOOT::SOCK-SEND-INT BOOT::ERASE + BOOT::ERASE BOOT::|sayErrorly| BOOT::|saturnSayErrorly| BOOT::|set1| BOOT::|displaySetOptionInformation| BOOT::|mkGrepPattern| BOOT::|showDoc| BOOT::|genSearchSayJump| BOOT::|oPageFrom| diff --git a/src/interp/sockio.lisp.pamphlet b/src/interp/sockio.lisp.pamphlet index c58f2cf..f03492e 100644 --- a/src/interp/sockio.lisp.pamphlet +++ b/src/interp/sockio.lisp.pamphlet @@ -113,57 +113,11 @@ resolve the problem (defentry NANQ () (double "NANQ")) ) -(defun open-server (name) -#+(and :lucid :ibm/370) -2 -#-(and :lucid :ibm/370) - (open_server name)) -(defun sock-get-int (type) -#+(and :lucid :ibm/370) () -#-(and :lucid :ibm/370) - (sock_get_int type)) -(defun sock-send-int (type val) -#+(and :lucid :ibm/370) () -#-(and :lucid :ibm/370) - (sock_send_int type val)) -(defun sock-get-string (type buf buf-len) -#+(and :lucid :ibm/370) () -#-(and :lucid :ibm/370) - (sock_get_string_buf type buf buf-len)) -(defun sock-send-string (type str) -#+(and :lucid :ibm/370) () -#-(and :lucid :ibm/370) - (sock_send_string_len type str (length str))) -(defun sock-get-float (type) -#+(and :lucid :ibm/370) () -#-(and :lucid :ibm/370) - (sock_get_float type)) -(defun sock-send-float (type val) -#+(and :lucid :ibm/370) () -#-(and :lucid :ibm/370) - (sock_send_float type val)) -(defun sock-send-wakeup (type) -#+(and :lucid :ibm/370) () -#-(and :lucid :ibm/370) - (sock_send_wakeup type)) -(defun server-switch () -#+(and :lucid :ibm/370) () -#-(and :lucid :ibm/370) - (server_switch)) -(defun sock-send-signal (type signal) -#+(and :lucid :ibm/370) () -#-(and :lucid :ibm/370) - (sock_send_signal type signal)) -(defun print-line (str) -#+(and :lucid :ibm/370) () -#-(and :lucid :ibm/370) - (print_line str)) (defun |plusInfinity| () (plus_infinity)) (defun |minusInfinity| () (minus_infinity)) ;; Macros for use in Boot -(defun |openServer| (name) - (open_server name)) (defun |sockGetInt| (type) (sock_get_int type)) (defun |sockSendInt| (type val)