diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 8e5dda8..a6cf930 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1476,6 +1476,68 @@ preferred to the underlying representation -- RDJ 9/12/83 @ +\defun{compList}{compList} +\begin{verbatim} +;compList(l,m is ["List",mUnder],e) == +; null l => [NIL,m,e] +; Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] +; Tl="failed" => nil +; T:= [["LIST",:[T.expr for T in Tl]],["List",mUnder],e] +\end{verbatim} +\calls{compList}{comp} +<>= +(defun |compList| (l m e) + (let (tmp1 tmp2 t0 failed (mUnder (cadr m))) + (if (null l) + (list nil m e) + (progn + (setq t0 + (do ((t3 l (cdr t3)) (x nil)) + ((or (atom t3) failed) (unless failed (nreverse0 tmp2))) + (setq x (car t3)) + (if (setq tmp1 (|comp| x mUnder e)) + (progn + (setq mUnder (cadr tmp1)) + (setq e (caddr tmp1)) + (push tmp1 tmp2)) + (setq failed t)))) + (unless failed + (cons + (cons 'list (loop for texpr in t0 collect (car texpr))) + (list (list '|List| mUnder) e))))))) + +@ + +\defun{compVector}{compVector} +\begin{verbatim} +; null l => [$EmptyVector,m,e] +; Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] +; Tl="failed" => nil +; [["VECTOR",:[T.expr for T in Tl]],m,e] +\end{verbatim} +\calls{compVector}{comp} +\usesdollar{compVector}{EmptyVector} +<>= +(defun |compVector| (l m e) + (let (tmp1 tmp2 t0 failed (mUnder (cadr m))) + (declare (special |$EmptyVector|)) + (if (null l) + (list |$EmptyVector| m e) + (progn + (setq t0 + (do ((t3 l (cdr t3)) (x nil)) + ((or (atom t3) failed) (unless failed (nreverse0 tmp2))) + (setq x (car t3)) + (if (setq tmp1 (|comp| x mUnder e)) + (progn + (setq mUnder (cadr tmp1)) + (setq e (caddr tmp1)) + (push tmp1 tmp2)) + (setq failed t)))) + (unless failed + (list (cons 'vector (loop for texpr in t0 collect (car texpr))) m e)))))) + +@ \defun{compExpression}{compExpression} \calls{compExpression}{getl} \calls{compExpression}{compForm} @@ -1877,6 +1939,18 @@ preferred to the underlying representation -- RDJ 9/12/83 @ +\defun{compMakeDeclaration}{compMakeDeclaration} +\calls{compMakeDeclaration}{compColon} +\usesdollar{compMakeDeclaration}{insideExpressionIfTrue} +<>= +(defun |compMakeDeclaration| (x m e) + (let (|$insideExpressionIfTrue|) + (declare (special |$insideExpressionIfTrue|)) + (setq |$insideExpressionIfTrue| nil) + (|compColon| x m e))) + +@ + \defun{freelist}{Create a list of unbound symbols} We walk argument u looking for symbols that are unbound. If we find a symbol we add it to the free list. If it occurs in a prog then it is @@ -2149,6 +2223,8 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> +<> <> <> <> @@ -2156,6 +2232,7 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> <> diff --git a/changelog b/changelog index e0e0360..cf4f2b3 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20100906 tpd src/axiom-website/patches.html 20100906.01.tpd.patch +20100906 tpd src/interp/compiler.lisp treeshake compiler +20100906 tpd books/bookvol9 treeshake compiler 20100904 tpd src/axiom-website/patches.html 20100904.04.tpd.patch 20100904 tpd src/interp/compiler.lisp treeshake compiler 20100904 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index f411a92..be06631 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3109,5 +3109,7 @@ books/bookvolbib add Steele [Ste90]
books/bookvol5 mark pure common lisp routines
20100904.04.tpd.patch books/bookvol9 treeshake compiler
+20100906.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/compiler.lisp.pamphlet b/src/interp/compiler.lisp.pamphlet index bcce837..0c5f0db 100644 --- a/src/interp/compiler.lisp.pamphlet +++ b/src/interp/compiler.lisp.pamphlet @@ -1819,21 +1819,6 @@ Compile setq ('T (|setqSetelt| |form| |val| |m| E)))))))) @ -\subsection{compMakeDeclaration} -<<*>>= -;compMakeDeclaration(x,m,e) == -; $insideExpressionIfTrue: local -; compColon(x,m,e) - -(DEFUN |compMakeDeclaration| (|x| |m| |e|) - (PROG (|$insideExpressionIfTrue|) - (DECLARE (SPECIAL |$insideExpressionIfTrue|)) - (RETURN - (PROGN - (SPADLET |$insideExpressionIfTrue| NIL) - (|compColon| |x| |m| |e|))))) - -@ \subsection{setqSetelt} Compile setelt <<*>>= @@ -2554,142 +2539,7 @@ Compile quote (CONS |expr| (CONS |m| (CONS |e| NIL)))) @ -\subsection{compList} -Compile list -<<*>>= -;compList(l,m is ["List",mUnder],e) == -; null l => [NIL,m,e] -; Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] -; Tl="failed" => nil -; T:= [["LIST",:[T.expr for T in Tl]],["List",mUnder],e] - -(DEFUN |compList| (|l| |m| |e|) - (PROG (|LETTMP#1| |mUnder| |Tl| T$) - (RETURN - (SEQ (PROGN - (COND ((EQ (CAR |m|) '|List|) (CAR |m|))) - (SPADLET |mUnder| (CADR |m|)) - (COND - ((NULL |l|) (CONS NIL (CONS |m| (CONS |e| NIL)))) - ('T - (SPADLET |Tl| - (PROG (G168690) - (SPADLET G168690 NIL) - (RETURN - (DO ((G168699 |l| (CDR G168699)) - (|x| NIL)) - ((OR (ATOM G168699) - (PROGN - (SETQ |x| (CAR G168699)) - NIL)) - (NREVERSE0 G168690)) - (SEQ (EXIT - (SETQ G168690 - (CONS - (PROGN - (SPADLET |LETTMP#1| - (OR (|comp| |x| |mUnder| |e|) - (RETURN '|failed|))) - (SPADLET |mUnder| - (CADR |LETTMP#1|)) - (SPADLET |e| - (CADDR |LETTMP#1|)) - |LETTMP#1|) - G168690)))))))) - (COND - ((BOOT-EQUAL |Tl| '|failed|) NIL) - ('T - (SPADLET T$ - (CONS (CONS 'LIST - (PROG (G168709) - (SPADLET G168709 NIL) - (RETURN - (DO - ((G168714 |Tl| - (CDR G168714)) - (T$ NIL)) - ((OR (ATOM G168714) - (PROGN - (SETQ T$ - (CAR G168714)) - NIL)) - (NREVERSE0 G168709)) - (SEQ - (EXIT - (SETQ G168709 - (CONS (CAR T$) - G168709)))))))) - (CONS (CONS '|List| - (CONS |mUnder| NIL)) - (CONS |e| NIL))))))))))))) - -@ -\subsection{compVector} -Compile vector -<<*>>= -;compVector(l,m is ["Vector",mUnder],e) == -; null l => [$EmptyVector,m,e] -; Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] -; Tl="failed" => nil -; [["VECTOR",:[T.expr for T in Tl]],m,e] - -(DEFUN |compVector| (|l| |m| |e|) - (PROG (|LETTMP#1| |mUnder| |Tl|) - (declare (special |$EmptyVector|)) - (RETURN - (SEQ (PROGN - (COND ((EQ (CAR |m|) '|Vector|) (CAR |m|))) - (SPADLET |mUnder| (CADR |m|)) - (COND - ((NULL |l|) - (CONS |$EmptyVector| (CONS |m| (CONS |e| NIL)))) - ('T - (SPADLET |Tl| - (PROG (G168759) - (SPADLET G168759 NIL) - (RETURN - (DO ((G168768 |l| (CDR G168768)) - (|x| NIL)) - ((OR (ATOM G168768) - (PROGN - (SETQ |x| (CAR G168768)) - NIL)) - (NREVERSE0 G168759)) - (SEQ (EXIT - (SETQ G168759 - (CONS - (PROGN - (SPADLET |LETTMP#1| - (OR (|comp| |x| |mUnder| |e|) - (RETURN '|failed|))) - (SPADLET |mUnder| - (CADR |LETTMP#1|)) - (SPADLET |e| - (CADDR |LETTMP#1|)) - |LETTMP#1|) - G168759)))))))) - (COND - ((BOOT-EQUAL |Tl| '|failed|) NIL) - ('T - (CONS (CONS 'VECTOR - (PROG (G168778) - (SPADLET G168778 NIL) - (RETURN - (DO - ((G168783 |Tl| (CDR G168783)) - (T$ NIL)) - ((OR (ATOM G168783) - (PROGN - (SETQ T$ (CAR G168783)) - NIL)) - (NREVERSE0 G168778)) - (SEQ - (EXIT - (SETQ G168778 - (CONS (CAR T$) G168778)))))))) - (CONS |m| (CONS |e| NIL)))))))))))) -@ \subsection{compMacro} The compMacro function does macro expansion during spad file compiles. If a macro occurs twice in the same file the macro expands infinitely