diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index f3e9b07..dcdeb4d 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -23149,6 +23149,73 @@ calls{/rf-1}{spad} \end{chunk} \defun{spad}{spad} +Here we begin the actual compilation process. +\begin{verbatim} + 1> (SPAD "/tmp/EQ.spad") + 2> (|makeInitialModemapFrame|) + <2 (|makeInitialModemapFrame| ((NIL))) + 2> (INIT-BOOT/SPAD-READER) + <2 (INIT-BOOT/SPAD-READER NIL) + 2> (OPEN "/tmp/EQ.spad" :DIRECTION :INPUT) + <2 (OPEN #) + 2> (INITIALIZE-PREPARSE #) + <2 (INITIALIZE-PREPARSE ")abbrev domain EQ Equation") + 2> (PREPARSE #) + EQ abbreviates domain Equation + <2 (PREPARSE (# # # # # # # # ...)) + 2> (|PARSE-NewExpr|) + <2 (|PARSE-NewExpr| T) + 2> (S-PROCESS (|where| # #)) +...[snip]... + 3> (OPEN "/tmp/EQ.erlib/info" :DIRECTION :OUTPUT) + <3 (OPEN #) + 3> (OPEN #p"/tmp/EQ.nrlib/EQ.lsp") + <3 (OPEN #) + 3> (OPEN #p"/tmp/EQ.nrlib/EQ.data" :DIRECTION :OUTPUT) + <3 (OPEN #) + 3> (OPEN #p"/tmp/EQ.nrlib/EQ.c" :DIRECTION :OUTPUT) + <3 (OPEN #) + 3> (OPEN #p"/tmp/EQ.nrlib/EQ.h" :DIRECTION :OUTPUT) + <3 (OPEN #) + 3> (OPEN #p"/tmp/EQ.nrlib/EQ.fn" :DIRECTION :OUTPUT) + <3 (OPEN #) + 3> (OPEN #p"/tmp/EQ.nrlib/EQ.o" :DIRECTION :OUTPUT :IF-EXISTS :APPEND) + <3 (OPEN #) + 3> (OPEN #p"/tmp/EQ.nrlib/EQ.data") + <3 (OPEN #) + 3> (OPEN "/tmp/EQ.nrlib/index.kaf") + <3 (OPEN #) + <2 (S-PROCESS NIL) + <1 (SPAD T) + 1> (OPEN "temp.text" :DIRECTION :OUTPUT) + <1 (OPEN #) + 1> (OPEN "libdb.text") + <1 (OPEN #) + 1> (OPEN "temp.text") + <1 (OPEN #) + 1> (OPEN "libdb.text" :DIRECTION :OUTPUT) + <1 (OPEN #) +\end{verbatim} + +The major steps in this process involve the {\bf preparse} function. +(See book volume 5 for more details). +The {\bf preparse} function returns a list of pairs of the form: +( (linenumber . linestring) .... (linenumber . linestring)) +For instance, for the file {\tt EQ.spad}, we get: +\begin{verbatim} + <2 (PREPARSE ( + (19 . "Equation(S: Type): public == private where") + (20 . " (Ex ==> OutputForm;") + (21 . " public ==> Type with") + (22 . " (\"=\": (S, S) -> $;") +...[skip]... + (202 . " inv eq == [inv lhs eq, inv rhs eq]);") + (203 . " if S has ExpressionSpace then") + (204 . " subst(eq1,eq2) ==") + (205 . " (eq3 := eq2 pretend Equation S;") + (206 . " [subst(lhs eq1,eq3),subst(rhs eq1,eq3)])))"))) +\end{verbatim} + \catches{spad}{spad-reader} \seebook{spad}{addBinding}{5} \seebook{spad}{makeInitialModemapFrame}{5} @@ -23230,377 +23297,6 @@ calls{/rf-1}{spad} \end{chunk} \defun{s-process}{Interpreter interface to the compiler} -\calls{s-process}{curstrm} -\calls{s-process}{def-rename} -\calls{s-process}{new2OldLisp} -\calls{s-process}{parseTransform} -\calls{s-process}{postTransform} -\calls{s-process}{displayPreCompilationErrors} -\calls{s-process}{prettyprint} -\seebook{s-process}{processInteractive}{5} -\calls{s-process}{compTopLevel} -\calls{s-process}{def-process} -\calls{s-process}{displaySemanticErrors} -\calls{s-process}{terpri} -\calls{s-process}{get-internal-run-time} -\usesdollar{s-process}{Index} -\usesdollar{s-process}{macroassoc} -\usesdollar{s-process}{newspad} -\usesdollar{s-process}{PolyMode} -\usesdollar{s-process}{EmptyMode} -\usesdollar{s-process}{compUniquelyIfTrue} -\usesdollar{s-process}{currentFunction} -\usesdollar{s-process}{postStack} -\usesdollar{s-process}{topOp} -\usesdollar{s-process}{semanticErrorStack} -\usesdollar{s-process}{warningStack} -\usesdollar{s-process}{exitMode} -\usesdollar{s-process}{exitModeStack} -\usesdollar{s-process}{returnMode} -\usesdollar{s-process}{leaveMode} -\usesdollar{s-process}{leaveLevelStack} -\usesdollar{s-process}{top-level} -\usesdollar{s-process}{insideFunctorIfTrue} -\usesdollar{s-process}{insideExpressionIfTrue} -\usesdollar{s-process}{insideCoerceInteractiveHardIfTrue} -\usesdollar{s-process}{insideWhereIfTrue} -\usesdollar{s-process}{insideCategoryIfTrue} -\usesdollar{s-process}{insideCapsuleFunctionIfTrue} -\usesdollar{s-process}{form} -\usesdollar{s-process}{DomainFrame} -\usesdollar{s-process}{e} -\usesdollar{s-process}{EmptyEnvironment} -\usesdollar{s-process}{genFVar} -\usesdollar{s-process}{genSDVar} -\usesdollar{s-process}{VariableCount} -\usesdollar{s-process}{previousTime} -\usesdollar{s-process}{LocalFrame} -\usesdollar{s-process}{Translation} -\usesdollar{s-process}{TranslateOnly} -\usesdollar{s-process}{PrintOnly} -\usesdollar{s-process}{currentLine} -\usesdollar{s-process}{InteractiveFrame} -\uses{s-process}{curoutstream} -\begin{chunk}{defun s-process} -(defun s-process (x) - (prog ((|$Index| 0) - ($macroassoc ()) - ($newspad t) - (|$PolyMode| |$EmptyMode|) - (|$compUniquelyIfTrue| nil) - |$currentFunction| - (|$postStack| nil) - |$topOp| - (|$semanticErrorStack| ()) - (|$warningStack| ()) - (|$exitMode| |$EmptyMode|) - (|$exitModeStack| ()) - (|$returnMode| |$EmptyMode|) - (|$leaveMode| |$EmptyMode|) - (|$leaveLevelStack| ()) - $top_level |$insideFunctorIfTrue| |$insideExpressionIfTrue| - |$insideCoerceInteractiveHardIfTrue| |$insideWhereIfTrue| - |$insideCategoryIfTrue| |$insideCapsuleFunctionIfTrue| |$form| - (|$DomainFrame| '((NIL))) - (|$e| |$EmptyEnvironment|) - (|$genFVar| 0) - (|$genSDVar| 0) - (|$VariableCount| 0) - (|$previousTime| (get-internal-run-time)) - (|$LocalFrame| '((NIL))) - (curstrm curoutstream) |$s| |$x| |$m| u) - (declare (special |$Index| $macroassoc $newspad |$PolyMode| |$EmptyMode| - |$compUniquelyIfTrue| |$currentFunction| |$postStack| |$topOp| - |$semanticErrorStack| |$warningStack| |$exitMode| |$exitModeStack| - |$returnMode| |$leaveMode| |$leaveLevelStack| $top_level - |$insideFunctorIfTrue| |$insideExpressionIfTrue| - |$insideCoerceInteractiveHardIfTrue| |$insideWhereIfTrue| - |$insideCategoryIfTrue| |$insideCapsuleFunctionIfTrue| |$form| - |$DomainFrame| |$e| |$EmptyEnvironment| |$genFVar| |$genSDVar| - |$VariableCount| |$previousTime| |$LocalFrame| - curstrm |$s| |$x| |$m| curoutstream $traceflag |$Translation| - |$TranslateOnly| |$PrintOnly| |$currentLine| |$InteractiveFrame|)) - (setq $traceflag t) - (if (not x) (return nil)) - (if $boot - (setq x (def-rename (new2OldLisp x))) - (setq x (|parseTransform| (postTransform x)))) - (when |$TranslateOnly| (return (setq |$Translation| x))) - (when |$postStack| (|displayPreCompilationErrors|) (return nil)) - (when |$PrintOnly| - (format t "~S =====>~%" |$currentLine|) - (return (prettyprint x))) - (if (not $boot) - (if |$InteractiveMode| - (|processInteractive| x nil) - (when (setq u (|compTopLevel| x |$EmptyMode| |$InteractiveFrame|)) - (setq |$InteractiveFrame| (third u)))) - (def-process x)) - (when |$semanticErrorStack| (|displaySemanticErrors|)) - (terpri))) - -\end{chunk} - -\defun{compTopLevel}{compTopLevel} -\calls{compTopLevel}{compOrCroak} -\usesdollar{compTopLevel}{NRTderivedTargetIfTrue} -\usesdollar{compTopLevel}{killOptimizeIfTrue} -\usesdollar{compTopLevel}{forceAdd} -\usesdollar{compTopLevel}{compTimeSum} -\usesdollar{compTopLevel}{resolveTimeSum} -\usesdollar{compTopLevel}{packagesUsed} -\usesdollar{compTopLevel}{envHashTable} -\begin{chunk}{defun compTopLevel} -(defun |compTopLevel| (form mode env) - (let (|$NRTderivedTargetIfTrue| |$killOptimizeIfTrue| |$forceAdd| - |$compTimeSum| |$resolveTimeSum| |$packagesUsed| |$envHashTable| - t1 t2 t3 val newmode) - (declare (special |$NRTderivedTargetIfTrue| |$killOptimizeIfTrue| - |$forceAdd| |$compTimeSum| |$resolveTimeSum| - |$packagesUsed| |$envHashTable| )) - (setq |$NRTderivedTargetIfTrue| nil) - (setq |$killOptimizeIfTrue| nil) - (setq |$forceAdd| nil) - (setq |$compTimeSum| 0) - (setq |$resolveTimeSum| 0) - (setq |$packagesUsed| NIL) - (setq |$envHashTable| (make-hashtable 'equal)) - (dolist (u (car (car env))) - (dolist (v (cdr u)) - (hput |$envHashTable| (cons (car u) (cons (car v) nil)) t))) - (cond - ((or (and (consp form) (eq (qfirst form) 'def)) - (and (consp form) (eq (qfirst form) '|where|) - (progn - (setq t1 (qrest form)) - (and (consp t1) - (progn - (setq t2 (qfirst t1)) - (and (consp t2) (eq (qfirst t2) 'def))))))) - (setq t3 (|compOrCroak| form mode env)) - (setq val (car t3)) - (setq newmode (second t3)) - (cons val (cons newmode (cons env nil)))) - (t (|compOrCroak| form mode env))))) - -\end{chunk} - -\defun{extendLocalLibdb}{extendLocalLibdb} -\calls{extendLocalLibdb}{buildLibdb} -\calls{extendLocalLibdb}{union} -\calls{extendLocalLibdb}{purgeNewConstructorLines} -\calls{extendLocalLibdb}{dbReadLines} -\calls{extendLocalLibdb}{dbWriteLines} -\calls{extendLocalLibdb}{deleteFile} -\calls{extendLocalLibdb}{msort} -\refsdollar{extendLocalLibdb}{createLocalLibDb} -\refsdollar{extendLocalLibdb}{newConstructorList} -\defsdollar{extendLocalLibdb}{newConstructorList} -\begin{chunk}{defun extendLocalLibdb} -(defun |extendLocalLibdb| (conlist) - (let (localLibdb oldlines newlines) - (declare (special |$createLocalLibDb| |$newConstructorList|)) - (cond - ((null |$createLocalLibDb|) nil) - ((null conlist) nil) - (t - (|buildLibdb| conlist) - (setq |$newConstructorList| (|union| conlist |$newConstructorList|)) - (setq localLibdb "libdb.text") - (cond - ((null (probe-file "libdb.text")) - (rename-file "temp.text" "libdb.text")) - (t - (setq oldlines - (|purgeNewConstructorLines| (|dbReadLines| localLibdb) conlist)) - (setq newlines (|dbReadLines| "temp.text")) - (|dbWriteLines| (msort (|union| oldlines newlines)) "libdb.text") - (|deleteFile| "temp.text"))))))) - -\end{chunk} - -\defun{buildLibdb}{buildLibdb} -This function appears to have two use cases, one in which the domainList -variable is undefined, in which case it writes out all of the constructors, -and the other case where it writes out a single constructor. -Formal for libdb.text: -\begin{verbatim} - constructors Cname\#\I\sig \args \abb \comments (C is C, D, P, X) - operations Op \#\E\sig \conname\pred\comments (E is one of U/E) - attributes Aname\#\E\args\conname\pred\comments - I = -\end{verbatim} -\calls{buildLibdb}{dsetq} -\calls{buildLibdb}{ifcar} -\calls{buildLibdb}{deleteFile} -\calls{buildLibdb}{make-outstream} -\calls{buildLibdb}{writedb} -\calls{buildLibdb}{buildLibdbString} -\calls{buildLibdb}{allConstructors} -\calls{buildLibdb}{buildLibdbConEntry} -\calls{buildLibdb}{getConstructorExports} -\calls{buildLibdb}{buildLibOps} -\calls{buildLibdb}{buildLibAttrs} -\calls{buildLibdb}{shut} -\calls{buildLibdb}{obey} -\calls{buildLibdb}{deleteFile} -\refsdollar{buildLibdb}{outStream} -\refsdollar{buildLibdb}{conform} -\defsdollar{buildLibdb}{kind} -\defsdollar{buildLibdb}{doc} -\defsdollar{buildLibdb}{exposed?} -\defsdollar{buildLibdb}{conform} -\defsdollar{buildLibdb}{conname} -\defsdollar{buildLibdb}{outStream} -\defsdollar{buildLibdb}{DefLst} -\defsdollar{buildLibdb}{PakLst} -\defsdollar{buildLibdb}{catLst} -\defsdollar{buildLibdb}{DomLst} -\defsdollar{buildLibdb}{AttrLst} -\defsdollar{buildLibdb}{OpLst} -\begin{chunk}{defun buildLibdb} -(defun |buildLibdb| (&rest G168131 &AUX options) - (dsetq options G168131) - (let (|$OpLst| |$AttrLst| |$DomLst| |$CatLst| |$PakLst| |$DefLst| - |$outStream| |$conname| |$conform| |$exposed?| |$doc| - |$kind| domainList comments constructorList tmp1 attrlist oplist) - (declare (special |$OpLst| |$AttrLst| |$DomLst| |$CatLst| |$PakLst| - |$DefLst| |$outStream| |$conname| |$conform| - |$exposed?| |$doc| |$kind|)) - (setq domainList (ifcar options)) - (setq |$OpLst| nil) - (setq |$AttrLst| nil) - (setq |$DomLst| nil) - (setq |$CatLst| nil) - (setq |$PakLst| nil) - (setq |$DefLst| nil) - (|deleteFile| "temp.text") - (setq |$outStream| (make-outstream "temp.text")) - (unless domainList - (setq comments - (concatenate 'string - "\\spad{Union(A,B,...,C)} is a primitive type in AXIOM used to " - "represent objects of type \\spad{A} or of type \\spad{B} or...or " - "of type \\spad{C}.")) - (|writedb| - (|buildLibdbString| - (list "dUnion" 1 "x" "special" "(A,B,...,C)" 'UNION comments))) - (setq comments - (concatenate 'string - "\\spad{Record(a:A,b:B,...,c:C)} is a primitive type in AXIOM used " - "to represent composite objects made up of objects of type " - "\\spad{A}, \\spad{B},..., \\spad{C} which are indexed by \"keys\"" - " (identifiers) \\spad{a},\\spad{b},...,\\spad{c}.")) - (|writedb| - (|buildLibdbString| - (list "dRecord" 1 "x" "special" "(a:A,b:B,...,c:C)" 'RECORD comments))) - (setq comments - (concatenate 'string - "\\spad{Mapping(T,S)} is a primitive type in AXIOM used to represent" - " mappings from source type \\spad{S} to target type \\spad{T}. " - "Similarly, \\spad{Mapping(T,A,B)} denotes a mapping from source " - "type \\spad{(A,B)} to target type \\spad{T}.")) - (|writedb| - (|buildLibdbString| - (list "dMapping" 1 "x" "special" "(T,S)" 'MAPPING comments))) - (setq comments - (concatenate 'string - "\\spad{Enumeration(a,b,...,c)} is a primitive type in AXIOM used to " - "represent the object composed of the symbols \\spad{a},\\spad{b}," - "..., and \\spad{c}.")) - (|writedb| - (|buildLibdbString| - (list "dEnumeration" 1 "x" "special" "(a,b,...,c)" 'ENUM comments)))) - (setq |$conname| nil) - (setq |$conform| nil) - (setq |$exposed?| nil) - (setq |$doc| nil) - (setq |$kind| nil) - (setq constructorList (or domainList (|allConstructors|))) - (loop for con in constructorList do - (|writedb| (|buildLibdbConEntry| con)) - (setq tmp1 (|getConstructorExports| |$conform|)) - (setq attrlist (car tmp1)) - (setq oplist (cdr tmp1)) - (|buildLibOps| oplist) - (|buildLibAttrs| attrlist)) - (shut |$outStream|) - (unless domainList - (obey "sort \"temp.text\" > \"libdb.text\"") - (rename-file "libdb.text" "olibdb.text") - (|deleteFile| "temp.text")))) - -\end{chunk} - - - -Here we begin the actual compilation process. -\begin{verbatim} - 1> (SPAD "/tmp/EQ.spad") - 2> (|makeInitialModemapFrame|) - <2 (|makeInitialModemapFrame| ((NIL))) - 2> (INIT-BOOT/SPAD-READER) - <2 (INIT-BOOT/SPAD-READER NIL) - 2> (OPEN "/tmp/EQ.spad" :DIRECTION :INPUT) - <2 (OPEN #) - 2> (INITIALIZE-PREPARSE #) - <2 (INITIALIZE-PREPARSE ")abbrev domain EQ Equation") - 2> (PREPARSE #) - EQ abbreviates domain Equation - <2 (PREPARSE (# # # # # # # # ...)) - 2> (|PARSE-NewExpr|) - <2 (|PARSE-NewExpr| T) - 2> (S-PROCESS (|where| # #)) -...[snip]... - 3> (OPEN "/tmp/EQ.erlib/info" :DIRECTION :OUTPUT) - <3 (OPEN #) - 3> (OPEN #p"/tmp/EQ.nrlib/EQ.lsp") - <3 (OPEN #) - 3> (OPEN #p"/tmp/EQ.nrlib/EQ.data" :DIRECTION :OUTPUT) - <3 (OPEN #) - 3> (OPEN #p"/tmp/EQ.nrlib/EQ.c" :DIRECTION :OUTPUT) - <3 (OPEN #) - 3> (OPEN #p"/tmp/EQ.nrlib/EQ.h" :DIRECTION :OUTPUT) - <3 (OPEN #) - 3> (OPEN #p"/tmp/EQ.nrlib/EQ.fn" :DIRECTION :OUTPUT) - <3 (OPEN #) - 3> (OPEN #p"/tmp/EQ.nrlib/EQ.o" :DIRECTION :OUTPUT :IF-EXISTS :APPEND) - <3 (OPEN #) - 3> (OPEN #p"/tmp/EQ.nrlib/EQ.data") - <3 (OPEN #) - 3> (OPEN "/tmp/EQ.nrlib/index.kaf") - <3 (OPEN #) - <2 (S-PROCESS NIL) - <1 (SPAD T) - 1> (OPEN "temp.text" :DIRECTION :OUTPUT) - <1 (OPEN #) - 1> (OPEN "libdb.text") - <1 (OPEN #) - 1> (OPEN "temp.text") - <1 (OPEN #) - 1> (OPEN "libdb.text" :DIRECTION :OUTPUT) - <1 (OPEN #) -\end{verbatim} - -The major steps in this process involve the {\bf preparse} function. -(See book volume 5 for more details). -The {\bf preparse} function returns a list of pairs of the form: -( (linenumber . linestring) .... (linenumber . linestring)) -For instance, for the file {\tt EQ.spad}, we get: -\begin{verbatim} - <2 (PREPARSE ( - (19 . "Equation(S: Type): public == private where") - (20 . " (Ex ==> OutputForm;") - (21 . " public ==> Type with") - (22 . " (\"=\": (S, S) -> $;") -...[skip]... - (202 . " inv eq == [inv lhs eq, inv rhs eq]);") - (203 . " if S has ExpressionSpace then") - (204 . " subst(eq1,eq2) ==") - (205 . " (eq3 := eq2 pretend Equation S;") - (206 . " [subst(lhs eq1,eq3),subst(rhs eq1,eq3)])))"))) -\end{verbatim} - And the {\bf s-process} function which returns a parsed version of the input. \begin{verbatim} 2> (S-PROCESS @@ -23955,6 +23651,326 @@ And the {\bf s-process} function which returns a parsed version of the input. \end{verbatim} +\calls{s-process}{curstrm} +\calls{s-process}{def-rename} +\calls{s-process}{new2OldLisp} +\calls{s-process}{parseTransform} +\calls{s-process}{postTransform} +\calls{s-process}{displayPreCompilationErrors} +\calls{s-process}{prettyprint} +\seebook{s-process}{processInteractive}{5} +\calls{s-process}{compTopLevel} +\calls{s-process}{def-process} +\calls{s-process}{displaySemanticErrors} +\calls{s-process}{terpri} +\calls{s-process}{get-internal-run-time} +\usesdollar{s-process}{Index} +\usesdollar{s-process}{macroassoc} +\usesdollar{s-process}{newspad} +\usesdollar{s-process}{PolyMode} +\usesdollar{s-process}{EmptyMode} +\usesdollar{s-process}{compUniquelyIfTrue} +\usesdollar{s-process}{currentFunction} +\usesdollar{s-process}{postStack} +\usesdollar{s-process}{topOp} +\usesdollar{s-process}{semanticErrorStack} +\usesdollar{s-process}{warningStack} +\usesdollar{s-process}{exitMode} +\usesdollar{s-process}{exitModeStack} +\usesdollar{s-process}{returnMode} +\usesdollar{s-process}{leaveMode} +\usesdollar{s-process}{leaveLevelStack} +\usesdollar{s-process}{top-level} +\usesdollar{s-process}{insideFunctorIfTrue} +\usesdollar{s-process}{insideExpressionIfTrue} +\usesdollar{s-process}{insideCoerceInteractiveHardIfTrue} +\usesdollar{s-process}{insideWhereIfTrue} +\usesdollar{s-process}{insideCategoryIfTrue} +\usesdollar{s-process}{insideCapsuleFunctionIfTrue} +\usesdollar{s-process}{form} +\usesdollar{s-process}{DomainFrame} +\usesdollar{s-process}{e} +\usesdollar{s-process}{EmptyEnvironment} +\usesdollar{s-process}{genFVar} +\usesdollar{s-process}{genSDVar} +\usesdollar{s-process}{VariableCount} +\usesdollar{s-process}{previousTime} +\usesdollar{s-process}{LocalFrame} +\usesdollar{s-process}{Translation} +\usesdollar{s-process}{TranslateOnly} +\usesdollar{s-process}{PrintOnly} +\usesdollar{s-process}{currentLine} +\usesdollar{s-process}{InteractiveFrame} +\uses{s-process}{curoutstream} +\begin{chunk}{defun s-process} +(defun s-process (x) + (prog ((|$Index| 0) + ($macroassoc ()) + ($newspad t) + (|$PolyMode| |$EmptyMode|) + (|$compUniquelyIfTrue| nil) + |$currentFunction| + (|$postStack| nil) + |$topOp| + (|$semanticErrorStack| ()) + (|$warningStack| ()) + (|$exitMode| |$EmptyMode|) + (|$exitModeStack| ()) + (|$returnMode| |$EmptyMode|) + (|$leaveMode| |$EmptyMode|) + (|$leaveLevelStack| ()) + $top_level |$insideFunctorIfTrue| |$insideExpressionIfTrue| + |$insideCoerceInteractiveHardIfTrue| |$insideWhereIfTrue| + |$insideCategoryIfTrue| |$insideCapsuleFunctionIfTrue| |$form| + (|$DomainFrame| '((NIL))) + (|$e| |$EmptyEnvironment|) + (|$genFVar| 0) + (|$genSDVar| 0) + (|$VariableCount| 0) + (|$previousTime| (get-internal-run-time)) + (|$LocalFrame| '((NIL))) + (curstrm curoutstream) |$s| |$x| |$m| u) + (declare (special |$Index| $macroassoc $newspad |$PolyMode| |$EmptyMode| + |$compUniquelyIfTrue| |$currentFunction| |$postStack| |$topOp| + |$semanticErrorStack| |$warningStack| |$exitMode| |$exitModeStack| + |$returnMode| |$leaveMode| |$leaveLevelStack| $top_level + |$insideFunctorIfTrue| |$insideExpressionIfTrue| + |$insideCoerceInteractiveHardIfTrue| |$insideWhereIfTrue| + |$insideCategoryIfTrue| |$insideCapsuleFunctionIfTrue| |$form| + |$DomainFrame| |$e| |$EmptyEnvironment| |$genFVar| |$genSDVar| + |$VariableCount| |$previousTime| |$LocalFrame| + curstrm |$s| |$x| |$m| curoutstream $traceflag |$Translation| + |$TranslateOnly| |$PrintOnly| |$currentLine| |$InteractiveFrame|)) + (setq $traceflag t) + (if (not x) (return nil)) + (if $boot + (setq x (def-rename (new2OldLisp x))) + (setq x (|parseTransform| (postTransform x)))) + (when |$TranslateOnly| (return (setq |$Translation| x))) + (when |$postStack| (|displayPreCompilationErrors|) (return nil)) + (when |$PrintOnly| + (format t "~S =====>~%" |$currentLine|) + (return (prettyprint x))) + (if (not $boot) + (if |$InteractiveMode| + (|processInteractive| x nil) + (when (setq u (|compTopLevel| x |$EmptyMode| |$InteractiveFrame|)) + (setq |$InteractiveFrame| (third u)))) + (def-process x)) + (when |$semanticErrorStack| (|displaySemanticErrors|)) + (terpri))) + +\end{chunk} + +\defun{compTopLevel}{compTopLevel} +\calls{compTopLevel}{compOrCroak} +\usesdollar{compTopLevel}{NRTderivedTargetIfTrue} +\usesdollar{compTopLevel}{killOptimizeIfTrue} +\usesdollar{compTopLevel}{forceAdd} +\usesdollar{compTopLevel}{compTimeSum} +\usesdollar{compTopLevel}{resolveTimeSum} +\usesdollar{compTopLevel}{packagesUsed} +\usesdollar{compTopLevel}{envHashTable} +\begin{chunk}{defun compTopLevel} +(defun |compTopLevel| (form mode env) + (let (|$NRTderivedTargetIfTrue| |$killOptimizeIfTrue| |$forceAdd| + |$compTimeSum| |$resolveTimeSum| |$packagesUsed| |$envHashTable| + t1 t2 t3 val newmode) + (declare (special |$NRTderivedTargetIfTrue| |$killOptimizeIfTrue| + |$forceAdd| |$compTimeSum| |$resolveTimeSum| + |$packagesUsed| |$envHashTable| )) + (setq |$NRTderivedTargetIfTrue| nil) + (setq |$killOptimizeIfTrue| nil) + (setq |$forceAdd| nil) + (setq |$compTimeSum| 0) + (setq |$resolveTimeSum| 0) + (setq |$packagesUsed| NIL) + (setq |$envHashTable| (make-hashtable 'equal)) + (dolist (u (car (car env))) + (dolist (v (cdr u)) + (hput |$envHashTable| (cons (car u) (cons (car v) nil)) t))) + (cond + ((or (and (consp form) (eq (qfirst form) 'def)) + (and (consp form) (eq (qfirst form) '|where|) + (progn + (setq t1 (qrest form)) + (and (consp t1) + (progn + (setq t2 (qfirst t1)) + (and (consp t2) (eq (qfirst t2) 'def))))))) + (setq t3 (|compOrCroak| form mode env)) + (setq val (car t3)) + (setq newmode (second t3)) + (cons val (cons newmode (cons env nil)))) + (t (|compOrCroak| form mode env))))) + +\end{chunk} + +\defun{extendLocalLibdb}{extendLocalLibdb} +\calls{extendLocalLibdb}{buildLibdb} +\calls{extendLocalLibdb}{union} +\calls{extendLocalLibdb}{purgeNewConstructorLines} +\calls{extendLocalLibdb}{dbReadLines} +\calls{extendLocalLibdb}{dbWriteLines} +\calls{extendLocalLibdb}{deleteFile} +\calls{extendLocalLibdb}{msort} +\refsdollar{extendLocalLibdb}{createLocalLibDb} +\refsdollar{extendLocalLibdb}{newConstructorList} +\defsdollar{extendLocalLibdb}{newConstructorList} +\begin{chunk}{defun extendLocalLibdb} +(defun |extendLocalLibdb| (conlist) + (let (localLibdb oldlines newlines) + (declare (special |$createLocalLibDb| |$newConstructorList|)) + (cond + ((null |$createLocalLibDb|) nil) + ((null conlist) nil) + (t + (|buildLibdb| conlist) + (setq |$newConstructorList| (|union| conlist |$newConstructorList|)) + (setq localLibdb "libdb.text") + (cond + ((null (probe-file "libdb.text")) + (rename-file "temp.text" "libdb.text")) + (t + (setq oldlines + (|purgeNewConstructorLines| (|dbReadLines| localLibdb) conlist)) + (setq newlines (|dbReadLines| "temp.text")) + (|dbWriteLines| (msort (|union| oldlines newlines)) "libdb.text") + (|deleteFile| "temp.text"))))))) + +\end{chunk} + +\defun{buildLibdb}{buildLibdb} +This function appears to have two use cases, one in which the domainList +variable is undefined, in which case it writes out all of the constructors, +and the other case where it writes out a single constructor. +Formal for libdb.text: +\begin{verbatim} + constructors Cname\#\I\sig \args \abb \comments (C is C, D, P, X) + operations Op \#\E\sig \conname\pred\comments (E is one of U/E) + attributes Aname\#\E\args\conname\pred\comments + I = +\end{verbatim} +\calls{buildLibdb}{dsetq} +\calls{buildLibdb}{ifcar} +\calls{buildLibdb}{deleteFile} +\calls{buildLibdb}{make-outstream} +\calls{buildLibdb}{writedb} +\calls{buildLibdb}{buildLibdbString} +\calls{buildLibdb}{allConstructors} +\calls{buildLibdb}{buildLibdbConEntry} +\calls{buildLibdb}{getConstructorExports} +\calls{buildLibdb}{buildLibOps} +\calls{buildLibdb}{buildLibAttrs} +\calls{buildLibdb}{shut} +\calls{buildLibdb}{obey} +\calls{buildLibdb}{deleteFile} +\refsdollar{buildLibdb}{outStream} +\refsdollar{buildLibdb}{conform} +\defsdollar{buildLibdb}{kind} +\defsdollar{buildLibdb}{doc} +\defsdollar{buildLibdb}{exposed?} +\defsdollar{buildLibdb}{conform} +\defsdollar{buildLibdb}{conname} +\defsdollar{buildLibdb}{outStream} +\defsdollar{buildLibdb}{DefLst} +\defsdollar{buildLibdb}{PakLst} +\defsdollar{buildLibdb}{catLst} +\defsdollar{buildLibdb}{DomLst} +\defsdollar{buildLibdb}{AttrLst} +\defsdollar{buildLibdb}{OpLst} +\begin{chunk}{defun buildLibdb} +(defun |buildLibdb| (&rest G168131 &AUX options) + (dsetq options G168131) + (let (|$OpLst| |$AttrLst| |$DomLst| |$CatLst| |$PakLst| |$DefLst| + |$outStream| |$conname| |$conform| |$exposed?| |$doc| + |$kind| domainList comments constructorList tmp1 attrlist oplist) + (declare (special |$OpLst| |$AttrLst| |$DomLst| |$CatLst| |$PakLst| + |$DefLst| |$outStream| |$conname| |$conform| + |$exposed?| |$doc| |$kind|)) + (setq domainList (ifcar options)) + (setq |$OpLst| nil) + (setq |$AttrLst| nil) + (setq |$DomLst| nil) + (setq |$CatLst| nil) + (setq |$PakLst| nil) + (setq |$DefLst| nil) + (|deleteFile| "temp.text") + (setq |$outStream| (make-outstream "temp.text")) + (unless domainList + (setq comments + (concatenate 'string + "\\spad{Union(A,B,...,C)} is a primitive type in AXIOM used to " + "represent objects of type \\spad{A} or of type \\spad{B} or...or " + "of type \\spad{C}.")) + (|writedb| + (|buildLibdbString| + (list "dUnion" 1 "x" "special" "(A,B,...,C)" 'UNION comments))) + (setq comments + (concatenate 'string + "\\spad{Record(a:A,b:B,...,c:C)} is a primitive type in AXIOM used " + "to represent composite objects made up of objects of type " + "\\spad{A}, \\spad{B},..., \\spad{C} which are indexed by \"keys\"" + " (identifiers) \\spad{a},\\spad{b},...,\\spad{c}.")) + (|writedb| + (|buildLibdbString| + (list "dRecord" 1 "x" "special" "(a:A,b:B,...,c:C)" 'RECORD comments))) + (setq comments + (concatenate 'string + "\\spad{Mapping(T,S)} is a primitive type in AXIOM used to represent" + " mappings from source type \\spad{S} to target type \\spad{T}. " + "Similarly, \\spad{Mapping(T,A,B)} denotes a mapping from source " + "type \\spad{(A,B)} to target type \\spad{T}.")) + (|writedb| + (|buildLibdbString| + (list "dMapping" 1 "x" "special" "(T,S)" 'MAPPING comments))) + (setq comments + (concatenate 'string + "\\spad{Enumeration(a,b,...,c)} is a primitive type in AXIOM used to " + "represent the object composed of the symbols \\spad{a},\\spad{b}," + "..., and \\spad{c}.")) + (|writedb| + (|buildLibdbString| + (list "dEnumeration" 1 "x" "special" "(a,b,...,c)" 'ENUM comments)))) + (setq |$conname| nil) + (setq |$conform| nil) + (setq |$exposed?| nil) + (setq |$doc| nil) + (setq |$kind| nil) + (setq constructorList (or domainList (|allConstructors|))) + (loop for con in constructorList do + (|writedb| (|buildLibdbConEntry| con)) + (setq tmp1 (|getConstructorExports| |$conform|)) + (setq attrlist (car tmp1)) + (setq oplist (cdr tmp1)) + (|buildLibOps| oplist) + (|buildLibAttrs| attrlist)) + (shut |$outStream|) + (unless domainList + (obey "sort \"temp.text\" > \"libdb.text\"") + (rename-file "libdb.text" "olibdb.text") + (|deleteFile| "temp.text")))) + +\end{chunk} + +\defun{dbReadLines}{dbReadLines} +\calls{dbReadLines}{eofp} +\calls{dbReadLines}{readline} +\begin{chunk}{defun dbReadLines} +(defun |dbReadLines| (target) + (let (instream lines) + (setq instream (open target)) + (setq lines + (loop while (not (eofp instream)) + collect (readline instream))) + (close instream) + lines)) + +\end{chunk} + + + + \defun{print-defun}{print-defun} \calls{print-defun}{is-console} \calls{print-defun}{print-full} @@ -26255,6 +26271,7 @@ The current input line. \getchunk{defun current-symbol} \getchunk{defun current-token} +\getchunk{defun dbReadLines} \getchunk{defun decodeScripts} \getchunk{defun deepestExpression} \getchunk{defun def-rename} diff --git a/changelog b/changelog index fe9b421..489849d 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20111231 tpd src/axiom-website/patches.html 20111231.02.tpd.patch +20111231 tpd src/interp/br-con.lisp treeshake compiler +20111231 tpd books/bookvol9 treeshake compiler 20111231 tpd src/axiom-website/patches.html 20111231.01.tpd.patch 20111231 tpd src/axiom-website/axiomgraph/maps/compiler.json Compiler 20111231 tpd src/axiom-website/axiomgraph/maps/compile.json Compile diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index d0a17bc..62bb129 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3751,5 +3751,7 @@ src/axiom-website/litprog.html note HTML escape code flaw
books/bookvol9 treeshake and document compiler
20111231.01.tpd.patch src/axiom-website/axiomgraph/js/axiomcode.js default compiler
+20111231.02.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index 3fe1a4a..97fb348 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -18196,30 +18196,6 @@ (SHUT |$outStream|) |pathname|))))) -;dbReadLines target == --AIX only--called by grepFile -; instream := OPEN target -; lines := [READLINE instream while not EOFP instream] -; CLOSE instream -; lines - -(DEFUN |dbReadLines| (|target|) - (PROG (|instream| |lines|) - (RETURN - (SEQ (PROGN - (SPADLET |instream| (OPEN |target|)) - (SPADLET |lines| - (PROG (G176375) - (SPADLET G176375 NIL) - (RETURN - (DO () - ((NULL (NULL (EOFP |instream|))) - (NREVERSE0 G176375)) - (SEQ (EXIT (SETQ G176375 - (CONS (READLINE |instream|) - G176375)))))))) - (CLOSE |instream|) - |lines|))))) - ;dbGetCommentOrigin line == ;--Given a comment line in comdb, returns line in libdb pointing to it ;--Comment lines have format [dcpxoa]xxxxxx`ccccc... where