diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 7a09c23..6af1a5b 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1829,6 +1829,101 @@ preferred to the underlying representation -- RDJ 9/12/83 @ +\defun{compForm1}{compForm1} +\calls{compForm1}{length} +\calls{compForm1}{outputComp} +\calls{compForm1}{compOrCroak} +\calls{compForm1}{compExpressionList} +\calls{compForm1}{coerceable} +\calls{compForm1}{comp} +\calls{compForm1}{coerce} +\calls{compForm1}{compForm2} +\calls{compForm1}{augModemapsFromDomain1} +\calls{compForm1}{getFormModemaps} +\calls{compForm1}{nreverse0} +\calls{compForm1}{addDomain} +\calls{compForm1}{compToApply} +\usesdollar{compForm1}{NumberOfArgsIfInteger} +\usesdollar{compForm1}{Expression} +\usesdollar{compForm1}{EmptyMode} +<>= +(defun |compForm1| (form m e) + (let (|$NumberOfArgsIfInteger| op argl domain tmp1 opprime ans mmList td + tmp2 tmp3 tmp4 tmp5 tmp6 tmp7) + (declare (special |$NumberOfArgsIfInteger| |$Expression| |$EmptyMode|)) + (setq op (car form)) + (setq argl (cdr form)) + (setq |$NumberOfArgsIfInteger| (|#| argl)) + (cond + ((eq op '|error|) + (list + (cons op + (dolist (x argl (nreverse0 tmp4)) + (setq tmp2 (|outputComp| x e)) + (setq e (third tmp2)) + (push (car tmp2) tmp4))) + m e)) + ((and (pairp op) (eq (qcar op) '|elt|) + (progn + (setq tmp3 (qcdr op)) + (and (pairp tmp3) + (progn + (setq domain (qcar tmp3)) + (setq tmp1 (qcdr tmp3)) + (and (pairp tmp1) + (eq (qcdr tmp1) nil) + (progn + (setq opprime (qcar tmp1)) + t)))))) + (cond + ((eq domain '|Lisp|) + (list + (cons opprime + (dolist (x argl (nreverse tmp7)) + (setq tmp2 (|compOrCroak| x |$EmptyMode| e)) + (setq e (third tmp2)) + (push (car tmp2) tmp7))) + m e)) + ((and (equal domain |$Expression|) (eq opprime '|construct|)) + (|compExpressionList| argl m e)) + ((and (eq opprime 'collect) (|coerceable| domain m e)) + (when (setq td (|comp| (cons opprime argl) domain e)) + (|coerce| td m))) + ((and (pairp domain) (eq (qcar domain) '|Mapping|) + (setq ans + (|compForm2| (cons opprime argl) m + (setq e (|augModemapsFromDomain1| domain domain e)) + (dolist (x (|getFormModemaps| (cons opprime argl) e) + (nreverse0 tmp6)) + (when + (and (pairp x) + (and (pairp (qcar x)) (equal (qcar (qcar x)) domain))) + (push x tmp6)))))) + ans) + ((setq ans + (|compForm2| (cons opprime argl) m + (setq e (|addDomain| domain e)) + (dolist (x (|getFormModemaps| (cons opprime argl) e) + (nreverse0 tmp5)) + (when + (and (pairp x) + (and (pairp (qcar x)) (equal (qcar (qcar x)) domain))) + (push x tmp5))))) + ans) + ((and (eq opprime '|construct|) (|coerceable| domain m e)) + (when (setq td (|comp| (cons opprime argl) domain e)) + (|coerce| td m))) + (t nil))) + (t + (setq e (|addDomain| m e)) + (cond + ((and (setq mmList (|getFormModemaps| form e)) + (setq td (|compForm2| form m e mmList))) + td) + (t + (|compToApply| op argl m e))))))) + +@ \defun{compArgumentsAndTryAgain}{compArgumentsAndTryAgain} \calls{compArgumentsAndTryAgain}{comp} \calls{compArgumentsAndTryAgain}{compForm1} @@ -2315,6 +2410,18 @@ preferred to the underlying representation -- RDJ 9/12/83 @ +\defun{compAtSign}{compAtSign} +\calls{compAtSign}{addDomain} +\calls{compAtSign}{comp} +\calls{compAtSign}{coerce} +<>= +(defun |compAtSign| (arg1 m e) + (let ((x (second arg1)) (mprime (third arg1)) tmp) + (setq e (|addDomain| mprime e)) + (when (setq tmp (|comp| x mprime e)) (|coerce| tmp m)))) + +@ + \defun{argsToSig}{argsToSig} <>= (defun |argsToSig| (args) @@ -2633,10 +2740,12 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index d5adba9..0c974b8 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20100919 tpd src/axiom-website/patches.html 20100919.01.tpd.patch +20100919 tpd src/interp/compiler.lisp treeshake compiler +20100919 tpd books/bookvol9 treeshake compiler 20100918 tpd src/axiom-website/patches.html 20100918.01.tpd.patch 20100918 tpd src/interp/compiler.lisp treeshake compiler 20100918 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 3160186..a6ef8a4 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3127,5 +3127,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20100918.01.tpd.patch books/bookvol9 treeshake compiler
+20100919.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/compiler.lisp.pamphlet b/src/interp/compiler.lisp.pamphlet index b76a276..88e6b33 100644 --- a/src/interp/compiler.lisp.pamphlet +++ b/src/interp/compiler.lisp.pamphlet @@ -210,204 +210,6 @@ ('T (CONS |x| (CONS |$Expression| (CONS |e| NIL))))))))) @ -\subsection{compForm1} -<<*>>= -;compForm1(form is [op,:argl],m,e) == -; $NumberOfArgsIfInteger: local:= #argl --see compElt -; op="error" => -; [[op,:[([.,.,e]:=outputComp(x,e)).expr -; for x in argl]],m,e] -; op is ["elt",domain,op'] => -; domain="Lisp" => -; --op'='QUOTE and null rest argl => [first argl,m,e] -; [[op',:[([.,.,e]:= compOrCroak(x,$EmptyMode,e)).expr for x in argl]],m,e] -; domain=$Expression and op'="construct" => compExpressionList(argl,m,e) -; (op'="COLLECT") and coerceable(domain,m,e) => -; (T:= comp([op',:argl],domain,e) or return nil; coerce(T,m)) -; -- Next clause added JHD 8/Feb/94: the clause after doesn't work -; -- since addDomain refuses to add modemaps from Mapping -; (domain is ['Mapping,:.]) and -; (ans := compForm2([op',:argl],m,e:= augModemapsFromDomain1(domain,domain,e), -; [x for x in getFormModemaps([op',:argl],e) | x is [[ =domain,:.],:.]])) => ans -; ans := compForm2([op',:argl],m,e:= addDomain(domain,e), -; [x for x in getFormModemaps([op',:argl],e) | x is [[ =domain,:.],:.]]) => ans -; (op'="construct") and coerceable(domain,m,e) => -; (T:= comp([op',:argl],domain,e) or return nil; coerce(T,m)) -; nil -; e:= addDomain(m,e) --???unneccessary because of comp2's call??? -; (mmList:= getFormModemaps(form,e)) and (T:= compForm2(form,m,e,mmList)) => T -; compToApply(op,argl,m,e) - -(DEFUN |compForm1| (|form| |m| |e|) - (PROG (|$NumberOfArgsIfInteger| |op| |argl| |domain| |ISTMP#2| |op'| - |LETTMP#1| |ISTMP#1| |ans| |mmList| T$) - (DECLARE (SPECIAL |$NumberOfArgsIfInteger| |$Expression| |$EmptyMode|)) - (RETURN - (SEQ (PROGN - (SPADLET |op| (CAR |form|)) - (SPADLET |argl| (CDR |form|)) - (SPADLET |$NumberOfArgsIfInteger| (|#| |argl|)) - (COND - ((BOOT-EQUAL |op| '|error|) - (CONS (CONS |op| - (PROG (G167108) - (SPADLET G167108 NIL) - (RETURN - (DO ((G167116 |argl| (CDR G167116)) - (|x| NIL)) - ((OR (ATOM G167116) - (PROGN - (SETQ |x| (CAR G167116)) - NIL)) - (NREVERSE0 G167108)) - (SEQ (EXIT - (SETQ G167108 - (CONS - (CAR - (PROGN - (SPADLET |LETTMP#1| - (|outputComp| |x| |e|)) - (SPADLET |e| - (CADDR |LETTMP#1|)) - |LETTMP#1|)) - G167108)))))))) - (CONS |m| (CONS |e| NIL)))) - ((AND (PAIRP |op|) (EQ (QCAR |op|) '|elt|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |op|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |domain| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |op'| (QCAR |ISTMP#2|)) - 'T)))))) - (COND - ((BOOT-EQUAL |domain| '|Lisp|) - (CONS (CONS |op'| - (PROG (G167129) - (SPADLET G167129 NIL) - (RETURN - (DO - ((G167137 |argl| (CDR G167137)) - (|x| NIL)) - ((OR (ATOM G167137) - (PROGN - (SETQ |x| (CAR G167137)) - NIL)) - (NREVERSE0 G167129)) - (SEQ - (EXIT - (SETQ G167129 - (CONS - (CAR - (PROGN - (SPADLET |LETTMP#1| - (|compOrCroak| |x| - |$EmptyMode| |e|)) - (SPADLET |e| - (CADDR |LETTMP#1|)) - |LETTMP#1|)) - G167129)))))))) - (CONS |m| (CONS |e| NIL)))) - ((AND (BOOT-EQUAL |domain| |$Expression|) - (BOOT-EQUAL |op'| '|construct|)) - (|compExpressionList| |argl| |m| |e|)) - ((AND (BOOT-EQUAL |op'| 'COLLECT) - (|coerceable| |domain| |m| |e|)) - (SPADLET T$ - (OR (|comp| (CONS |op'| |argl|) |domain| - |e|) - (RETURN NIL))) - (|coerce| T$ |m|)) - ((AND (PAIRP |domain|) - (EQ (QCAR |domain|) '|Mapping|) - (SPADLET |ans| - (|compForm2| (CONS |op'| |argl|) |m| - (SPADLET |e| - (|augModemapsFromDomain1| - |domain| |domain| |e|)) - (PROG (G167148) - (SPADLET G167148 NIL) - (RETURN - (DO - ((G167154 - (|getFormModemaps| - (CONS |op'| |argl|) |e|) - (CDR G167154)) - (|x| NIL)) - ((OR (ATOM G167154) - (PROGN - (SETQ |x| - (CAR G167154)) - NIL)) - (NREVERSE0 G167148)) - (SEQ - (EXIT - (COND - ((AND (PAIRP |x|) - (PROGN - (SPADLET |ISTMP#1| - (QCAR |x|)) - (AND - (PAIRP |ISTMP#1|) - (EQUAL - (QCAR |ISTMP#1|) - |domain|)))) - (SETQ G167148 - (CONS |x| G167148)))))))))))) - |ans|) - ((SPADLET |ans| - (|compForm2| (CONS |op'| |argl|) |m| - (SPADLET |e| - (|addDomain| |domain| |e|)) - (PROG (G167165) - (SPADLET G167165 NIL) - (RETURN - (DO - ((G167171 - (|getFormModemaps| - (CONS |op'| |argl|) |e|) - (CDR G167171)) - (|x| NIL)) - ((OR (ATOM G167171) - (PROGN - (SETQ |x| (CAR G167171)) - NIL)) - (NREVERSE0 G167165)) - (SEQ - (EXIT - (COND - ((AND (PAIRP |x|) - (PROGN - (SPADLET |ISTMP#1| - (QCAR |x|)) - (AND (PAIRP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) - |domain|)))) - (SETQ G167165 - (CONS |x| G167165))))))))))) - |ans|) - ((AND (BOOT-EQUAL |op'| '|construct|) - (|coerceable| |domain| |m| |e|)) - (SPADLET T$ - (OR (|comp| (CONS |op'| |argl|) |domain| - |e|) - (RETURN NIL))) - (|coerce| T$ |m|)) - ('T NIL))) - ('T (SPADLET |e| (|addDomain| |m| |e|)) - (COND - ((AND (SPADLET |mmList| - (|getFormModemaps| |form| |e|)) - (SPADLET T$ - (|compForm2| |form| |m| |e| |mmList|))) - T$) - ('T (|compToApply| |op| |argl| |m| |e|)))))))))) - -@ \subsection{compExpressionList} <<*>>= ;compExpressionList(argl,m,e) == @@ -4071,25 +3873,6 @@ of basic objects may not be the same. |m'|))))) @ -\subsection{compAtSign} -<<*>>= -;compAtSign(["@",x,m'],m,e) == -; e:= addDomain(m',e) -; T:= comp(x,m',e) or return nil -; coerce(T,m) - -(DEFUN |compAtSign| (G170401 |m| |e|) - (PROG (|x| |m'| T$) - (RETURN - (PROGN - (COND ((EQ (CAR G170401) '@) (CAR G170401))) - (SPADLET |x| (CADR G170401)) - (SPADLET |m'| (CADDR G170401)) - (SPADLET |e| (|addDomain| |m'| |e|)) - (SPADLET T$ (OR (|comp| |x| |m'| |e|) (RETURN NIL))) - (|coerce| T$ |m|))))) - -@ \subsection{compCoerce} <<*>>= ;compCoerce(["::",x,m'],m,e) ==