diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 0942f8a..f468135 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -2613,6 +2613,97 @@ of the symbol being parsed. The original list read: (\| |compSuchthat|) ; (VECTOR |compVector|) ; (|where| |compWhere|) +\end{verbatim} + +\defplist{@}{compAtSign} +<>= +(eval-when (eval load) + (setf (get '|add| 'special) '|compAdd|)) + +@ + +\defun{compAdd}{compAdd} +\calls{compAdd}{comp} +\calls{compAdd}{qcdr} +\calls{compAdd}{qcar} +\calls{compAdd}{compSubDomain1} +\calls{compAdd}{pairp} +\calls{compAdd}{nreverse0} +\calls{compAdd}{NRTgetLocalIndex} +\calls{compAdd}{compTuple2Record} +\calls{compAdd}{compOrCroak} +\calls{compAdd}{compCapsule} +\uses{compAdd}{/editfile} +\usesdollar{compAdd}{addForm} +\usesdollar{compAdd}{addFormLhs} +\usesdollar{compAdd}{EmptyMode} +\usesdollar{compAdd}{NRTaddForm} +\usesdollar{compAdd}{packagesUsed} +\usesdollar{compAdd}{functorForm} +\usesdollar{compAdd}{bootStrapMode} +<>= +(defun |compAdd| (arg m e) + (let (|$addForm| |$addFormLhs| code domainForm predicate tmp3 tmp4) + (declare (special |$addForm| |$addFormLhs| |$EmptyMode| |$NRTaddForm| + |$packagesUsed| |$functorForm| |$bootStrapMode| /editfile)) + (setq |$addForm| (second arg)) + (cond + ((eq |$bootStrapMode| t) + (cond + ((and (pairp |$addForm|) (eq (qcar |$addForm|) '|@Tuple|)) + (setq code nil)) + (t + (setq tmp3 (|comp| |$addForm| m e)) + (setq code (first tmp3)) + (setq m (second tmp3)) + (setq e (third tmp3)) tmp3)) + (list + (list 'cond + (list '|$bootStrapMode| code) + (list 't + (list '|systemError| + (list 'list ''|%b| (mkq (car |$functorForm|)) ''|%d| "from" + ''|%b| (mkq (|namestring| /editfile)) ''|%d| + "needs to be compiled")))) + m e)) + (t + (setq |$addFormLhs| |$addForm|) + (cond + ((and (pairp |$addForm|) (eq (qcar |$addForm|) '|SubDomain|) + (pairp (qcdr |$addForm|)) (pairp (qcdr (qcdr |$addForm|))) + (eq (qcdr (qcdr (qcdr |$addForm|))) nil)) + (setq domainForm (second |$addForm|)) + (setq predicate (third |$addForm|)) + (setq |$packagesUsed| (cons domainForm |$packagesUsed|)) + (setq |$NRTaddForm| domainForm) + (|NRTgetLocalIndex| domainForm) + ; need to generate slot for add form since all $ go-get + ; slots will need to access it + (setq tmp3 (|compSubDomain1| domainForm predicate m e)) + (setq |$addForm| (first tmp3)) + (setq e (third tmp3)) tmp3) + (t + (setq |$packagesUsed| + (if (and (pairp |$addForm|) (eq (qcar |$addForm|) '|@Tuple|)) + (append (qcdr |$addForm|) |$packagesUsed|) + (cons |$addForm| |$packagesUsed|))) + (setq |$NRTaddForm| |$addForm|) + (setq tmp3 + (cond + ((and (pairp |$addForm|) (eq (qcar |$addForm|) '|@Tuple|)) + (setq |$NRTaddForm| + (cons '|@Tuple| + (dolist (x (cdr |$addForm|) (nreverse0 tmp4)) + (push (|NRTgetLocalIndex| x) tmp4)))) + (|compOrCroak| (|compTuple2Record| |$addForm|) |$EmptyMode| e)) + (t + (|compOrCroak| |$addForm| |$EmptyMode| e)))) + (setq |$addForm| (first tmp3)) + (setq e (third tmp3)) + tmp3)) + (|compCapsule| (third arg) m e))))) + +@ \defplist{@}{compAtSign} <>= @@ -10154,6 +10245,7 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 096a064..ee4c1b1 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20101121 tpd src/axiom-website/patches.html 20101121.02.tpd.patch +20101121 tpd src/interp/postprop.lisp treeshake compiler +20101121 tpd src/interp/define.lisp treeshake compiler +20101121 tpd books/bookvol9 treeshake compiler 20101121 tpd src/axiom-website/patches.html 20101121.01.tpd.patch 20101121 tpd src/interp/postprop.lisp fix |special| bug 20101121 tpd src/interp/vmlisp.lisp fix |special| bug diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 2a3f027..4eed4b4 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3268,5 +3268,7 @@ books/bookvol9 treeshake compiler
books/bookvolbib Chee Keng Yap [Yap00]
20101121.01.tpd.patch books/bookvol9 fix |special| bug
+20101121.02.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/define.lisp.pamphlet b/src/interp/define.lisp.pamphlet index f200595..f10229d 100644 --- a/src/interp/define.lisp.pamphlet +++ b/src/interp/define.lisp.pamphlet @@ -5014,159 +5014,6 @@ NIL)) NIL)))) -;compAdd(['add,$addForm,capsule],m,e) == -; $bootStrapMode = true => -; if $addForm is ['Tuple,:.] then code := nil -; else [code,m,e]:= comp($addForm,m,e) -; [['COND, _ -; ['$bootStrapMode, _ -; code],_ -; [''T, ['systemError,['LIST,''%b,MKQ CAR $functorForm,''%d,'"from", _ -; ''%b,MKQ namestring _/EDITFILE,''%d,'"needs to be compiled"]]]],m,e] -; $addFormLhs: local:= $addForm -; if $addForm is ["SubDomain",domainForm,predicate] then -; $packagesUsed := [domainForm,:$packagesUsed] -;--+ -; $NRTaddForm := domainForm -; NRTgetLocalIndex domainForm -; --need to generate slot for add form since all $ go-get -; -- slots will need to access it -; [$addForm,.,e]:= compSubDomain1(domainForm,predicate,m,e) -; else -; $packagesUsed := -; $addForm is ['Tuple,:u] => [:u,:$packagesUsed] -; [$addForm,:$packagesUsed] -;--+ -; $NRTaddForm := $addForm -; [$addForm,.,e]:= -; $addForm is ['Tuple,:.] => -; $NRTaddForm := ['Tuple,:[NRTgetLocalIndex x for x in rest $addForm]] -; compOrCroak(compTuple2Record $addForm,$EmptyMode,e) -; compOrCroak($addForm,$EmptyMode,e) -; compCapsule(capsule,m,e) - -(DEFUN |compAdd| (G169618 |m| |e|) - (PROG (|$addForm| |$addFormLhs| |capsule| |code| |ISTMP#1| - |domainForm| |ISTMP#2| |predicate| |u| |LETTMP#1|) - (DECLARE (SPECIAL |$addForm| |$addFormLhs| |$EmptyMode| |$NRTaddForm| - |$packagesUsed| |$functorForm| |$bootStrapMode| - /EDITFILE)) - (RETURN - (SEQ (PROGN - (SPADLET |$addForm| (CADR G169618)) - (SPADLET |capsule| (CADDR G169618)) - (COND - ((BOOT-EQUAL |$bootStrapMode| 'T) - (COND - ((AND (PAIRP |$addForm|) - (EQ (QCAR |$addForm|) '|@Tuple|)) - (SPADLET |code| NIL)) - ('T (SPADLET |LETTMP#1| (|comp| |$addForm| |m| |e|)) - (SPADLET |code| (CAR |LETTMP#1|)) - (SPADLET |m| (CADR |LETTMP#1|)) - (SPADLET |e| (CADDR |LETTMP#1|)) |LETTMP#1|)) - (CONS (CONS 'COND - (CONS (CONS '|$bootStrapMode| - (CONS |code| NIL)) - (CONS (CONS ''T - (CONS - (CONS '|systemError| - (CONS - (CONS 'LIST - (CONS ''|%b| - (CONS - (MKQ - (CAR |$functorForm|)) - (CONS ''|%d| - (CONS - "from" - (CONS ''|%b| - (CONS - (MKQ - (|namestring| - /EDITFILE)) - (CONS ''|%d| - (CONS - "needs to be compiled" - NIL))))))))) - NIL)) - NIL)) - NIL))) - (CONS |m| (CONS |e| NIL)))) - ('T (SPADLET |$addFormLhs| |$addForm|) - (COND - ((AND (PAIRP |$addForm|) - (EQ (QCAR |$addForm|) '|SubDomain|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |$addForm|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |domainForm| - (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |predicate| - (QCAR |ISTMP#2|)) - 'T)))))) - (SPADLET |$packagesUsed| - (CONS |domainForm| |$packagesUsed|)) - (SPADLET |$NRTaddForm| |domainForm|) - (|NRTgetLocalIndex| |domainForm|) - (SPADLET |LETTMP#1| - (|compSubDomain1| |domainForm| |predicate| - |m| |e|)) - (SPADLET |$addForm| (CAR |LETTMP#1|)) - (SPADLET |e| (CADDR |LETTMP#1|)) |LETTMP#1|) - ('T - (SPADLET |$packagesUsed| - (COND - ((AND (PAIRP |$addForm|) - (EQ (QCAR |$addForm|) '|@Tuple|) - (PROGN - (SPADLET |u| (QCDR |$addForm|)) - 'T)) - (APPEND |u| |$packagesUsed|)) - ('T (CONS |$addForm| |$packagesUsed|)))) - (SPADLET |$NRTaddForm| |$addForm|) - (SPADLET |LETTMP#1| - (COND - ((AND (PAIRP |$addForm|) - (EQ (QCAR |$addForm|) '|@Tuple|)) - (SPADLET |$NRTaddForm| - (CONS '|@Tuple| - (PROG (G169653) - (SPADLET G169653 NIL) - (RETURN - (DO - ((G169658 - (CDR |$addForm|) - (CDR G169658)) - (|x| NIL)) - ((OR (ATOM G169658) - (PROGN - (SETQ |x| - (CAR G169658)) - NIL)) - (NREVERSE0 G169653)) - (SEQ - (EXIT - (SETQ G169653 - (CONS - (|NRTgetLocalIndex| - |x|) - G169653))))))))) - (|compOrCroak| - (|compTuple2Record| |$addForm|) - |$EmptyMode| |e|)) - ('T - (|compOrCroak| |$addForm| |$EmptyMode| - |e|)))) - (SPADLET |$addForm| (CAR |LETTMP#1|)) - (SPADLET |e| (CADDR |LETTMP#1|)) |LETTMP#1|)) - (|compCapsule| |capsule| |m| |e|)))))))) - ;compTuple2Record u == ['Record,:[[":",i,x] for i in 1.. for x in rest u]] (DEFUN |compTuple2Record| (|u|) diff --git a/src/interp/postprop.lisp.pamphlet b/src/interp/postprop.lisp.pamphlet index 555dd55..73f4e26 100644 --- a/src/interp/postprop.lisp.pamphlet +++ b/src/interp/postprop.lisp.pamphlet @@ -50,7 +50,7 @@ (mapcar #'(lambda (x) (MAKEPROP (CAR X) 'special (CADR X))) '( - (|add| |compAdd|) +; (|add| |compAdd|) ; (\@ |compAtSign|) (CAPSULE |compCapsule|) (|case| |compCase|)