diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 00027d1..67c6ba2 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1454,7 +1454,7 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") @ -\begin{postTran}{postTran} +\defun{postTran}{postTran} \calls{postTran}{postAtom} \calls{postTran}{postTran} \calls{postTran}{pairp} @@ -1496,6 +1496,19 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") @ +\defun{postOp}{postOp} +<>= +(defun |postOp| (x) + (declare (special $boot)) + (cond + ((eq x '|:=|) (if $boot 'spadlet 'let)) + ((eq x '|:-|) 'letd) + ((eq x '|Attribute|) 'attribute) + (t x))) + +@ + + \defun{postAtom}{postAtom} \usesdollar{postAtom}{boot} <>= @@ -1531,6 +1544,33 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") @ +\defun{postTranScripts}{postTranScripts} +\calls{postTranScripts}{postTranScripts} +\calls{postTranScripts}{postTran} +<>= +(defun |postTranScripts| (a) + (labels ( + (fn (x) + (if (and (pairp x) (eq (qcar x) '|@Tuple|)) + (qcdr x) + (list x)))) + (let (tmp1 tmp2 tmp3) + (cond + ((and (pairp a) (eq (qcar a) '|PrefixSC|) + (progn + (setq tmp1 (qcdr a)) + (and (pairp tmp1) (eq (qcdr tmp1) nil)))) + (|postTranScripts| (qcar tmp1))) + ((and (pairp a) (eq (qcar a) '|;|)) + (dolist (y (qcdr a) tmp2) + (setq tmp2 (append tmp2 (|postTranScripts| y))))) + ((and (pairp a) (eq (qcar a) '|,|)) + (dolist (y (qcdr a) tmp3) + (setq tmp3 (append tmp3 (fn (|postTran| y)))))) + (t (list (|postTran| a))))))) + +@ + \chapter{The Compiler} \section{Compiling EQ.spad} @@ -4650,9 +4690,11 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> +<> <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 2529949..53edf8b 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20101004 tpd src/axiom-website/patches.html 20101004.02.tpd.patch +20101004 tpd src/interp/parsing.lisp treeshake compiler +20101004 tpd books/bookvol9 treeshake compiler 20101004 tpd src/axiom-website/patches.html 20101004.01.tpd.patch 20101004 tpd src/interp/parsing.lisp treeshake compiler 20101004 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 4dee3a7..0574526 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3186,5 +3186,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20101004.01.tpd.patch books/bookvol9 treeshake compiler
+20101004.02.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 5266f7a..12b5e69 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -4329,23 +4329,6 @@ parse ;;; *** |getScriptName| REDEFINED (DEFUN |getScriptName| (|op| |a| |numberOfFunctionalArgs|) (PROGN (COND ((NULL (IDENTP |op|)) (|postError| (CONS " " (CONS |op| (CONS " cannot have scripts" NIL)))))) (INTERNL (QUOTE *) (STRINGIMAGE |numberOfFunctionalArgs|) (|decodeScripts| |a|) (PNAME |op|)))) -;postTranScripts a == -; a is ['PrefixSC,b] => postTranScripts b -; a is [";",:b] => "append"/[postTranScripts y for y in b] -; a is [",",:b] => -; ("append"/[fn postTran y for y in b]) where -; fn x == -; x is ['Tuple,:y] => y -; LIST x -; LIST postTran a - -;;; *** |postTranScripts,fn| REDEFINED - -(DEFUN |postTranScripts,fn| (|x|) (PROG (|y|) (RETURN (SEQ (IF (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |@Tuple|)) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) (EXIT |y|)) (EXIT (LIST |x|)))))) - -;;; *** |postTranScripts| REDEFINED - -(DEFUN |postTranScripts| (|a|) (PROG (|ISTMP#1| |b|) (RETURN (SEQ (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |PrefixSC|)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (|postTranScripts| |b|)) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |;|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (PROG (#0=#:G167089) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167094 |b| (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|postTranScripts| |y|))))))))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |,|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (PROG (#2=#:G167100) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G167105 |b| (CDR #3#)) (|y| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |y| (CAR #3#)) NIL)) #2#) (SEQ (EXIT (SETQ #2# (APPEND #2# (|postTranScripts,fn| (|postTran| |y|)))))))))) ((QUOTE T) (LIST (|postTran| |a|)))))))) ;decodeScripts a == ; a is ['PrefixSC,b] => STRCONC(STRINGIMAGE 0,decodeScripts b) ; a is [";",:b] => APPLX('STRCONC,[decodeScripts x for x in b]) @@ -4388,17 +4371,6 @@ parse ;;; *** |postMapping| REDEFINED (DEFUN |postMapping| (|u|) (PROG (|ISTMP#1| |source| |ISTMP#2| |target|) (RETURN (COND ((NULL (AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE ->)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |source| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |target| (QCAR |ISTMP#2|)) (QUOTE T)))))))) |u|) ((QUOTE T) (CONS (QUOTE |Mapping|) (CONS (|postTran| |target|) (|unTuple| (|postTran| |source|))))))))) -;postOp x == -; x=":=" => -; $BOOT => 'SPADLET -; 'LET -; x=":-" => 'LETD -; x='Attribute => 'ATTRIBUTE -; x - -;;; *** |postOp| REDEFINED - -(DEFUN |postOp| (|x|) (COND ((BOOT-EQUAL |x| (QUOTE |:=|)) (COND ($BOOT (QUOTE SPADLET)) ((QUOTE T) (QUOTE LET)))) ((BOOT-EQUAL |x| (QUOTE |:-|)) (QUOTE LETD)) ((BOOT-EQUAL |x| (QUOTE |Attribute|)) (QUOTE ATTRIBUTE)) ((QUOTE T) |x|))) ;postRepeat ['REPEAT,:m,x] == ['REPEAT,:postIteratorList m,postTran x] ;;; *** |postRepeat| REDEFINED