diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 67c6ba2..9c1f4a3 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1571,6 +1571,50 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") @ +\defun{postTransformCheck}{postTransformCheck} +\calls{postTransformCheck}{postcheck} +\usesdollar{postTransformCheck}{defOp} +<>= +(defun |postTransformCheck| (x) + (let (|$defOp|) + (declare (special |$defOp|)) + (setq |$defOp| nil) + (|postcheck| x))) + +@ + +\defun{postcheck}{postcheck} +\calls{postcheck}{setDefOp} +\calls{postcheck}{postcheck} +<>= +(defun |postcheck| (x) + (cond + ((atom x) nil) + ((and (pairp x) (eq (qcar x) 'def) (pairp (qcdr x))) + (|setDefOp| (qcar (qcdr x))) + (|postcheck| (qcdr (qcdr x)))) + ((and (pairp x) (eq (qcar x) 'quote)) nil) + (t (|postcheck| (car x)) (|postcheck| (cdr x))))) + +@ + +\defun{setDefOp}{setDefOp} +\usesdollar{setDefOp}{defOp} +\usesdollar{setDefOp}{topOp} +<>= +(defun |setDefOp| (f) + (let (tmp1 g) + (declare (special |$defOp| |$topOp|)) + (when (and (pairp f) (eq (qcar f) '|:|) + (pairp (setq tmp1 (qcdr f)))) + (setq f (qcar tmp1))) + (unless (atom f) (setq f (car f))) + (if |$topOp| + (setq |$defOp| f) + (setq |$topOp| f)))) + +@ + \chapter{The Compiler} \section{Compiling EQ.spad} @@ -4690,12 +4734,14 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> +<> <> <> <> <> <> <> +<> <> <> <> @@ -4708,6 +4754,7 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> +<> <> <> <> diff --git a/changelog b/changelog index 53edf8b..9286eca 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20101004 tpd src/axiom-website/patches.html 20101004.03.tpd.patch +20101004 tpd src/interp/parsing.lisp treeshake compiler +20101004 tpd books/bookvol9 treeshake compiler 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 diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 0574526..d2db0f8 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3188,5 +3188,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20101004.02.tpd.patch books/bookvol9 treeshake compiler
+20101004.03.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 12b5e69..7e6c651 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -4570,41 +4570,6 @@ parse ;;; *** |postWith| REDEFINED (DEFUN |postWith| (#0=#:G167795) (PROG (|$insidePostCategoryIfTrue| |a| |op| |b|) (DECLARE (SPECIAL |$insidePostCategoryIfTrue|)) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |$insidePostCategoryIfTrue| (QUOTE T)) (SPADLET |a| (|postTran| |a|)) (COND ((AND (PAIRP |a|) (PROGN (SPADLET |op| (QCAR |a|)) (QUOTE T)) (member |op| (QUOTE (SIGNATURE ATTRIBUTE IF)))) (CONS (QUOTE CATEGORY) (CONS |a| NIL))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE PROGN)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (CONS (QUOTE CATEGORY) |b|)) ((QUOTE T) |a|)))))) -;postTransformCheck x == -; $defOp: local:= nil -; postcheck x - -;;; *** |postTransformCheck| REDEFINED - -(DEFUN |postTransformCheck| (|x|) (PROG (|$defOp|) (DECLARE (SPECIAL |$defOp|)) (RETURN (PROGN (SPADLET |$defOp| NIL) (|postcheck| |x|))))) -;postcheck x == -; atom x => nil -; x is ['DEF,form,[target,:.],:.] => -; (setDefOp form; postcheckTarget target; postcheck rest rest x) -; x is ['QUOTE,:.] => nil -; postcheck first x -; postcheck rest x - -;;; *** |postcheck| REDEFINED - -(DEFUN |postcheck| (|x|) (PROG (|ISTMP#1| |form| |ISTMP#2| |ISTMP#3| |target|) (RETURN (COND ((ATOM |x|) NIL) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE DEF)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |form| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |target| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (|setDefOp| |form|) (|postcheckTarget| |target|) (|postcheck| (CDR (CDR |x|)))) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE QUOTE))) NIL) ((QUOTE T) (|postcheck| (CAR |x|)) (|postcheck| (CDR |x|))))))) -;setDefOp f == -; if f is [":",g,:.] then f := g -; f := (atom f => f; first f) -; if $topOp then $defOp:= f else $topOp:= f - -;;; *** |setDefOp| REDEFINED - -(DEFUN |setDefOp| (|f|) (PROG (|ISTMP#1| |g|) (RETURN (PROGN (COND ((AND (PAIRP |f|) (EQ (QCAR |f|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |f|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |g| (QCAR |ISTMP#1|)) (QUOTE T))))) (SPADLET |f| |g|))) (SPADLET |f| (COND ((ATOM |f|) |f|) ((QUOTE T) (CAR |f|)))) (COND (|$topOp| (SPADLET |$defOp| |f|)) ((QUOTE T) (SPADLET |$topOp| |f|))))))) -;postcheckTarget x == -; -- doesn't seem that useful! -; isPackageType x => nil -; x is ['Join,:.] => nil -; NIL - -;;; *** |postcheckTarget| REDEFINED - -(DEFUN |postcheckTarget| (|x|) (COND ((|isPackageType| |x|) NIL) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Join|))) NIL) ((QUOTE T) NIL))) ;isPackageType x == not CONTAINED("$",x) ;;; *** |isPackageType| REDEFINED