diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 7e96512..b3075bc 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -6999,7 +6999,7 @@ identifier in newvars in the expression x (cons (car x) (loop for y in (cdr x) collect (fn y alist))))))) - (let (head tail tmp1 x tmp2 y nhead) + (let (head tail nhead) (if (pairp u) (progn (setq head (qcar u)) @@ -11134,6 +11134,136 @@ An angry JHD - August 15th., 1984 \end{chunk} +\defun{outputComp}{outputComp} +\calls{outputComp}{comp} +\calls{outputComp}{pairp} +\calls{outputComp}{qcar} +\calls{outputComp}{qcdr} +\calls{outputComp}{nreverse0} +\calls{outputComp}{outputComp} +\calls{outputComp}{get} +\refsdollar{outputComp}{Expression} +\begin{chunk}{defun outputComp} +;outputComp(x,e) == +; u:=comp(['_:_:,x,$Expression],$Expression,e) => u +; x is ['construct,:argl] => +; [['LIST,:[([.,.,e]:=outputComp(x,e)).expr for x in argl]],$Expression,e] +; (v:= get(x,"value",e)) and (v.mode is ['Union,:l]) => +; [['coerceUn2E,x,v.mode],$Expression,e] +; [x,$Expression,e] + +(DEFUN |outputComp| (|x| |e|) + (PROG (|u| |argl| |LETTMP#1| |v| |ISTMP#1| |l|) + (declare (special |$Expression|)) + (RETURN + (SEQ (COND + ((SPADLET |u| + (|comp| (CONS '|::| + (CONS |x| + (CONS |$Expression| NIL))) + |$Expression| |e|)) + |u|) + ((AND (PAIRP |x|) (EQ (QCAR |x|) '|construct|) + (PROGN (SPADLET |argl| (QCDR |x|)) 'T)) + (CONS (CONS 'LIST + (PROG (G167017) + (SPADLET G167017 NIL) + (RETURN + (DO ((G167025 |argl| (CDR G167025)) + (|x| NIL)) + ((OR (ATOM G167025) + (PROGN + (SETQ |x| (CAR G167025)) + NIL)) + (NREVERSE0 G167017)) + (SEQ (EXIT + (SETQ G167017 + (CONS + (CAR + (PROGN + (SPADLET |LETTMP#1| + (|outputComp| |x| |e|)) + (SPADLET |e| + (CADDR |LETTMP#1|)) + |LETTMP#1|)) + G167017)))))))) + (CONS |$Expression| (CONS |e| NIL)))) + ((AND (SPADLET |v| (|get| |x| '|value| |e|)) + (PROGN + (SPADLET |ISTMP#1| (CADR |v|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) '|Union|) + (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) 'T)))) + (CONS (CONS '|coerceUn2E| + (CONS |x| (CONS (CADR |v|) NIL))) + (CONS |$Expression| (CONS |e| NIL)))) + ('T (CONS |x| (CONS |$Expression| (CONS |e| NIL))))))))) + +\end{chunk} + +;(defun |outputComp| (x env) +; (let (u tmp1 v argl tmp2) +; (declare (special |$Expression|)) +; (cond +; ((setq u (|comp| (list '|::| x |$Expression|) |$Expression| env)) +; u) +; ((and (pairp x) (eq (qcar x) '|construct|)) +; (setq argl (qcdr x)) +; (list (cons 'list +; (prog (result) +; (return +; (do ((tmp1 argl (cdr tmp1)) (x nil)) +; ((or (atom tmp1)) (nreverse0 result)) +; (setq x (car tmp1)) +; (setq result +; (cons +; (car +; (progn +; (setq tmp2 (|outputComp| x env)) +; (setq env (third tmp2)) +; tmp2)) +; result)))))) +; |$Expression| env)) +; ((and (setq v (|get| x '|value| env)) +; (pairp (cadr v)) (eq (qcar (cadr v)) '|Union|)) +; (list (list '|coerceUn2E| x (cadr v)) |$Expression| env)) +; (t (list x |$Expression| env))))) + +;(defun |outputComp| (x env) +; (let (tmp1 v result) +; (declare (special |$Expression|)) +; (cond +; ((|comp| (list '|::| x |$Expression|) |$Expression| env)) +; ((and (pairp x) (eq (qcar x) '|construct|)) +; (list +; (cons 'list +; (dolist (y (rest x) (nreverse0 result)) +; (push (car (progn +; (setq tmp1 (|outputComp| y env)) +; (setq env (third tmp1)) +; tmp1)) +; result)) +; |$Expression| env))) +; ((and (setq v (|get| x '|value| env)) +; (pairp (second v)) (eq (qcar (second v)) '|Union|)) +; (list (list '|coerceUn2E| x (second v)) |$Expression| env)) +; (t +; (list x |$Expression| env))))) + +\end{chunk} + +\defun{maxSuperType}{maxSuperType} +\calls{maxSuperType}{get} +\calls{maxSuperType}{maxSuperType} +\begin{chunk}{defun maxSuperType} +(defun |maxSuperType| (m env) + (let (typ) + (if (setq typ (|get| m '|SuperDomain| env)) + (|maxSuperType| typ env) + m))) + +\end{chunk} + \defun{isDomainForm}{isDomainForm} \calls{isDomainForm}{kar} \calls{isDomainForm}{pairp} @@ -17665,6 +17795,42 @@ preferred to the underlying representation -- RDJ 9/12/83 \end{chunk} +\defun{compExpressionList}{compExpressionList} +\calls{compExpressionList}{nreverse0} +\calls{compExpressionList}{comp} +\calls{compExpressionList}{convert} +\refsdollar{compExpressionList}{Expression} +\begin{chunk}{defun compExpressionList} +(defun |compExpressionList| (argl m env) + (let (tmp1 tlst) + (declare (special |$Expression|)) + (setq tlst + (prog (result) + (return + (do ((tmp2 argl (cdr tmp2)) (x nil)) + ((or (atom tmp2)) (nreverse0 result)) + (setq x (car tmp2)) + (setq result + (cons + (progn + (setq tmp1 (or (|comp| x |$Expression| env) (return '|failed|))) + (setq env (third tmp1)) + tmp1) + result)))))) + (unless (eq tlst '|failed|) + (|convert| + (list (cons 'list + (prog (result) + (return + (do ((tmp3 tlst (cdr tmp3)) (y nil)) + ((or (atom tmp3)) (nreverse0 result)) + (setq y (car tmp3)) + (setq result (cons (car y) result)))))) + |$Expression| env) + m)))) + +\end{chunk} + \defun{compForm2}{compForm2} \calls{compForm2}{take} \calls{compForm2}{length} @@ -17754,6 +17920,46 @@ preferred to the underlying representation -- RDJ 9/12/83 \end{chunk} +\defun{compFormPartiallyBottomUp}{compFormPartiallyBottomUp} +\calls{compFormPartiallyBottomUp}{compForm3} +\calls{compFormPartiallyBottomUp}{compFormMatch} +\begin{chunk}{defun compFormPartiallyBottomUp} +(defun |compFormPartiallyBottomUp| (form mode env modemapList partialModeList) + (let (mmList) + (when (setq mmList (loop for mm in modemapList + when (|compFormMatch| mm partialModeList) + collect mm)) + (|compForm3| form mode env mmList)))) + +\end{chunk} + +\defun{compFormMatch}{compFormMatch} +\begin{chunk}{defun compFormMatch} +(defun |compFormMatch| (mm partialModeList) + (labels ( + (ismatch (a b) + (cond + ((null b) t) + ((null (car b)) (|compFormMatch,match| (cdr a) (cdr b))) + ((and (equal (car a) (car b)) (ismatch (cdr a) (cdr b))))))) + (and (pairp mm) (pairp (qcar mm)) (pairp (qcdr (qcar mm))) + (ismatch (qcdr (qcdr (qcar mm))) partialModeList)))) + +\end{chunk} + +\defun{compUniquely}{compUniquely} +\catches{compUniquely}{compUniquely} +\calls{compUniquely}{comp} +\defsdollar{compUniquely}{compUniquelyIfTrue} +\begin{chunk}{defun compUniquely} +(defun |compUniquely| (x m env) + (let (|$compUniquelyIfTrue|) + (declare (special |$compUniquelyIfTrue|)) + (setq |$compUniquelyIfTrue| t) + (catch '|compUniquely| (|comp| x m env)))) + +\end{chunk} + \defun{compArgumentsAndTryAgain}{compArgumentsAndTryAgain} \calls{compArgumentsAndTryAgain}{comp} \calls{compArgumentsAndTryAgain}{compForm1} @@ -18565,9 +18771,12 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun compElt} \getchunk{defun compExit} \getchunk{defun compExpression} +\getchunk{defun compExpressionList} \getchunk{defun compForm} \getchunk{defun compForm1} \getchunk{defun compForm2} +\getchunk{defun compFormMatch} +\getchunk{defun compFormPartiallyBottomUp} \getchunk{defun compFunctorBody} \getchunk{defun compHas} \getchunk{defun compIf} @@ -18612,6 +18821,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun compSuchthat} \getchunk{defun compTopLevel} \getchunk{defun compTypeOf} +\getchunk{defun compUniquely} \getchunk{defun compVector} \getchunk{defun compWhere} \getchunk{defun compWithMappingMode} @@ -18722,6 +18932,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun match-next-token} \getchunk{defun match-string} \getchunk{defun match-token} +\getchunk{defun maxSuperType} \getchunk{defun mergeModemap} \getchunk{defun mergeSignatureAndLocalVarAlists} \getchunk{defun meta-syntax-error} @@ -18747,6 +18958,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun optional} \getchunk{defun orderPredicateItems} \getchunk{defun orderPredTran} +\getchunk{defun outputComp} \getchunk{defun PARSE-AnyId} \getchunk{defun PARSE-Application} diff --git a/changelog b/changelog index 804db21..6d36c13 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20110804 tpd src/axiom-website/patches.html 20110804.01.tpd.patch +20110804 tpd src/interp/compiler.lisp treeshake compiler +20110804 tpd books/bookvol9 treeshake compiler 20110803 tpd src/axiom-website/patches.html 20110803.02.tpd.patch 20110803 tpd src/interp/Makefile removed ax.lisp 20110803 tpd src/interp/util.lisp removed aldor compiler hooks diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 63bbddf..2d3e1f1 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3575,6 +3575,8 @@ src/interp/database.lisp removed
20110803.01.tpd.patch src/interp/as.lisp removed
20110803.02.tpd.patch -src/interp/ax.lisp removed aldor compiler hooks +src/interp/ax.lisp removed aldor compiler hooks
+20110804.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/compiler.lisp.pamphlet b/src/interp/compiler.lisp.pamphlet index 95c5451..3fdb0ac 100644 --- a/src/interp/compiler.lisp.pamphlet +++ b/src/interp/compiler.lisp.pamphlet @@ -19,30 +19,15 @@ (defvar |$abbreviationStack| nil) \end{chunk} -\subsection{compUniquely} -\begin{chunk}{*} -;compUniquely(x,m,e) == -; $compUniquelyIfTrue: local:= true -; CATCH("compUniquely",comp(x,m,e)) - -(DEFUN |compUniquely| (|x| |m| |e|) - (PROG (|$compUniquelyIfTrue|) - (DECLARE (SPECIAL |$compUniquelyIfTrue|)) - (RETURN - (PROGN - (SPADLET |$compUniquelyIfTrue| 'T) - (CATCH '|compUniquely| (|comp| |x| |m| |e|)))))) - -\end{chunk} \subsection{tc} \begin{chunk}{*} ;tc() == ; $tripleCache:= nil ; comp($x,$m,$f) -(DEFUN |tc| () - (declare (special |$tripleCache| |$x| |$m| |$f|)) - (PROGN (SPADLET |$tripleCache| NIL) (|comp| |$x| |$m| |$f|))) +;(DEFUN |tc| () +; (declare (special |$tripleCache| |$x| |$m| |$f|)) +; (PROGN (SPADLET |$tripleCache| NIL) (|comp| |$x| |$m| |$f|))) \end{chunk} @@ -102,21 +87,6 @@ ('T (CONS '|Union| (CONS |a| (CONS |b| NIL)))))))) \end{chunk} -\subsection{maxSuperType} -\begin{chunk}{*} -;maxSuperType(m,e) == -; typ:= get(m,"SuperDomain",e) => maxSuperType(typ,e) -; m - -(DEFUN |maxSuperType| (|m| |e|) - (PROG (|typ|) - (RETURN - (COND - ((SPADLET |typ| (|get| |m| '|SuperDomain| |e|)) - (|maxSuperType| |typ| |e|)) - ('T |m|))))) - -\end{chunk} \subsection{hasType} \begin{chunk}{*} ;hasType(x,e) == @@ -153,186 +123,6 @@ (|hasType,fn| (|get| |x| '|condition| |e|))) \end{chunk} -\subsection{outputComp} -\begin{chunk}{*} -;outputComp(x,e) == -; u:=comp(['_:_:,x,$Expression],$Expression,e) => u -; x is ['construct,:argl] => -; [['LIST,:[([.,.,e]:=outputComp(x,e)).expr for x in argl]],$Expression,e] -; (v:= get(x,"value",e)) and (v.mode is ['Union,:l]) => -; [['coerceUn2E,x,v.mode],$Expression,e] -; [x,$Expression,e] - -(DEFUN |outputComp| (|x| |e|) - (PROG (|u| |argl| |LETTMP#1| |v| |ISTMP#1| |l|) - (declare (special |$Expression|)) - (RETURN - (SEQ (COND - ((SPADLET |u| - (|comp| (CONS '|::| - (CONS |x| - (CONS |$Expression| NIL))) - |$Expression| |e|)) - |u|) - ((AND (PAIRP |x|) (EQ (QCAR |x|) '|construct|) - (PROGN (SPADLET |argl| (QCDR |x|)) 'T)) - (CONS (CONS 'LIST - (PROG (G167017) - (SPADLET G167017 NIL) - (RETURN - (DO ((G167025 |argl| (CDR G167025)) - (|x| NIL)) - ((OR (ATOM G167025) - (PROGN - (SETQ |x| (CAR G167025)) - NIL)) - (NREVERSE0 G167017)) - (SEQ (EXIT - (SETQ G167017 - (CONS - (CAR - (PROGN - (SPADLET |LETTMP#1| - (|outputComp| |x| |e|)) - (SPADLET |e| - (CADDR |LETTMP#1|)) - |LETTMP#1|)) - G167017)))))))) - (CONS |$Expression| (CONS |e| NIL)))) - ((AND (SPADLET |v| (|get| |x| '|value| |e|)) - (PROGN - (SPADLET |ISTMP#1| (CADR |v|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) '|Union|) - (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) 'T)))) - (CONS (CONS '|coerceUn2E| - (CONS |x| (CONS (CADR |v|) NIL))) - (CONS |$Expression| (CONS |e| NIL)))) - ('T (CONS |x| (CONS |$Expression| (CONS |e| NIL))))))))) - -\end{chunk} -\subsection{compExpressionList} -\begin{chunk}{*} -;compExpressionList(argl,m,e) == -; Tl:= [[.,.,e]:= comp(x,$Expression,e) or return "failed" for x in argl] -; Tl="failed" => nil -; convert([["LIST",:[y.expr for y in Tl]],$Expression,e],m) - -(DEFUN |compExpressionList| (|argl| |m| |e|) - (PROG (|LETTMP#1| |Tl|) - (declare (special |$Expression|)) - (RETURN - (SEQ (PROGN - (SPADLET |Tl| - (PROG (G167221) - (SPADLET G167221 NIL) - (RETURN - (DO ((G167229 |argl| (CDR G167229)) - (|x| NIL)) - ((OR (ATOM G167229) - (PROGN - (SETQ |x| (CAR G167229)) - NIL)) - (NREVERSE0 G167221)) - (SEQ (EXIT (SETQ G167221 - (CONS - (PROGN - (SPADLET |LETTMP#1| - (OR - (|comp| |x| |$Expression| - |e|) - (RETURN '|failed|))) - (SPADLET |e| - (CADDR |LETTMP#1|)) - |LETTMP#1|) - G167221)))))))) - (COND - ((BOOT-EQUAL |Tl| '|failed|) NIL) - ('T - (|convert| - (CONS (CONS 'LIST - (PROG (G167239) - (SPADLET G167239 NIL) - (RETURN - (DO - ((G167244 |Tl| (CDR G167244)) - (|y| NIL)) - ((OR (ATOM G167244) - (PROGN - (SETQ |y| (CAR G167244)) - NIL)) - (NREVERSE0 G167239)) - (SEQ - (EXIT - (SETQ G167239 - (CONS (CAR |y|) G167239)))))))) - (CONS |$Expression| (CONS |e| NIL))) - |m|)))))))) - -\end{chunk} -\subsection{compFormPartiallyBottomUp} -\begin{chunk}{*} -;compFormPartiallyBottomUp(form,m,e,modemapList,partialModeList) == -; mmList:= [mm for mm in modemapList | compFormMatch(mm,partialModeList)] => -; compForm3(form,m,e,mmList) - -(DEFUN |compFormPartiallyBottomUp| - (|form| |m| |e| |modemapList| |partialModeList|) - (PROG (|mmList|) - (RETURN - (SEQ (COND - ((SPADLET |mmList| - (PROG (G167545) - (SPADLET G167545 NIL) - (RETURN - (DO ((G167551 |modemapList| - (CDR G167551)) - (|mm| NIL)) - ((OR (ATOM G167551) - (PROGN - (SETQ |mm| (CAR G167551)) - NIL)) - (NREVERSE0 G167545)) - (SEQ (EXIT (COND - ((|compFormMatch| |mm| - |partialModeList|) - (SETQ G167545 - (CONS |mm| G167545)))))))))) - (EXIT (|compForm3| |form| |m| |e| |mmList|)))))))) - -\end{chunk} -\subsection{compFormMatch} -\begin{chunk}{*} -;compFormMatch(mm,partialModeList) == -; mm is [[.,.,:argModeList],:.] and match(argModeList,partialModeList) where -; match(a,b) == -; null b => true -; null first b => match(rest a,rest b) -; first a=first b and match(rest a,rest b) - -(DEFUN |compFormMatch,match| (|a| |b|) - (SEQ (IF (NULL |b|) (EXIT 'T)) - (IF (NULL (CAR |b|)) - (EXIT (|compFormMatch,match| (CDR |a|) (CDR |b|)))) - (EXIT (AND (BOOT-EQUAL (CAR |a|) (CAR |b|)) - (|compFormMatch,match| (CDR |a|) (CDR |b|)))))) - -(DEFUN |compFormMatch| (|mm| |partialModeList|) - (PROG (|ISTMP#1| |ISTMP#2| |argModeList|) - (RETURN - (AND (PAIRP |mm|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |mm|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |argModeList| (QCDR |ISTMP#2|)) - 'T))))) - (|compFormMatch,match| |argModeList| |partialModeList|))))) - -\end{chunk} \subsection{compForm3} \begin{chunk}{*} ;compForm3(form is [op,:argl],m,e,modemapList) ==