diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index ecf9478..98dac92 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -1733,6 +1733,139 @@ This calls the analysis and output printing routines @ +\defun{interpretTopLevel}{interpretTopLevel} +\catches{interpretTopLevel}{interpreter} +\calls{interpretTopLevel}{interpret} +\calls{interpretTopLevel}{stopTimingProcess} +\calls{interpretTopLevel}{peekTimedName} +\calls{interpretTopLevel}{interpretTopLevel} +\usesdollar{interpretTopLevel}{timedNameStack} +<>= +(defun |interpretTopLevel| (x posnForm) + (let (savedTimerStack c) + (declare (special |$timedNameStack|)) + (setq savedTimerStack (copy |$timedNameStack|)) + (setq c (catch '|interpreter| (|interpret| x posnForm))) + (do () + ((equal savedTimerStack |$timedNameStack|) nil) + (|stopTimingProcess| (|peekTimedName|))) + (if (eq c '|tryAgain|) + (|interpretTopLevel| x posnForm) + c))) + +@ + +\defdollar{genValue} +If the \verb|$genValue| variable is true then evaluate generated code, +otherwise leave code unevaluated. If \verb|$genValue| is false then we +are compiling. This variable is only defined and used locally. +<>= +(defvar |$genValue| nil "evaluate generated code if true") + +@ + +\defun{interpret}{Type analyzes and evaluates expression x, returns object} +\calls{interpret}{pairp} +\calls{interpret}{interpret1} +\usesdollar{interpret}{env} +\usesdollar{interpret}{eval} +\usesdollar{interpret}{genValue} +<>= +(defun |interpret| (&rest arg &aux restargs x) + (dsetq (x . restargs) arg) + (let (|$env| |$eval| |$genValue| posnForm) + (declare (special |$env| |$eval| |$genValue|)) + (if (pairp restargs) + (setq posnForm (car restargs)) + (setq posnForm restargs)) + (setq |$env| (list (list nil))) + (setq |$eval| t) ; generate code -- don't just type analyze + (setq |$genValue| t) ; evaluate all generated code + (|interpret1| x nil posnForm))) + +@ + +\defun{interpret1}{Dispatcher for the type analysis routines} +This is the dispatcher for the type analysis routines. It type analyzes and +evaluates the expression x in the rootMode (if non-nil) +which may be \verb|$EmptyMode|. It returns an object if evaluating, and a +modeset otherwise. It creates the attributed tree. +\calls{interpret1}{mkAtreeWithSrcPos} +\calls{interpret1}{putTarget} +\calls{interpret1}{bottomUp} +\calls{interpret1}{getArgValue} +\calls{interpret1}{objNew} +\calls{interpret1}{getValue} +\calls{interpret1}{interpret2} +\calls{interpret1}{keyedSystemError} +\usesdollar{interpret1}{genValue} +\usesdollar{interpret1}{eval} +<>= +(defun |interpret1| (x rootMode posnForm) + (let (node modeSet newRootMode argVal val) + (declare (special |$genValue| |$eval|)) + (setq node (|mkAtreeWithSrcPos| x posnForm)) + (when rootMode (|putTarget| node rootMode)) + (setq modeSet (|bottomUp| node)) + (if (null |$eval|) + modeSet + (progn + (if (null rootMode) + (setq newRootMode (car modeSet)) + (setq newRootMode rootMode)) + (setq argVal (|getArgValue| node newRootMode)) + (cond + ((and argVal (null |$genValue|)) + (|objNew| argVal newRootMode)) + ((and argVal (setq val (|getValue| node))) + (|interpret2| val newRootMode posnForm)) + (t + (|keyedSystemError| 'S2IS0053 (list x)))))))) + +@ + +\defun{interpret2}{interpret2} +This is the late interpretCoerce. I removed the call to +coerceInteractive, so it only does the JENKS cases ALBI +\calls{interpret2}{objVal} +\calls{interpret2}{objMode} +\calls{interpret2}{pairp} +\calls{interpret2}{member} +\calls{interpret2}{objNew} +\calls{interpret2}{systemErrorHere} +\calls{interpret2}{coerceInteractive} +\calls{interpret2}{throwKeyedMsgCannotCoerceWithValue} +\usesdollar{interpret2}{EmptyMode} +\usesdollar{interpret2}{ThrowAwayMode} +<>= +(defun |interpret2| (object m1 posnForm) + (declare (ignore posnForm)) + (let (x m op ans) + (declare (special |$EmptyMode| |$ThrowAwayMode|)) + (cond + ((equal m1 |$ThrowAwayMode|) object) + (t + (setq x (|objVal| object)) + (setq m (|objMode| object)) + (cond + ((equal m |$EmptyMode|) + (cond + ((and (pairp x) + (progn (setq op (qcar x)) t) + (|member| op '(map stream))) + (|objNew| x m1)) + ((equal m1 |$EmptyMode|) + (|objNew| x m)) + (t + (|systemErrorHere| "interpret2")))) + (m1 + (if (setq ans (|coerceInteractive| object m1)) + ans + (|throwKeyedMsgCannotCoerceWithValue| x m m1))) + (t object)))))) + +@ + \defun{recordAndPrint}{} Result Output Printing. Prints out the value x which is of type m, and records the changes @@ -31221,6 +31354,10 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> +<> +<> +<> <> <> <> @@ -31935,15 +32072,6 @@ If no changes are found for former, no special entry is given. This is part of the undo mechanism. -\subsection{\$genValue} -If the \verb|$genValue| variable is true then evaluate generated code, -otherwise leave code unevaluated. If \verb|$genValue| is false then we -are compiling. This variable is only defined and used locally. -<>= -(defvar |$genValue| nil "evaluate generated code if true") - -@ - \subsection{\$HiFiAccess} The \verb|$HiFiAccess| is set by initHist to T. It is a flag used by the history mechanism to record whether the history function diff --git a/changelog b/changelog index 1b2f422..f0c9549 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20100117 tpd src/axiom-website/patches.html 20100117.02.tpd.patch +20100117 tpd src/interp/i-toplev.lisp treeshake +20100117 tpd books/bookvol5 treeshake i-toplev 20100117 tpd src/axiom-website/patches.html 20100117.01.tpd.patch 20100117 tpd src/interp/server.lisp treeshake 20100117 tpd src/interp/i-toplev.lisp treeshake diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index f427d56..3daa243 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2378,5 +2378,7 @@ books/bookvol5 do not set si::*system-directory* in restart
books/bookvol5 merge and remove exposed.lsp
20100117.01.tpd.patch books/bookvol5 treeshake i-toplev, server
+20100117.02.tpd.patch +books/bookvol5 treeshake i-toplev
diff --git a/src/interp/i-toplev.lisp.pamphlet b/src/interp/i-toplev.lisp.pamphlet index 4f02e81..ce4dabc 100644 --- a/src/interp/i-toplev.lisp.pamphlet +++ b/src/interp/i-toplev.lisp.pamphlet @@ -174,137 +174,6 @@ from LISP. (RETURN (PROGN (SPADLET |$highlightDelta| 0) (|maprinSpecial| |x| 0 79))))) -;--% Interpreter Middle-Level Driver + Utilities -;interpretTopLevel(x, posnForm) == -; -- Top level entry point from processInteractive1. Sets up catch -; -- for a thrown result -; savedTimerStack := COPY $timedNameStack -; c := CATCH('interpreter,interpret(x, posnForm)) -; while savedTimerStack ^= $timedNameStack repeat -; stopTimingProcess peekTimedName() -; c = 'tryAgain => interpretTopLevel(x, posnForm) -; c - -(DEFUN |interpretTopLevel| (|x| |posnForm|) - (PROG (|savedTimerStack| |c|) - (declare (special |$timedNameStack|)) - (RETURN - (SEQ (PROGN - (SPADLET |savedTimerStack| (COPY |$timedNameStack|)) - (SPADLET |c| - (CATCH '|interpreter| - (|interpret| |x| |posnForm|))) - (DO () - ((NULL (NEQUAL |savedTimerStack| |$timedNameStack|)) - NIL) - (SEQ (EXIT (|stopTimingProcess| (|peekTimedName|))))) - (COND - ((BOOT-EQUAL |c| '|tryAgain|) - (|interpretTopLevel| |x| |posnForm|)) - ('T |c|))))))) - -;interpret(x, :restargs) == -; posnForm := if PAIRP restargs then CAR restargs else restargs -; --type analyzes and evaluates expression x, returns object -; $env:local := [[NIL]] -; $eval:local := true --generate code-- don't just type analyze -; $genValue:local := true --evaluate all generated code -; interpret1(x,nil,posnForm) - -(DEFUN |interpret| (&REST G166333 &AUX |restargs| |x|) - (DSETQ (|x| . |restargs|) G166333) - (PROG (|$env| |$eval| |$genValue| |posnForm|) - (DECLARE (SPECIAL |$env| |$eval| |$genValue|)) - (RETURN - (PROGN - (SPADLET |posnForm| - (COND - ((PAIRP |restargs|) (CAR |restargs|)) - ('T |restargs|))) - (SPADLET |$env| (CONS (CONS NIL NIL) NIL)) - (SPADLET |$eval| 'T) - (SPADLET |$genValue| 'T) - (|interpret1| |x| NIL |posnForm|))))) - -;interpret1(x,rootMode,posnForm) == -; -- dispatcher for the type analysis routines. type analyzes and -; -- evaluates the expression x in the rootMode (if non-nil) -; -- which may be $EmptyMode. returns an object if evaluating, and a -; -- modeset otherwise -; -- create the attributed tree -; node := mkAtreeWithSrcPos(x, posnForm) -; if rootMode then putTarget(node,rootMode) -; -- do type analysis and evaluation of expression. The real guts -; modeSet:= bottomUp node -; not $eval => modeSet -; newRootMode := (null rootMode => first modeSet ; rootMode) -; argVal := getArgValue(node, newRootMode) -; argVal and not $genValue => objNew(argVal, newRootMode) -; argVal and (val:=getValue node) => interpret2(val,newRootMode,posnForm) -; keyedSystemError("S2IS0053",[x]) - -(DEFUN |interpret1| (|x| |rootMode| |posnForm|) - (PROG (|node| |modeSet| |newRootMode| |argVal| |val|) - (declare (special |$genValue| |$eval|)) - (RETURN - (PROGN - (SPADLET |node| (|mkAtreeWithSrcPos| |x| |posnForm|)) - (COND (|rootMode| (|putTarget| |node| |rootMode|))) - (SPADLET |modeSet| (|bottomUp| |node|)) - (COND - ((NULL |$eval|) |modeSet|) - ('T - (SPADLET |newRootMode| - (COND - ((NULL |rootMode|) (CAR |modeSet|)) - ('T |rootMode|))) - (SPADLET |argVal| (|getArgValue| |node| |newRootMode|)) - (COND - ((AND |argVal| (NULL |$genValue|)) - (|objNew| |argVal| |newRootMode|)) - ((AND |argVal| (SPADLET |val| (|getValue| |node|))) - (|interpret2| |val| |newRootMode| |posnForm|)) - ('T (|keyedSystemError| 'S2IS0053 (CONS |x| NIL)))))))))) - -;interpret2(object,m1,posnForm) == -; -- this is the late interpretCoerce. I removed the call to -; -- coerceInteractive, so it only does the JENKS cases ALBI -; m1=$ThrowAwayMode => object -; x := objVal object -; m := objMode object -; m=$EmptyMode => -; x is [op,:.] and op in '(MAP STREAM) => objNew(x,m1) -; m1 = $EmptyMode => objNew(x,m) -; systemErrorHere '"interpret2" -; m1 => -; if (ans := coerceInteractive(object,m1)) then ans -; else throwKeyedMsgCannotCoerceWithValue(x,m,m1) -; object - -(DEFUN |interpret2| (|object| |m1| |posnForm|) - (declare (ignore |posnForm|)) - (PROG (|x| |m| |op| |ans|) - (declare (special |$EmptyMode| |$ThrowAwayMode|)) - (RETURN - (COND - ((BOOT-EQUAL |m1| |$ThrowAwayMode|) |object|) - ('T (SPADLET |x| (|objVal| |object|)) - (SPADLET |m| (|objMode| |object|)) - (COND - ((BOOT-EQUAL |m| |$EmptyMode|) - (COND - ((AND (PAIRP |x|) (PROGN (SPADLET |op| (QCAR |x|)) 'T) - (|member| |op| '(MAP STREAM))) - (|objNew| |x| |m1|)) - ((BOOT-EQUAL |m1| |$EmptyMode|) (|objNew| |x| |m|)) - ('T (|systemErrorHere| (MAKESTRING "interpret2"))))) - (|m1| (COND - ((SPADLET |ans| (|coerceInteractive| |object| |m1|)) - |ans|) - ('T - (|throwKeyedMsgCannotCoerceWithValue| |x| |m| |m1|)))) - ('T |object|))))))) - @ \eject \begin{thebibliography}{99}