diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 335891e..062a8a4 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -19121,7 +19121,7 @@ Command Syntax: Command Description: This command is used by AXIOM developers to leave the AXIOM system and return -to the underlying Lisp system. To return to AXIOM, issue the ``(|spad|)'' +to the underlying Lisp system. To return to AXIOM, issue the ``(spad)'' function call to Lisp. Also See: @@ -34517,7 +34517,7 @@ o )library @ \defun{/rq}{/rq} -\calls{/rq}{/rf-1} +\calls{/rq}{/rf-1(9)} \uses{/rq}{echo-meta} <>= (defun /RQ (&rest foo &aux (echo-meta nil)) @@ -34537,35 +34537,6 @@ Compile with noisy output @ -\defun{/rf-1}{/rf-1} -\calls{/rf-1}{ncINTERPFILE} -\uses{/rf-1}{/editfile} -\uses{/rf-1}{echo-meta} -<>= -(defun /rf-1 (ignore) - (declare (ignore ignore)) - (let* ((input-file (makeInputFilename /editfile)) - (type (pathname-type input-file))) - (declare (special echo-meta /editfile)) - (cond - ((string= type "lisp") (load input-file)) - ((string= type "input") (|ncINTERPFILE| input-file echo-meta)) - (t (spad input-file))))) - -@ - -\defun{ncINTERPFILE}{Interpreter interface to the compiler} -\calls{ncINTERPFILE}{SpadInterpretStream} -\usesdollar{ncINTERPFILE}{EchoLines} -\usesdollar{ncINTERPFILE}{ReadingFile} -<>= -(defun |ncINTERPFILE| (file echo) - (let ((|$EchoLines| echo) (|$ReadingFile| t)) - (declare (special |$EchoLines| |$ReadingFile|)) - (|SpadInterpretStream| 1 file nil))) - -@ - \defvar{boot-line-stack} <>= (defvar boot-line-stack nil "List of lines returned from preparse") @@ -34599,82 +34570,6 @@ Compile with noisy output @ -\defun{spad}{spad} -\catches{spad}{spad-reader} -\calls{spad}{addBinding} -\calls{spad}{makeInitialModemapFrame} -\calls{spad}{init-boot/spad-reader} -\calls{spad}{initialize-preparse} -\calls{spad}{preparse} -\calls{spad}{PARSE-NewExpr} -\calls{spad}{pop-stack-1} -\calls{spad}{s-process} -\calls{spad}{ioclear} -\calls{spad}{shut} -\usesdollar{spad}{noSubsumption} -\usesdollar{spad}{InteractiveFrame} -\usesdollar{spad}{InitialDomainsInScope} -\usesdollar{spad}{InteractiveMode} -\uses{spad}{line} -\uses{spad}{echo-meta} -\uses{spad}{/editfile} -\uses{spad}{*comp370-apply*} -\uses{spad}{*eof*} -\uses{spad}{file-closed} -\uses{spad}{xcape} -\catches{spad}{spad-reader} -<>= -(defun spad (&optional (*spad-input-file* nil) (*spad-output-file* nil) - &aux (*comp370-apply* #'print-defun) - (*fileactq-apply* #'print-defun) - ($spad t) ($boot nil) (xcape #\_) (optionlist nil) (*eof* nil) - (file-closed nil) (/editfile *spad-input-file*) - (|$noSubsumption| |$noSubsumption|) in-stream out-stream) - (declare (special echo-meta /editfile *comp370-apply* *eof* - file-closed xcape |$noSubsumption| |$InteractiveFrame| - |$InteractiveMode| |$InitialDomainsInScope|)) - ;; only rebind |$InteractiveFrame| if compiling - (progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|)) - (if (not |$InteractiveMode|) - (list (|addBinding| '|$DomainsInScope| - `((fluid . |true|) - (|special| . ,(copy-tree |$InitialDomainsInScope|))) - (|addBinding| '|$Information| nil - (|makeInitialModemapFrame|))))) - (init-boot/spad-reader) - (unwind-protect - (progn - (setq in-stream (if *spad-input-file* - (open *spad-input-file* :direction :input) - *standard-input*)) - (initialize-preparse in-stream) - (setq out-stream (if *spad-output-file* - (open *spad-output-file* :direction :output) - *standard-output*)) - (when *spad-output-file* - (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot -*-~%~%") - (print-package "BOOT")) - (setq curoutstream out-stream) - (loop - (if (or *eof* file-closed) (return nil)) - (catch 'spad_reader - (if (setq boot-line-stack (preparse in-stream)) - (let ((line (cdar boot-line-stack))) - (declare (special line)) - (|PARSE-NewExpr|) - (let ((parseout (pop-stack-1)) ) - (when parseout - (let ((*standard-output* out-stream)) - (s-process parseout)) - (format out-stream "~&"))) - ))) - (ioclear in-stream out-stream))) - (if *spad-input-file* (shut in-stream)) - (if *spad-output-file* (shut out-stream))) - t)) - -@ - \defdollar{envHashTable} The \verb|$envHashTable| variable is a hashtable that optimizes lookups in the environment, which normally involve search. This gets populated @@ -40445,7 +40340,6 @@ This needs to work off the internal exposure list, not the file. <> <> <> -<> <> <> <> @@ -41035,7 +40929,6 @@ This needs to work off the internal exposure list, not the file. <> <> <> -<> <> <> <> diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index c73fc65..cc03f5a 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -429,6 +429,39 @@ the spad compiler does when it encounters an error. should stop at the first error. The value of the {\tt )set break} variable then controls what happens. +Given the top level command: +\begin{verbatim} +)co PR +\end{verbatim} +The default call chain looks like: +\begin{verbatim} + 1> (|compiler| (PR)) + 2> (|compileSpad2Cmd| ("/research/test/int/algebra/PR.spad")) + 3> (|compilerDoit| NIL (|rq| |lib|)) + 4> (/RF-1 NIL) + 5> (SPAD "/research/test/int/algebra/PR.spad") + 6> (S-PROCESS (|where| ... + 7> (|compTopLevel| (|where| (DEF ... + 8> (|compOrCroak| (|where| (DEF ... + 9> (|compOrCroak| (CATEGORY |domain| ... + <9 (|compOrCroak| ((|DomainSubstitutionMacro| # #) ... +... + 10> (|compOrCroak| (|FreeModule| R E) |$EmptyMode| ((#))) + <10 (|compOrCroak| ((|FreeModule| R E) (|Join| # # #) (#))) +... + 11> (|compOrCroak| (|construct| (|construct| # #)) $ ((#))) + <11 (|compOrCroak| ((LIST #) $ (#))) +... + <9 (|compOrCroak| ((PROGN ... $) #1=(|Join| # #) (#))) + <8 (|compOrCroak| (|PolynomialRing| (|Mapping| ... + <7 (|compTopLevel| (|PolynomialRing| ... + <6 (S-PROCESS NIL) + <5 (SPAD T) + <4 (/RF-1 T) + <3 (|compilerDoit| T) +(1) -> +\end{verbatim} + \subsection{Aldor compiler} This command compiles files with file extensions {\it .as, .ao} and {\it .al} with the Aldor compiler. It also can compile files @@ -765,6 +798,254 @@ and mode. (|sayBrightly| `(">>> Warning " |%b| ,x |%d| " was not found")))))))) @ + +\defun{/rf-1}{/rf-1} +\calls{/rf-1}{makeInputFilename(5)} +\calls{/rf-1}{ncINTERPFILE} +\calls{/rf-1}{spad} +\uses{/rf-1}{/editfile} +\uses{/rf-1}{echo-meta} +<>= +(defun /rf-1 (ignore) + (declare (ignore ignore)) + (let* ((input-file (makeInputFilename /editfile)) + (type (pathname-type input-file))) + (declare (special echo-meta /editfile)) + (cond + ((string= type "lisp") (load input-file)) + ((string= type "input") (|ncINTERPFILE| input-file echo-meta)) + (t (spad input-file))))) + +@ + +\defun{spad}{spad} +\catches{spad}{spad-reader} +\calls{spad}{addBinding} +\calls{spad}{makeInitialModemapFrame} +\calls{spad}{init-boot/spad-reader} +\calls{spad}{initialize-preparse} +\calls{spad}{preparse} +\calls{spad}{PARSE-NewExpr} +\calls{spad}{pop-stack-1} +\calls{spad}{s-process} +\calls{spad}{ioclear} +\calls{spad}{shut} +\usesdollar{spad}{noSubsumption} +\usesdollar{spad}{InteractiveFrame} +\usesdollar{spad}{InitialDomainsInScope} +\usesdollar{spad}{InteractiveMode} +\uses{spad}{line} +\uses{spad}{echo-meta} +\uses{spad}{/editfile} +\uses{spad}{*comp370-apply*} +\uses{spad}{*eof*} +\uses{spad}{file-closed} +\uses{spad}{xcape} +\catches{spad}{spad-reader} +<>= +(defun spad (&optional (*spad-input-file* nil) (*spad-output-file* nil) + &aux (*comp370-apply* #'print-defun) + (*fileactq-apply* #'print-defun) + ($spad t) ($boot nil) (xcape #\_) (optionlist nil) (*eof* nil) + (file-closed nil) (/editfile *spad-input-file*) + (|$noSubsumption| |$noSubsumption|) in-stream out-stream) + (declare (special echo-meta /editfile *comp370-apply* *eof* + file-closed xcape |$noSubsumption| |$InteractiveFrame| + |$InteractiveMode| |$InitialDomainsInScope|)) + ;; only rebind |$InteractiveFrame| if compiling + (progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|)) + (if (not |$InteractiveMode|) + (list (|addBinding| '|$DomainsInScope| + `((fluid . |true|) + (|special| . ,(copy-tree |$InitialDomainsInScope|))) + (|addBinding| '|$Information| nil + (|makeInitialModemapFrame|))))) + (init-boot/spad-reader) + (unwind-protect + (progn + (setq in-stream (if *spad-input-file* + (open *spad-input-file* :direction :input) + *standard-input*)) + (initialize-preparse in-stream) + (setq out-stream (if *spad-output-file* + (open *spad-output-file* :direction :output) + *standard-output*)) + (when *spad-output-file* + (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot -*-~%~%") + (print-package "BOOT")) + (setq curoutstream out-stream) + (loop + (if (or *eof* file-closed) (return nil)) + (catch 'spad_reader + (if (setq boot-line-stack (preparse in-stream)) + (let ((line (cdar boot-line-stack))) + (declare (special line)) + (|PARSE-NewExpr|) + (let ((parseout (pop-stack-1)) ) + (when parseout + (let ((*standard-output* out-stream)) + (s-process parseout)) + (format out-stream "~&"))) + ))) + (ioclear in-stream out-stream))) + (if *spad-input-file* (shut in-stream)) + (if *spad-output-file* (shut out-stream))) + t)) + +@ + +\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} +\calls{s-process}{processInteractive} +\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} +\uses{s-process}{curoutstream} +<>= +(defun s-process (X) + (let ((|$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)))) + (prog ((curstrm curoutstream) |$s| |$x| |$m| u) + (declare (special curstrm |$s| |$x| |$m| curoutstream)) + (setq $traceflag t) + (if (not x) (return nil)) + (setq x (if $boot (def-rename (|new2OldLisp| x)) + (|parseTransform| (|postTransform| x)))) + (if |$TranslateOnly| (return (setq |$Translation| x))) + (when |$postStack| (|displayPreCompilationErrors|) (return nil)) + (cond (|$PrintOnly| + (format t "~S =====>~%" |$currentLine|) + (return (prettyprint x)))) + (if (not $boot) + (if |$InteractiveMode| + (|processInteractive| x nil) + (if (setq u (|compTopLevel| x |$EmptyMode| |$InteractiveFrame|)) + (setq |$InteractiveFrame| (third u)))) + (def-process x)) + (if |$semanticErrorStack| (|displaySemanticErrors|)) + (terpri)))) + +@ + +\defun{compTopLevel}{compTopLevel} +\calls{compTopLevel}{newComp} +\calls{compTopLevel}{compOrCroak} +\usesdollar{compTopLevel}{NRTderivedTargetIfTrue} +\usesdollar{compTopLevel}{killOptimizeIfTrue} +\usesdollar{compTopLevel}{forceAdd} +\usesdollar{compTopLevel}{compTimeSum} +\usesdollar{compTopLevel}{resolveTimeSum} +\usesdollar{compTopLevel}{packagesUsed} +\usesdollar{compTopLevel}{envHashTable} +<>= +(defun |compTopLevel| (x m e) + (let (|$NRTderivedTargetIfTrue| |$killOptimizeIfTrue| |$forceAdd| + |$compTimeSum| |$resolveTimeSum| |$packagesUsed| |$envHashTable| + t1 t2 t3 val mode) + (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 e))) + (dolist (v (cdr u)) + (hput |$envHashTable| (cons (car u) (cons (car v) nil)) t))) + (cond + ((or (and (pairp x) (eq (qcar x) 'def)) + (and (pairp x) (eq (qcar x) '|where|) + (progn + (setq t1 (qcdr x)) + (and (pairp t1) + (progn + (setq t2 (qcar t1)) + (and (pairp t2) (eq (qcar t2) 'def))))))) + (setq t3 (|compOrCroak| x m e)) + (setq val (car t3)) + (setq mode (cadr t3)) + (cons val (cons mode (cons e nil)))) + (t (|compOrCroak| x m e))))) + +@ +\defun{ncINTERPFILE}{Compiler/Interpreter interface} +\calls{ncINTERPFILE}{SpadInterpretStream(5)} +\usesdollar{ncINTERPFILE}{EchoLines} +\usesdollar{ncINTERPFILE}{ReadingFile} +<>= +(defun |ncINTERPFILE| (file echo) + (let ((|$EchoLines| echo) (|$ReadingFile| t)) + (declare (special |$EchoLines| |$ReadingFile|)) + (|SpadInterpretStream| 1 file nil))) + +@ + \defun{/RQ,LIB}{/RQ,LIB} Compile a library quietly \calls{/RQ,LIB}{/rf-1(5)} @@ -957,9 +1238,17 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> + +<> + <> +<> <> + +<> <> +<> <> @ diff --git a/changelog b/changelog index 5684b11..7333ae0 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,10 @@ +20100828 tpd src/axiom-website/patches.html 20100828.01.tpd.patch +20100828 tpd src/interp/define.lisp treeshake the compiler +20100828 tpd src/interp/vmlisp.lisp treeshake the compiler +20100828 tpd src/interp/compiler.lisp treeshake the compiler +20100828 tpd src/interp/br-con.lisp treeshake the compiler +20100828 tpd books/bookvol5 treeshake the compiler +20100828 tpd books/bookvol9 treeshake the compiler 20100826 tpd src/axiom-website/patches.html 20100826.03.tpd.patch 20100826 tpd src/interp/Makefile remove nspadaux,mark,pspad1,pspad2 20100826 tpd src/interp/compiler.lisp merge needed defvars diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 235b323..99cf8e4 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3087,5 +3087,7 @@ src/interp/wi1.lisp removed
src/interp/wi2.lisp removed
20100826.03.tpd.patch src/interp/Makefile remove nspadaux,mark,pspad1,pspad2
+20100828.01.tpd.patch +books/bookvol9 treeshake the compiler
diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index e5fc1a3..43c2946 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -26844,49 +26844,12 @@ $dbKindAlist := (APPEND (|bright| |$op|) (CONS ": " |formattedSig|))))) - (COND - ((BOOT-EQUAL |$newComp| 'T) - (SPADLET |wholeBody| - (CONS 'DEF - (CONS |form| - (CONS |signature'| - (CONS |specialCases| - (CONS |body| NIL)))))) - (SPADLET T$ - (OR (CATCH '|compCapsuleBody| - (|newComp| |wholeBody| |$NoValueMode| - |e|)) - (CONS (INTERN " " "BOOT") - (CONS |rettype| (CONS |e| NIL))))) - (SPADLET T$ - (CONS (ELT (ELT (CAR T$) 2) 2) - (CONS |rettype| - (CONS (CADDR T$) NIL)))) - (COND - ((BOOT-EQUAL |$newCompCompare| 'T) - (SPADLET |oldT| - (OR (CATCH '|compCapsuleBody| - (|compOrCroak| |body| |rettype| - |e|)) - (CONS (INTERN " " "BOOT") - (CONS |rettype| (CONS |e| NIL))))) - (SAY "The old compiler generates:") - (|prTriple| |oldT|) - (SAY "The new compiler generates:") - (|prTriple| T$)) - ('T NIL))) - ('T - (SPADLET T$ + (SPADLET T$ (OR (CATCH '|compCapsuleBody| (|compOrCroak| |body| |rettype| |e|)) (CONS (INTERN " " "BOOT") (CONS |rettype| (CONS |e| NIL))))) - (|NRTassignCapsuleFunctionSlot| |$op| |signature'|) - (COND - ((BOOT-EQUAL |$newCompCompare| 'T) - (SAY "The old compiler generates:") - (|prTriple| T$)) - ('T NIL)))) + (|NRTassignCapsuleFunctionSlot| |$op| |signature'|) (SPADLET |catchTag| (MKQ (GENSYM))) (SPADLET |fun| (PROGN diff --git a/src/interp/compiler.lisp.pamphlet b/src/interp/compiler.lisp.pamphlet index 80c3ecf..fbe1b9b 100644 --- a/src/interp/compiler.lisp.pamphlet +++ b/src/interp/compiler.lisp.pamphlet @@ -18,81 +18,6 @@ (defvar |$globalMacroStack| nil) (defvar |$abbreviationStack| nil) -;compTopLevel(x,m,e) == -;--+ signals that target is derived from lhs-- see NRTmakeSlot1Info -; $NRTderivedTargetIfTrue: local := false -; $killOptimizeIfTrue: local:= false -; $forceAdd: local:= false -; $compTimeSum: local := 0 -; $resolveTimeSum: local := 0 -; $packagesUsed: local := [] -; -- This hashtable is a performance improvement by Waldek Hebisch -; $envHashTable: local := MAKE_-HASHTABLE 'EQUAL -; for u in CAR(CAR(e)) repeat -; for v in CDR(u) repeat -; HPUT($envHashTable,[CAR u, CAR v],true) -; -- The next line allows the new compiler to be tested interactively. -; compFun := if $newCompAtTopLevel=true then 'newComp else 'compOrCroak -; x is ["DEF",:.] or x is ["where",["DEF",:.],:.] => -; ([val,mode,.]:= FUNCALL(compFun,x,m,e); [val,mode,e]) -; --keep old environment after top level function defs -; FUNCALL(compFun,x,m,e) - -(DEFUN |compTopLevel| (|x| |m| |e|) - (PROG (|$NRTderivedTargetIfTrue| |$killOptimizeIfTrue| |$forceAdd| - |$compTimeSum| |$resolveTimeSum| |$packagesUsed| - |$envHashTable| |compFun| |ISTMP#1| |ISTMP#2| |LETTMP#1| - |val| |mode|) - (DECLARE (SPECIAL |$NRTderivedTargetIfTrue| |$killOptimizeIfTrue| - |$forceAdd| |$compTimeSum| |$resolveTimeSum| - |$packagesUsed| |$envHashTable| |$newCompAtTopLevel|)) - (RETURN - (SEQ (PROGN - (SPADLET |$NRTderivedTargetIfTrue| NIL) - (SPADLET |$killOptimizeIfTrue| NIL) - (SPADLET |$forceAdd| NIL) - (SPADLET |$compTimeSum| 0) - (SPADLET |$resolveTimeSum| 0) - (SPADLET |$packagesUsed| NIL) - (SPADLET |$envHashTable| (MAKE-HASHTABLE 'EQUAL)) - (DO ((G166075 (CAR (CAR |e|)) (CDR G166075)) - (|u| NIL)) - ((OR (ATOM G166075) - (PROGN (SETQ |u| (CAR G166075)) NIL)) - NIL) - (SEQ (EXIT (DO ((G166084 (CDR |u|) (CDR G166084)) - (|v| NIL)) - ((OR (ATOM G166084) - (PROGN - (SETQ |v| (CAR G166084)) - NIL)) - NIL) - (SEQ (EXIT (HPUT |$envHashTable| - (CONS (CAR |u|) - (CONS (CAR |v|) NIL)) - 'T))))))) - (SPADLET |compFun| - (COND - ((BOOT-EQUAL |$newCompAtTopLevel| 'T) - '|newComp|) - ('T '|compOrCroak|))) - (COND - ((OR (AND (PAIRP |x|) (EQ (QCAR |x|) 'DEF)) - (AND (PAIRP |x|) (EQ (QCAR |x|) '|where|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) 'DEF))))))) - (SPADLET |LETTMP#1| (FUNCALL |compFun| |x| |m| |e|)) - (SPADLET |val| (CAR |LETTMP#1|)) - (SPADLET |mode| (CADR |LETTMP#1|)) - (CONS |val| (CONS |mode| (CONS |e| NIL)))) - ('T (FUNCALL |compFun| |x| |m| |e|)))))))) - -@ \subsection{compUniquely} <<*>>= ;compUniquely(x,m,e) == diff --git a/src/interp/define.lisp.pamphlet b/src/interp/define.lisp.pamphlet index 44eb606..776dd3a 100644 --- a/src/interp/define.lisp.pamphlet +++ b/src/interp/define.lisp.pamphlet @@ -3306,7 +3306,7 @@ (DECLARE (SPECIAL |$form| |$op| |$functionStats| |$functorStats| |$argumentConditionList| |$finalEnv| |$returnMode| |$initCapsuleErrorCount| |$newCompCompare| |$NoValueMode| - |$insideCapsuleFunctionIfTrue| |$newComp| + |$insideCapsuleFunctionIfTrue| |$CapsuleModemapFrame| |$CapsuleDomainsInScope| |$insideExpressionIfTrue| |$compileOnlyCertainItems| |$profileCompiler| |$functionLocations| |$finalEnv| @@ -3442,49 +3442,12 @@ (APPEND (|bright| |$op|) (CONS ": " |formattedSig|))))) - (COND - ((BOOT-EQUAL |$newComp| 'T) - (SPADLET |wholeBody| - (CONS 'DEF - (CONS |form| - (CONS |signature'| - (CONS |specialCases| - (CONS |body| NIL)))))) - (SPADLET T$ - (OR (CATCH '|compCapsuleBody| - (|newComp| |wholeBody| |$NoValueMode| - |e|)) - (CONS (INTERN " " "BOOT") - (CONS |rettype| (CONS |e| NIL))))) - (SPADLET T$ - (CONS (ELT (ELT (CAR T$) 2) 2) - (CONS |rettype| - (CONS (CADDR T$) NIL)))) - (COND - ((BOOT-EQUAL |$newCompCompare| 'T) - (SPADLET |oldT| - (OR (CATCH '|compCapsuleBody| - (|compOrCroak| |body| |rettype| - |e|)) - (CONS (INTERN " " "BOOT") - (CONS |rettype| (CONS |e| NIL))))) - (SAY "The old compiler generates:") - (|prTriple| |oldT|) - (SAY "The new compiler generates:") - (|prTriple| T$)) - ('T NIL))) - ('T - (SPADLET T$ + (SPADLET T$ (OR (CATCH '|compCapsuleBody| (|compOrCroak| |body| |rettype| |e|)) (CONS (INTERN " " "BOOT") (CONS |rettype| (CONS |e| NIL))))) - (|NRTassignCapsuleFunctionSlot| |$op| |signature'|) - (COND - ((BOOT-EQUAL |$newCompCompare| 'T) - (SAY "The old compiler generates:") - (|prTriple| T$)) - ('T NIL)))) + (|NRTassignCapsuleFunctionSlot| |$op| |signature'|) (SPADLET |catchTag| (MKQ (GENSYM))) (SPADLET |fun| (PROGN diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index a84c648..c7c9bb5 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -5659,10 +5659,8 @@ now the function is defined but does nothing. (defvar |$compForModeIfTrue| nil "checked in compSymbol") (defvar |$functorForm| nil "checked in addModemap0") (defvar |$formalArgList| nil "checked in compSymbol") -(defvar |$newComp| nil "use new compiler") (defvar |$newCompCompare| nil "compare new compiler with old") (defvar |$compileOnlyCertainItems| nil "list of functions to compile") -(defvar |$newCompAtTopLevel| nil "if t uses new compiler") (defvar |$doNotCompileJustPrint| nil "switch for compile") (defvar |$PrintCompilerMessageIfTrue| t) (defvar |$Rep| '|$Rep| "should be bound to gensym? checked in coerce") @@ -5875,53 +5873,6 @@ now the function is defined but does nothing. ;; This is used in the domain Boolean (BOOLEAN.nrlib/code.lsp) (defun |BooleanEquality| (x y) (if x y (null y))) -(defun S-PROCESS (X) - (let ((|$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)))) - (prog ((CURSTRM CUROUTSTREAM) |$s| |$x| |$m| u) - (declare (special CURSTRM |$s| |$x| |$m| CUROUTSTREAM)) - (SETQ $TRACEFLAG T) - (if (NOT X) (RETURN NIL)) - (setq X (if $BOOT (DEF-RENAME (|new2OldLisp| X)) - (|parseTransform| (|postTransform| X)))) - (if |$TranslateOnly| (RETURN (SETQ |$Translation| X))) - (when |$postStack| (|displayPreCompilationErrors|) (RETURN NIL)) - (COND (|$PrintOnly| - (format t "~S =====>~%" |$currentLine|) - (RETURN (PRETTYPRINT X)))) - (if (NOT $BOOT) - (if |$InteractiveMode| - (|processInteractive| X NIL) - (if (setq U (|compTopLevel| X |$EmptyMode| - |$InteractiveFrame|)) - (SETQ |$InteractiveFrame| (third U)))) - (DEF-PROCESS X)) - (if |$semanticErrorStack| (|displaySemanticErrors|)) - (TERPRI)))) - (MAKEPROP 'END_UNIT 'KEY T) (defun |process| (x)