diff --git a/books/Makefile.pamphlet b/books/Makefile.pamphlet index df96faf..02d7458 100644 --- a/books/Makefile.pamphlet +++ b/books/Makefile.pamphlet @@ -31,12 +31,40 @@ RM=rm -f BOOKS=${PDF}/bookvol0.pdf ${PDF}/bookvol1.pdf ${PDF}/bookvol2.pdf \ ${PDF}/bookvol3.pdf ${PDF}/bookvol4.pdf ${PDF}/bookvol5.pdf \ ${PDF}/bookvol6.pdf ${PDF}/bookvol7.pdf ${PDF}/bookvol7.1.pdf \ - ${PDF}/bookvol8.pdf ${PDF}/bookvol9.pdf ${PDF}/bookvol10.pdf \ + ${PDF}/bookvol8.pdf ${PDF}/bookvol10.pdf \ ${PDF}/bookvol10.1.pdf ${PDF}/bookvol10.2.pdf ${PDF}/bookvol10.3.pdf \ ${PDF}/bookvol10.4.pdf ${PDF}/bookvol10.5.pdf \ ${PDF}/bookvol11.pdf ${PDF}/bookvol12.pdf ${PDF}/bookvolbib.pdf -all: ${PDF}/axiom.sty ${BOOKS} ${PDF}/toc.pdf +BUUKS=${PDF}/bookvol9.pdf + +all: ${PDF}/axiom.sty ${BUUKS} ${BOOKS} ${PDF}/toc.pdf + +${PDF}/bookvol9.pdf: ${IN}/bookvol9.pamphlet + @echo books/1 making ${PDF}/bookvol9.pdf from ${IN}/bookvol9.pamphlet + (cd ${PDF} ; \ + cp ${IN}/bookvol9.pamphlet ${PDF}/bookvol9.tex ; \ + cp -pr ${IN}/ps ${PDF} ; \ + if [ -z "${NOISE}" ] ; then \ + ${RM} bookvol9.toc ; \ + ${LATEX} bookvol9.tex ; \ + ${MAKEINDEX} bookvol9 >/dev/null ; \ + ${LATEX} bookvol9.tex >/dev/null ; \ + ${DVIPDFM} bookvol9.dvi 2>/dev/null ; \ + ${RM} bookvol9.aux bookvol9.dvi bookvol9.log bookvol9.ps ; \ + ${RM} bookvol9.idx bookvol9.tex bookvol9.pamphlet ; \ + ${RM} bookvol9.ilg bookvol9.ind ; \ + else \ + ${RM} bookvol9.toc ; \ + ${LATEX} bookvol9.tex >${TMP}/trace ; \ + echo ...first latex complete ; \ + ${MAKEINDEX} bookvol9 >${TMP}/trace ; \ + ${LATEX} bookvol9.tex >${TMP}/trace ; \ + ${DVIPDFM} bookvol9.dvi 2>${TMP}/trace ; \ + ${RM} bookvol9.aux bookvol9.dvi bookvol9.log bookvol9.ps ; \ + ${RM} bookvol9.idx bookvol9.tex bookvol9.pamphlet ; \ + ${RM} bookvol9.ilg bookvol9.ind ; \ + fi ) ${PDF}/%.pdf: ${IN}/%.pamphlet @echo 0 making ${PDF}/$*.pdf from ${IN}/$*.pamphlet diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 6fbe322..d26fcd9 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -3144,7 +3144,7 @@ The value of the {\tt )set break} variable then controls what happens. ; the right argument of the first operator. \end{verbatim} -<>= +\begin{chunk}{LEDNUDTables} ; ** TABLE CREATION (defun makenewop (x y) (makeop x y '|PARSE-NewKEY|)) @@ -3228,14 +3228,14 @@ The value of the {\tt )set break} variable then controls what happens. (|then| 0 114) (|else| 0 114))) -@ +\end{chunk} \section{Gliph Table} Gliphs are symbol clumps. The gliph property of a symbol gives the tree describing the tokens which begin with that symbol. The token reader uses the gliph property to determine the longest token. -Thus [[:=]] is read as one token not as [[:]] followed by [[=]]. +Thus $:=$ is read as one token not as : followed by $=$. -<>= +\begin{chunk}{GLIPHTable} (mapcar #'(lambda (x) (makeprop (car x) 'gliph (cdr x))) `( ( \| (\)) ) @@ -3253,11 +3253,11 @@ Thus [[:=]] is read as one token not as [[:]] followed by [[=]]. ( \~ (=) ) ( \: (=) (-) (\:)))) -@ +\end{chunk} \subsection{Rename Token Table} RENAMETOK defines alternate token strings which can be used for different keyboards which define equivalent tokens. -<>= +\begin{chunk}{RENAMETOKTable} (mapcar #'(lambda (x) (makeprop (car x) 'renametok (cadr x)) (makenewop x nil)) '((\(\| \[) ; (| |) means [] @@ -3265,17 +3265,17 @@ keyboards which define equivalent tokens. (\(< \{) ; (< >) means {} (>\) \}))) -@ +\end{chunk} \subsection{Generic function table} -GENERIC operators be suffixed by [[$]] qualifications in SPAD code. -[[$]] is then followed by a domain label, such as I for Integer, which -signifies which domain the operator refers to. For example [[+$Integer]] -is [[+]] for Integers. -<>= +GENERIC operators be suffixed by \$ qualifications in SPAD code. +\$ is then followed by a domain label, such as I for Integer, which +signifies which domain the operator refers to. For example \verb|+$Integer| +is $+$ for Integers. +\begin{chunk}{GENERICTable} (mapcar #'(lambda (x) (makeprop x 'generic 'true)) '(- = * |rem| |mod| |quo| |div| / ** |exquo| + - < > <= >= ^= )) -@ +\end{chunk} \section{Giant steps, Baby steps} We will walk through the compiler with the EQ.spad example using a @@ -3514,28 +3514,28 @@ where the ``pile'' structure of the code has been converted to a semicolon delimited form. \defdollar{index} -<>= +\begin{chunk}{initvars} (defvar $index 0 "File line number of most recently read line") -@ +\end{chunk} \defdollar{linelist} -<>= +\begin{chunk}{initvars} (defvar $linelist nil "Stack of preparsed lines") -@ +\end{chunk} \defdollar{echolinestack} -<>= +\begin{chunk}{initvars} (defvar $echolinestack nil "Stack of lines to list") -@ +\end{chunk} \defdollar{preparse-last-line} -<>= +\begin{chunk}{initvars} (defvar $preparse-last-line nil "Most recently read line") -@ +\end{chunk} \section{Parsing routines} The {\bf initialize-preparse} expects to be called before the {\bf preparse} @@ -3553,14 +3553,14 @@ is initialized as: \usesdollar{initialize-preparse}{linelist} \usesdollar{initialize-preparse}{echolinestack} \usesdollar{initialize-preparse}{preparse-last-line} -<>= +\begin{chunk}{defun initialize-preparse} (defun initialize-preparse (strm) (setq $index 0) (setq $linelist nil) (setq $echolinestack nil) (setq $preparse-last-line (get-a-line strm))) -@ +\end{chunk} The {\bf preparse} function returns a list of pairs of the form: ( (linenumber . linestring) .... (linenumber . linestring)) @@ -3742,7 +3742,7 @@ For instance, for the file {\tt EQ.spad}, we get: \usesdollar{preparse}{headerDocumentation} \usesdollar{preparse}{maxSignatureLineNumber} \usesdollar{preparse}{constructorLineNumber} -<>= +\begin{chunk}{defun preparse} (defun preparse (strm &aux (stack ())) (declare (special $comblocklist $skipme $preparse-last-line $index |$docList| $preparseReportIfTrue |$headerDocumentation| @@ -3765,7 +3765,7 @@ For instance, for the file {\tt EQ.spad}, we get: (setq |$constructorLineNumber| (ifcar (ifcar u))) u)))) -@ +\end{chunk} The {\bf preparse} function returns a list of pairs of the form: ( (linenumber . linestring) .... (linenumber . linestring)) @@ -3955,7 +3955,7 @@ The READLOOP calls preparseReadLine which returns a pair of the form \usesdollar{preparse1}{skipme} \usesdollar{preparse1}{constructorsSeen} \usesdollar{preparse1}{preparse-last-line} -<>= +\begin{chunk}{defun preparse1} (defun preparse1 (linelist) (labels ( (isSystemCommand (line lines) @@ -4206,18 +4206,18 @@ REREAD ; (pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines))))) ; (go READLOOP))) -@ +\end{chunk} \defun{parsepiles}{parsepiles} Add parens and semis to lines to aid parsing. \calls{parsepiles}{add-parens-and-semis-to-line} -<>= +\begin{chunk}{defun parsepiles} (defun parsepiles (locs lines) (mapl #'add-parens-and-semis-to-line (nconc lines '(" ")) (nconc locs '(nil))) lines) -@ +\end{chunk} \defun{add-parens-and-semis-to-line}{add-parens-and-semis-to-line} The line to be worked on is (CAR SLINES). It's indentation is (CAR SLOCS). @@ -4234,7 +4234,7 @@ leave it alone." \calls{add-parens-and-semis-to-line}{drop} \calls{add-parens-and-semis-to-line}{addclose} \calls{add-parens-and-semis-to-line}{nonblankloc} -<>= +\begin{chunk}{defun add-parens-and-semis-to-line} (defun add-parens-and-semis-to-line (slines slocs) (let ((start-column (car slocs))) (when (and start-column (> start-column 0)) @@ -4259,7 +4259,7 @@ leave it alone." (setq slines (drop (1- i) slines)) (rplaca slines (addclose (car slines) #\) ))))))) -@ +\end{chunk} \defun{preparseReadLine}{preparseReadLine} \calls{preparseReadLine}{dcq} @@ -4269,7 +4269,7 @@ leave it alone." \calls{preparseReadLine}{storeblanks} \calls{preparseReadLine}{skip-to-endif} \calls{preparseReadLine}{preparseReadLine} -<>= +\begin{chunk}{defun preparseReadLine} (defun preparseReadLine (x) (let (line ind) (dcq (ind . line) (preparseReadLine1)) @@ -4290,7 +4290,7 @@ leave it alone." (cons ind nil))))) (cons ind line))) -@ +\end{chunk} \defun{preparseReadLine1}{preparseReadLine1} \calls{preparseReadLine1}{get-a-line} @@ -4302,7 +4302,7 @@ leave it alone." \usesdollar{preparseReadLine1}{preparse-last-line} \usesdollar{preparseReadLine1}{index} \usesdollar{preparseReadLine1}{EchoLineStack} -<>= +\begin{chunk}{defun preparseReadLine1} (defun preparseReadLine1 () (labels ( (accumulateLinesWithTrailingEscape (line) @@ -4327,13 +4327,13 @@ leave it alone." (cons $index (accumulateLinesWithTrailingEscape line))) (cons $index line))))) -@ +\end{chunk} \section{I/O Handling} \defun{preparse-echo}{preparse-echo} \uses{preparse-echo}{Echo-Meta} \usesdollar{preparse-echo}{EchoLineStack} -<>= +\begin{chunk}{defun preparse-echo} (defun preparse-echo (linelist) (declare (special $EchoLineStack Echo-Meta) (ignore linelist)) (if Echo-Meta @@ -4341,21 +4341,21 @@ leave it alone." (format out-stream "~&;~A~%" x))) (setq $EchoLineStack ())) -@ +\end{chunk} -<>= +\begin{chunk}{initvars} (defparameter Current-Fragment nil "A string containing remaining chars from readline; needed because Symbolics read-line returns embedded newlines in a c-m-Y.") -@ +\end{chunk} \defun{read-a-line}{read-a-line} \calls{read-a-line}{subseq} \calls{read-a-line}{Line-New-Line} \calls{read-a-line}{read-a-line} \uses{read-a-line}{*eof*} -<>= +\begin{chunk}{defun read-a-line} (defun read-a-line (&optional (stream t)) (let (cp) (declare (special *eof*)) @@ -4374,7 +4374,7 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") (when (setq Current-Fragment (read-line stream)) (return (read-a-line stream))))))) -@ +\end{chunk} \section{Line Handling} @@ -4389,7 +4389,7 @@ non-blank line, and there is always a separator character between tokens on separate lines. Also, when a line is read, the character pointer is always positioned ON the first character. \defstruct{Line} -<>= +\begin{chunk}{initvars} ;(defstruct Line "Line of input file to parse." ; (Buffer (make-string 0) :type string) ; (Current-Char #\Return :type character) @@ -4397,11 +4397,11 @@ always positioned ON the first character. ; (Last-Index 0 :type fixnum) ; (Number 0 :type fixnum)) -@ +\end{chunk} \defun{Line-New-Line}{Line-New-Line} \usesstruct{Line-New-Line}{Line} -<>= +\begin{chunk}{defun Line-New-Line} (defun Line-New-Line (string line &optional (linenum nil)) "Sets string to be the next line stored in line." (setf (Line-Last-Index line) (1- (length string))) @@ -4411,39 +4411,39 @@ always positioned ON the first character. (setf (Line-Buffer line) string) (setf (Line-Number line) (or linenum (1+ (Line-Number line))))) -@ +\end{chunk} \defun{next-line}{next-line} -<>= +\begin{chunk}{defun next-line} (defun next-line (&optional (in-stream t)) (funcall Line-Handler in-stream)) -@ +\end{chunk} \defun{storeblanks}{storeblanks} -<>= +\begin{chunk}{defun storeblanks} (defun storeblanks (line n) (do ((i 0 (1+ i))) ((= i n) line) (setf (char line i) #\ ))) -@ +\end{chunk} \defun{initial-substring}{initial-substring} \calls{initial-substring}{mismatch} -<>= +\begin{chunk}{defun initial-substring} (defun initial-substring (pattern line) (let ((ind (mismatch pattern line))) (or (null ind) (eql ind (size pattern))))) -@ +\end{chunk} \defun{get-a-line}{get-a-line} \calls{get-a-line}{is-console} \calls{get-a-line}{mkprompt} \calls{get-a-line}{read-a-line} \calls{get-a-line}{make-string-adjustable} -<>= +\begin{chunk}{defun get-a-line} (defun get-a-line (stream) (when (is-console stream) (princ (mkprompt))) (let ((ll (read-a-line stream))) @@ -4451,17 +4451,17 @@ always positioned ON the first character. (make-string-adjustable ll) ll))) -@ +\end{chunk} \defun{make-string-adjustable}{make-string-adjustable} -<>= +\begin{chunk}{defun make-string-adjustable} (defun make-string-adjustable (s) (if (adjustable-array-p s) s (make-array (array-dimensions s) :element-type 'string-char :adjustable t :initial-contents s))) -@ +\end{chunk} \chapter{Parse Transformers} \section{Direct called parse routines} @@ -4469,7 +4469,7 @@ always positioned ON the first character. \calls{parseTransform}{msubst} \calls{parseTransform}{parseTran} \usesdollar{parseTransform}{defOp} -<>= +\begin{chunk}{defun parseTransform} (defun |parseTransform| (x) (let (|$defOp|) (declare (special |$defOp|)) @@ -4477,7 +4477,7 @@ always positioned ON the first character. (setq x (msubst '$ '% x)) ; for new compiler compatibility (|parseTran| x))) -@ +\end{chunk} \defun{parseTran}{parseTran} @@ -4487,7 +4487,7 @@ always positioned ON the first character. \calls{parseTran}{parseTranList} \calls{parseTran}{getl} \usesdollar{parseTran}{op} -<>= +\begin{chunk}{defun parseTran} (defun |parseTran| (x) (labels ( (g (op) @@ -4524,42 +4524,42 @@ always positioned ON the first character. (funcall fn argl)) (t (cons (|parseTran| |$op|) (|parseTranList| argl))))))))) -@ +\end{chunk} \defun{parseAtom}{parseAtom} \calls{parseAtom}{parseLeave} \usesdollar{parseAtom}{NoValue} -<>= +\begin{chunk}{defun parseAtom} (defun |parseAtom| (x) (declare (special |$NoValue|)) (if (eq x '|break|) (|parseLeave| (list '|$NoValue|)) x)) -@ +\end{chunk} \defun{parseTranList}{parseTranList} \calls{parseTranList}{parseTran} \calls{parseTranList}{parseTranList} -<>= +\begin{chunk}{defun parseTranList} (defun |parseTranList| (x) (if (atom x) (|parseTran| x) (cons (|parseTran| (car x)) (|parseTranList| (cdr x))))) -@ +\end{chunk} \defplist{construct}{parseConstruct} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|construct| '|parseTran|) '|parseConstruct|)) -@ +\end{chunk} \defun{parseConstruct}{parseConstruct} \calls{parseConstruct}{parseTranList} \usesdollar{parseConstruct}{insideConstructIfTrue} -<>= +\begin{chunk}{defun parseConstruct} (defun |parseConstruct| (u) (let (|$insideConstructIfTrue| x) (declare (special |$insideConstructIfTrue|)) @@ -4567,7 +4567,7 @@ always positioned ON the first character. (setq x (|parseTranList| u)) (cons '|construct| x))) -@ +\end{chunk} \section{Indirect called parse routines} In the {\bf parseTran} function there is the code: @@ -4625,11 +4625,11 @@ of the symbol being parsed. The original list read: \defplist{and}{parseAnd} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|and| '|parseTran|) '|parseAnd|)) -@ +\end{chunk} \defun{parseAnd}{parseAnd} \calls{parseAnd}{parseTran} @@ -4637,7 +4637,7 @@ of the symbol being parsed. The original list read: \calls{parseAnd}{parseTranList} \calls{parseAnd}{parseIf} \usesdollar{parseAnd}{InteractiveMode} -<>= +\begin{chunk}{defun parseAnd} (defun |parseAnd| (arg) (cond (|$InteractiveMode| (cons '|and| (|parseTranList| arg))) @@ -4647,81 +4647,81 @@ of the symbol being parsed. The original list read: (|parseIf| (list (|parseTran| (car arg)) (|parseAnd| (CDR arg)) '|false| ))))) -@ +\end{chunk} \defplist{@}{parseAtSign} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '@ '|parseTran|) '|parseAtSign|)) -@ +\end{chunk} \defun{parseAtSign}{parseAtSign} \calls{parseAtSign}{parseTran} \calls{parseAtSign}{parseType} \usesdollar{parseAtSign}{InteractiveMode} -<>= +\begin{chunk}{defun parseAtSign} (defun |parseAtSign| (arg) (declare (special |$InteractiveMode|)) (if |$InteractiveMode| (list '@ (|parseTran| (first arg)) (|parseTran| (|parseType| (second arg)))) (list '@ (|parseTran| (first arg)) (|parseTran| (second arg))))) -@ +\end{chunk} \defplist{category}{parseCategory} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'category '|parseTran|) '|parseCategory|)) -@ +\end{chunk} \defun{parseCategory}{parseCategory} \calls{parseCategory}{parseTranList} \calls{parseCategory}{parseDropAssertions} \calls{parseCategory}{contained} -<>= +\begin{chunk}{defun parseCategory} (defun |parseCategory| (arg) (let (z key) (setq z (|parseTranList| (|parseDropAssertions| arg))) (setq key (if (contained '$ z) '|domain| '|package|)) (cons 'category (cons key z)))) -@ +\end{chunk} \defplist{::}{parseCoerce} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|::| '|parseTran|) '|parseCoerce|)) -@ +\end{chunk} \defun{parseCoerce}{parseCoerce} \calls{parseCoerce}{parseType} \calls{parseCoerce}{parseTran} \usesdollar{parseCoerce}{InteractiveMode} -<>= +\begin{chunk}{defun parseCoerce} (defun |parseCoerce| (arg) (if |$InteractiveMode| (list '|::| (|parseTran| (first arg)) (|parseTran| (|parseType| (second arg)))) (list '|::| (|parseTran| (first arg)) (|parseTran| (second arg))))) -@ +\end{chunk} \defplist{:}{parseColon} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|:| '|parseTran|) '|parseColon|)) -@ +\end{chunk} \defun{parseColon}{parseColon} \calls{parseColon}{parseTran} \calls{parseColon}{parseType} \usesdollar{parseColon}{InteractiveMode} \usesdollar{parseColon}{insideConstructIfTrue} -<>= +\begin{chunk}{defun parseColon} (defun |parseColon| (arg) (cond ((and (pairp arg) (eq (qcdr arg) nil)) @@ -4736,14 +4736,14 @@ of the symbol being parsed. The original list read: (list '|:| (|parseTran| (first arg)) (|parseTran| (second arg))))))) -@ +\end{chunk} \defplist{def}{parseDEF} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'def '|parseTran|) '|parseDEF|)) -@ +\end{chunk} \defun{parseDEF}{parseDEF} \calls{parseDEF}{setDefOp} @@ -4752,7 +4752,7 @@ of the symbol being parsed. The original list read: \calls{parseDEF}{parseTranCheckForRecord} \calls{parseDEF}{opFf} \usesdollar{parseDEF}{lhs} -<>= +\begin{chunk}{defun parseDEF} (defun |parseDEF| (arg) (let (|$lhs| tList specialList body) (declare (special |$lhs|)) @@ -4766,110 +4766,110 @@ of the symbol being parsed. The original list read: (|parseTranList| specialList) (|parseTranCheckForRecord| body (|opOf| |$lhs|))))) -@ +\end{chunk} \defplist{dollargreaterthan}{parseDollarGreaterthan} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|$>| '|parseTran|) '|parseDollarGreaterThan|)) -@ +\end{chunk} \defun{parseDollarGreaterThan}{parseDollarGreaterThan} \calls{parseDollarGreaterThan}{msubst} \calls{parseDollarGreaterThan}{parseTran} \usesdollar{parseDollarGreaterThan}{op} -<>= +\begin{chunk}{defun parseDollarGreaterThan} (defun |parseDollarGreaterThan| (arg) (declare (special |$op|)) (list (msubst '$< '$> |$op|) (|parseTran| (second arg)) (|parseTran| (first arg)))) -@ +\end{chunk} \defplist{dollargreaterequal}{parseDollarGreaterEqual} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|$>=| '|parseTran|) '|parseDollarGreaterEqual|)) -@ +\end{chunk} \defun{parseDollarGreaterEqual}{parseDollarGreaterEqual} \calls{parseDollarGreaterEqual}{msubst} \calls{parseDollarGreaterEqual}{parseTran} \usesdollar{parseDollarGreaterEqual}{op} -<>= +\begin{chunk}{defun parseDollarGreaterEqual} (defun |parseDollarGreaterEqual| (arg) (declare (special |$op|)) (|parseTran| (list '|not| (cons (msubst '$< '$>= |$op|) arg)))) -@ +\end{chunk} %\defplist{dollarlessequal}{parseDollarLessEqual} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|$<=| '|parseTran|) '|parseDollarLessEqual|)) -@ +\end{chunk} \defun{parseDollarLessEqual}{parseDollarLessEqual} \calls{parseDollarLessEqual}{msubst} \calls{parseDollarLessEqual}{parseTran} \usesdollar{parseDollarLessEqual}{op} -<>= +\begin{chunk}{defun parseDollarLessEqual} (defun |parseDollarLessEqual| (arg) (declare (special |$op|)) (|parseTran| (list '|not| (cons (msubst '$> '$<= |$op|) arg)))) -@ +\end{chunk} \defplist{dollarnotequal}{parseDollarNotEqual} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|$^=| '|parseTran|) '|parseDollarNotEqual|)) -@ +\end{chunk} \defun{parseDollarNotEqual}{parseDollarNotEqual} \calls{parseDollarNotEqual}{parseTran} \calls{parseDollarNotEqual}{msubst} \usesdollar{parseDollarNotEqual}{op} -<>= +\begin{chunk}{defun parseDollarNotEqual} (defun |parseDollarNotEqual| (arg) (declare (special |$op|)) (|parseTran| (list '|not| (cons (msubst '$= '$^= |$op|) arg)))) -@ +\end{chunk} \defplist{eqv}{parseEquivalence} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|eqv| '|parseTran|) '|parseEquivalence|)) -@ +\end{chunk} \defun{parseEquivalence}{parseEquivalence} \calls{parseEquivalence}{parseIf} -<>= +\begin{chunk}{defun parseEquivalence} (defun |parseEquivalence| (arg) (|parseIf| (list (first arg) (second arg) (|parseIf| (cons (second arg) '(|false| |true|)))))) -@ +\end{chunk} \defplist{$>=$}{parseExit} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|exit| '|parseTran|) '|parseExit|)) -@ +\end{chunk} \defun{parseExit}{parseExit} \calls{parseExit}{parseTran} \calls{parseExit}{moan} -<>= +\begin{chunk}{defun parseExit} (defun |parseExit| (arg) (let (a b) (setq a (|parseTran| (car arg))) @@ -4883,51 +4883,51 @@ of the symbol being parsed. The original list read: (cons '|exit| (cons a b)))) (list '|exit| 1 a )))) -@ +\end{chunk} \defplist{$>=$}{parseGreaterEqual} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|>=| '|parseTran|) '|parseGreaterEqual|)) -@ +\end{chunk} \defun{parseGreaterEqual}{parseGreaterEqual} \calls{parseGreaterEqual}{parseTran} \usesdollar{parseGreaterEqual}{op} -<>= +\begin{chunk}{defun parseGreaterEqual} (defun |parseGreaterEqual| (arg) (declare (special |$op|)) (|parseTran| (list '|not| (cons (msubst '< '>= |$op|) arg)))) -@ +\end{chunk} \defplist{$>$}{parseGreaterThan} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|>| '|parseTran|) '|parseGreaterThan|)) -@ +\end{chunk} \defun{parseGreaterThan}{parseGreaterThan} \calls{parseGreaterThan}{parseTran} \usesdollar{parseGreaterThan}{op} -<>= +\begin{chunk}{defun parseGreaterThan} (defun |parseGreaterThan| (arg) (declare (special |$op|)) (list (msubst '< '> |$op|) (|parseTran| (second arg)) (|parseTran| (first arg)))) -@ +\end{chunk} \defplist{has}{parseHas} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|has| '|parseTran|) '|parseHas|)) -@ +\end{chunk} -<>= +\begin{chunk}{defun parseHas} (defun |parseHas| (arg) (labels ( (fn (arg) @@ -4983,7 +4983,7 @@ of the symbol being parsed. The original list read: -@ +\end{chunk} \defun{parseIf,ifTran}{parseIf,ifTran} \calls{parseIf,ifTran}{parseIf,ifTran} @@ -4992,7 +4992,7 @@ of the symbol being parsed. The original list read: \calls{parseIf,ifTran}{incExitLevel} \calls{parseIf,ifTran}{parseTran} \usesdollar{parseIf,ifTran}{InteractiveMode} -<>= +\begin{chunk}{defun parseIf,ifTran} (defun |parseIf,ifTran| (p a b) (let (pp z ap bp tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 val s) (declare (special |$InteractiveMode|)) @@ -5081,19 +5081,19 @@ of the symbol being parsed. The original list read: (t (list 'if p a b ))))) -@ +\end{chunk} \defplist{if}{parseIf} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'if '|parseTran|) '|parseIf|)) -@ +\end{chunk} \defun{parseIf}{parseIf} \calls{parseIf}{parseIf,ifTran} \calls{parseIf}{parseTran} -<>= +\begin{chunk}{defun parseIf} (defun |parseIf| (arg) (if (null (and (pairp arg) (pairp (qcdr arg)) (pairp (qcdr (qcdr arg))) (eq (qcdr (qcdr (qcdr arg))) nil))) @@ -5103,34 +5103,34 @@ of the symbol being parsed. The original list read: (|parseTran| (second arg)) (|parseTran| (third arg))))) -@ +\end{chunk} \defplist{implies}{parseImplies} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|implies| '|parseTran|) '|parseImplies|)) -@ +\end{chunk} \defun{parseImplies}{parseImplies} \calls{parseImplies}{parseIf} -<>= +\begin{chunk}{defun parseImplies} (defun |parseImplies| (arg) (|parseIf| (list (first arg) (second arg) '|true|))) -@ +\end{chunk} \defplist{in}{parseIn} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'in '|parseTran|) '|parseIn|)) -@ +\end{chunk} \defun{parseIn}{parseIn} \calls{parseIn}{parseTran} \calls{parseIn}{postError} -<>= +\begin{chunk}{defun parseIn} (defun |parseIn| (arg) (let (i n) (setq i (|parseTran| (first arg))) @@ -5166,21 +5166,21 @@ of the symbol being parsed. The original list read: (t (list 'in i n))))) -@ +\end{chunk} \defplist{inby}{parseInBy} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'inby '|parseTran|) '|parseInBy|)) -@ +\end{chunk} \defun{parseInBy}{parseInBy} \calls{parseInBy}{postError} \calls{parseInBy}{parseTran} \calls{parseInBy}{bright} \calls{parseInBy}{parseIn} -<>= +\begin{chunk}{defun parseInBy} (defun |parseInBy| (arg) (let (i n inc u) (setq i (first arg)) @@ -5203,52 +5203,52 @@ of the symbol being parsed. The original list read: (cons (third u) (cons (|parseTran| inc) (cddddr u))))))))) -@ +\end{chunk} \defplist{is}{parseIs} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|is| '|parseTran|) '|parseIs|)) -@ +\end{chunk} \defun{parseIs}{parseIs} \calls{parseIs}{parseTran} \calls{parseIs}{transIs} -<>= +\begin{chunk}{defun parseIs} (defun |parseIs| (arg) (list '|is| (|parseTran| (first arg)) (|transIs| (|parseTran| (second arg))))) -@ +\end{chunk} \defplist{isnt}{parseIsnt} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|isnt| '|parseTran|) '|parseIsnt|)) -@ +\end{chunk} \defun{parseIsnt}{parseIsnt} \calls{parseIsnt}{parseTran} \calls{parseIsnt}{transIs} -<>= +\begin{chunk}{defun parseIsnt} (defun |parseIsnt| (arg) (list '|isnt| (|parseTran| (first arg)) (|transIs| (|parseTran| (second arg))))) -@ +\end{chunk} \defplist{Join}{parseJoin} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|Join| '|parseTran|) '|parseJoin|)) -@ +\end{chunk} \defun{parseJoin}{parseJoin} \calls{parseJoin}{parseTranList} -<>= +\begin{chunk}{defun parseJoin} (defun |parseJoin| (thejoin) (labels ( (fn (arg) @@ -5262,18 +5262,18 @@ of the symbol being parsed. The original list read: ) (cons '|Join| (fn (|parseTranList| thejoin))))) -@ +\end{chunk} \defplist{leave}{parseLeave} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|leave| '|parseTran|) '|parseLeave|)) -@ +\end{chunk} \defun{parseLeave}{parseLeave} \calls{parseLeave}{parseTran} -<>= +\begin{chunk}{defun parseLeave} (defun |parseLeave| (arg) (let (a b) (setq a (|parseTran| (car arg))) @@ -5287,38 +5287,38 @@ of the symbol being parsed. The original list read: (t (cons '|leave| (cons a b))))) (t (list '|leave| 1 a))))) -@ +\end{chunk} \defplist{$<=$}{parseLessEqual} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|<=| '|parseTran|) '|parseLessEqual|)) -@ +\end{chunk} \defun{parseLessEqual}{parseLessEqual} \calls{parseLessEqual}{parseTran} \usesdollar{parseLessEqual}{op} -<>= +\begin{chunk}{defun parseLessEqual} (defun |parseLessEqual| (arg) (declare (special |$op|)) (|parseTran| (list '|not| (cons (msubst '> '<= |$op|) arg)))) -@ +\end{chunk} \defplist{let}{parseLET} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'let '|parseTran|) '|parseLET|)) -@ +\end{chunk} \defun{parseLET}{parseLET} \calls{parseLET}{parseTran} \calls{parseLET}{parseTranCheckForRecord} \calls{parseLET}{opOf} \calls{parseLET}{transIs} -<>= +\begin{chunk}{defun parseLET} (defun |parseLET| (arg) (let (p) (setq p @@ -5328,32 +5328,32 @@ of the symbol being parsed. The original list read: (list 'let (|transIs| (second p)) (third p)) p))) -@ +\end{chunk} \defplist{letd}{parseLETD} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'letd '|parseTran|) '|parseLETD|)) -@ +\end{chunk} \defun{parseLETD}{parseLETD} \calls{parseLETD}{parseTran} \calls{parseLETD}{parseType} -<>= +\begin{chunk}{defun parseLETD} (defun |parseLETD| (arg) (list 'letd (|parseTran| (first arg)) (|parseTran| (|parseType| (second arg))))) -@ +\end{chunk} \defplist{mdef}{parseMDEF} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'mdef '|parseTran|) '|parseMDEF|)) -@ +\end{chunk} \defun{parseMDEF}{parseMDEF} \calls{parseMDEF}{parseTran} @@ -5361,7 +5361,7 @@ of the symbol being parsed. The original list read: \calls{parseMDEF}{parseTranCheckForRecord} \calls{parseMDEF}{opOf} \usesdollar{parseMDEF}{lhs} -<>= +\begin{chunk}{defun parseMDEF} (defun |parseMDEF| (arg) (let (|$lhs|) (declare (special |$lhs|)) @@ -5372,65 +5372,65 @@ of the symbol being parsed. The original list read: (|parseTranList| (third arg)) (|parseTranCheckForRecord| (fourth arg) (|opOf| |$lhs|))))) -@ +\end{chunk} \defplist{not}{parseNot} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|not| '|parseTran|) '|parseNot|)) -@ +\end{chunk} \defplist{not}{parseNot} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|^| '|parseTran|) '|parseNot|)) -@ +\end{chunk} \defun{parseNot}{parseNot} \calls{parseNot}{parseTran} \usesdollar{parseNot}{InteractiveMode} -<>= +\begin{chunk}{defun parseNot} (defun |parseNot| (arg) (declare (special |$InteractiveMode|)) (if |$InteractiveMode| (list '|not| (|parseTran| (car arg))) (|parseTran| (cons 'if (cons (car arg) '(|false| |true|)))))) -@ +\end{chunk} \defplist{notequal}{parseNotEqual} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|^=| '|parseTran|) '|parseNotEqual|)) -@ +\end{chunk} \defun{parseNotEqual}{parseNotEqual} \calls{parseNotEqual}{parseTran} \calls{parseNotEqual}{msubst} \usesdollar{parseNotEqual}{op} -<>= +\begin{chunk}{defun parseNotEqual} (defun |parseNotEqual| (arg) (declare (special |$op|)) (|parseTran| (list '|not| (cons (msubst '= '^= |$op|) arg)))) -@ +\end{chunk} \defplist{or}{parseOr} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|or| '|parseTran|) '|parseOr|)) -@ +\end{chunk} \defun{parseOr}{parseOr} \calls{parseOr}{parseTran} \calls{parseOr}{parseTranList} \calls{parseOr}{parseIf} \calls{parseOr}{parseOr} -<>= +\begin{chunk}{defun parseOr} (defun |parseOr| (arg) (let (x) (setq x (|parseTran| (car arg))) @@ -5444,19 +5444,19 @@ of the symbol being parsed. The original list read: (t (|parseIf| (list x '|true| (|parseOr| (cdr arg)))))))) -@ +\end{chunk} \defplist{pretend}{parsePretend} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|pretend| '|parseTran|) '|parsePretend|)) -@ +\end{chunk} \defun{parsePretend}{parsePretend} \calls{parsePretend}{parseTran} \calls{parsePretend}{parseType} -<>= +\begin{chunk}{defun parsePretend} (defun |parsePretend| (arg) (if |$InteractiveMode| (list '|pretend| @@ -5466,19 +5466,19 @@ of the symbol being parsed. The original list read: (|parseTran| (first arg)) (|parseTran| (second arg))))) -@ +\end{chunk} \defplist{return}{parseReturn} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|return| '|parseTran|) '|parseReturn|)) -@ +\end{chunk} \defun{parseReturn}{parseReturn} \calls{parseReturn}{parseTran} \calls{parseReturn}{moan} -<>= +\begin{chunk}{defun parseReturn} (defun |parseReturn| (arg) (let (a b) (setq a (|parseTran| (car arg))) @@ -5489,18 +5489,18 @@ of the symbol being parsed. The original list read: (cons '|return| (cons 1 b))) (t (list '|return| 1 a))))) -@ +\end{chunk} \defplist{segment}{parseSegment} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'segment '|parseTran|) '|parseSegment|)) -@ +\end{chunk} \defun{parseSegment}{parseSegment} \calls{parseSegment}{parseTran} -<>= +\begin{chunk}{defun parseSegment} (defun |parseSegment| (arg) (if (and (pairp arg) (pairp (qcdr arg)) (eq (qcdr (qcdr arg)) nil)) (if (second arg) @@ -5508,21 +5508,21 @@ of the symbol being parsed. The original list read: (list 'segment (|parseTran| (first arg)))) (cons 'segment arg))) -@ +\end{chunk} \defplist{segment}{parseSeq} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'seq '|parseTran|) '|parseSeq|)) -@ +\end{chunk} \defun{parseSeq}{parseSeq} \calls{parseSeq}{postError} \calls{parseSeq}{transSeq} \calls{parseSeq}{mapInto} \calls{parseSeq}{last} -<>= +\begin{chunk}{defun parseSeq} (defun |parseSeq| (arg) (let (tmp1) (when (pairp arg) (setq tmp1 (reverse arg))) @@ -5531,37 +5531,37 @@ of the symbol being parsed. The original list read: (|postError| (list " Invalid ending to block: " (|last| arg))) (|transSeq| (|mapInto| arg '|parseTran|))))) -@ +\end{chunk} \defplist{vcons}{parseVCONS} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'vcons '|parseTran|) '|parseVCONS|)) -@ +\end{chunk} \defun{parseVCONS}{parseVCONS} \calls{parseVCONS}{parseTranList} -<>= +\begin{chunk}{defun parseVCONS} (defun |parseVCONS| (arg) (cons 'vector (|parseTranList| arg))) -@ +\end{chunk} \defplist{where}{parseWhere} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|where| '|parseTran|) '|parseWhere|)) -@ +\end{chunk} \defun{parseWhere}{parseWhere} \calls{parseWhere}{mapInto} -<>= +\begin{chunk}{defun parseWhere} (defun |parseWhere| (arg) (cons '|where| (|mapInto| arg '|parseTran|))) -@ +\end{chunk} \chapter{Compile Transformers} \section{Direct called comp routines} @@ -5623,11 +5623,11 @@ of the symbol being parsed. The original list read: \end{verbatim} \defplist{@}{compAtSign} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|add| 'special) '|compAdd|)) -@ +\end{chunk} \defun{compAdd}{compAdd} \calls{compAdd}{comp} @@ -5648,7 +5648,7 @@ of the symbol being parsed. The original list read: \usesdollar{compAdd}{packagesUsed} \usesdollar{compAdd}{functorForm} \usesdollar{compAdd}{bootStrapMode} -<>= +\begin{chunk}{defun compAdd} (defun |compAdd| (arg m e) (let (|$addForm| |$addFormLhs| code domainForm predicate tmp3 tmp4) (declare (special |$addForm| |$addFormLhs| |$EmptyMode| |$NRTaddForm| @@ -5710,33 +5710,33 @@ of the symbol being parsed. The original list read: tmp3)) (|compCapsule| (third arg) m e))))) -@ +\end{chunk} \defplist{@}{compAtSign} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|@| 'special) '|compAtSign|)) -@ +\end{chunk} \defun{compAtSign}{compAtSign} \calls{compAtSign}{addDomain} \calls{compAtSign}{comp} \calls{compAtSign}{coerce} -<>= +\begin{chunk}{defun compAtSign} (defun |compAtSign| (arg1 m e) (let ((x (second arg1)) (mprime (third arg1)) tmp) (setq e (|addDomain| mprime e)) (when (setq tmp (|comp| x mprime e)) (|coerce| tmp m)))) -@ +\end{chunk} \defplist{capsule}{compCapsule} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'capsule 'special) '|compCapsule|)) -@ +\end{chunk} \defun{compCapsule}{compCapsule} \calls{compCapsule}{bootStrapError} @@ -5746,7 +5746,7 @@ of the symbol being parsed. The original list read: \usesdollar{compCapsule}{insideExpressionIfTrue} \usesdollar{compCapsule}{functorForm} \usesdollar{compCapsule}{bootStrapMode} -<>= +\begin{chunk}{defun compCapsule} (defun |compCapsule| (arg m e) (let (|$insideExpressionIfTrue| itemList) (declare (special |$insideExpressionIfTrue| |$functorForm| /editfile @@ -5759,7 +5759,7 @@ of the symbol being parsed. The original list read: (setq |$insideExpressionIfTrue| nil) (|compCapsuleInner| itemList m (|addDomain| '$ e)))))) -@ +\end{chunk} \defun{compCapsuleInner}{compCapsuleInner} \calls{compCapsuleInner}{addInformation} @@ -5773,7 +5773,7 @@ of the symbol being parsed. The original list read: \usesdollar{compCapsuleInner}{insideCategoryPackageIfTrue} \usesdollar{compCapsuleInner}{insideCategoryIfTrue} \usesdollar{compCapsuleInner}{functorLocalParameters} -<>= +\begin{chunk}{defun compCapsuleInner} (defun |compCapsuleInner| (itemList m e) (let (localParList data code) (declare (special |$getDomainCode| |$signature| |$form| |$addForm| @@ -5790,14 +5790,14 @@ of the symbol being parsed. The original list read: (|processFunctorOrPackage| |$form| |$signature| data localParList m e))) (cons (mkpf (append |$getDomainCode| (list code)) 'progn) (list m e)))) -@ +\end{chunk} \defplist{case}{compCase} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|case| 'special) '|compCase|)) -@ +\end{chunk} \defun{compCase}{compCase} Will the jerk who commented out these two functions please NOT do so @@ -5812,14 +5812,14 @@ An angry JHD - August 15th., 1984 \calls{compCase}{addDomain} \calls{compCase}{compCase1} \calls{compCase}{coerce} -<>= +\begin{chunk}{defun compCase} (defun |compCase| (arg m e) (let (mp td) (setq mp (third arg)) (setq e (|addDomain| mp e)) (when (setq td (|compCase1| (second arg) mp e)) (|coerce| td m)))) -@ +\end{chunk} \defun{compCase1}{compCase1} \calls{compCase1}{comp} @@ -5828,7 +5828,7 @@ An angry JHD - August 15th., 1984 \calls{compCase1}{modeEqual} \usesdollar{compCase1}{Boolean} \usesdollar{compCase1}{EmptyMode} -<>= +\begin{chunk}{defun compCase1} (defun |compCase1| (x m e) (let (xp mp ep map tmp3 tmp5 tmp6 u fn) (declare (special |$Boolean| |$EmptyMode|)) @@ -5853,32 +5853,32 @@ An angry JHD - August 15th., 1984 (when (first onepair) (setq tmp6 (or tmp6 (second onepair)))))) (list (list '|call| fn xp) |$Boolean| ep)))))) -@ +\end{chunk} \defplist{Record}{compCat} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|Record| 'special) '|compCat|)) -@ +\end{chunk} \defplist{Mapping}{compCat} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|Mapping| 'special) '|compCat|)) -@ +\end{chunk} \defplist{Union}{compCat} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|Union| 'special) '|compCat|)) -@ +\end{chunk} \defun{compCat}{compCat} \calls{compCat}{getl} -<>= +\begin{chunk}{defun compCat} (defun |compCat| (form m e) (declare (ignore m)) (let (functorName fn tmp1 tmp2 funList op sig catForm) @@ -5897,14 +5897,14 @@ An angry JHD - August 15th., 1984 (unless (eq op '=) (push (list 'signature op sig) tmp2))))))) (list form catForm e)))) -@ +\end{chunk} \defplist{category}{compCategory} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'category 'special) '|compCategory|)) -@ +\end{chunk} \defun{compCategory}{compCategory} \calls{compCategory}{resolve} @@ -5913,7 +5913,7 @@ An angry JHD - August 15th., 1984 \calls{compCategory}{compCategoryItem} \calls{compCategory}{mkExplicitCategoryFunction} \calls{compCategory}{systemErrorHere} -<>= +\begin{chunk}{defun compCategory} (defun |compCategory| (x m e) (let ($top_level |$sigList| |$atList| domainOrPackage z rep) (declare (special $top_level |$sigList| |$atList|)) @@ -5937,21 +5937,21 @@ An angry JHD - August 15th., 1984 (t (|systemErrorHere| "compCategory"))))) -@ +\end{chunk} \defplist{::}{compCoerce} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|::| 'special) '|compCoerce|)) -@ +\end{chunk} \defun{compCoerce}{compCoerce} \calls{compCoerce}{addDomain} \calls{compCoerce}{getmode} \calls{compCoerce}{compCoerce1} \calls{compCoerce}{coerce} -<>= +\begin{chunk}{defun compCoerce} (defun |compCoerce| (arg m e) (let (x mp tmp1 tmp4 z td) (setq x (second arg)) @@ -5971,7 +5971,7 @@ An angry JHD - August 15th., 1984 (dolist (m1 z tmp4) (setq tmp4 (or tmp4 (|compCoerce1| x m1 e))))) (|coerce| (list (car td) mp (third td)) m)))))) -@ +\end{chunk} \defun{compCoerce1}{compCoerce1} \calls{compCoerce1}{comp} @@ -5980,7 +5980,7 @@ An angry JHD - August 15th., 1984 \calls{compCoerce1}{coerceByModemap} \calls{compCoerce1}{msubst} \calls{compCoerce1}{mkq} -<>= +\begin{chunk}{defun compCoerce1} (defun |compCoerce1| (x mp e) (let (m1 td tp gg pred code) (declare (special |$String| |$EmptyMode|)) @@ -6000,14 +6000,14 @@ An angry JHD - August 15th., 1984 (cons '|check-subtype| (cons pred (list (mkq mp) gg))))) (list code mp (third td))))))) -@ +\end{chunk} \defplist{:}{compColon} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|:| 'special) '|compColon|)) -@ +\end{chunk} \defun{compColon}{compColon} \begin{verbatim} @@ -6067,7 +6067,7 @@ An angry JHD - August 15th., 1984 \usesdollar{compColon}{FormalMapVariableList} \usesdollar{compColon}{insideCategoryIfTrue} \usesdollar{compColon}{insideExpressionIfTrue} -<>= +\begin{chunk}{defun compColon} (defun |compColon| (arg0 m e) (let (|$lhsOfColon| argf argt tprime mprime r td op argl newTarget a signature tmp2 catform tmp3 g2 g5) @@ -6183,23 +6183,23 @@ An angry JHD - August 15th., 1984 e)))) (list '|/throwAway| (|getmode| argf e) e ))))))) -@ +\end{chunk} \defplist{cons}{compCons} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'cons 'special) '|compCons|)) -@ +\end{chunk} \defun{compCons}{compCons} \calls{compCons}{compCons1} \calls{compCons}{compForm} -<>= +\begin{chunk}{defun compCons} (defun |compCons| (form m e) (or (|compCons1| form m e) (|compForm| form m e))) -@ +\end{chunk} \defun{compCons1}{compCons1} \calls{compCons1}{comp} @@ -6208,7 +6208,7 @@ An angry JHD - August 15th., 1984 \calls{compCons1}{qcar} \calls{compCons1}{qcdr} \usesdollar{compCons1}{EmptyMode} -<>= +\begin{chunk}{defun compCons1} (defun |compCons1| (arg m e) (let (mx y my yt mp mr ytp tmp1 x td) (declare (special |$EmptyMode|)) @@ -6244,52 +6244,52 @@ An angry JHD - August 15th., 1984 (list (list 'cons x y) (list '|Pair| mx my) e )))) (|convert| td m))))))) -@ +\end{chunk} \defplist{ListCategory}{compConstructorCategory} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|ListCategory| 'special) '|compConstructorCategory|)) -@ +\end{chunk} \defplist{RecordCategory}{compConstructorCategory} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|RecordCategory| 'special) '|compConstructorCategory|)) -@ +\end{chunk} \defplist{UnionCategory}{compConstructorCategory} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|UnionCategory| 'special) '|compConstructorCategory|)) -@ +\end{chunk} \defplist{VectorCategory}{compConstructorCategory} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|VectorCategory| 'special) '|compConstructorCategory|)) -@ +\end{chunk} \defun{compConstructorCategory}{compConstructorCategory} \calls{compConstructorCategory}{resolve} \usesdollar{compConstructorCategory}{Category} -<>= +\begin{chunk}{defun compConstructorCategory} (defun |compConstructorCategory| (x m e) (declare (special |$Category|)) (list x (|resolve| |$Category| m) e)) -@ +\end{chunk} \defplist{construct}{compConstruct} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|construct| 'special) '|compConstruct|)) -@ +\end{chunk} \defun{compConstruct}{compConstruct} \calls{compConstruct}{modeIsAggregateOf} @@ -6298,7 +6298,7 @@ An angry JHD - August 15th., 1984 \calls{compConstruct}{compForm} \calls{compConstruct}{compVector} \calls{compConstruct}{getDomainsInScope} -<>= +\begin{chunk}{defun compConstruct} (defun |compConstruct| (form m e) (let (z y td tp) (setq z (cdr form)) @@ -6324,14 +6324,14 @@ An angry JHD - August 15th., 1984 (setq tp (|convert| td m))) (return tp)))))))) -@ +\end{chunk} \defplist{def}{compDefine} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'def 'special) '|compDefine|)) -@ +\end{chunk} \defun{compDefine}{compDefine} \calls{compDefine}{compDefine1} @@ -6339,7 +6339,7 @@ An angry JHD - August 15th., 1984 \usesdollar{compDefine}{tripleHits} \usesdollar{compDefine}{macroIfTrue} \usesdollar{compDefine}{packagesUsed} -<>= +\begin{chunk}{defun compDefine} (defun |compDefine| (form m e) (let (|$tripleCache| |$tripleHits| |$macroIfTrue| |$packagesUsed|) (declare (special |$tripleCache| |$tripleHits| |$macroIfTrue| @@ -6350,7 +6350,7 @@ An angry JHD - August 15th., 1984 (setq |$packagesUsed| nil) (|compDefine1| form m e))) -@ +\end{chunk} \defun{compDefine1}{compDefine1} \calls{compDefine1}{macroExpand} @@ -6385,7 +6385,7 @@ An angry JHD - August 15th., 1984 \usesdollar{compDefine1}{EmptyMode} \usesdollar{compDefine1}{insideWhereIfTrue} \usesdollar{compDefine1}{insideExpressionIfTrue} -<>= +\begin{chunk}{defun compDefine1} (defun |compDefine1| (form m e) (let (|$insideExpressionIfTrue| lhs specialCases sig signature rhs newPrefix (tmp1 t)) @@ -6437,14 +6437,14 @@ An angry JHD - August 15th., 1984 (|getAbbreviation| |$op| (|#| (cdr |$form|))))) (|compDefineCapsuleFunction| form m e newPrefix |$formalArgList|))))))) -@ +\end{chunk} \defplist{elt}{compElt} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|elt| 'special) '|compElt|)) -@ +\end{chunk} \defun{compElt}{compElt} \calls{compElt}{compForm} @@ -6460,7 +6460,7 @@ An angry JHD - August 15th., 1984 \calls{compElt}{nequal} \usesdollar{compElt}{One} \usesdollar{compElt}{Zero} -<>= +\begin{chunk}{defun compElt} (defun |compElt| (form m e) (let (aDomain anOp mmList n modemap sig pred val) (declare (special |$One| |$Zero|)) @@ -6506,21 +6506,21 @@ An angry JHD - August 15th., 1984 (t (|compForm| form m e))))) -@ +\end{chunk} \defplist{exit}{compExit} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|exit| 'special) '|compExit|)) -@ +\end{chunk} \defun{compExit}{compExit} \calls{compExit}{comp} \calls{compExit}{modifyModeStack} \calls{compExit}{stackMessageIfNone} \usesdollar{compExit}{exitModeStack} -<>= +\begin{chunk}{defun compExit} (defun |compExit| (arg0 m e) (let (x index m1 u) (declare (special |$exitModeStack|)) @@ -6540,21 +6540,21 @@ An angry JHD - August 15th., 1984 (|stackMessageIfNone| (list '|cannot compile exit expression| x '|in mode| m1)))))))) -@ +\end{chunk} \defplist{has}{compHas} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|has| 'special) '|compHas|)) -@ +\end{chunk} \defun{compHas}{compHas} \calls{compHas}{chaseInferences} \calls{compHas}{compHasFormat} \calls{compHas}{coerce} \usesdollar{compHas}{e} -<>= +\begin{chunk}{defun compHas} (defun |compHas| (pred m |$e|) (declare (special |$e|)) (let (a b predCode) @@ -6564,14 +6564,14 @@ An angry JHD - August 15th., 1984 (setq predCode (|compHasFormat| pred)) (|coerce| (list predCode |$Boolean| |$e|) m))) -@ +\end{chunk} \defplist{if}{compIf} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'if 'special) '|compIf|)) -@ +\end{chunk} \defun{compIf}{compIf} \calls{compIf}{canReturn} @@ -6582,7 +6582,7 @@ An angry JHD - August 15th., 1984 \calls{compIf}{coerce} \calls{compIf}{quotify} \usesdollar{compIf}{Boolean} -<>= +\begin{chunk}{defun compIf} (defun |compIf| (arg m e) (labels ( (env (bEnv cEnv b c e) @@ -6614,40 +6614,40 @@ An angry JHD - August 15th., 1984 (setq returnEnv (env (third xbp) Ec (first xbp) xc e)) (list x mc returnEnv)))))))) -@ +\end{chunk} \defplist{import}{compImport} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|import| 'special) '|compImport|)) -@ +\end{chunk} \defun{compImport}{compImport} \calls{compImport}{addDomain} \usesdollar{compImport}{NoValueMode} -<>= +\begin{chunk}{defun compImport} (defun |compImport| (arg m e) (declare (ignore m)) (declare (special |$NoValueMode|)) (dolist (dom (cdr arg)) (setq e (|addDomain| dom e))) (list '|/throwAway| |$NoValueMode| e)) -@ +\end{chunk} \defplist{is}{compIs} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|is| 'special) '|compIs|)) -@ +\end{chunk} \defun{compIs}{compIs} \calls{compIs}{comp} \calls{compIs}{coerce} \usesdollar{compIs}{Boolean} \usesdollar{compIs}{EmptyMode} -<>= +\begin{chunk}{defun compIs} (defun |compIs| (arg m e) (let (a b aval am tmp1 bval bm td) (declare (special |$Boolean| |$EmptyMode|)) @@ -6664,14 +6664,14 @@ An angry JHD - August 15th., 1984 (setq td (list (list '|domainEqual| aval bval) |$Boolean| e )) (|coerce| td m))))) -@ +\end{chunk} \defplist{Join}{compJoin} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|Join| 'special) '|compJoin|)) -@ +\end{chunk} \defun{compJoin}{compJoin} \calls{compJoin}{nreverse0} @@ -6687,7 +6687,7 @@ An angry JHD - August 15th., 1984 \calls{compJoin}{wrapDomainSub} \calls{compJoin}{convert} \usesdollar{compJoin}{Category} -<>= +\begin{chunk}{defun compJoin} (defun |compJoin| (arg m e) (labels ( (getParms (y e) @@ -6739,14 +6739,14 @@ An angry JHD - August 15th., 1984 |$Category| e)) (|convert| td m)))))) -@ +\end{chunk} \defplist{$+->$}{compLambda} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|+->| 'special) '|compLambda|)) -@ +\end{chunk} \defun{compLambda}{compLambda} \calls{compLambda}{qcar} @@ -6754,7 +6754,7 @@ An angry JHD - August 15th., 1984 \calls{compLambda}{argsToSig} \calls{compLambda}{compAtSign} \calls{compLambda}{stackAndThrow} -<>= +\begin{chunk}{defun compLambda} (defun |compLambda| (x m e) (let (vl body tmp1 tmp2 tmp3 target args arg1 sig1 ress) (setq vl (second x)) @@ -6791,21 +6791,21 @@ An angry JHD - August 15th., 1984 (t (|stackAndThrow| (list '|compLambda| x ))))) (t (|stackAndThrow| (list '|compLambda| x )))))) -@ +\end{chunk} \defplist{leave}{compLeave} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|leave| 'special) '|compLeave|)) -@ +\end{chunk} \defun{compLeave}{compLeave} \calls{compLeave}{comp} \calls{compLeave}{modifyModeStack} \usesdollar{compLeave}{exitModeStack} \usesdollar{compLeave}{leaveLevelStack} -<>= +\begin{chunk}{defun compLeave} (defun |compLeave| (arg m e) (let (level x index u) (declare (special |$exitModeStack| |$leaveLevelStack|)) @@ -6817,14 +6817,14 @@ An angry JHD - August 15th., 1984 (|modifyModeStack| (second u) index) (list (list '|TAGGEDexit| index u) m e )))) -@ +\end{chunk} \defplist{mdef}{compMacro} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'mdef 'special) '|compMacro|)) -@ +\end{chunk} \defun{compMacro}{compMacro} \calls{compMacro}{qcar} @@ -6835,7 +6835,7 @@ An angry JHD - August 15th., 1984 \usesdollar{compMacro}{macroIfTrue} \usesdollar{compMacro}{NoValueMode} \usesdollar{compMacro}{EmptyMode} -<>= +\begin{chunk}{defun compMacro} (defun |compMacro| (form m e) (let (|$macroIfTrue| lhs signature specialCases rhs prhs) (declare (special |$macroIfTrue| |$NoValueMode| |$EmptyMode|)) @@ -6865,14 +6865,14 @@ An angry JHD - August 15th., 1984 (list '|/throwAway| |$NoValueMode| (|put| (CAR lhs) '|macro| (|macroExpand| rhs e) e))))) -@ +\end{chunk} \defplist{pretend}{compPretend} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|pretend| 'special) '|compPretend|)) -@ +\end{chunk} \defun{compPretend}{compPretend} \calls{compPretend}{addDomain} @@ -6883,7 +6883,7 @@ An angry JHD - August 15th., 1984 \calls{compPretend}{stackWarning} \usesdollar{compPretend}{newCompilerUnionFlag} \usesdollar{compPretend}{EmptyMode} -<>= +\begin{chunk}{defun compPretend} (defun |compPretend| (arg m e) (let (x tt warningMessage td tp) (declare (special |$newCompilerUnionFlag| |$EmptyMode|)) @@ -6906,35 +6906,35 @@ An angry JHD - August 15th., 1984 (when warningMessage (|stackWarning| warningMessage)) tp)))))) -@ +\end{chunk} \defplist{quote}{compQuote} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'quote 'special) '|compQuote|)) -@ +\end{chunk} \defun{compQuote}{compQuote} -<>= +\begin{chunk}{defun compQuote} (defun |compQuote| (expr m e) (list expr m e)) -@ +\end{chunk} \defplist{collect}{compRepeatOrCollect} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'collect 'special) '|compRepeatOrCollect|)) -@ +\end{chunk} \defplist{repeat}{compRepeatOrCollect} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'repeat 'special) '|compRepeatOrCollect|)) -@ +\end{chunk} \defun{compRepeatOrCollect}{compRepeatOrCollect} \calls{compRepeatOrCollect}{length} @@ -6953,7 +6953,7 @@ An angry JHD - August 15th., 1984 \usesdollar{compRepeatOrCollect}{exitModeStack} \usesdollar{compRepeatOrCollect}{leaveLevelStack} \usesdollar{compRepeatOrCollect}{formalArgList} -<>= +\begin{chunk}{defun compRepeatOrCollect} (defun |compRepeatOrCollect| (form m e) (labels ( (fn (form |$exitModeStack| |$leaveLevelStack| |$formalArgList| e) @@ -7026,24 +7026,24 @@ An angry JHD - August 15th., 1984 e))) -@ +\end{chunk} \defplist{reduce}{compReduce} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'reduce 'special) '|compReduce|)) -@ +\end{chunk} \defun{compReduce}{compReduce} \calls{compReduce}{compReduce1} \usesdollar{compReduce}{formalArgList} -<>= +\begin{chunk}{defun compReduce} (defun |compReduce| (form m e) (declare (special |$formalArgList|)) (|compReduce1| form m e |$formalArgList|)) -@ +\end{chunk} \defun{compReduce1}{compReduce1} \calls{compReduce1}{systemError} @@ -7059,7 +7059,7 @@ An angry JHD - August 15th., 1984 \usesdollar{compReduce1}{Boolean} \usesdollar{compReduce1}{e} \usesdollar{compReduce1}{endTestList} -<>= +\begin{chunk}{defun compReduce1} (defun |compReduce1| (form m e |$formalArgList|) (declare (special |$formalArgList|)) (let (|$sideEffectsList| |$until| |$initList| |$endTestList| collectForm @@ -7127,14 +7127,14 @@ An angry JHD - August 15th., 1984 (msubst (list 'until untilCode) '|$until| finalCode))) (list finalCode m e )))))))))) -@ +\end{chunk} \defplist{return}{compReturn} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|return| 'special) '|compReturn|)) -@ +\end{chunk} \defun{compReturn}{compReturn} \calls{compReturn}{stackSemanticError} @@ -7145,7 +7145,7 @@ An angry JHD - August 15th., 1984 \calls{compReturn}{modifyModeStack} \usesdollar{compReturn}{exitModeStack} \usesdollar{compReturn}{returnMode} -<>= +\begin{chunk}{defun compReturn} (defun |compReturn| (arg m e) (let (level x index u xp mp ep) (declare (special |$returnMode| |$exitModeStack|)) @@ -7172,24 +7172,24 @@ An angry JHD - August 15th., 1984 (|modifyModeStack| mp index)) (list (list '|TAGGEDreturn| 0 u) m ep)))))) -@ +\end{chunk} \defplist{seq}{compSeq} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'seq 'special) '|compSeq|)) -@ +\end{chunk} \defun{compSeq}{compSeq} \calls{compSeq}{compSeq1} \usesdollar{compSeq}{exitModeStack} -<>= +\begin{chunk}{defun compSeq} (defun |compSeq| (arg0 m e) (declare (special |$exitModeStack|)) (|compSeq1| (cdr arg0) (cons m |$exitModeStack|) e)) -@ +\end{chunk} \defun{compSeq1}{compSeq1} \calls{compSeq1}{nreverse0} @@ -7200,7 +7200,7 @@ An angry JHD - August 15th., 1984 \usesdollar{compSeq1}{insideExpressionIfTrue} \usesdollar{compSeq1}{finalEnv} \usesdollar{compSeq1}{NoValueMode} -<>= +\begin{chunk}{defun compSeq1} (defun |compSeq1| (l |$exitModeStack| e) (declare (special |$exitModeStack|)) (let (|$insideExpressionIfTrue| |$finalEnv| tmp1 tmp2 c catchTag form) @@ -7220,38 +7220,38 @@ An angry JHD - August 15th., 1984 (|replaceExitEtc| c catchTag '|TAGGEDexit| (elt |$exitModeStack| 0)))) (list (list 'catch catchTag form) (elt |$exitModeStack| 0) |$finalEnv|)))) -@ +\end{chunk} \defun{compSeqItem}{compSeqItem} \calls{compSeqItem}{comp} \calls{compSeqItem}{macroExpand} -<>= +\begin{chunk}{defun compSeqItem} (defun |compSeqItem| (x m e) (|comp| (|macroExpand| x e) m e)) -@ +\end{chunk} \defplist{let}{compSetq} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'let 'special) '|compSetq|)) -@ +\end{chunk} \defplist{setq}{compSetq} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'setq 'special) '|compSetq|)) -@ +\end{chunk} \defun{compSetq}{compSetq} \calls{compSetq}{compSetq1} -<>= +\begin{chunk}{defun compSetq} (defun |compSetq| (arg m e) (|compSetq1| (second arg) (third arg) m e)) -@ +\end{chunk} \defun{compSetq1}{compSetq1} \calls{compSetq1}{setqSingle} @@ -7263,7 +7263,7 @@ An angry JHD - August 15th., 1984 \calls{compSetq1}{setqMultiple} \calls{compSetq1}{setqSetelt} \usesdollar{compSetq1}{EmptyMode} -<>= +\begin{chunk}{defun compSetq1} (defun |compSetq1| (form val m e) (let (x y ep op z) (declare (special |$EmptyMode|)) @@ -7283,15 +7283,15 @@ An angry JHD - August 15th., 1984 ((eq op '|@Tuple|) (|setqMultiple| z val m e)) (t (|setqSetelt| form val m e))))))) -@ +\end{chunk} \defun{setqSetelt}{setqSetelt} \calls{setqSetelt}{comp} -<>= +\begin{chunk}{defun setqSetelt} (defun |setqSetelt| (arg val m e) (|comp| (cons '|setelt| (cons (car arg) (append (cdr arg) (list val)))) m e)) -@ +\end{chunk} \defun{setqSingle}{setqSingle} \calls{setqSingle}{getProplist} @@ -7321,7 +7321,7 @@ An angry JHD - August 15th., 1984 \usesdollar{setqSingle}{profileCompiler} \usesdollar{setqSingle}{EmptyMode} \usesdollar{setqSingle}{NoValueMode} -<>= +\begin{chunk}{defun setqSingle} (defun |setqSingle| (id val m e) (let (|$insideSetqSingleIfTrue| currentProplist mpp maxmpp td x mp tp key newProplist ep k form) @@ -7371,31 +7371,31 @@ An angry JHD - August 15th., 1984 (car (|outputComp| id ep))))))) (list form mp ep))))) -@ +\end{chunk} \defplist{String}{compString} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|String| 'special) '|compString|)) -@ +\end{chunk} \defun{compString}{compString} \calls{compString}{resolve} \usesdollar{compString}{StringCategory} -<>= +\begin{chunk}{defun compString} (defun |compString| (x m e) (declare (special |$StringCategory|)) (list x (|resolve| |$StringCategory| m) e)) -@ +\end{chunk} \defplist{SubDomain}{compSubDomain} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|SubDomain| 'special) '|compSubDomain|)) -@ +\end{chunk} \defun{compSubDomain}{compSubDomain} \calls{compSubDomain}{compSubDomain1} @@ -7404,7 +7404,7 @@ An angry JHD - August 15th., 1984 \usesdollar{compSubDomain}{NRTaddForm} \usesdollar{compSubDomain}{addForm} \usesdollar{compSubDomain}{addFormLhs} -<>= +\begin{chunk}{defun compSubDomain} (defun |compSubDomain| (arg m e) (let (|$addFormLhs| |$addForm| domainForm predicate tmp1) (declare (special |$addFormLhs| |$addForm| |$NRTaddForm| |$addFormLhs|)) @@ -7418,7 +7418,7 @@ An angry JHD - August 15th., 1984 (setq e (third tmp1)) (|compCapsule| (list 'capsule) m e))) -@ +\end{chunk} \defun{compSubDomain1}{compSubDomain1} \calls{compSubDomain1}{compMakeDeclaration} @@ -7432,7 +7432,7 @@ An angry JHD - August 15th., 1984 \usesdollar{compSubDomain1}{lisplibSuperDomain} \usesdollar{compSubDomain1}{Boolean} \usesdollar{compSubDomain1}{EmptyMode} -<>= +\begin{chunk}{defun compSubDomain1} (defun |compSubDomain1| (domainForm predicate m e) (let (u prefixPredicate opp dFp) (declare (special |$CategoryFrame| |$op| |$lisplibSuperDomain| |$Boolean| @@ -7459,21 +7459,21 @@ An angry JHD - August 15th., 1984 '|$CategoryFrame|)))) (list domainForm m e))) -@ +\end{chunk} \defplist{SubsetCategory}{compSubsetCategory} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|SubsetCategory| 'special) '|compSubsetCategory|)) -@ +\end{chunk} \defun{compSubsetCategory}{compSubsetCategory} \calls{compSubsetCategory}{put} \calls{compSubsetCategory}{comp} \calls{compSubsetCategory}{msubst} \usesdollar{compSubsetCategory}{lhsOfColon} -<>= +\begin{chunk}{defun compSubsetCategory} (defun |compSubsetCategory| (arg m e) (let (cat r) (declare (special |$lhsOfColon|)) @@ -7492,20 +7492,20 @@ An angry JHD - August 15th., 1984 (list 'signature '|reduce| (list '$ r))))) m e))) -@ +\end{chunk} \defplist{|}{compSuchthat} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '\| 'special) '|compSuchthat|)) -@ +\end{chunk} \defun{compSuchthat}{compSuchthat} \calls{compSuchthat}{comp} \calls{compSuchthat}{put} \usesdollar{compSuchthat}{Boolean} -<>= +\begin{chunk}{defun compSuchthat} (defun |compSuchthat| (arg m e) (let (x p xp mp tmp1 pp) (declare (special |$Boolean|)) @@ -7521,14 +7521,14 @@ An angry JHD - August 15th., 1984 (setq e (|put| xp '|condition| pp e)) (list xp mp e))))) -@ +\end{chunk} \defplist{vector}{compVector} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'vector 'special) '|compVector|)) -@ +\end{chunk} \defun{compVector}{compVector} \begin{verbatim} @@ -7539,7 +7539,7 @@ An angry JHD - August 15th., 1984 \end{verbatim} \calls{compVector}{comp} \usesdollar{compVector}{EmptyVector} -<>= +\begin{chunk}{defun compVector} (defun |compVector| (l m e) (let (tmp1 tmp2 t0 failed (mUnder (second m))) (declare (special |$EmptyVector|)) @@ -7559,14 +7559,14 @@ An angry JHD - August 15th., 1984 (unless failed (list (cons 'vector (loop for texpr in t0 collect (car texpr))) m e)))))) -@ +\end{chunk} \defplist{where}{compWhere} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|where| 'special) '|compWhere|)) -@ +\end{chunk} \defun{compWhere}{compWhere} \calls{compWhere}{comp} @@ -7576,7 +7576,7 @@ An angry JHD - August 15th., 1984 \usesdollar{compWhere}{insideExpressionIfTrue} \usesdollar{compWhere}{insideWhereIfTrue} \usesdollar{compWhere}{EmptyMode} -<>= +\begin{chunk}{defun compWhere} (defun |compWhere| (arg0 m eInit) (let (|$insideExpressionIfTrue| |$insideWhereIfTrue| form exprList e eBefore tmp1 x eAfter del eFinal) @@ -7603,7 +7603,7 @@ An angry JHD - August 15th., 1984 (setq eFinal eInit)) (list x m eFinal))))) -@ +\end{chunk} \chapter{Post Transformers} \section{Direct called postparse routines} @@ -7612,7 +7612,7 @@ An angry JHD - August 15th., 1984 \calls{postTransform}{identp} \calls{postTransform}{postTransformCheck} \calls{postTransform}{aplTran} -<>= +\begin{chunk}{defun postTransform} (defun |postTransform| (y) (let (x tmp1 tmp2 tmp3 tmp4 tmp5 tt l u) (setq x y) @@ -7644,7 +7644,7 @@ An angry JHD - August 15th., 1984 (|postTransformCheck| u) (|aplTran| u))) -@ +\end{chunk} \defun{postTran}{postTran} \calls{postTran}{postAtom} @@ -7657,7 +7657,7 @@ An angry JHD - August 15th., 1984 \calls{postTran}{postForm} \calls{postTran}{postOp} \calls{postTran}{postScriptsForm} -<>= +\begin{chunk}{defun postTran} (defun |postTran| (x) (let (op f tmp1 a tmp2 tmp3 b y) (if (atom x) @@ -7686,10 +7686,10 @@ An angry JHD - August 15th., 1984 (cons y (|postTranList| (cdr x)))) (t (|postForm| x))))))) -@ +\end{chunk} \defun{postOp}{postOp} -<>= +\begin{chunk}{defun postOp} (defun |postOp| (x) (declare (special $boot)) (cond @@ -7698,12 +7698,12 @@ An angry JHD - August 15th., 1984 ((eq x '|Attribute|) 'attribute) (t x))) -@ +\end{chunk} \defun{postAtom}{postAtom} \usesdollar{postAtom}{boot} -<>= +\begin{chunk}{defun postAtom} (defun |postAtom| (x) (declare (special $boot)) (cond @@ -7714,32 +7714,32 @@ An angry JHD - August 15th., 1984 ((and (identp x) (getdatabase x 'niladic)) (list x)) (t x))) -@ +\end{chunk} \defun{postTranList}{postTranList} \calls{postTranList}{postTran} -<>= +\begin{chunk}{defun postTranList} (defun |postTranList| (x) (loop for y in x collect (|postTran| y))) -@ +\end{chunk} \defun{postScriptsForm}{postScriptsForm} \calls{postScriptsForm}{getScriptName} \calls{postScriptsForm}{length} \calls{postScriptsForm}{postTranScripts} -<>= +\begin{chunk}{defun postScriptsForm} (defun |postScriptsForm| (arg0 argl) (let ((op (second arg0)) (a (third arg0))) (cons (|getScriptName| op a (|#| argl)) (append (|postTranScripts| a) argl)))) -@ +\end{chunk} \defun{postTranScripts}{postTranScripts} \calls{postTranScripts}{postTranScripts} \calls{postTranScripts}{postTran} -<>= +\begin{chunk}{defun postTranScripts} (defun |postTranScripts| (a) (labels ( (fn (x) @@ -7761,24 +7761,24 @@ An angry JHD - August 15th., 1984 (setq tmp3 (append tmp3 (fn (|postTran| y)))))) (t (list (|postTran| a))))))) -@ +\end{chunk} \defun{postTransformCheck}{postTransformCheck} \calls{postTransformCheck}{postcheck} \usesdollar{postTransformCheck}{defOp} -<>= +\begin{chunk}{defun postTransformCheck} (defun |postTransformCheck| (x) (let (|$defOp|) (declare (special |$defOp|)) (setq |$defOp| nil) (|postcheck| x))) -@ +\end{chunk} \defun{postcheck}{postcheck} \calls{postcheck}{setDefOp} \calls{postcheck}{postcheck} -<>= +\begin{chunk}{defun postcheck} (defun |postcheck| (x) (cond ((atom x) nil) @@ -7788,7 +7788,7 @@ An angry JHD - August 15th., 1984 ((and (pairp x) (eq (qcar x) 'quote)) nil) (t (|postcheck| (car x)) (|postcheck| (cdr x))))) -@ +\end{chunk} \defun{postError}{postError} \calls{postError}{nequal} @@ -7796,7 +7796,7 @@ An angry JHD - August 15th., 1984 \usesdollar{postError}{defOp} \usesdollar{postError}{InteractiveMode} \usesdollar{postError}{postStack} -<>= +\begin{chunk}{defun postError} (defun |postError| (msg) (let (xmsg) (declare (special |$defOp| |$postStack| |$InteractiveMode|)) @@ -7808,7 +7808,7 @@ An angry JHD - August 15th., 1984 (push xmsg |$postStack|) nil)) -@ +\end{chunk} \defun{postForm}{postForm} \calls{postForm}{postTranList} @@ -7817,7 +7817,7 @@ An angry JHD - August 15th., 1984 \calls{postForm}{postError} \calls{postForm}{bright} \usesdollar{postForm}{boot} -<>= +\begin{chunk}{defun postForm} (defun |postForm| (u) (let (op argl arglp numOfArgs opp x) (declare (special $boot)) @@ -7859,7 +7859,7 @@ An angry JHD - August 15th., 1984 (cons (car x) (qcdr (qcar (qcdr x))))) (t x))))) -@ +\end{chunk} \section{Indirect called postparse routines} In the {\bf postTran} function there is the code: @@ -7904,54 +7904,52 @@ of the symbol being parsed. The original list read: with postWith \end{verbatim} -@ - \defplist{add}{postAdd} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|add| '|postTran|) '|postAdd|)) -@ +\end{chunk} \defun{postAdd}{postAdd} \calls{postAdd}{postTran} \calls{postAdd}{postCapsule} -<>= +\begin{chunk}{defun postAdd} (defun |postAdd| (arg) (if (null (cddr arg)) (|postCapsule| (second arg)) (list '|add| (|postTran| (second arg)) (|postCapsule| (third arg))))) -@ +\end{chunk} \defplist{@}{postAtSign} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '@ '|postTran|) '|postAtSign|)) -@ +\end{chunk} \defun{postAtSign}{postAtSign} \calls{postAtSign}{postTran} \calls{postAtSign}{postType} -<>= +\begin{chunk}{defun postAtSign} (defun |postAtSign| (arg) (cons '@ (cons (|postTran| (second arg)) (|postType| (third arg))))) -@ +\end{chunk} \defplist{:BF:}{postBigFloat} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|:BF:| '|postTran|) '|postBigFloat|)) -@ +\end{chunk} \defun{postBigFloat}{postBigFloat} \calls{postBigFloat}{postTran} \usesdollar{postBigFloat}{boot} \usesdollar{postBigFloat}{InteractiveMode} -<>= +\begin{chunk}{defun postBigFloat} (defun |postBigFloat| (arg) (let (mant expon eltword) (declare (special $boot |$InteractiveMode|)) @@ -7965,19 +7963,19 @@ of the symbol being parsed. The original list read: (list (list eltword '(|Float|) '|float|) (list '|,| (list '|,| mant expon) 10))))))) -@ +\end{chunk} \defplist{Block}{postBlock} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|Block| '|postTran|) '|postBlock|)) -@ +\end{chunk} \defun{postBlock}{postBlock} \calls{postBlock}{postBlockItemList} \calls{postBlock}{postTran} -<>= +\begin{chunk}{defun postBlock} (defun |postBlock| (arg) (let (tmp1 x y) (setq tmp1 (reverse (cdr arg))) @@ -7986,20 +7984,20 @@ of the symbol being parsed. The original list read: (cons 'seq (append (|postBlockItemList| y) (list (list '|exit| (|postTran| x))))))) -@ +\end{chunk} \defplist{category}{postCategory} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'category '|postTran|) '|postCategory|)) -@ +\end{chunk} \defun{postCategory}{postCategory} \calls{postCategory}{postTran} \calls{postCategory}{nreverse0} \usesdollar{postCategory}{insidePostCategoryIfTrue} -<>= +\begin{chunk}{defun postCategory} (defun |postCategory| (u) (declare (special |$insidePostCategoryIfTrue|)) (labels ( @@ -8015,10 +8013,10 @@ of the symbol being parsed. The original list read: (setq op (if |$insidePostCategoryIfTrue| 'progn 'category)) (cons op (dolist (x z (nreverse0 tmp1)) (push (fn x) tmp1)))))))) -@ +\end{chunk} \defun{postCollect,finish}{postCollect,finish} -<>= +\begin{chunk}{defun postCollect,finish} (defun |postCollect,finish| (op itl y) (let (tmp2 tmp5 newBody) (cond @@ -8040,21 +8038,21 @@ of the symbol being parsed. The original list read: (list 'reduce '|append| 0 (cons op (append itl (list newBody))))) (t (cons op (append itl (list y))))))) -@ +\end{chunk} \defplist{collect}{postCollect} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'collect '|postTran|) '|postCollect|)) -@ +\end{chunk} \defun{postCollect}{postCollect} \calls{postCollect}{postCollect,finish} \calls{postCollect}{postCollect} \calls{postCollect}{postIteratorList} \calls{postCollect}{postTran} -<>= +\begin{chunk}{defun postCollect} (defun |postCollect| (arg) (let (constructOp tmp3 m itl x) (setq constructOp (car arg)) @@ -8078,19 +8076,19 @@ of the symbol being parsed. The original list read: x)) (|postCollect,finish| constructOp itl (|postTran| x)))))) -@ +\end{chunk} \defplist{:}{postColon} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|:| '|postTran|) '|postColon|)) -@ +\end{chunk} \defun{postColon}{postColon} \calls{postColon}{postTran} \calls{postColon}{postType} -<>= +\begin{chunk}{defun postColon} (defun |postColon| (u) (cond ((and (pairp u) (eq (qcar u) '|:|) @@ -8100,58 +8098,58 @@ of the symbol being parsed. The original list read: (pairp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) (cons '|:| (cons (|postTran| (second u)) (|postType| (third u))))))) -@ +\end{chunk} \defplist{::}{postColonColon} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|::| '|postTran|) '|postColonColon|)) -@ +\end{chunk} \defun{postColonColon}{postColonColon} \calls{postColonColon}{stringimage} \calls{postColonColon}{postForm} \usesdollar{postColonColon}{boot} -<>= +\begin{chunk}{defun postColonColon} (defun |postColonColon| (u) (if (and $boot (pairp u) (eq (qcar u) '|::|) (pairp (qcdr u)) (pairp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) (intern (stringimage (third u)) (second u)) (|postForm| u))) -@ +\end{chunk} \defplist{,}{postComma} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|,| '|postTran|) '|postComma|)) -@ +\end{chunk} \defun{postComma}{postComma} \calls{postComma}{postTuple} \calls{postComma}{comma2Tuple} -<>= +\begin{chunk}{defun postComma} (defun |postComma| (u) (|postTuple| (|comma2Tuple| u))) -@ +\end{chunk} \defun{comma2Tuple}{comma2Tuple} \calls{comma2Tuple}{postFlatten} -<>= +\begin{chunk}{defun comma2Tuple} (defun |comma2Tuple| (u) (cons '|@Tuple| (|postFlatten| u '|,|))) -@ +\end{chunk} \defplist{construct}{postConstruct} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|construct| '|postTran|) '|postConstruct|)) -@ +\end{chunk} \defun{postConstruct}{postConstruct} \calls{postConstruct}{comma2Tuple} @@ -8160,7 +8158,7 @@ of the symbol being parsed. The original list read: \calls{postConstruct}{tuple2List} \calls{postConstruct}{postTranList} \calls{postConstruct}{postTran} -<>= +\begin{chunk}{defun postConstruct} (defun |postConstruct| (u) (let (b a tmp4 tmp7) (cond @@ -8190,14 +8188,14 @@ of the symbol being parsed. The original list read: (t (list '|construct| (|postTran| a))))) (t u)))) -@ +\end{chunk} \defplist{==}{postDef} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|==| '|postTran|) '|postDef|)) -@ +\end{chunk} \defun{postDef}{postDef} \calls{postDef}{postMDef} @@ -8211,7 +8209,7 @@ of the symbol being parsed. The original list read: \usesdollar{postDef}{headerDocumentation} \usesdollar{postDef}{docList} \usesdollar{postDef}{InteractiveMode} -<>= +\begin{chunk}{defun postDef} (defun |postDef| (arg) (let (defOp rhs lhs targetType tmp1 op argl newLhs argTypeList typeList form specialCaseForm tmp4 tmp6 tmp8) @@ -8263,37 +8261,37 @@ of the symbol being parsed. The original list read: (setq specialCaseForm (dolist (x form (nreverse tmp8)) (push nil tmp8))) (list 'def newLhs typeList specialCaseForm (|postTran| rhs)))))) -@ +\end{chunk} \defplist{$=>$}{postExit} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|=>| '|postTran|) '|postExit|)) -@ +\end{chunk} \defun{postExit}{postExit} \calls{postExit}{postTran} -<>= +\begin{chunk}{defun postExit} (defun |postExit| (arg) (list 'if (|postTran| (second arg)) (list '|exit| (|postTran| (third arg))) '|noBranch|)) -@ +\end{chunk} \defplist{if}{postIf} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|if| '|postTran|) '|postIf|)) -@ +\end{chunk} \defun{postIf}{postIf} \calls{postIf}{nreverse0} \calls{postIf}{postTran} \usesdollar{postIf}{boot} -<>= +\begin{chunk}{defun postIf} (defun |postIf| (arg) (let (tmp1) (if (null (and (pairp arg) (eq (qcar arg) '|if|))) @@ -8304,59 +8302,59 @@ of the symbol being parsed. The original list read: (if (and (null (setq x (|postTran| x))) (null $boot)) '|noBranch| x) tmp1)))))) -@ +\end{chunk} \defplist{in}{postin} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|in| '|postTran|) '|postin|)) -@ +\end{chunk} \defun{postin}{postin} \calls{postin}{systemErrorHere} \calls{postin}{postTran} \calls{postin}{postInSeq} -<>= +\begin{chunk}{defun postin} (defun |postin| (arg) (if (null (and (pairp arg) (eq (qcar arg) '|in|) (pairp (qcdr arg)) (pairp (qcdr (qcdr arg))) (eq (qcdr (qcdr (qcdr arg))) nil))) (|systemErrorHere| "postin") (list '|in| (|postTran| (second arg)) (|postInSeq| (third arg))))) -@ +\end{chunk} \defplist{In}{postIn} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'in '|postTran|) '|postIn|)) -@ +\end{chunk} \defun{postIn}{postIn} \calls{postIn}{systemErrorHere} \calls{postIn}{postTran} \calls{postIn}{postInSeq} -<>= +\begin{chunk}{defun postIn} (defun |postIn| (arg) (if (null (and (pairp arg) (eq (qcar arg) 'in) (pairp (qcdr arg)) (pairp (qcdr (qcdr arg))) (eq (qcdr (qcdr (qcdr arg))) nil))) (|systemErrorHere| "postIn") (list 'in (|postTran| (second arg)) (|postInSeq| (third arg))))) -@ +\end{chunk} \defplist{Join}{postJoin} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|Join| '|postTran|) '|postJoin|)) -@ +\end{chunk} \defun{postJoin}{postJoin} \calls{postJoin}{postTran} \calls{postJoin}{postTranList} -<>= +\begin{chunk}{defun postJoin} (defun |postJoin| (arg) (let (a l al) (setq a (|postTran| (cadr arg))) @@ -8367,19 +8365,19 @@ of the symbol being parsed. The original list read: (setq al (if (and (pairp a) (eq (qcar a) '|@Tuple|)) (qcdr a) (list a))) (cons '|Join| (append al l)))) -@ +\end{chunk} \defplist{$->$}{postMapping} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|->| '|postTran|) '|postMapping|)) -@ +\end{chunk} \defun{postMapping}{postMapping} \calls{postMapping}{postTran} \calls{postMapping}{unTuple} -<>= +\begin{chunk}{defun postMapping} (defun |postMapping| (u) (if (null (and (pairp u) (eq (qcar u) '->) (pairp (qcdr u)) (pairp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil))) @@ -8388,14 +8386,14 @@ of the symbol being parsed. The original list read: (cons (|postTran| (third u)) (|unTuple| (|postTran| (second u))))))) -@ +\end{chunk} \defplist{$==>$}{postMDef} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|==>| '|postTran|) '|postMDef|)) -@ +\end{chunk} \defun{postMDef}{postMDef} \calls{postMDef}{postTran} @@ -8403,7 +8401,7 @@ of the symbol being parsed. The original list read: \calls{postMDef}{nreverse0} \usesdollar{postMDef}{InteractiveMode} \usesdollar{postMDef}{boot} -<>= +\begin{chunk}{defun postMDef} (defun |postMDef| (arg) (let (rhs lhs tmp1 targetType form newLhs typeList tmp4 tmp5 tmp8) (declare (special |$InteractiveMode| $boot)) @@ -8439,49 +8437,49 @@ of the symbol being parsed. The original list read: (dolist (x form (nreverse0 tmp8)) (push nil tmp8)) (|postTran| rhs)))))) -@ +\end{chunk} \defplist{pretend}{postPretend} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|pretend| '|postTran|) '|postPretend|)) -@ +\end{chunk} \defun{postPretend}{postPretend} \calls{postPretend}{postTran} \calls{postPretend}{postType} -<>= +\begin{chunk}{defun postPretend} (defun |postPretend| (arg) (cons '|pretend| (cons (|postTran| (second arg)) (|postType| (third arg))))) -@ +\end{chunk} \defplist{quote}{postQUOTE} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'quote '|postTran|) '|postQUOTE|)) -@ +\end{chunk} \defun{postQUOTE}{postQUOTE} -<>= +\begin{chunk}{defun postQUOTE} (defun |postQUOTE| (arg) arg) -@ +\end{chunk} \defplist{reduce}{postReduce} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|Reduce| '|postTran|) '|postReduce|)) -@ +\end{chunk} \defun{postReduce}{postReduce} \calls{postReduce}{postTran} \calls{postReduce}{postReduce} \usesdollar{postReduce}{InteractiveMode} -<>= +\begin{chunk}{defun postReduce} (defun |postReduce| (arg) (let (op expr g) (setq op (second arg)) @@ -8494,19 +8492,19 @@ of the symbol being parsed. The original list read: (list 'in (setq g (gensym)) expr) (list '|construct| g))))))) -@ +\end{chunk} \defplist{repeat}{postRepeat} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get 'repeat '|postTran|) '|postRepeat|)) -@ +\end{chunk} \defun{postRepeat}{postRepeat} \calls{postRepeat}{postIteratorList} \calls{postRepeat}{postTran} -<>= +\begin{chunk}{defun postRepeat} (defun |postRepeat| (arg) (let (tmp1 x m) (setq tmp1 (reverse (cdr arg))) @@ -8514,55 +8512,55 @@ of the symbol being parsed. The original list read: (setq m (nreverse (cdr tmp1))) (cons 'repeat (append (|postIteratorList| m) (list (|postTran| x)))))) -@ +\end{chunk} \defplist{Scripts}{postScripts} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|Scripts| '|postTran|) '|postScripts|)) -@ +\end{chunk} \defun{postScripts}{postScripts} \calls{postScripts}{getScriptName} \calls{postScripts}{postTranScripts} -<>= +\begin{chunk}{defun postScripts} (defun |postScripts| (arg) (cons (|getScriptName| (second arg) (third arg) 0) (|postTranScripts| (third arg)))) -@ +\end{chunk} \defplist{;}{postSemiColon} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|;| '|postTran|) '|postSemiColon|)) -@ +\end{chunk} \defun{postSemiColon}{postSemiColon} \calls{postSemiColon}{postBlock} \calls{postSemiColon}{postFlattenLeft} -<>= +\begin{chunk}{defun postSemiColon} (defun |postSemiColon| (u) (|postBlock| (cons '|Block| (|postFlattenLeft| u '|;|)))) -@ +\end{chunk} \defplist{Signature}{postSignature} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|Signature| '|postTran|) '|postSignature|)) -@ +\end{chunk} \defun{postSignature}{postSignature} \calls{postSignature}{pairp} \calls{postSignature}{postType} \calls{postSignature}{removeSuperfluousMapping} \calls{postSignature}{killColons} -<>= +\begin{chunk}{defun postSignature} (defun |postSignature| (arg) (let (sig sig1 op) (setq op (second arg)) @@ -8573,35 +8571,35 @@ of the symbol being parsed. The original list read: (cons 'signature (cons op (|removeSuperfluousMapping| (|killColons| sig1))))))) -@ +\end{chunk} \defplist{/}{postSlash} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '/ '|postTran|) '|postSlash|)) -@ +\end{chunk} \defun{postSlash}{postSlash} \calls{postSlash}{postTran} -<>= +\begin{chunk}{defun postSlash} (defun |postSlash| (arg) (if (stringp (second arg)) (|postTran| (list '|Reduce| (intern (second arg)) (third arg) )) (list '/ (|postTran| (second arg)) (|postTran| (third arg))))) -@ +\end{chunk} \defplist{@Tuple}{postTuple} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|@Tuple| '|postTran|) '|postTuple|)) -@ +\end{chunk} \defun{postTuple}{postTuple} \calls{postTuple}{postTranList} -<>= +\begin{chunk}{defun postTuple} (defun |postTuple| (arg) (cond ((and (pairp arg) (eq (qcdr arg) nil) (eq (qcar arg) '|@Tuple|)) @@ -8609,18 +8607,18 @@ of the symbol being parsed. The original list read: ((and (pairp arg) (eq (qcar arg) '|@Tuple|) (pairp (qcdr arg))) (cons '|@Tuple| (|postTranList| (cdr arg)))))) -@ +\end{chunk} \defplist{TupleCollect}{postTupleCollect} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|TupleCollect| '|postTran|) '|postTupleCollect|)) -@ +\end{chunk} \defun{postTupleCollect}{postTupleCollect} \calls{postTupleCollect}{postCollect} -<>= +\begin{chunk}{defun postTupleCollect} (defun |postTupleCollect| (arg) (let (constructOp tmp1 x m) (setq constructOp (car arg)) @@ -8629,38 +8627,38 @@ of the symbol being parsed. The original list read: (setq m (nreverse (cdr tmp1))) (|postCollect| (cons constructOp (append m (list (list '|construct| x))))))) -@ +\end{chunk} \defplist{where}{postWhere} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|where| '|postTran|) '|postWhere|)) -@ +\end{chunk} \defun{postWhere}{postWhere} \calls{postWhere}{postTran} \calls{postWhere}{postTranList} -<>= +\begin{chunk}{defun postWhere} (defun |postWhere| (arg) (let (b x) (setq b (third arg)) (setq x (if (and (pairp b) (eq (qcar b) '|Block|)) (qcdr b) (list b))) (cons '|where| (cons (|postTran| (second arg)) (|postTranList| x))))) -@ +\end{chunk} \defplist{with}{postWith} -<>= +\begin{chunk}{postvars} (eval-when (eval load) (setf (get '|with| '|postTran|) '|postWith|)) -@ +\end{chunk} \defun{postWith}{postWith} \calls{postWith}{postTran} \usesdollar{postWith}{insidePostCategoryIfTrue} -<>= +\begin{chunk}{defun postWith} (defun |postWith| (arg) (let (|$insidePostCategoryIfTrue| a) (declare (special |$insidePostCategoryIfTrue|)) @@ -8673,14 +8671,14 @@ of the symbol being parsed. The original list read: (cons 'category (qcdr a))) (t a)))) -@ +\end{chunk} \section{Support routines} \defun{setDefOp}{setDefOp} \usesdollar{setDefOp}{defOp} \usesdollar{setDefOp}{topOp} -<>= +\begin{chunk}{defun setDefOp} (defun |setDefOp| (f) (let (tmp1) (declare (special |$defOp| |$topOp|)) @@ -8692,14 +8690,14 @@ of the symbol being parsed. The original list read: (setq |$defOp| f) (setq |$topOp| f)))) -@ +\end{chunk} \defun{aplTran}{aplTran} \calls{aplTran}{aplTran1} \calls{aplTran}{containsBang} \usesdollar{aplTran}{genno} \usesdollar{aplTran}{boot} -<>= +\begin{chunk}{defun aplTran} (defun |aplTran| (x) (let ($genno u) (declare (special $genno $boot)) @@ -8712,7 +8710,7 @@ of the symbol being parsed. The original list read: ((|containsBang| u) (|throwKeyedMsg| 's2ip0002 nil)) (t u)))))) -@ +\end{chunk} \defun{aplTran1}{aplTran1} \calls{aplTran1}{aplTranList} @@ -8721,7 +8719,7 @@ of the symbol being parsed. The original list read: \calls{aplTran1}{nreverse0} \calls{aplTran1}{} \usesdollar{aplTran1}{boot} -<>= +\begin{chunk}{defun aplTran1} (defun |aplTran1| (x) (let (op argl1 argl f y opprime yprime tmp1 arglAssoc futureArgl g) (declare (special $boot)) @@ -8783,18 +8781,18 @@ of the symbol being parsed. The original list read: (list (cdar arglAssoc)))) (t (cons op argl))))))) -@ +\end{chunk} \defun{aplTranList}{aplTranList} \calls{aplTranList}{aplTran1} \calls{aplTranList}{aplTranList} -<>= +\begin{chunk}{defun aplTranList} (defun |aplTranList| (x) (if (atom x) x (cons (|aplTran1| (car x)) (|aplTranList| (cdr x))))) -@ +\end{chunk} \defun{hasAplExtension}{hasAplExtension} \calls{hasAplExtension}{nreverse0} @@ -8802,7 +8800,7 @@ of the symbol being parsed. The original list read: \calls{hasAplExtension}{genvar} \calls{hasAplExtension}{aplTran1} \calls{hasAplExtension}{msubst} -<>= +\begin{chunk}{defun hasAplExtension} (defun |hasAplExtension| (argl) (let (tmp2 tmp3 y z g arglAssoc u) (when @@ -8823,22 +8821,22 @@ of the symbol being parsed. The original list read: tmp3))) (cons arglAssoc u)))) -@ +\end{chunk} \defun{deepestExpression}{deepestExpression} \calls{deepestExpression}{deepestExpression} -<>= +\begin{chunk}{defun deepestExpression} (defun |deepestExpression| (x) (if (and (pairp x) (eq (qcar x) '!) (pairp (qcdr x)) (eq (qcdr (qcdr x)) nil)) (|deepestExpression| (qcar (qcdr x))) x)) -@ +\end{chunk} \defun{containsBang}{containsBang} \calls{containsBang}{containsBang} -<>= +\begin{chunk}{defun containsBang} (defun |containsBang| (u) (let (tmp2) (cond @@ -8850,7 +8848,7 @@ of the symbol being parsed. The original list read: (dolist (x u tmp2) (setq tmp2 (or tmp2 (|containsBang| x)))))))) -@ +\end{chunk} \defun{getScriptName}{getScriptName} \calls{getScriptName}{identp} @@ -8859,14 +8857,14 @@ of the symbol being parsed. The original list read: \calls{getScriptName}{stringimage} \calls{getScriptName}{decodeScripts} \calls{getScriptName}{pname} -<>= +\begin{chunk}{defun getScriptName} (defun |getScriptName| (op a numberOfFunctionalArgs) (when (null (identp op)) (|postError| (list " " op " cannot have scripts" ))) (internl '* (stringimage numberOfFunctionalArgs) (|decodeScripts| a) (pname op))) -@ +\end{chunk} \defun{decodeScripts}{decodeScripts} \calls{decodeScripts}{qcar} @@ -8874,7 +8872,7 @@ of the symbol being parsed. The original list read: \calls{decodeScripts}{strconc} \calls{decodeScripts}{stringimage} \calls{decodeScripts}{decodeScripts} -<>= +\begin{chunk}{defun decodeScripts} (defun |decodeScripts| (a) (labels ( (fn (a) @@ -8893,85 +8891,85 @@ of the symbol being parsed. The original list read: (t (stringimage 1))))) -@ +\end{chunk} \chapter{DEF forms} \defdollar{defstack} -<>= +\begin{chunk}{initvars} (defparameter $defstack nil) -@ +\end{chunk} \defdollar{is-spill} -<>= +\begin{chunk}{initvars} (defvar $is-spill nil) -@ +\end{chunk} \defdollar{is-spill-list} -<>= +\begin{chunk}{initvars} (defvar $is-spill-list nil) -@ +\end{chunk} \defdollar{vl} -<>= +\begin{chunk}{initvars} (defparameter $vl nil) -@ +\end{chunk} -<>= +\begin{chunk}{initvars} (defparameter $IS-GENSYMLIST nil) -@ +\end{chunk} -<>= +\begin{chunk}{initvars} (defparameter Initial-Gensym (list (gensym))) -@ +\end{chunk} \defdollar{is-eqlist} -<>= +\begin{chunk}{initvars} (defparameter $is-eqlist nil) -@ +\end{chunk} \defun{hackforis}{hackforis} \calls{hackforis}{hackforis1} -<>= +\begin{chunk}{defun hackforis} (defun hackforis (l) (mapcar #'hackforis1 L)) -@ +\end{chunk} \defun{hackforis1}{hackforis1} \calls{hackforis1}{kar} \calls{hackforis1}{eqcar} -<>= +\begin{chunk}{defun hackforis1} (defun hackforis1 (x) (if (and (member (kar x) '(in on)) (eqcar (second x) 'is)) (cons (first x) (cons (cons 'spadlet (cdadr x)) (cddr x))) x)) -@ +\end{chunk} \defun{unTuple}{unTuple} -<>= +\begin{chunk}{defun unTuple} (defun |unTuple| (x) (if (and (pairp x) (eq (qcar x) '|@Tuple|)) (qcdr x) (list x))) -@ +\end{chunk} \defun{errhuh}{errhuh} \calls{errhuh}{systemError} -<>= +\begin{chunk}{defun errhuh} (defun errhuh () (|systemError| "problem with BOOT to LISP translation")) -@ +\end{chunk} \chapter{PARSE forms} \section{The original meta specification} @@ -9236,34 +9234,34 @@ IteratorTail: ('repeat' ! / Iterator*) ; \section{The PARSE code} \defvar{tmptok} -<>= +\begin{chunk}{initvars} (defvar |tmptok| nil) -@ +\end{chunk} \defvar{tok} -<>= +\begin{chunk}{initvars} (defvar tok nil) -@ +\end{chunk} \defvar{ParseMode} -<>= +\begin{chunk}{initvars} (defvar |ParseMode| nil) -@ +\end{chunk} \defvar{definition-name} -<>= +\begin{chunk}{initvars} (defvar definition-name nil) -@ +\end{chunk} \defvar{lablasoc} -<>= +\begin{chunk}{initvars} (defvar lablasoc nil) -@ +\end{chunk} \defun{PARSE-NewExpr}{PARSE-NewExpr} \calls{PARSE-NewExpr}{match-string} \calls{PARSE-NewExpr}{action} @@ -9272,14 +9270,14 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-NewExpr}{current-symbol} \calls{PARSE-NewExpr}{PARSE-Statement} \uses{PARSE-NewExpr}{definition-name} -<>= +\begin{chunk}{defun PARSE-NewExpr} (defun |PARSE-NewExpr| () (or (and (match-string ")") (action (|processSynonyms|)) (must (|PARSE-Command|))) (and (action (setq definition-name (current-symbol))) (|PARSE-Statement|)))) -@ +\end{chunk} \defun{PARSE-Command}{PARSE-Command} \calls{PARSE-Command}{match-advance-string} @@ -9287,13 +9285,13 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Command}{PARSE-SpecialKeyWord} \calls{PARSE-Command}{PARSE-SpecialCommand} \calls{PARSE-Command}{push-reduction} -<>= +\begin{chunk}{defun PARSE-Command} (defun |PARSE-Command| () (and (match-advance-string ")") (must (|PARSE-SpecialKeyWord|)) (must (|PARSE-SpecialCommand|)) (push-reduction '|PARSE-Command| nil))) -@ +\end{chunk} \defun{PARSE-SpecialKeyWord}{PARSE-SpecialKeyWord} \calls{PARSE-SpecialKeyWord}{match-current-token} @@ -9302,13 +9300,13 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-SpecialKeyWord}{current-token} \calls{PARSE-SpecialKeyWord}{unAbbreviateKeyword} \calls{PARSE-SpecialKeyWord}{current-symbol} -<>= +\begin{chunk}{defun PARSE-SpecialKeyWord} (defun |PARSE-SpecialKeyWord| () (and (match-current-token 'identifier) (action (setf (token-symbol (current-token)) (|unAbbreviateKeyword| (current-symbol)))))) -@ +\end{chunk} \defun{PARSE-SpecialCommand}{PARSE-SpecialCommand} \calls{PARSE-SpecialCommand}{match-advance-string} @@ -9329,7 +9327,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-SpecialCommand}{PARSE-CommandTail} \usesdollar{PARSE-SpecialCommand}{noParseCommands} \usesdollar{PARSE-SpecialCommand}{tokenCommands} -<>= +\begin{chunk}{defun PARSE-SpecialCommand} (defun |PARSE-SpecialCommand| () (declare (special $noParseCommands $tokenCommands)) (or (and (match-advance-string "show") @@ -9347,7 +9345,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (and (star repeator (|PARSE-PrimaryOrQM|)) (must (|PARSE-CommandTail|))))) -@ +\end{chunk} \defun{PARSE-TokenCommandTail}{PARSE-TokenCommandTail} \calls{PARSE-TokenCommandTail}{bang} @@ -9361,7 +9359,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-TokenCommandTail}{pop-stack-1} \calls{PARSE-TokenCommandTail}{action} \calls{PARSE-TokenCommandTail}{systemCommand} -<>= +\begin{chunk}{defun PARSE-TokenCommandTail} (defun |PARSE-TokenCommandTail| () (and (bang fil_test (optional (star repeator (|PARSE-TokenOption|)))) (|atEndOfLine|) @@ -9369,18 +9367,18 @@ IteratorTail: ('repeat' ! / Iterator*) ; (cons (pop-stack-2) (append (pop-stack-1) nil))) (action (|systemCommand| (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-TokenOption}{PARSE-TokenOption} \calls{PARSE-TokenOption}{match-advance-string} \calls{PARSE-TokenOption}{must} \calls{PARSE-TokenOption}{PARSE-TokenList} -<>= +\begin{chunk}{defun PARSE-TokenOption} (defun |PARSE-TokenOption| () (and (match-advance-string ")") (must (|PARSE-TokenList|)))) -@ +\end{chunk} \defun{PARSE-TokenList}{PARSE-TokenList} \calls{PARSE-TokenList}{star} @@ -9389,14 +9387,14 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-TokenList}{current-symbol} \calls{PARSE-TokenList}{action} \calls{PARSE-TokenList}{advance-token} -<>= +\begin{chunk}{defun PARSE-TokenList} (defun |PARSE-TokenList| () (star repeator (and (not (|isTokenDelimiter|)) (push-reduction '|PARSE-TokenList| (current-symbol)) (action (advance-token))))) -@ +\end{chunk} \defun{PARSE-CommandTail}{PARSE-CommandTail} \calls{PARSE-CommandTail}{bang} @@ -9409,7 +9407,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-CommandTail}{pop-stack-1} \calls{PARSE-CommandTail}{action} \calls{PARSE-CommandTail}{systemCommand} -<>= +\begin{chunk}{defun PARSE-CommandTail} (defun |PARSE-CommandTail| () (and (bang fil_test (optional (star repeator (|PARSE-Option|)))) (|atEndOfLine|) @@ -9417,32 +9415,32 @@ IteratorTail: ('repeat' ! / Iterator*) ; (cons (pop-stack-2) (append (pop-stack-1) nil))) (action (|systemCommand| (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-PrimaryOrQM}{PARSE-PrimaryOrQM} \calls{PARSE-PrimaryOrQM}{match-advance-string} \calls{PARSE-PrimaryOrQM}{push-reduction} \calls{PARSE-PrimaryOrQM}{PARSE-PrimaryOrQM} \calls{PARSE-PrimaryOrQM}{PARSE-Primary} -<>= +\begin{chunk}{defun PARSE-PrimaryOrQM} (defun |PARSE-PrimaryOrQM| () (or (and (match-advance-string "?") (push-reduction '|PARSE-PrimaryOrQM| '?)) (|PARSE-Primary|))) -@ +\end{chunk} \defun{PARSE-Option}{PARSE-Option} \calls{PARSE-Option}{match-advance-string} \calls{PARSE-Option}{must} \calls{PARSE-Option}{star} \calls{PARSE-Option}{PARSE-PrimaryOrQM} -<>= +\begin{chunk}{defun PARSE-Option} (defun |PARSE-Option| () (and (match-advance-string ")") (must (star repeator (|PARSE-PrimaryOrQM|))))) -@ +\end{chunk} \defun{PARSE-Statement}{PARSE-Statement} \calls{PARSE-Statement}{PARSE-Expr} @@ -9453,7 +9451,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Statement}{push-reduction} \calls{PARSE-Statement}{pop-stack-2} \calls{PARSE-Statement}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Statement} (defun |PARSE-Statement| () (and (|PARSE-Expr| 0) (optional @@ -9465,33 +9463,33 @@ IteratorTail: ('repeat' ! / Iterator*) ; (cons (pop-stack-2) (append (pop-stack-1) nil)))))))) -@ +\end{chunk} \defun{PARSE-InfixWith}{PARSE-InfixWith} \calls{PARSE-InfixWith}{PARSE-With} \calls{PARSE-InfixWith}{push-reduction} \calls{PARSE-InfixWith}{pop-stack-2} \calls{PARSE-InfixWith}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-InfixWith} (defun |PARSE-InfixWith| () (and (|PARSE-With|) (push-reduction '|PARSE-InfixWith| (list '|Join| (pop-stack-2) (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-With}{PARSE-With} \calls{PARSE-With}{match-advance-string} \calls{PARSE-With}{must} \calls{PARSE-With}{push-reduction} \calls{PARSE-With}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-With} (defun |PARSE-With| () (and (match-advance-string "with") (must (|PARSE-Category|)) (push-reduction '|PARSE-With| (cons '|with| (cons (pop-stack-1) nil))))) -@ +\end{chunk} \defun{PARSE-Category}{PARSE-Category} \calls{PARSE-Category}{match-advance-string} @@ -9512,7 +9510,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Category}{nth-stack} \calls{PARSE-Category}{recordAttributeDocumentation} \uses{PARSE-Category}{current-line} -<>= +\begin{chunk}{defun PARSE-Category} (defun |PARSE-Category| () (let (g1) (or (and (match-advance-string "if") (must (|PARSE-Expression|)) @@ -9548,7 +9546,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (action (|recordAttributeDocumentation| (nth-stack 1) g1))))))))) -@ +\end{chunk} \defun{PARSE-Expression}{PARSE-Expression} \calls{PARSE-Expression}{PARSE-Expr} @@ -9558,7 +9556,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Expression}{pop-stack-1} \uses{PARSE-Expression}{ParseMode} \uses{PARSE-Expression}{prior-token} -<>= +\begin{chunk}{defun PARSE-Expression} (defun |PARSE-Expression| () (declare (special prior-token)) (and (|PARSE-Expr| @@ -9566,7 +9564,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; |ParseMode|)) (push-reduction '|PARSE-Expression| (pop-stack-1)))) -@ +\end{chunk} \defun{PARSE-Import}{PARSE-Import} \calls{PARSE-Import}{match-advance-string} @@ -9578,7 +9576,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Import}{push-reduction} \calls{PARSE-Import}{pop-stack-2} \calls{PARSE-Import}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Import} (defun |PARSE-Import| () (and (match-advance-string "import") (must (|PARSE-Expr| 1000)) (bang fil_test @@ -9590,7 +9588,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (cons '|import| (cons (pop-stack-2) (append (pop-stack-1) nil)))))) -@ +\end{chunk} \defun{PARSE-Expr}{PARSE-Expr} \calls{PARSE-Expr}{PARSE-NudPart} @@ -9599,26 +9597,26 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Expr}{star} \calls{PARSE-Expr}{push-reduction} \calls{PARSE-Expr}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Expr} (defun |PARSE-Expr| (rbp) (declare (special rbp)) (and (|PARSE-NudPart| rbp) (optional (star opt_expr (|PARSE-LedPart| rbp))) (push-reduction '|PARSE-Expr| (pop-stack-1)))) -@ +\end{chunk} \defun{PARSE-LedPart}{PARSE-LedPart} \calls{PARSE-LedPart}{PARSE-Operation} \calls{PARSE-LedPart}{push-reduction} \calls{PARSE-LedPart}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-LedPart} (defun |PARSE-LedPart| (rbp) (declare (special rbp)) (and (|PARSE-Operation| '|Led| rbp) (push-reduction '|PARSE-LedPart| (pop-stack-1)))) -@ +\end{chunk} \defun{PARSE-NudPart}{PARSE-NudPart} \calls{PARSE-NudPart}{PARSE-Operation} @@ -9627,14 +9625,14 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-NudPart}{push-reduction} \calls{PARSE-NudPart}{pop-stack-1} \uses{PARSE-NudPart}{rbp} -<>= +\begin{chunk}{defun PARSE-NudPart} (defun |PARSE-NudPart| (rbp) (declare (special rbp)) (and (or (|PARSE-Operation| '|Nud| rbp) (|PARSE-Reduction|) (|PARSE-Form|)) (push-reduction '|PARSE-NudPart| (pop-stack-1)))) -@ +\end{chunk} \defun{PARSE-Operation}{PARSE-Operation} \calls{PARSE-Operation}{match-current-token} @@ -9649,7 +9647,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \uses{PARSE-Operation}{ParseMode} \uses{PARSE-Operation}{rbp} \uses{PARSE-Operation}{tmptok} -<>= +\begin{chunk}{defun PARSE-Operation} (defun |PARSE-Operation| (|ParseMode| rbp) (declare (special |ParseMode| rbp |tmptok|)) (and (not (match-current-token 'identifier)) @@ -9659,38 +9657,38 @@ IteratorTail: ('repeat' ! / Iterator*) ; (|PARSE-getSemanticForm| |tmptok| |ParseMode| (elemn (getl |tmptok| |ParseMode|) 5 nil)))) -@ +\end{chunk} \defun{PARSE-leftBindingPowerOf}{PARSE-leftBindingPowerOf} \calls{PARSE-leftBindingPowerOf}{getl} \calls{PARSE-leftBindingPowerOf}{elemn} -<>= +\begin{chunk}{defun PARSE-leftBindingPowerOf} (defun |PARSE-leftBindingPowerOf| (x ind) (declare (special x ind)) (let ((y (getl x ind))) (if y (elemn y 3 0) 0))) -@ +\end{chunk} \defun{PARSE-rightBindingPowerOf}{PARSE-rightBindingPowerOf} \calls{PARSE-rightBindingPowerOf}{getl} \calls{PARSE-rightBindingPowerOf}{elemn} -<>= +\begin{chunk}{defun PARSE-rightBindingPowerOf} (defun |PARSE-rightBindingPowerOf| (x ind) (declare (special x ind)) (let ((y (getl x ind))) (if y (elemn y 4 105) 105))) -@ +\end{chunk} \defun{PARSE-getSemanticForm}{PARSE-getSemanticForm} \calls{PARSE-getSemanticForm}{PARSE-Prefix} \calls{PARSE-getSemanticForm}{PARSE-Infix} -<>= +\begin{chunk}{defun PARSE-getSemanticForm} (defun |PARSE-getSemanticForm| (x ind y) (declare (special x ind y)) (or (and y (eval y)) (and (eq ind '|Nud|) (|PARSE-Prefix|)) (and (eq ind '|Led|) (|PARSE-Infix|)))) -@ +\end{chunk} \defun{PARSE-Prefix}{PARSE-Prefix} \calls{PARSE-Prefix}{push-reduction} @@ -9704,7 +9702,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Prefix}{push-reduction} \calls{PARSE-Prefix}{pop-stack-2} \calls{PARSE-Prefix}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Prefix} (defun |PARSE-Prefix| () (and (push-reduction '|PARSE-Prefix| (current-symbol)) (action (advance-token)) (optional (|PARSE-TokTail|)) @@ -9712,7 +9710,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-Prefix| (list (pop-stack-2) (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-Infix}{PARSE-Infix} \calls{PARSE-Infix}{push-reduction} @@ -9725,7 +9723,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Infix}{PARSE-Expression} \calls{PARSE-Infix}{pop-stack-2} \calls{PARSE-Infix}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Infix} (defun |PARSE-Infix| () (and (push-reduction '|PARSE-Infix| (current-symbol)) (action (advance-token)) (optional (|PARSE-TokTail|)) @@ -9733,7 +9731,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-Infix| (list (pop-stack-2) (pop-stack-2) (pop-stack-1) )))) -@ +\end{chunk} \defun{PARSE-TokTail}{PARSE-TokTail} \calls{PARSE-TokTail}{current-symbol} @@ -9743,7 +9741,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-TokTail}{action} \calls{PARSE-TokTail}{PARSE-Qualification} \usesdollar{PARSE-TokTail}{boot} -<>= +\begin{chunk}{defun PARSE-TokTail} (defun |PARSE-TokTail| () (let (g1) (and (null $boot) (eq (current-symbol) '$) @@ -9754,7 +9752,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (action (setq g1 (copy-token prior-token))) (|PARSE-Qualification|) (action (setq prior-token g1))))) -@ +\end{chunk} \defun{PARSE-Qualification}{PARSE-Qualification} \calls{PARSE-Qualification}{match-advance-string} @@ -9763,13 +9761,13 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Qualification}{push-reduction} \calls{PARSE-Qualification}{dollarTran} \calls{PARSE-Qualification}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Qualification} (defun |PARSE-Qualification| () (and (match-advance-string "$") (must (|PARSE-Primary1|)) (push-reduction '|PARSE-Qualification| (|dollarTran| (pop-stack-1) (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-Reduction}{PARSE-Reduction} \calls{PARSE-Reduction}{PARSE-ReductionOp} @@ -9778,13 +9776,13 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Reduction}{push-reduction} \calls{PARSE-Reduction}{pop-stack-2} \calls{PARSE-Reduction}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Reduction} (defun |PARSE-Reduction| () (and (|PARSE-ReductionOp|) (must (|PARSE-Expr| 1000)) (push-reduction '|PARSE-Reduction| (list '|Reduce| (pop-stack-2) (pop-stack-1) )))) -@ +\end{chunk} \defun{PARSE-ReductionOp}{PARSE-ReductionOp} \calls{PARSE-ReductionOp}{getl} @@ -9792,14 +9790,14 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-ReductionOp}{match-next-token} \calls{PARSE-ReductionOp}{action} \calls{PARSE-ReductionOp}{advance-token} -<>= +\begin{chunk}{defun PARSE-ReductionOp} (defun |PARSE-ReductionOp| () (and (getl (current-symbol) '|Led|) (match-next-token 'special-char (code-char 47)) (push-reduction '|PARSE-ReductionOp| (current-symbol)) (action (advance-token)) (action (advance-token)))) -@ +\end{chunk} \defun{PARSE-Form}{PARSE-Form} \calls{PARSE-Form}{match-advance-string} @@ -9809,7 +9807,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Form}{push-reduction} \calls{PARSE-Form}{pop-stack-1} \calls{PARSE-Form}{PARSE-Application} -<>= +\begin{chunk}{defun PARSE-Form} (defun |PARSE-Form| () (or (and (match-advance-string "iterate") (bang fil_test @@ -9825,7 +9823,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (list '|yield| (pop-stack-1)))) (|PARSE-Application|))) -@ +\end{chunk} \defun{PARSE-Application}{PARSE-Application} \calls{PARSE-Application}{PARSE-Primary} @@ -9836,7 +9834,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Application}{push-reduction} \calls{PARSE-Application}{pop-stack-2} \calls{PARSE-Application}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Application} (defun |PARSE-Application| () (and (|PARSE-Primary|) (optional (star opt_expr (|PARSE-Selector|))) (optional @@ -9844,18 +9842,18 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-Application| (list (pop-stack-2) (pop-stack-1))))))) -@ +\end{chunk} \defun{PARSE-Label}{PARSE-Label} \calls{PARSE-Label}{match-advance-string} \calls{PARSE-Label}{must} \calls{PARSE-Label}{PARSE-Name} -<>= +\begin{chunk}{defun PARSE-Label} (defun |PARSE-Label| () (and (match-advance-string "<<") (must (|PARSE-Name|)) (must (match-advance-string ">>")))) -@ +\end{chunk} \defun{PARSE-Selector}{PARSE-Selector} \calls{PARSE-Selector}{current-symbol} @@ -9870,7 +9868,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Selector}{PARSE-Float} \calls{PARSE-Selector}{PARSE-Primary} \usesdollar{PARSE-Selector}{boot} -<>= +\begin{chunk}{defun PARSE-Selector} (defun |PARSE-Selector| () (declare (special $boot)) (or (and nonblank (eq (current-symbol) '|.|) @@ -9890,26 +9888,26 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-Selector| (list (pop-stack-2) (pop-stack-1)))))))) -@ +\end{chunk} \defun{PARSE-PrimaryNoFloat}{PARSE-PrimaryNoFloat} \calls{PARSE-PrimaryNoFloat}{PARSE-Primary1} \calls{PARSE-PrimaryNoFloat}{optional} \calls{PARSE-PrimaryNoFloat}{PARSE-TokTail} -<>= +\begin{chunk}{defun PARSE-PrimaryNoFloat} (defun |PARSE-PrimaryNoFloat| () (and (|PARSE-Primary1|) (optional (|PARSE-TokTail|)))) -@ +\end{chunk} \defun{PARSE-Primary}{PARSE-Primary} \calls{PARSE-Primary}{PARSE-Float} \calls{PARSE-Primary}{PARSE-PrimaryNoFloat} -<>= +\begin{chunk}{defun PARSE-Primary} (defun |PARSE-Primary| () (or (|PARSE-Float|) (|PARSE-PrimaryNoFloat|))) -@ +\end{chunk} \defun{PARSE-Primary1}{PARSE-Primary1} \calls{PARSE-Primary1}{PARSE-VarForm} @@ -9931,7 +9929,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Primary1}{PARSE-Sequence} \calls{PARSE-Primary1}{PARSE-Enclosure} \usesdollar{PARSE-Primary1}{boot} -<>= +\begin{chunk}{defun PARSE-Primary1} (defun |PARSE-Primary1| () (or (and (|PARSE-VarForm|) (optional @@ -9949,7 +9947,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (list 'quote (pop-stack-1))))))) (|PARSE-Sequence|) (|PARSE-Enclosure|)))) -@ +\end{chunk} \defun{PARSE-Float}{PARSE-Float} \calls{PARSE-Float}{PARSE-FloatBase} @@ -9961,7 +9959,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Float}{pop-stack-3} \calls{PARSE-Float}{pop-stack-2} \calls{PARSE-Float}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Float} (defun |PARSE-Float| () (and (|PARSE-FloatBase|) (must (or (and nonblank (|PARSE-FloatExponent|)) @@ -9970,7 +9968,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (make-float (pop-stack-4) (pop-stack-2) (pop-stack-2) (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-FloatBase}{PARSE-FloatBase} \calls{PARSE-FloatBase}{current-symbol} @@ -9984,7 +9982,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-FloatBase}{PARSE-IntegerTok} \calls{PARSE-FloatBase}{push-reduction} \calls{PARSE-FloatBase}{digitp} -<>= +\begin{chunk}{defun PARSE-FloatBase} (defun |PARSE-FloatBase| () (or (and (integerp (current-symbol)) (char-eq (current-char) ".") (char-ne (next-char) ".") (|PARSE-IntegerTok|) @@ -9997,7 +9995,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-FloatBase| 0) (|PARSE-FloatBasePart|)))) -@ +\end{chunk} \defun{PARSE-FloatBasePart}{PARSE-FloatBasePart} \calls{PARSE-FloatBasePart}{match-advance-string} @@ -10008,7 +10006,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-FloatBasePart}{token-nonblank} \calls{PARSE-FloatBasePart}{current-token} \calls{PARSE-FloatBasePart}{PARSE-IntegerTok} -<>= +\begin{chunk}{defun PARSE-FloatBasePart} (defun |PARSE-FloatBasePart| () (and (match-advance-string ".") (must (or (and (digitp (current-char)) @@ -10018,7 +10016,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (and (push-reduction '|PARSE-FloatBasePart| 0) (push-reduction '|PARSE-FloatBasePart| 0)))))) -@ +\end{chunk} \defun{PARSE-FloatExponent}{PARSE-FloatExponent} \calls{PARSE-FloatExponent}{current-symbol} @@ -10031,7 +10029,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-FloatExponent}{push-reduction} \calls{PARSE-FloatExponent}{identp} \calls{PARSE-FloatExponent}{floatexpid} -<>= +\begin{chunk}{defun PARSE-FloatExponent} (defun |PARSE-FloatExponent| () (let (g1) (or (and (member (current-symbol) '(e |e|)) @@ -10049,7 +10047,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (action (advance-token)) (push-reduction '|PARSE-FloatExponent| g1))))) -@ +\end{chunk} \defun{PARSE-Enclosure}{PARSE-Enclosure} \calls{PARSE-Enclosure}{match-advance-string} @@ -10057,7 +10055,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Enclosure}{PARSE-Expr} \calls{PARSE-Enclosure}{push-reduction} \calls{PARSE-Enclosure}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Enclosure} (defun |PARSE-Enclosure| () (or (and (match-advance-string "(") (must (or (and (|PARSE-Expr| 6) @@ -10075,49 +10073,49 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-Enclosure| (list '|brace|)))))))) -@ +\end{chunk} \defun{PARSE-IntegerTok}{PARSE-IntegerTok} \calls{PARSE-IntegerTok}{parse-number} -<>= +\begin{chunk}{defun PARSE-IntegerTok} (defun |PARSE-IntegerTok| () (parse-number)) -@ +\end{chunk} \defun{PARSE-FormalParameter}{PARSE-FormalParameter} \calls{PARSE-FormalParameter}{PARSE-FormalParameterTok} -<>= +\begin{chunk}{defun PARSE-FormalParameter} (defun |PARSE-FormalParameter| () (|PARSE-FormalParameterTok|)) -@ +\end{chunk} \defun{PARSE-FormalParameterTok}{PARSE-FormalParameterTok} \calls{PARSE-FormalParameterTok}{parse-argument-designator} -<>= +\begin{chunk}{defun PARSE-FormalParameterTok} (defun |PARSE-FormalParameterTok| () (parse-argument-designator)) -@ +\end{chunk} \defun{PARSE-Quad}{PARSE-Quad} \calls{PARSE-Quad}{match-advance-string} \calls{PARSE-Quad}{push-reduction} \calls{PARSE-Quad}{PARSE-GliphTok} \usesdollar{PARSE-Quad}{boot} -<>= +\begin{chunk}{defun PARSE-Quad} (defun |PARSE-Quad| () (or (and (match-advance-string "$") (push-reduction '|PARSE-Quad| '$)) (and $boot (|PARSE-GliphTok| '|.|) (push-reduction '|PARSE-Quad| '|.|)))) -@ +\end{chunk} \defun{PARSE-String}{PARSE-String} \calls{PARSE-String}{parse-spadstring} -<>= +\begin{chunk}{defun PARSE-String} (defun |PARSE-String| () (parse-spadstring)) -@ +\end{chunk} \defun{PARSE-VarForm}{PARSE-VarForm} \calls{PARSE-VarForm}{PARSE-Name} @@ -10126,7 +10124,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-VarForm}{push-reduction} \calls{PARSE-VarForm}{pop-stack-2} \calls{PARSE-VarForm}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-VarForm} (defun |PARSE-VarForm| () (and (|PARSE-Name|) (optional @@ -10135,18 +10133,18 @@ IteratorTail: ('repeat' ! / Iterator*) ; (list '|Scripts| (pop-stack-2) (pop-stack-1))))) (push-reduction '|PARSE-VarForm| (pop-stack-1)))) -@ +\end{chunk} \defun{PARSE-Scripts}{PARSE-Scripts} \calls{PARSE-Scripts}{match-advance-string} \calls{PARSE-Scripts}{must} \calls{PARSE-Scripts}{PARSE-ScriptItem} -<>= +\begin{chunk}{defun PARSE-Scripts} (defun |PARSE-Scripts| () (and nonblank (match-advance-string "[") (must (|PARSE-ScriptItem|)) (must (match-advance-string "]")))) -@ +\end{chunk} \defun{PARSE-ScriptItem}{PARSE-ScriptItem} \calls{PARSE-ScriptItem}{PARSE-Expr} @@ -10158,7 +10156,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-ScriptItem}{push-reduction} \calls{PARSE-ScriptItem}{pop-stack-2} \calls{PARSE-ScriptItem}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-ScriptItem} (defun |PARSE-ScriptItem| () (or (and (|PARSE-Expr| 90) (optional @@ -10173,17 +10171,17 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-ScriptItem| (list '|PrefixSC| (pop-stack-1)))))) -@ +\end{chunk} \defun{PARSE-Name}{PARSE-Name} \calls{PARSE-Name}{parse-identifier} \calls{PARSE-Name}{push-reduction} \calls{PARSE-Name}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Name} (defun |PARSE-Name| () (and (parse-identifier) (push-reduction '|PARSE-Name| (pop-stack-1)))) -@ +\end{chunk} \defun{PARSE-Data}{PARSE-Data} \calls{PARSE-Data}{action} @@ -10192,22 +10190,22 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Data}{translabel} \calls{PARSE-Data}{pop-stack-1} \uses{PARSE-Data}{labasoc} -<>= +\begin{chunk}{defun PARSE-Data} (defun |PARSE-Data| () (declare (special lablasoc)) (and (action (setq lablasoc nil)) (|PARSE-Sexpr|) (push-reduction '|PARSE-Data| (list 'quote (translabel (pop-stack-1) lablasoc))))) -@ +\end{chunk} \defun{PARSE-Sexpr}{PARSE-Sexpr} \calls{PARSE-Sexpr}{PARSE-Sexpr1} -<>= +\begin{chunk}{defun PARSE-Sexpr} (defun |PARSE-Sexpr| () (and (action (advance-token)) (|PARSE-Sexpr1|))) -@ +\end{chunk} \defun{PARSE-Sexpr1}{PARSE-Sexpr1} \calls{PARSE-Sexpr1}{PARSE-AnyId} @@ -10226,7 +10224,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Sexpr1}{bang} \calls{PARSE-Sexpr1}{star} \calls{PARSE-Sexpr1}{PARSE-GliphTok} -<>= +\begin{chunk}{defun PARSE-Sexpr1} (defun |PARSE-Sexpr1| () (or (and (|PARSE-AnyId|) (optional @@ -10257,31 +10255,31 @@ IteratorTail: ('repeat' ! / Iterator*) ; (nconc (pop-stack-2) (pop-stack-1)))))))) (must (match-advance-string ")"))))) -@ +\end{chunk} \defun{PARSE-NBGliphTok}{PARSE-NBGliphTok} \calls{PARSE-NBGliphTok}{match-current-token} \calls{PARSE-NBGliphTok}{action} \calls{PARSE-NBGliphTok}{advance-token} \uses{PARSE-NBGliphTok}{tok} -<>= +\begin{chunk}{defun PARSE-NBGliphTok} (defun |PARSE-NBGliphTok| (|tok|) (declare (special |tok|)) (and (match-current-token 'gliph |tok|) nonblank (action (advance-token)))) -@ +\end{chunk} \defun{PARSE-GliphTok}{PARSE-GliphTok} \calls{PARSE-GliphTok}{match-current-token} \calls{PARSE-GliphTok}{action} \calls{PARSE-GliphTok}{advance-token} \uses{PARSE-GliphTok}{tok} -<>= +\begin{chunk}{defun PARSE-GliphTok} (defun |PARSE-GliphTok| (|tok|) (declare (special |tok|)) (and (match-current-token 'gliph |tok|) (action (advance-token)))) -@ +\end{chunk} \defun{PARSE-AnyId}{PARSE-AnyId} \calls{PARSE-AnyId}{parse-identifier} @@ -10291,7 +10289,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-AnyId}{action} \calls{PARSE-AnyId}{advance-token} \calls{PARSE-AnyId}{parse-keyword} -<>= +\begin{chunk}{defun PARSE-AnyId} (defun |PARSE-AnyId| () (or (parse-identifier) (or (and (match-string "$") @@ -10299,7 +10297,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (action (advance-token))) (parse-keyword)))) -@ +\end{chunk} \defun{PARSE-Sequence}{PARSE-Sequence} \calls{PARSE-Sequence}{PARSE-OpenBracket} @@ -10309,7 +10307,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Sequence}{PARSE-OpenBrace} \calls{PARSE-Sequence}{push-reduction} \calls{PARSE-Sequence}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Sequence} (defun |PARSE-Sequence| () (or (and (|PARSE-OpenBracket|) (must (|PARSE-Sequence1|)) (must (match-advance-string "]"))) @@ -10318,7 +10316,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-Sequence| (list '|brace| (pop-stack-1)))))) -@ +\end{chunk} \defun{PARSE-Sequence1}{PARSE-Sequence1} \calls{PARSE-Sequence1}{PARSE-Expression} @@ -10327,7 +10325,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Sequence1}{pop-stack-1} \calls{PARSE-Sequence1}{optional} \calls{PARSE-Sequence1}{PARSE-IteratorTail} -<>= +\begin{chunk}{defun PARSE-Sequence1} (defun |PARSE-Sequence1| () (and (or (and (|PARSE-Expression|) (push-reduction '|PARSE-Sequence1| @@ -10340,7 +10338,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (append (pop-stack-1) (list (pop-stack-1))))))))) -@ +\end{chunk} \defun{PARSE-OpenBracket}{PARSE-OpenBracket} \calls{PARSE-OpenBracket}{getToken} @@ -10349,7 +10347,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-OpenBracket}{push-reduction} \calls{PARSE-OpenBracket}{action} \calls{PARSE-OpenBracket}{advance-token} -<>= +\begin{chunk}{defun PARSE-OpenBracket} (defun |PARSE-OpenBracket| () (let (g1) (and (eq (|getToken| (setq g1 (current-symbol))) '[) @@ -10359,7 +10357,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-OpenBracket| '|construct|))) (action (advance-token)))))) -@ +\end{chunk} \defun{PARSE-OpenBrace}{PARSE-OpenBrace} \calls{PARSE-OpenBrace}{getToken} @@ -10368,7 +10366,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-OpenBrace}{push-reduction} \calls{PARSE-OpenBrace}{action} \calls{PARSE-OpenBrace}{advance-token} -<>= +\begin{chunk}{defun PARSE-OpenBrace} (defun |PARSE-OpenBrace| () (let (g1) (and (eq (|getToken| (setq g1 (current-symbol))) '{) @@ -10378,7 +10376,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-OpenBrace| '|construct|))) (action (advance-token)))))) -@ +\end{chunk} \defun{PARSE-IteratorTail}{PARSE-IteratorTail} \calls{PARSE-IteratorTail}{match-advance-string} @@ -10386,13 +10384,13 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-IteratorTail}{optional} \calls{PARSE-IteratorTail}{star} \calls{PARSE-IteratorTail}{PARSE-Iterator} -<>= +\begin{chunk}{defun PARSE-IteratorTail} (defun |PARSE-IteratorTail| () (or (and (match-advance-string "repeat") (bang fil_test (optional (star repeator (|PARSE-Iterator|))))) (star repeator (|PARSE-Iterator|)))) -@ +\end{chunk} \defun{PARSE-Iterator}{PARSE-Iterator} \calls{PARSE-Iterator}{match-advance-string} @@ -10404,7 +10402,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-Iterator}{pop-stack-2} \calls{PARSE-Iterator}{pop-stack-1} \calls{PARSE-Iterator}{optional} -<>= +\begin{chunk}{defun PARSE-Iterator} (defun |PARSE-Iterator| () (or (and (match-advance-string "for") (must (|PARSE-Primary|)) (must (match-advance-string "in")) @@ -10428,7 +10426,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (push-reduction '|PARSE-Iterator| (list 'until (pop-stack-1)))))) -@ +\end{chunk} \subsection{The PARSE implicit routines} These symbols are not explicitly referenced in the source. Nevertheless, they are called during runtime. For example, @@ -10451,14 +10449,14 @@ so there is a bit of indirection involved in the call. \calls{PARSE-Suffix}{optional} \calls{PARSE-Suffix}{PARSE-TokTail} \calls{PARSE-Suffix}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Suffix} (defun |PARSE-Suffix| () (and (push-reduction '|PARSE-Suffix| (current-symbol)) (action (advance-token)) (optional (|PARSE-TokTail|)) (push-reduction '|PARSE-Suffix| (list (pop-stack-1) (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-SemiColon}{PARSE-SemiColon} \calls{PARSE-SemiColon}{match-advance-string} @@ -10467,7 +10465,7 @@ so there is a bit of indirection involved in the call. \calls{PARSE-SemiColon}{push-reduction} \calls{PARSE-SemiColon}{pop-stack-2} \calls{PARSE-SemiColon}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-SemiColon} (defun |PARSE-SemiColon| () (and (match-advance-string ";") (must (or (|PARSE-Expr| 82) @@ -10475,7 +10473,7 @@ so there is a bit of indirection involved in the call. (push-reduction '|PARSE-SemiColon| (list '|;| (pop-stack-2) (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-Return}{PARSE-Return} \calls{PARSE-Return}{match-advance-string} @@ -10483,13 +10481,13 @@ so there is a bit of indirection involved in the call. \calls{PARSE-Return}{PARSE-Expression} \calls{PARSE-Return}{push-reduction} \calls{PARSE-Return}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Return} (defun |PARSE-Return| () (and (match-advance-string "return") (must (|PARSE-Expression|)) (push-reduction '|PARSE-Return| (list '|return| (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-Exit}{PARSE-Exit} \calls{PARSE-Exit}{match-advance-string} @@ -10497,7 +10495,7 @@ so there is a bit of indirection involved in the call. \calls{PARSE-Exit}{PARSE-Expression} \calls{PARSE-Exit}{push-reduction} \calls{PARSE-Exit}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Exit} (defun |PARSE-Exit| () (and (match-advance-string "exit") (must (or (|PARSE-Expression|) @@ -10505,7 +10503,7 @@ so there is a bit of indirection involved in the call. (push-reduction '|PARSE-Exit| (list '|exit| (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-Leave}{PARSE-Leave} \calls{PARSE-Leave}{match-advance-string} @@ -10514,7 +10512,7 @@ so there is a bit of indirection involved in the call. \calls{PARSE-Leave}{push-reduction} \calls{PARSE-Leave}{PARSE-Label} \calls{PARSE-Leave}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Leave} (defun |PARSE-Leave| () (and (match-advance-string "leave") (must (or (|PARSE-Expression|) @@ -10526,7 +10524,7 @@ so there is a bit of indirection involved in the call. (push-reduction '|PARSE-Leave| (list '|leave| (pop-stack-1))))))) -@ +\end{chunk} \defun{PARSE-Seg}{PARSE-Seg} \calls{PARSE-Seg}{PARSE-GliphTok} @@ -10536,14 +10534,14 @@ so there is a bit of indirection involved in the call. \calls{PARSE-Seg}{push-reduction} \calls{PARSE-Seg}{pop-stack-2} \calls{PARSE-Seg}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Seg} (defun |PARSE-Seg| () (and (|PARSE-GliphTok| '|..|) (bang fil_test (optional (|PARSE-Expression|))) (push-reduction '|PARSE-Seg| (list 'segment (pop-stack-2) (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-Conditional}{PARSE-Conditional} \calls{PARSE-Conditional}{match-advance-string} @@ -10556,7 +10554,7 @@ so there is a bit of indirection involved in the call. \calls{PARSE-Conditional}{pop-stack-3} \calls{PARSE-Conditional}{pop-stack-2} \calls{PARSE-Conditional}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Conditional} (defun |PARSE-Conditional| () (and (match-advance-string "if") (must (|PARSE-Expression|)) (must (match-advance-string "then")) (must (|PARSE-Expression|)) @@ -10567,18 +10565,18 @@ so there is a bit of indirection involved in the call. (push-reduction '|PARSE-Conditional| (list '|if| (pop-stack-3) (pop-stack-2) (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-ElseClause}{PARSE-ElseClause} \calls{PARSE-ElseClause}{current-symbol} \calls{PARSE-ElseClause}{PARSE-Conditional} \calls{PARSE-ElseClause}{PARSE-Expression} -<>= +\begin{chunk}{defun PARSE-ElseClause} (defun |PARSE-ElseClause| () (or (and (eq (current-symbol) '|if|) (|PARSE-Conditional|)) (|PARSE-Expression|))) -@ +\end{chunk} \defun{PARSE-Loop}{PARSE-Loop} \calls{PARSE-Loop}{star} @@ -10589,7 +10587,7 @@ so there is a bit of indirection involved in the call. \calls{PARSE-Loop}{push-reduction} \calls{PARSE-Loop}{pop-stack-2} \calls{PARSE-Loop}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-Loop} (defun |PARSE-Loop| () (or (and (star repeator (|PARSE-Iterator|)) (must (match-advance-string "repeat")) @@ -10601,7 +10599,7 @@ so there is a bit of indirection involved in the call. (push-reduction '|PARSE-Loop| (list 'repeat (pop-stack-1)))))) -@ +\end{chunk} \defun{PARSE-LabelExpr}{PARSE-LabelExpr} \calls{PARSE-LabelExpr}{PARSE-Label} @@ -10610,13 +10608,13 @@ so there is a bit of indirection involved in the call. \calls{PARSE-LabelExpr}{push-reduction} \calls{PARSE-LabelExpr}{pop-stack-2} \calls{PARSE-LabelExpr}{pop-stack-1} -<>= +\begin{chunk}{defun PARSE-LabelExpr} (defun |PARSE-LabelExpr| () (and (|PARSE-Label|) (must (|PARSE-Expr| 120)) (push-reduction '|PARSE-LabelExpr| (list 'label (pop-stack-2) (pop-stack-1))))) -@ +\end{chunk} \defun{PARSE-FloatTok}{PARSE-FloatTok} \calls{PARSE-FloatTok}{parse-number} @@ -10624,13 +10622,13 @@ so there is a bit of indirection involved in the call. \calls{PARSE-FloatTok}{pop-stack-1} \calls{PARSE-FloatTok}{bfp-} \usesdollar{PARSE-FloatTok}{boot} -<>= +\begin{chunk}{defun PARSE-FloatTok} (defun |PARSE-FloatTok| () (and (parse-number) (push-reduction '|PARSE-FloatTok| (if $boot (pop-stack-1) (bfp- (pop-stack-1)))))) -@ +\end{chunk} \section{The PARSE support routines} @@ -10660,7 +10658,7 @@ if X matches initial segment of inputstream. \calls{match-string}{subseq} \usesstruct{match-string}{line} \uses{match-string}{line} -<>= +\begin{chunk}{defun match-string} (defun match-string (x) (unget-tokens) ; So we don't get out of synch with token stream (skip-blanks) @@ -10668,7 +10666,7 @@ if X matches initial segment of inputstream. (initial-substring-p x (subseq (line-buffer current-line) (line-current-index current-line))))) -@ +\end{chunk} \defun{match-advance-string}{match-advance-string} The match-string function returns length of X @@ -10682,7 +10680,7 @@ If it is successful, advance inputstream past X. \calls{match-advance-string}{line-current-char} \usesstruct{match-advance-string}{token} \usesstruct{match-advance-string}{line} -<>= +\begin{chunk}{defun match-advance-string} (defun match-advance-string (x) (let ((y (if (>= (length (string x)) (length (string (quote-if-string (current-token))))) @@ -10701,17 +10699,17 @@ If it is successful, advance inputstream past X. :nonblank nonblank)) t))) -@ +\end{chunk} \defun{initial-substring-p}{initial-substring-p} \calls{initial-substring-p}{string-not-greaterp} -<>= +\begin{chunk}{defun initial-substring-p} (defun initial-substring-p (part whole) "Returns length of part if part matches initial segment of whole." (let ((x (string-not-greaterp part whole))) (and x (= x (length part)) x))) -@ +\end{chunk} \defun{quote-if-string}{quote-if-string} \calls{quote-if-string}{token-type} @@ -10723,7 +10721,7 @@ If it is successful, advance inputstream past X. \calls{quote-if-string}{escape-keywords} \usesdollar{quote-if-string}{boot} \usesdollar{quote-if-string}{spad} -<>= +\begin{chunk}{defun quote-if-string} (defun quote-if-string (token) (declare (special $boot $spad)) (when token ;only use token-type on non-null tokens @@ -10745,29 +10743,29 @@ If it is successful, advance inputstream past X. id))) (t (token-symbol token))))) -@ +\end{chunk} \defun{escape-keywords}{escape-keywords} -<>= +\begin{chunk}{defun escape-keywords} (defun escape-keywords (pname id) (if (member id keywords) (concatenate 'string "_" pname) pname)) -@ +\end{chunk} \defun{isTokenDelimiter}{isTokenDelimiter} NIL needed below since END\_UNIT is not generated by current parser \calls{isTokenDelimiter}{current-symbol} -<>= +\begin{chunk}{defun isTokenDelimiter} (defun |isTokenDelimiter| () (member (current-symbol) '(\) end\_unit nil))) -@ +\end{chunk} \defun{underscore}{underscore} \calls{underscore}{vector-push} -<>= +\begin{chunk}{defun underscore} (defun underscore (string) (if (every #'alpha-char-p string) string @@ -10782,17 +10780,17 @@ NIL needed below since END\_UNIT is not generated by current parser (vector-push next-char out-string)) out-string))) -@ +\end{chunk} \subsection{Token Handling} \defun{getToken}{getToken} \calls{getToken}{eqcar} -<>= +\begin{chunk}{defun getToken} (defun |getToken| (x) (if (eqcar x '|elt|) (third x) x)) -@ +\end{chunk} \defun{unget-tokens}{unget-tokens} \calls{unget-tokens}{quote-if-string} @@ -10803,7 +10801,7 @@ NIL needed below since END\_UNIT is not generated by current parser \calls{unget-tokens}{line-new-line} \calls{unget-tokens}{line-number} \uses{unget-tokens}{valid-tokens} -<>= +\begin{chunk}{defun unget-tokens} (defun unget-tokens () (case valid-tokens (0 t) @@ -10826,52 +10824,52 @@ NIL needed below since END\_UNIT is not generated by current parser (setq valid-tokens 0))) (t (error "How many tokens do you think you have?")))) -@ +\end{chunk} \defun{match-current-token}{match-current-token} This returns the current token if it has EQ type and (optionally) equal symbol. \calls{match-current-token}{current-token} \calls{match-current-token}{match-token} -<>= +\begin{chunk}{defun match-current-token} (defun match-current-token (type &optional (symbol nil)) (match-token (current-token) type symbol)) -@ +\end{chunk} \defun{match-token}{match-token} \calls{match-token}{token-type} \calls{match-token}{token-symbol} -<>= +\begin{chunk}{defun match-token} (defun match-token (token type &optional (symbol nil)) (when (and token (eq (token-type token) type)) (if symbol (when (equal symbol (token-symbol token)) token) token))) -@ +\end{chunk} \defun{match-next-token}{match-next-token} This returns the next token if it has equal type and (optionally) equal symbol. \calls{match-next-token}{next-token} \calls{match-next-token}{match-token} -<>= +\begin{chunk}{defun match-next-token} (defun match-next-token (type &optional (symbol nil)) (match-token (next-token) type symbol)) -@ +\end{chunk} \defun{current-symbol}{current-symbol} \calls{current-symbol}{make-symbol-of} \calls{current-symbol}{current-token} -<>= +\begin{chunk}{defun current-symbol} (defun current-symbol () (make-symbol-of (current-token))) -@ +\end{chunk} \defun{make-symbol-of}{make-symbol-of} \usesstruct{make-symbol-of}{token} -<>= +\begin{chunk}{defun make-symbol-of} (defun make-symbol-of (token) (let ((u (and token (token-symbol token)))) (cond @@ -10879,26 +10877,26 @@ This returns the next token if it has equal type and (optionally) equal symbol. ((characterp u) (intern (string u))) (u)))) -@ +\end{chunk} \defun{current-token}{current-token} This returns the current token getting a new one if necessary. \calls{current-token}{try-get-token} \uses{current-token}{valid-tokens} \uses{current-token}{current-token} -<>= +\begin{chunk}{defun current-token} (defun current-token () (declare (special valid-tokens current-token)) (if (> valid-tokens 0) current-token (try-get-token current-token))) -@ +\end{chunk} \defun{try-get-token}{try-get-token} \calls{try-get-token}{get-token} \uses{try-get-token}{valid-tokens} -<>= +\begin{chunk}{defun try-get-token} (defun try-get-token (token) (declare (special valid-tokens)) (let ((tok (get-token token))) @@ -10906,7 +10904,7 @@ This returns the current token getting a new one if necessary. (incf valid-tokens) token))) -@ +\end{chunk} \defun{next-token}{next-token} This returns the token after the current token, or NIL if there is none after. @@ -10914,7 +10912,7 @@ This returns the token after the current token, or NIL if there is none after. \calls{next-token}{current-token} \uses{next-token}{valid-tokens} \uses{next-token}{next-token} -<>= +\begin{chunk}{defun next-token} (defun next-token () (declare (special valid-tokens next-token)) (current-token) @@ -10922,7 +10920,7 @@ This returns the token after the current token, or NIL if there is none after. next-token (try-get-token next-token))) -@ +\end{chunk} \defun{advance-token}{advance-token} This makes the next token be the current token. @@ -10931,7 +10929,7 @@ This makes the next token be the current token. \calls{advance-token}{try-get-token} \uses{advance-token}{valid-tokens} \uses{advance-token}{current-token} -<>= +\begin{chunk}{defun advance-token} (defun advance-token () (current-token) ;don't know why this is needed (case valid-tokens @@ -10943,22 +10941,22 @@ This makes the next token be the current token. (setq current-token (copy-token next-token)) (decf valid-tokens)))) -@ +\end{chunk} \defvar{XTokenReader} -<>= +\begin{chunk}{initvars} (defvar XTokenReader 'get-meta-token "Name of tokenizing function") -@ +\end{chunk} \defun{get-token}{get-token} \calls{get-token}{XTokenReader} \uses{get-token}{XTokenReader} -<>= +\begin{chunk}{defun get-token} (defun get-token (token) (funcall XTokenReader token)) -@ +\end{chunk} \subsection{Character handling} @@ -10967,13 +10965,13 @@ This returns the current character of the line, initially blank for an unread line. \usesstruct{current-char}{line} \uses{current-char}{current-line} -<>= +\begin{chunk}{defun current-char} (defun current-char () (if (line-past-end-p current-line) #\return (line-current-char current-line))) -@ +\end{chunk} \defun{next-char}{next-char} This returns the character after the current character, blank if at @@ -10983,44 +10981,44 @@ equivalent to. \calls{next-char}{line-at-end-p} \calls{next-char}{line-next-char} \uses{next-char}{current-line} -<>= +\begin{chunk}{defun next-char} (defun next-char () (if (line-at-end-p current-line) #\return (line-next-char current-line))) -@ +\end{chunk} \defun{char-eq}{char-eq} -<>= +\begin{chunk}{defun char-eq} (defun char-eq (x y) (char= (character x) (character y))) -@ +\end{chunk} \defun{char-ne}{char-ne} -<>= +\begin{chunk}{defun char-ne} (defun char-ne (x y) (char/= (character x) (character y))) -@ +\end{chunk} \subsection{Error handling} \defvar{meta-error-handler} -<>= +\begin{chunk}{initvars} (defvar meta-error-handler 'meta-meta-error-handler) -@ +\end{chunk} \defun{meta-syntax-error}{meta-syntax-error} \calls{meta-syntax-error}{meta-error-handler} \uses{meta-syntax-error}{meta-error-handler} -<>= +\begin{chunk}{defun meta-syntax-error} (defun meta-syntax-error (&optional (wanted nil) (parsing nil)) (declare (special meta-error-handler)) (funcall meta-error-handler wanted parsing)) -@ +\end{chunk} \subsection{Floating Point Support} @@ -11032,7 +11030,7 @@ equivalent to. \calls{floatexpid}{step} \calls{floatexpid}{maxindex} \calls{floatexpid}{digitp} -<>= +\begin{chunk}{defun floatexpid} (defun floatexpid (x &aux s) (when (and (identp x) (char= (char-upcase (elt (setq s (pname x)) 0)) #\E) (> (length s) 1) @@ -11040,13 +11038,13 @@ equivalent to. (digitp (elt s i))))) (read-from-string s t nil :start 1))) -@ +\end{chunk} \subsection{Dollar Translation} \defun{dollarTran}{dollarTran} \usesdollar{dollarTran}{InteractiveMode} -<>= +\begin{chunk}{defun dollarTran} (defun |dollarTran| (dom rand) (let ((eltWord (if |$InteractiveMode| '|$elt| '|elt|))) (declare (special |$InteractiveMode|)) @@ -11054,7 +11052,7 @@ equivalent to. (cons (list eltWord dom (car rand)) (cdr rand)) (list eltWord dom rand)))) -@ +\end{chunk} \subsection{Applying metagrammatical elements of a production (e.g., Star).} \begin{itemize} @@ -11072,7 +11070,7 @@ are performed upon recognizing the head and tail. \defmacro{Bang} If the execution of prod does not result in an increase in the size of the stack, then stack a NIL. Return the value of prod. -<>= +\begin{chunk}{defmacro bang} (defmacro bang (lab prod) `(progn (setf (stack-updated reduce-stack) nil) @@ -11080,27 +11078,27 @@ the stack, then stack a NIL. Return the value of prod. (unless updated (push-reduction ',lab nil)) prodvalue))) -@ +\end{chunk} \defmacro{must} \calls{must}{meta-syntax-error} -<>= +\begin{chunk}{defmacro must} (defmacro must (dothis &optional (this-is nil) (in-rule nil)) `(or ,dothis (meta-syntax-error ,this-is ,in-rule))) -@ +\end{chunk} \defun{action}{action} -<>= +\begin{chunk}{defun action} (defun action (dothis) (or dothis t)) -@ +\end{chunk} \defun{optional}{optional} -<>= +\begin{chunk}{defun optional} (defun optional (dothis) (or dothis t)) -@ +\end{chunk} \defmacro{star} Succeeds if there are one or more of PROD, stacking as one unit @@ -11110,7 +11108,7 @@ where (parse-id) would stack (1 ID (A)) when applied once. \calls{star}{stack-size} \calls{star}{push-reduction} \calls{star}{pop-stack-1} -<>= +\begin{chunk}{defmacro star} (defmacro star (lab prod) `(prog ((oldstacksize (stack-size reduce-stack))) (if (not ,prod) (return nil)) @@ -11127,24 +11125,24 @@ loop (return t))) (go loop)))) -@ +\end{chunk} \subsection{Stacking and retrieving reductions of rules.} \defun{push-reduction}{push-reduction} \calls{push-reduction}{stack-push} \calls{push-reduction}{make-reduction} \uses{push-reduction}{reduce-stack} -<>= +\begin{chunk}{defun push-reduction} (defun push-reduction (rule redn) (stack-push (make-reduction :rule rule :value redn) reduce-stack)) -@ +\end{chunk} \chapter{Utility Functions} \defun{addclose}{addclose} \calls{addclose}{suffix} -<>= +\begin{chunk}{defun addclose} (defun addclose (line char) (cond ((char= (char line (maxindex line)) #\; ) @@ -11152,21 +11150,21 @@ loop (if (char= char #\;) line (suffix #\; line))) ((suffix char line)))) -@ +\end{chunk} \defun{blankp}{blankp} -<>= +\begin{chunk}{defun blankp} (defun blankp (char) (or (eq char #\Space) (eq char #\tab))) -@ +\end{chunk} \defun{drop}{drop} Return a pointer to the Nth cons of X, counting 0 as the first cons. \calls{drop}{drop} \calls{drop}{take} \calls{drop}{croak} -<>= +\begin{chunk}{defun drop} (defun drop (n x &aux m) (cond ((eql n 0) x) @@ -11174,20 +11172,20 @@ Return a pointer to the Nth cons of X, counting 0 as the first cons. ((>= (setq m (+ (length x) n)) 0) (take m x)) ((croak (list "Bad args to DROP" n x))))) -@ +\end{chunk} \defun{escaped}{escaped} -<>= +\begin{chunk}{defun escaped} (defun escaped (str n) (and (> n 0) (eq (char str (1- n)) #\_))) -@ +\end{chunk} \defdollar{comblocklist} -<>= +\begin{chunk}{initvars} (defvar $comblocklist nil "a dynamic lists of comments for this block") -@ +\end{chunk} \defun{fincomblock}{fincomblock} \begin{itemize} @@ -11199,7 +11197,7 @@ Return a pointer to the Nth cons of X, counting 0 as the first cons. \calls{fincomblock}{preparse-echo} \usesdollar{fincomblock}{comblocklist} \usesdollar{fincomblock}{EchoLineStack} -<>= +\begin{chunk}{defun fincomblock} (defun fincomblock (num oldnums oldlocs ncblock linelist) (declare (special $EchoLineStack $comblocklist)) (push @@ -11221,10 +11219,10 @@ Return a pointer to the Nth cons of X, counting 0 as the first cons. (reverse (cdr ncblock))))) $comblocklist)) -@ +\end{chunk} \defun{indent-pos}{indent-pos} -<>= +\begin{chunk}{defun indent-pos} (defun indent-pos (str) (do ((i 0 (1+ i)) (pos 0)) ((>= i (length str)) nil) @@ -11233,58 +11231,58 @@ Return a pointer to the Nth cons of X, counting 0 as the first cons. (#\tab (setq pos (next-tab-loc pos))) (otherwise (return pos))))) -@ +\end{chunk} \defun{infixtok}{infixtok} \calls{infixtok}{string2id-n} -<>= +\begin{chunk}{defun infixtok} (defun infixtok (s) (member (string2id-n s 1) '(|then| |else|) :test #'eq)) -@ +\end{chunk} \defun{is-console}{is-console} \calls{is-console}{fp-output-stream} \uses{is-console}{*terminal-io*} -<>= +\begin{chunk}{defun is-console} (defun is-console (stream) (and (streamp stream) (output-stream-p stream) (eq (system:fp-output-stream stream) (system:fp-output-stream *terminal-io*)))) -@ +\end{chunk} \defun{next-tab-loc}{next-tab-loc} -<>= +\begin{chunk}{defun next-tab-loc} (defun next-tab-loc (i) (* (1+ (truncate i 8)) 8)) -@ +\end{chunk} \defun{nonblankloc}{nonblankloc} \calls{nonblankloc}{blankp} -<>= +\begin{chunk}{defun nonblankloc} (defun nonblankloc (str) (position-if-not #'blankp str)) -@ +\end{chunk} \defun{parseprint}{parseprint} -<>= +\begin{chunk}{defun parseprint} (defun parseprint (l) (when l (format t "~&~% *** PREPARSE ***~%~%") (dolist (x l) (format t "~5d. ~a~%" (car x) (cdr x))) (format t "~%"))) -@ +\end{chunk} \defun{skip-to-endif}{skip-to-endif} \calls{skip-to-endif}{initial-substring} \calls{skip-to-endif}{preparseReadLine} \calls{skip-to-endif}{preparseReadLine1} \calls{skip-to-endif}{skip-to-endif} -<>= +\begin{chunk}{defun skip-to-endif} (defun skip-to-endif (x) (let (line ind) (dcq (ind . line) (preparseReadLine1)) @@ -11294,7 +11292,7 @@ Return a pointer to the Nth cons of X, counting 0 as the first cons. ((initial-substring line ")fin") (cons ind nil)) (t (skip-to-endif x))))) -@ +\end{chunk} \chapter{The Compiler} @@ -11505,7 +11503,7 @@ function with a list containing the full pathname as a string. \usesdollar{compiler}{newConlist} \usesdollar{compiler}{options} \uses{compiler}{/editfile} -<>= +\begin{chunk}{defun compiler} (defun |compiler| (args) "The top level compiler command" (let (|$newConlist| optlist optname optargs havenew haveold aft ef af af1) @@ -11567,7 +11565,7 @@ function with a list containing the full pathname as a string. (|compileSpad2Cmd| (cons af1 nil))) (t (|throwKeyedMsg| 's2iz0039 nil))))))))))))))))) -@ +\end{chunk} \defunsec{compileSpad2Cmd}{The Spad compiler top level function} The argument to this function, as noted above, is a list containing @@ -11672,7 +11670,7 @@ Again we find a lot of redundant work. We finally end up calling \usesdollar{compileSpad2Cmd}{options} \usesdollar{compileSpad2Cmd}{newConlist} \uses{compileSpad2Cmd}{/editfile} -<>= +\begin{chunk}{defun compileSpad2Cmd} (defun |compileSpad2Cmd| (args) (let (|$newComp| |$scanIfTrue| |$compileOnlyCertainItems| |$f| |$m| |$QuickLet| |$QuickCode| @@ -11736,7 +11734,7 @@ Again we find a lot of redundant work. We finally end up calling (|terminateSystemCommand|) (|spadPrompt|))))) -@ +\end{chunk} This trivial function cases on the second argument to decide which combination of operations was requested. For this case we see: @@ -11763,7 +11761,7 @@ combination of operations was requested. For this case we see: \calls{compilerDoit}{/RQ,LIB} \usesdollar{compilerDoit}{byConstructors} \usesdollar{compilerDoit}{constructorsSeen} -<>= +\begin{chunk}{defun compilerDoit} (defun |compilerDoit| (constructor fun) (let (|$byConstructors| |$constructorsSeen|) (declare (special |$byConstructors| |$constructorsSeen|)) @@ -11779,7 +11777,7 @@ combination of operations was requested. For this case we see: (unless (|member| x |$constructorsSeen|) (|sayBrightly| `(">>> Warning " |%b| ,x |%d| " was not found")))))))) -@ +\end{chunk} This function simply calls {\bf \verb|/rf-1|}. \begin{verbatim} @@ -11799,12 +11797,12 @@ This function simply calls {\bf \verb|/rf-1|}. \calls{/RQ,LIB}{/rf-1} \uses{/RQ,LIB}{echo-meta(5)} \usesdollar{/RQ,LIB}{lisplib} -<>= +\begin{chunk}{defun /RQ,LIB} (defun |/RQ,LIB| (&rest foo &aux (echo-meta nil) ($lisplib t)) (declare (special echo-meta $lisplib) (ignore foo)) (/rf-1 nil)) -@ +\end{chunk} Since this function is called with nil we fall directly into the call to the function {\bf spad}: @@ -11829,7 +11827,7 @@ call to the function {\bf spad}: \calls{/rf-1}{spad} \uses{/rf-1}{/editfile} \uses{/rf-1}{echo-meta} -<>= +\begin{chunk}{defun /rf-1} (defun /rf-1 (ignore) (declare (ignore ignore)) (let* ((input-file (makeInputFilename /editfile)) @@ -11840,7 +11838,7 @@ call to the function {\bf spad}: ((string= type "input") (|ncINTERPFILE| input-file echo-meta)) (t (spad input-file))))) -@ +\end{chunk} Here we begin the actual compilation process. \begin{verbatim} @@ -12286,7 +12284,7 @@ And the {\bf s-process} function which returns a parsed version of the input. \uses{spad}{*eof*} \uses{spad}{file-closed} \catches{spad}{spad-reader} -<>= +\begin{chunk}{defun spad} (defun spad (&optional (*spad-input-file* nil) (*spad-output-file* nil) &aux (*comp370-apply* #'print-defun) (*fileactq-apply* #'print-defun) @@ -12336,7 +12334,7 @@ And the {\bf s-process} function which returns a parsed version of the input. (if *spad-output-file* (shut out-stream))) t)) -@ +\end{chunk} \defun{s-process}{Interpreter interface to the compiler} \calls{s-process}{curstrm} @@ -12386,7 +12384,7 @@ And the {\bf s-process} function which returns a parsed version of the input. \usesdollar{s-process}{LocalFrame} \usesdollar{s-process}{Translation} \uses{s-process}{curoutstream} -<>= +\begin{chunk}{defun s-process} (defun s-process (x) (prog ((|$Index| 0) ($macroassoc ()) @@ -12443,19 +12441,19 @@ And the {\bf s-process} function which returns a parsed version of the input. (when |$semanticErrorStack| (|displaySemanticErrors|)) (terpri))) -@ +\end{chunk} \defun{def-rename}{def-rename} \calls{def-rename}{def-rename1} -<>= +\begin{chunk}{defun def-rename} (defun def-rename (x) (def-rename1 x)) -@ +\end{chunk} \defun{def-rename1}{def-rename1} \calls{def-rename1}{def-rename1} -<>= +\begin{chunk}{defun def-rename1} (defun def-rename1 (x) (cond ((symbolp x) @@ -12466,7 +12464,7 @@ And the {\bf s-process} function which returns a parsed version of the input. (cons (def-rename1 (first x)) (def-rename1 (cdr x))))) (x))) -@ +\end{chunk} \defun{compTopLevel}{compTopLevel} \calls{compTopLevel}{newComp} @@ -12478,7 +12476,7 @@ And the {\bf s-process} function which returns a parsed version of the input. \usesdollar{compTopLevel}{resolveTimeSum} \usesdollar{compTopLevel}{packagesUsed} \usesdollar{compTopLevel}{envHashTable} -<>= +\begin{chunk}{defun compTopLevel} (defun |compTopLevel| (x m e) (let (|$NRTderivedTargetIfTrue| |$killOptimizeIfTrue| |$forceAdd| |$compTimeSum| |$resolveTimeSum| |$packagesUsed| |$envHashTable| @@ -12511,7 +12509,7 @@ And the {\bf s-process} function which returns a parsed version of the input. (cons val (cons mode (cons e nil)))) (t (|compOrCroak| x m e))))) -@ +\end{chunk} Given: \begin{verbatim} CohenCategory(): Category == SetCategory with @@ -12549,11 +12547,11 @@ The third argument, {\tt e}, is the environment. \defun{compOrCroak}{compOrCroak} \calls{compOrCroak}{compOrCroak1} -<>= +\begin{chunk}{defun compOrCroak} (defun |compOrCroak| (x m e) (|compOrCroak1| x m e nil nil)) -@ +\end{chunk} This results in a call to the inner function with \begin{verbatim} @@ -12600,7 +12598,7 @@ implicit stacking to retain the information. \usesdollar{compOrCroak1}{scanIfTrue} \usesdollar{compOrCroak1}{exitModeStack} \catches{compOrCroak1}{compOrCroak} -<>= +\begin{chunk}{defun compOrCroak1} (defun |compOrCroak1| (x m e |$compStack| |$compErrorMessageStack|) (declare (special |$compStack| |$compErrorMessageStack|)) (let (td errorMessage) @@ -12625,13 +12623,13 @@ implicit stacking to retain the information. (|displayComp| |$level|) (|userError| errorMessage))))))) -@ +\end{chunk} \defun{comp}{comp} \calls{comp}{compNoStacking} \usesdollar{comp}{compStack} \usesdollar{comp}{exitModeStack} -<>= +\begin{chunk}{defun comp} (defun |comp| (x m e) (let (td) (declare (special |$compStack| |$exitModeStack|)) @@ -12640,7 +12638,7 @@ implicit stacking to retain the information. (push (list x m e |$exitModeStack|) |$compStack|)) td)) -@ +\end{chunk} \defun{compNoStacking}{compNoStacking} \verb|$Representation| is bound in compDefineFunctor, set by doIt. @@ -12651,7 +12649,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \usesdollar{compNoStacking}{compStack} \usesdollar{compNoStacking}{Representation} \usesdollar{compNoStacking}{EmptyMode} -<>= +\begin{chunk}{defun compNoStacking} (defun |compNoStacking| (x m e) (let (td) (declare (special |$compStack| |$Representation| |$EmptyMode|)) @@ -12661,13 +12659,13 @@ preferred to the underlying representation -- RDJ 9/12/83 td) (|compNoStacking1| x m e |$compStack|)))) -@ +\end{chunk} \defun{compNoStacking1}{compNoStacking1} \calls{compNoStacking1}{get} \calls{compNoStacking1}{comp2} \usesdollar{compNoStacking1}{compStack} -<>= +\begin{chunk}{defun compNoStacking1} (defun |compNoStacking1| (x m e |$compStack|) (declare (special |$compStack|)) (let (u td) @@ -12677,7 +12675,7 @@ preferred to the underlying representation -- RDJ 9/12/83 nil) nil))) -@ +\end{chunk} \defun{comp2}{comp2} \calls{comp2}{comp3} @@ -12690,7 +12688,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \usesdollar{comp2}{bootStrapMode} \usesdollar{comp2}{packagesUsed} \usesdollar{comp2}{lisplib} -<>= +\begin{chunk}{defun comp2} (defun |comp2| (x m e) (let (tmp1) (declare (special |$bootStrapMode| |$packagesUsed| $lisplib)) @@ -12705,7 +12703,7 @@ preferred to the underlying representation -- RDJ 9/12/83 (list y mprime (|addDomain| mprime e)) (list y mprime e)))))) -@ +\end{chunk} \defun{comp3}{comp3} \begin{verbatim} @@ -12746,7 +12744,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \calls{comp3}{getDomainsInScope} \usesdollar{comp3}{e} \usesdollar{comp3}{insideCompTypeOf} -<>= +\begin{chunk}{defun comp3} (defun |comp3| (x m |$e|) (declare (special |$e|)) (let (e a op ml u sig varlist tmp3 body tt xprime tmp1 mprime tmp2 eprime) @@ -12817,7 +12815,7 @@ preferred to the underlying representation -- RDJ 9/12/83 (list xprime mprime (|addDomain| mprime eprime))) (t tt)))))))) -@ +\end{chunk} \defun{compTypeOf}{compTypeOf} \calls{compTypeOf}{eqsubstlist} @@ -12826,7 +12824,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \calls{compTypeOf}{comp3} \usesdollar{compTypeOf}{insideCompTypeOf} \usesdollar{compTypeOf}{FormalMapVariableList} -<>= +\begin{chunk}{defun compTypeOf} (defun |compTypeOf| (x m e) (let (|$insideCompTypeOf| op argl newModemap) (declare (special |$insideCompTypeOf| |$FormalMapVariableList|)) @@ -12838,7 +12836,7 @@ preferred to the underlying representation -- RDJ 9/12/83 (setq e (|put| op '|modemap| newModemap e)) (|comp3| x m e))) -@ +\end{chunk} \defun{compColonInside}{compColonInside} \calls{compColonInside}{addDomain} @@ -12849,7 +12847,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \calls{compColonInside}{stackSemanticError} \usesdollar{compColonInside}{newCompilerUnionFlag} \usesdollar{compColonInside}{EmptyMode} -<>= +\begin{chunk}{defun compColonInside} (defun |compColonInside| (x m e mprime) (let (mpp warningMessage td tprime) (declare (special |$newCompilerUnionFlag| |$EmptyMode|)) @@ -12873,7 +12871,7 @@ preferred to the underlying representation -- RDJ 9/12/83 (list '|:| mprime '| -- should replace by pretend|)))) tprime)))) -@ +\end{chunk} \defun{compAtom}{compAtom} \begin{verbatim} @@ -12903,7 +12901,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \calls{compAtom}{primitiveType} \calls{compAtom}{primitiveType} \usesdollar{compAtom}{Expression} -<>= +\begin{chunk}{defun compAtom} (defun |compAtom| (x m e) (prog (tmp1 tmp2 r td tt) (declare (special |$Expression|)) @@ -12942,18 +12940,18 @@ preferred to the underlying representation -- RDJ 9/12/83 (t (list x (or (|primitiveType| x) (return nil)) e )))) (|convert| tt m)))))) -@ +\end{chunk} \defun{convert}{convert} \calls{convert}{resolve} \calls{convert}{coerce} -<>= +\begin{chunk}{defun convert} (defun |convert| (td m) (let (res) (when (setq res (|resolve| (second td) m)) (|coerce| td res)))) -@ +\end{chunk} \defun{primitiveType}{primitiveType} \usesdollar{primitiveType}{DoubleFloat} \usesdollar{primitiveType}{NegativeInteger} @@ -12961,7 +12959,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \usesdollar{primitiveType}{NonNegativeInteger} \usesdollar{primitiveType}{String} \usesdollar{primitiveType}{EmptyMode} -<>= +\begin{chunk}{defun primitiveType} (defun |primitiveType| (x) (declare (special |$DoubleFloat| |$NegativeInteger| |$PositiveInteger| |$NonNegativeInteger| |$String| |$EmptyMode|)) @@ -12976,7 +12974,7 @@ preferred to the underlying representation -- RDJ 9/12/83 ((floatp x) |$DoubleFloat|) (t nil))) -@ +\end{chunk} \defun{compSymbol}{compSymbol} \calls{compSymbol}{getmode} \calls{compSymbol}{get} @@ -12994,7 +12992,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \usesdollar{compSymbol}{functorLocalParameters} \usesdollar{compSymbol}{Boolean} \usesdollar{compSymbol}{NoValue} -<>= +\begin{chunk}{defun compSymbol} (defun |compSymbol| (s m e) (let (v mprime mode) (declare (special |$Symbol| |$Expression| |$FormalMapVariableList| @@ -13031,7 +13029,7 @@ preferred to the underlying representation -- RDJ 9/12/83 (list (list 'quote s) m e )) ((null (|isFunction| s e)) (|errorRef| s))))) -@ +\end{chunk} \defun{compList}{compList} \begin{verbatim} @@ -13042,7 +13040,7 @@ preferred to the underlying representation -- RDJ 9/12/83 ; T:= [["LIST",:[T.expr for T in Tl]],["List",mUnder],e] \end{verbatim} \calls{compList}{comp} -<>= +\begin{chunk}{defun compList} (defun |compList| (l m e) (let (tmp1 tmp2 t0 failed (mUnder (second m))) (if (null l) @@ -13063,13 +13061,13 @@ preferred to the underlying representation -- RDJ 9/12/83 (cons 'list (loop for texpr in t0 collect (car texpr))) (list (list '|List| mUnder) e))))))) -@ +\end{chunk} \defun{compExpression}{compExpression} \calls{compExpression}{getl} \calls{compExpression}{compForm} \usesdollar{compExpression}{insideExpressionIfTrue} -<>= +\begin{chunk}{defun compExpression} (defun |compExpression| (x m e) (let (|$insideExpressionIfTrue| fn) (declare (special |$insideExpressionIfTrue|)) @@ -13078,20 +13076,20 @@ preferred to the underlying representation -- RDJ 9/12/83 (funcall fn x m e) (|compForm| x m e)))) -@ +\end{chunk} \defun{compForm}{compForm} \calls{compForm}{compForm1} \calls{compForm}{compArgumentsAndTryAgain} \calls{compForm}{stackMessageIfNone} -<>= +\begin{chunk}{defun compForm} (defun |compForm| (form m e) (cond ((|compForm1| form m e)) ((|compArgumentsAndTryAgain| form m e)) (t (|stackMessageIfNone| (list '|cannot compile| '|%b| form '|%d| ))))) -@ +\end{chunk} \defun{compForm1}{compForm1} \calls{compForm1}{length} @@ -13110,7 +13108,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \usesdollar{compForm1}{NumberOfArgsIfInteger} \usesdollar{compForm1}{Expression} \usesdollar{compForm1}{EmptyMode} -<>= +\begin{chunk}{defun compForm1} (defun |compForm1| (form m e) (let (|$NumberOfArgsIfInteger| op argl domain tmp1 opprime ans mmList td tmp2 tmp3 tmp4 tmp5 tmp6 tmp7) @@ -13187,7 +13185,7 @@ preferred to the underlying representation -- RDJ 9/12/83 (t (|compToApply| op argl m e))))))) -@ +\end{chunk} \defun{compForm2}{compForm2} \calls{compForm2}{take} @@ -13202,7 +13200,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \calls{compForm2}{compForm3} \usesdollar{compForm2}{EmptyMode} \usesdollar{compForm2}{TriangleVariableList} -<>= +\begin{chunk}{defun compForm2} (defun |compForm2| (form m e modemapList) (let (op argl sargl aList dc cond nsig v ncond deleteList newList td tl partialModeList tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 tmp7) @@ -13275,13 +13273,13 @@ preferred to the underlying representation -- RDJ 9/12/83 (|compForm3| form m e modemapList))) (t (|compForm3| form m e modemapList))))) -@ +\end{chunk} \defun{compArgumentsAndTryAgain}{compArgumentsAndTryAgain} \calls{compArgumentsAndTryAgain}{comp} \calls{compArgumentsAndTryAgain}{compForm1} \usesdollar{compArgumentsAndTryAgain}{EmptyMode} -<>= +\begin{chunk}{defun compArgumentsAndTryAgain} (defun |compArgumentsAndTryAgain| (form m e) (let (argl tmp1 a tmp2 tmp3 u) (declare (special |$EmptyMode|)) @@ -13307,16 +13305,16 @@ preferred to the underlying representation -- RDJ 9/12/83 (unless (eq u '|failed|) (|compForm1| form m e)))))) -@ +\end{chunk} \defun{compWithMappingMode}{compWithMappingMode} \calls{compWithMappingMode}{compWithMappingMode1} \usesdollar{compWithMappingMode}{formalArgList} -<>= +\begin{chunk}{defun compWithMappingMode} (defun |compWithMappingMode| (x m oldE) (declare (special |$formalArgList|)) (|compWithMappingMode1| x m oldE |$formalArgList|)) -@ +\end{chunk} \defun{compWithMappingMode1}{compWithMappingMode1} \begin{verbatim} @@ -13453,7 +13451,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \usesdollar{compWithMappingMode1}{FormalMapVariableList} \usesdollar{compWithMappingMode1}{CategoryFrame} \usesdollar{compWithMappingMode1}{formatArgList} -<>= +\begin{chunk}{defun compWithMappingMode1} (defun |compWithMappingMode1| (x m oldE |$formalArgList|) (declare (special |$formalArgList|)) (prog (|$killOptimizeIfTrue| $funname $funnameTail mprime sl tmp1 tmp2 @@ -13680,10 +13678,10 @@ preferred to the underlying representation -- RDJ 9/12/83 (t (list 'list fname)))) (list uu m oldE)))))))))))) -@ +\end{chunk} \defun{extractCodeAndConstructTriple}{extractCodeAndConstructTriple} -<>= +\begin{chunk}{defun extractCodeAndConstructTriple} (defun |extractCodeAndConstructTriple| (u m oldE) (let (tmp1 a fn op env) (cond @@ -13705,22 +13703,22 @@ preferred to the underlying representation -- RDJ 9/12/83 (setq env (car (reverse (cdr u)))) (list (list 'cons (list '|function| op) env) m oldE))))) -@ +\end{chunk} \defun{hasFormalMapVariable}{hasFormalMapVariable} \calls{hasFormalMapVariable}{ScanOrPairVec} \usesdollar{hasFormalMapVariable}{formalMapVariables} -<>= +\begin{chunk}{defun hasFormalMapVariable} (defun |hasFormalMapVariable| (x vl) (let (|$formalMapVariables|) (declare (special |$formalMapVariables|)) (when (setq |$formalMapVariables| vl) (|ScanOrPairVec| #'(lambda (y) (member y |$formalMapVariables|)) x)))) -@ +\end{chunk} \defun{argsToSig}{argsToSig} -<>= +\begin{chunk}{defun argsToSig} (defun |argsToSig| (args) (let (tmp1 v tmp2 tt sig1 arg1 bad) (cond @@ -13761,19 +13759,19 @@ preferred to the underlying representation -- RDJ 9/12/83 (bad (list nil nil )) (t (list (reverse arg1) (reverse sig1)))))))) -@ +\end{chunk} \defun{compMakeDeclaration}{compMakeDeclaration} \calls{compMakeDeclaration}{compColon} \usesdollar{compMakeDeclaration}{insideExpressionIfTrue} -<>= +\begin{chunk}{defun compMakeDeclaration} (defun |compMakeDeclaration| (x m e) (let (|$insideExpressionIfTrue|) (declare (special |$insideExpressionIfTrue|)) (setq |$insideExpressionIfTrue| nil) (|compColon| x m e))) -@ +\end{chunk} \defun{modifyModeStack}{modifyModeStack} \calls{modifyModeStack}{say} @@ -13782,7 +13780,7 @@ preferred to the underlying representation -- RDJ 9/12/83 \calls{modifyModeStack}{resolve} \usesdollar{modifyModeStack}{reportExitModeStack} \usesdollar{modifyModeStack}{exitModeStack} -<>= +\begin{chunk}{defun modifyModeStack} (defun |modifyModeStack| (|m| |index|) (declare (special |$exitModeStack| |$reportExitModeStack|)) (if |$reportExitModeStack| @@ -13795,7 +13793,7 @@ preferred to the underlying representation -- RDJ 9/12/83 (setelt |$exitModeStack| |index| (|resolve| |m| (elt |$exitModeStack| |index|))))) -@ +\end{chunk} \defun{freelist}{Create a list of unbound symbols} We walk argument u looking for symbols that are unbound. If we find a @@ -13807,7 +13805,7 @@ symbol in the free list are represented by the alist (symbol . count) \calls{freelist}{identp} \calls{freelist}{getmode} \calls{freelist}{unionq} -<>= +\begin{chunk}{defun freelist} (defun freelist (u bound free e) (let (v op) (if (atom u) @@ -13845,31 +13843,31 @@ symbol in the free list are represented by the alist (symbol . count) (setq free (freelist v bound free e))))) free)))) -@ +\end{chunk} \defun{compOrCroak1,compactify}{compOrCroak1,compactify} \calls{compOrCroak1,compactify}{compOrCroak1,compactify} \calls{compOrCroak1,compactify}{lassoc} -<>= +\begin{chunk}{defun compOrCroak1,compactify} (defun |compOrCroak1,compactify| (al) (cond ((null al) nil) ((lassoc (caar al) (cdr al)) (|compOrCroak1,compactify| (cdr al))) (t (cons (car al) (|compOrCroak1,compactify| (cdr al)))))) -@ +\end{chunk} \defun{ncINTERPFILE}{Compiler/Interpreter interface} \calls{ncINTERPFILE}{SpadInterpretStream(5)} \usesdollar{ncINTERPFILE}{EchoLines} \usesdollar{ncINTERPFILE}{ReadingFile} -<>= +\begin{chunk}{defun ncINTERPFILE} (defun |ncINTERPFILE| (file echo) (let ((|$EchoLines| echo) (|$ReadingFile| t)) (declare (special |$EchoLines| |$ReadingFile|)) (|SpadInterpretStream| 1 file nil))) -@ +\end{chunk} \defun{compileSpadLispCmd}{compileSpadLispCmd} \calls{compileSpadLispCmd}{pathname(5)} @@ -13888,7 +13886,7 @@ symbol in the free list are represented by the alist (symbol . count) \calls{compileSpadLispCmd}{recompile-lib-file-if-necessary} \calls{compileSpadLispCmd}{spadPrompt} \usesdollar{compileSpadLispCmd}{options} -<>= +\begin{chunk}{defun compileSpadLispCmd} (defun |compileSpadLispCmd| (args) (let (path optlist optname optargs beQuiet dolibrary lsp) (declare (special |$options|)) @@ -13931,12 +13929,12 @@ symbol in the free list are represented by the alist (symbol . count) (|terminateSystemCommand|) (|spadPrompt|))))) -@ +\end{chunk} \defun{recompile-lib-file-if-necessary}{recompile-lib-file-if-necessary} \calls{recompile-lib-file-if-necessary}{compile-lib-file} \uses{recompile-lib-file-if-necessary}{*lisp-bin-filetype*} -<>= +\begin{chunk}{defun recompile-lib-file-if-necessary} (defun recompile-lib-file-if-necessary (lfile) (let* ((bfile (make-pathname :type *lisp-bin-filetype* :defaults lfile)) (bdate (and (probe-file bfile) (file-write-date bfile))) @@ -13945,10 +13943,10 @@ symbol in the free list are represented by the alist (symbol . count) (compile-lib-file lfile) (list bfile)))) -@ +\end{chunk} \defun{spad-fixed-arg}{spad-fixed-arg} -<>= +\begin{chunk}{defun spad-fixed-arg} (defun spad-fixed-arg (fname ) (and (equal (symbol-package fname) (find-package "BOOT")) (not (get fname 'compiler::spad-var-arg)) @@ -13957,10 +13955,10 @@ symbol in the free list are represented by the alist (symbol . count) (setf (get fname 'compiler::fixed-args) t))) nil) -@ +\end{chunk} \defun{compile-lib-file}{compile-lib-file} -<>= +\begin{chunk}{defun compile-lib-file} (defun compile-lib-file (fn &rest opts) (unwind-protect (progn @@ -13973,13 +13971,13 @@ symbol in the free list are represented by the alist (symbol . count) (apply #'compile-file fn opts)) (untrace compiler::fast-link-proclaimed-type-p compiler::t1defun))) -@ +\end{chunk} \defun{compileFileQuietly}{compileFileQuietly} if \verb|$InteractiveMode| then use a null outputstream \usesdollar{compileFileQuietly}{InteractiveMode} \uses{compileFileQuietly}{*standard-output*} -<>= +\begin{chunk}{defun compileFileQuietly} (defun |compileFileQuietly| (fn) (let ( (*standard-output* @@ -13988,372 +13986,372 @@ if \verb|$InteractiveMode| then use a null outputstream (declare (special *standard-output* |$InteractiveMode|)) (compile-file fn))) -@ +\end{chunk} \defdollar{byConstructors} -<>= +\begin{chunk}{initvars} (defvar |$byConstructors| () "list of constructors to be compiled") -@ +\end{chunk} \defdollar{constructorsSeen} -<>= +\begin{chunk}{initvars} (defvar |$constructorsSeen| () "list of constructors found") -@ +\end{chunk} -<>= +\begin{chunk}{Compiler} (in-package "BOOT") -<> - -<> -<> -<> -<> - -<> -<> -<> - -<> -<> -<> -<> -<> -<> -<> -<> - -<> - -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> - -<> -<> -<> -<> -<> -<> - -<> -<> -<> -<> - -<> -<> -<> - -<> -<> -<> -<> - -<> -<> -<> -<> - -<> -<> -<> -<> -<> -<> -<> - -<> - -<> -<> -<> -<> -<> -<> -<> -<> -<> - -<> -<> -<> -<> -<> -<> - -<> - -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> - -<> - -<> -<> -<> -<> - -<> -<> -<> -<> -<> -<> - -<> - -<> -<> -<> - -<> - -@ +\getchunk{initvars} + +\getchunk{LEDNUDTables} +\getchunk{GLIPHTable} +\getchunk{RENAMETOKTable} +\getchunk{GENERICTable} + +\getchunk{defmacro bang} +\getchunk{defmacro must} +\getchunk{defmacro star} + +\getchunk{defun action} +\getchunk{defun addclose} +\getchunk{defun add-parens-and-semis-to-line} +\getchunk{defun advance-token} +\getchunk{defun aplTran} +\getchunk{defun aplTran1} +\getchunk{defun aplTranList} +\getchunk{defun argsToSig} + +\getchunk{defun blankp} + +\getchunk{defun char-eq} +\getchunk{defun char-ne} +\getchunk{defun comma2Tuple} +\getchunk{defun comp} +\getchunk{defun comp2} +\getchunk{defun comp3} +\getchunk{defun compAdd} +\getchunk{defun compArgumentsAndTryAgain} +\getchunk{defun compAtom} +\getchunk{defun compAtSign} +\getchunk{defun compCapsule} +\getchunk{defun compCapsuleInner} +\getchunk{defun compCase} +\getchunk{defun compCase1} +\getchunk{defun compCat} +\getchunk{defun compCategory} +\getchunk{defun compCoerce} +\getchunk{defun compCoerce1} +\getchunk{defun compColon} +\getchunk{defun compColonInside} +\getchunk{defun compCons} +\getchunk{defun compCons1} +\getchunk{defun compConstruct} +\getchunk{defun compConstructorCategory} +\getchunk{defun compDefine} +\getchunk{defun compDefine1} +\getchunk{defun compElt} +\getchunk{defun compExit} +\getchunk{defun compExpression} +\getchunk{defun compForm} +\getchunk{defun compForm1} +\getchunk{defun compForm2} +\getchunk{defun compHas} +\getchunk{defun compIf} +\getchunk{defun compileFileQuietly} +\getchunk{defun compile-lib-file} +\getchunk{defun compiler} +\getchunk{defun compilerDoit} +\getchunk{defun compileSpad2Cmd} +\getchunk{defun compileSpadLispCmd} +\getchunk{defun compImport} +\getchunk{defun compIs} +\getchunk{defun compJoin} +\getchunk{defun compLambda} +\getchunk{defun compLeave} +\getchunk{defun compList} +\getchunk{defun compMacro} +\getchunk{defun compMakeDeclaration} +\getchunk{defun compNoStacking} +\getchunk{defun compNoStacking1} +\getchunk{defun compOrCroak} +\getchunk{defun compOrCroak1} +\getchunk{defun compOrCroak1,compactify} +\getchunk{defun compPretend} +\getchunk{defun compQuote} +\getchunk{defun compRepeatOrCollect} +\getchunk{defun compReduce} +\getchunk{defun compReduce1} +\getchunk{defun compReturn} +\getchunk{defun compSeq} +\getchunk{defun compSeqItem} +\getchunk{defun compSeq1} +\getchunk{defun setqSetelt} +\getchunk{defun setqSingle} +\getchunk{defun compSetq} +\getchunk{defun compSetq1} +\getchunk{defun compString} +\getchunk{defun compSubDomain} +\getchunk{defun compSubDomain1} +\getchunk{defun compSymbol} +\getchunk{defun compSubsetCategory} +\getchunk{defun compSuchthat} +\getchunk{defun compTopLevel} +\getchunk{defun compTypeOf} +\getchunk{defun compVector} +\getchunk{defun compWhere} +\getchunk{defun compWithMappingMode} +\getchunk{defun compWithMappingMode1} +\getchunk{defun containsBang} +\getchunk{defun convert} +\getchunk{defun current-char} +\getchunk{defun current-symbol} +\getchunk{defun current-token} + +\getchunk{defun decodeScripts} +\getchunk{defun deepestExpression} +\getchunk{defun def-rename} +\getchunk{defun def-rename1} +\getchunk{defun dollarTran} +\getchunk{defun drop} + +\getchunk{defun errhuh} +\getchunk{defun escape-keywords} +\getchunk{defun escaped} +\getchunk{defun extractCodeAndConstructTriple} + +\getchunk{defun fincomblock} +\getchunk{defun floatexpid} +\getchunk{defun freelist} + +\getchunk{defun get-a-line} +\getchunk{defun getScriptName} +\getchunk{defun get-token} +\getchunk{defun getToken} + +\getchunk{defun hackforis} +\getchunk{defun hackforis1} +\getchunk{defun hasAplExtension} +\getchunk{defun hasFormalMapVariable} + +\getchunk{defun indent-pos} +\getchunk{defun infixtok} +\getchunk{defun initialize-preparse} +\getchunk{defun initial-substring} +\getchunk{defun initial-substring-p} +\getchunk{defun is-console} +\getchunk{defun isTokenDelimiter} + +\getchunk{defun Line-New-Line} + +\getchunk{defun make-string-adjustable} +\getchunk{defun make-symbol-of} +\getchunk{defun match-advance-string} +\getchunk{defun match-current-token} +\getchunk{defun match-next-token} +\getchunk{defun match-string} +\getchunk{defun match-token} +\getchunk{defun meta-syntax-error} +\getchunk{defun modifyModeStack} + +\getchunk{defun next-char} +\getchunk{defun next-line} +\getchunk{defun next-tab-loc} +\getchunk{defun next-token} +\getchunk{defun ncINTERPFILE} +\getchunk{defun nonblankloc} + +\getchunk{defun optional} + +\getchunk{defun PARSE-AnyId} +\getchunk{defun PARSE-Application} +\getchunk{defun PARSE-Category} +\getchunk{defun PARSE-Command} +\getchunk{defun PARSE-CommandTail} +\getchunk{defun PARSE-Conditional} +\getchunk{defun PARSE-Data} +\getchunk{defun PARSE-ElseClause} +\getchunk{defun PARSE-Enclosure} +\getchunk{defun PARSE-Exit} +\getchunk{defun PARSE-Expr} +\getchunk{defun PARSE-Expression} +\getchunk{defun PARSE-Float} +\getchunk{defun PARSE-FloatBase} +\getchunk{defun PARSE-FloatBasePart} +\getchunk{defun PARSE-FloatExponent} +\getchunk{defun PARSE-FloatTok} +\getchunk{defun PARSE-Form} +\getchunk{defun PARSE-FormalParameter} +\getchunk{defun PARSE-FormalParameterTok} +\getchunk{defun PARSE-getSemanticForm} +\getchunk{defun PARSE-GliphTok} +\getchunk{defun PARSE-Import} +\getchunk{defun PARSE-Infix} +\getchunk{defun PARSE-InfixWith} +\getchunk{defun PARSE-IntegerTok} +\getchunk{defun PARSE-Iterator} +\getchunk{defun PARSE-IteratorTail} +\getchunk{defun PARSE-Label} +\getchunk{defun PARSE-LabelExpr} +\getchunk{defun PARSE-Leave} +\getchunk{defun PARSE-LedPart} +\getchunk{defun PARSE-leftBindingPowerOf} +\getchunk{defun PARSE-Loop} +\getchunk{defun PARSE-Name} +\getchunk{defun PARSE-NBGliphTok} +\getchunk{defun PARSE-NewExpr} +\getchunk{defun PARSE-NudPart} +\getchunk{defun PARSE-OpenBrace} +\getchunk{defun PARSE-OpenBracket} +\getchunk{defun PARSE-Operation} +\getchunk{defun PARSE-Option} +\getchunk{defun PARSE-Prefix} +\getchunk{defun PARSE-Primary} +\getchunk{defun PARSE-Primary1} +\getchunk{defun PARSE-PrimaryNoFloat} +\getchunk{defun PARSE-PrimaryOrQM} +\getchunk{defun PARSE-Qualification} +\getchunk{defun PARSE-Quad} +\getchunk{defun PARSE-Reduction} +\getchunk{defun PARSE-ReductionOp} +\getchunk{defun PARSE-Return} +\getchunk{defun PARSE-rightBindingPowerOf} +\getchunk{defun PARSE-ScriptItem} +\getchunk{defun PARSE-Scripts} +\getchunk{defun PARSE-Seg} +\getchunk{defun PARSE-Selector} +\getchunk{defun PARSE-SemiColon} +\getchunk{defun PARSE-Sequence} +\getchunk{defun PARSE-Sequence1} +\getchunk{defun PARSE-Sexpr} +\getchunk{defun PARSE-Sexpr1} +\getchunk{defun PARSE-SpecialCommand} +\getchunk{defun PARSE-SpecialKeyWord} +\getchunk{defun PARSE-Statement} +\getchunk{defun PARSE-String} +\getchunk{defun PARSE-Suffix} +\getchunk{defun PARSE-TokenCommandTail} +\getchunk{defun PARSE-TokenList} +\getchunk{defun PARSE-TokenOption} +\getchunk{defun PARSE-TokTail} +\getchunk{defun PARSE-VarForm} +\getchunk{defun PARSE-With} +\getchunk{defun parsepiles} +\getchunk{defun parseAnd} +\getchunk{defun parseAtom} +\getchunk{defun parseAtSign} +\getchunk{defun parseCategory} +\getchunk{defun parseCoerce} +\getchunk{defun parseColon} +\getchunk{defun parseConstruct} +\getchunk{defun parseDEF} +\getchunk{defun parseDollarGreaterEqual} +\getchunk{defun parseDollarGreaterThan} +\getchunk{defun parseDollarLessEqual} +\getchunk{defun parseDollarNotEqual} +\getchunk{defun parseEquivalence} +\getchunk{defun parseExit} +\getchunk{defun postForm} +\getchunk{defun parseGreaterEqual} +\getchunk{defun parseGreaterThan} +\getchunk{defun parseHas} +\getchunk{defun parseIf} +\getchunk{defun parseIf,ifTran} +\getchunk{defun parseImplies} +\getchunk{defun parseIn} +\getchunk{defun parseInBy} +\getchunk{defun parseIs} +\getchunk{defun parseIsnt} +\getchunk{defun parseJoin} +\getchunk{defun parseLeave} +\getchunk{defun parseLessEqual} +\getchunk{defun parseLET} +\getchunk{defun parseLETD} +\getchunk{defun parseMDEF} +\getchunk{defun parseNot} +\getchunk{defun parseNotEqual} +\getchunk{defun parseOr} +\getchunk{defun parsePretend} +\getchunk{defun parseprint} +\getchunk{defun parseReturn} +\getchunk{defun parseSegment} +\getchunk{defun parseSeq} +\getchunk{defun parseTran} +\getchunk{defun parseTranList} +\getchunk{defun parseTransform} +\getchunk{defun parseVCONS} +\getchunk{defun parseWhere} +\getchunk{defun postAdd} +\getchunk{defun postAtom} +\getchunk{defun postAtSign} +\getchunk{defun postBigFloat} +\getchunk{defun postBlock} +\getchunk{defun postCategory} +\getchunk{defun postcheck} +\getchunk{defun postCollect} +\getchunk{defun postCollect,finish} +\getchunk{defun postColon} +\getchunk{defun postColonColon} +\getchunk{defun postComma} +\getchunk{defun postConstruct} +\getchunk{defun postDef} +\getchunk{defun postError} +\getchunk{defun postExit} +\getchunk{defun postIf} +\getchunk{defun postin} +\getchunk{defun postIn} +\getchunk{defun postJoin} +\getchunk{defun postMapping} +\getchunk{defun postMDef} +\getchunk{defun postOp} +\getchunk{defun postPretend} +\getchunk{defun postQUOTE} +\getchunk{defun postReduce} +\getchunk{defun postRepeat} +\getchunk{defun postScripts} +\getchunk{defun postScriptsForm} +\getchunk{defun postSemiColon} +\getchunk{defun postSignature} +\getchunk{defun postSlash} +\getchunk{defun postTran} +\getchunk{defun postTranList} +\getchunk{defun postTranScripts} +\getchunk{defun postTransform} +\getchunk{defun postTransformCheck} +\getchunk{defun postTuple} +\getchunk{defun postTupleCollect} +\getchunk{defun postWhere} +\getchunk{defun postWith} +\getchunk{defun preparse} +\getchunk{defun preparse1} +\getchunk{defun preparse-echo} +\getchunk{defun preparseReadLine} +\getchunk{defun preparseReadLine1} +\getchunk{defun primitiveType} +\getchunk{defun push-reduction} + +\getchunk{defun quote-if-string} + +\getchunk{defun read-a-line} +\getchunk{defun recompile-lib-file-if-necessary} +\getchunk{defun /rf-1} +\getchunk{defun /RQ,LIB} + +\getchunk{defun setDefOp} +\getchunk{defun skip-to-endif} +\getchunk{defun spad} +\getchunk{defun spad-fixed-arg} +\getchunk{defun storeblanks} +\getchunk{defun s-process} + +\getchunk{defun try-get-token} + +\getchunk{defun underscore} +\getchunk{defun unget-tokens} +\getchunk{defun unTuple} + +\getchunk{postvars} + +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} Jenks, R.J. and Sutor, R.S. diff --git a/changelog b/changelog index 1331fd9..c5a1aca 100644 --- a/changelog +++ b/changelog @@ -1,4 +1,7 @@ -20110122 tpd src/axiom-website/patches.html 20110122.01.tpd.patch +20110122 tpd src/axiom-website/patches.html 20110122.03.tpd.patch +20110122 tpd books/Makefile move bookvol9 to lisp tangle +20110122 tpd books/bookvol9 move to lisp tangle +20110122 tpd src/axiom-website/patches.html 20110122.02.tpd.patch 20110122 tpd src/interp/vmlisp.lisp move to lisp tangle 20110122 tpd src/interp/util.lisp move to lisp tangle 20110122 tpd src/interp/topics.lisp move to lisp tangle diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 98a2195..63c88c7 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3357,5 +3357,7 @@ src/interp/*.lisp move to lisp tangle
src/input/derivefail.input fix failing test
20110122.02.tpd.patch src/interp/*.lisp move to lisp tangle
+20110122.03.tpd.patch +books/bookvol9 move to lisp tangle