diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 0ee6bf9..d4de7ff 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -6395,10 +6395,8 @@ $\rightarrow$ (declare (special |$prefix| |$formalArgList|) (ignore specialCases)) (let (|$insideCategoryIfTrue| $TOP_LEVEL |$definition| |$form| |$op| |$extraParms| |$functionStats| |$functorStats| |$frontier| - |$getDomainCode| |$addForm| argl sargl aList - signaturep tmp1 opp formalBody formals - actuals g fun pairlis parSignature parForm - modemap formp) + |$getDomainCode| |$addForm| argl sargl aList signaturep opp formp + formalBody formals actuals g fun pairlis parSignature parForm modemap) (declare (special |$insideCategoryIfTrue| $top_level |$definition| |$form| |$op| |$extraParms| |$functionStats| |$functorStats| |$frontier| |$getDomainCode| @@ -6505,6 +6503,60 @@ $\rightarrow$ \end{chunk} +\defun{mkConstructor}{mkConstructor} +\calls{mkConstructor}{mkConstructor} +\begin{chunk}{defun mkConstructor} +(defun |mkConstructor| (form) + (cond + ((atom form) (list '|devaluate| form)) + ((null (rest form)) (list 'quote (list (first form)))) + (t + (cons 'list + (cons (mkq (first form)) + (loop for x in (rest form) collect (|mkConstructor| x))))))) + +\end{chunk} + +\defun{compDefineCategory}{compDefineCategory} +\calls{compDefineCategory}{compDefineLisplib} +\calls{compDefineCategory}{compDefineCategory1} +\usesdollar{compDefineCategory}{domainShell} +\usesdollar{compDefineCategory}{lisplibCategory} +\usesdollar{compDefineCategory}{lisplib} +\usesdollar{compDefineCategory}{insideFunctorIfTrue} +\begin{chunk}{defun compDefineCategory} +(defun |compDefineCategory| (df mode env prefix fal) + (let (|$domainShell| |$lisplibCategory|) + (declare (special |$domainShell| |$lisplibCategory| $lisplib + |$insideFunctorIfTrue|)) + (setq |$domainShell| nil) ; holds the category of the object being compiled + (setq |$lisplibCategory| nil) + (if (and (null |$insideFunctorIfTrue|) $lisplib) + (|compDefineLisplib| df mode env prefix fal '|compDefineCategory1|) + (|compDefineCategory1| df mode env prefix fal)))) + +\end{chunk} + +\defun{compDefineFunctor}{compDefineFunctor} +\calls{compDefineFunctor}{compDefineLisplib} +\calls{compDefineFunctor}{compDefineFunctor1} +\usesdollar{compDefineFunctor}{domainShell} +\usesdollar{compDefineFunctor}{profileCompiler} +\usesdollar{compDefineFunctor}{lisplib} +\usesdollar{compDefineFunctor}{profileAlist} +\begin{chunk}{defun compDefineFunctor} +(defun |compDefineFunctor| (df mode env prefix fal) + (let (|$domainShell| |$profileCompiler| |$profileAlist|) + (declare (special |$domainShell| |$profileCompiler| $lisplib |$profileAlist|)) + (setq |$domainShell| nil) + (setq |$profileCompiler| t) + (setq |$profileAlist| nil) + (if $lisplib + (|compDefineLisplib| df mode env prefix fal '|compDefineFunctor1|) + (|compDefineFunctor1| df mode env prefix fal)))) + +\end{chunk} + \section{Indirect called comp routines} In the {\bf compExpression} function there is the code: \begin{verbatim} @@ -15651,7 +15703,9 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun compDefine} \getchunk{defun compDefine1} \getchunk{defun compDefineAddSignature} +\getchunk{defun compDefineCategory} \getchunk{defun compDefineCategory2} +\getchunk{defun compDefineFunctor} \getchunk{defun compElt} \getchunk{defun compExit} \getchunk{defun compExpression} @@ -15773,6 +15827,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun match-token} \getchunk{defun meta-syntax-error} \getchunk{defun mkCategoryPackage} +\getchunk{defun mkConstructor} \getchunk{defun modifyModeStack} \getchunk{defun ncINTERPFILE} diff --git a/changelog b/changelog index f67a158..90e27be 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20110518 tpd src/axiom-website/patches.html 20110518.01.tpd.patch +20110518 tpd src/interp/define.lisp treeshake compiler +20110518 tpd books/bookvol9 treeshake compiler 20110517 tpd src/axiom-website/patches.html 20110517.01.tpd.patch 20110517 tpd src/interp/define.lisp treeshake compiler 20110517 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index ba85357..2ab7916 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3480,5 +3480,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20110517.01.tpd.patch books/bookvol9 treeshake compiler
+20110518.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/define.lisp.pamphlet b/src/interp/define.lisp.pamphlet index 0bcad45..2243066 100644 --- a/src/interp/define.lisp.pamphlet +++ b/src/interp/define.lisp.pamphlet @@ -14,81 +14,6 @@ ;--% FUNCTIONS WHICH MUNCH ON == STATEMENTS ; - -;mkConstructor form == -; atom form => ['devaluate,form] -; null rest form => ['QUOTE,[first form]] -; ['LIST,MKQ first form,:[mkConstructor x for x in rest form]] - -(DEFUN |mkConstructor| (|form|) - (PROG () - (RETURN - (SEQ (COND - ((ATOM |form|) (CONS '|devaluate| (CONS |form| NIL))) - ((NULL (CDR |form|)) - (CONS 'QUOTE (CONS (CONS (CAR |form|) NIL) NIL))) - ('T - (CONS 'LIST - (CONS (MKQ (CAR |form|)) - (PROG (G166784) - (SPADLET G166784 NIL) - (RETURN - (DO ((G166789 (CDR |form|) - (CDR G166789)) - (|x| NIL)) - ((OR (ATOM G166789) - (PROGN - (SETQ |x| (CAR G166789)) - NIL)) - (NREVERSE0 G166784)) - (SEQ (EXIT - (SETQ G166784 - (CONS (|mkConstructor| |x|) - G166784))))))))))))))) - -;compDefineCategory(df,m,e,prefix,fal) == -; $domainShell: local -- holds the category of the object being compiled -; $lisplibCategory: local := nil -; not $insideFunctorIfTrue and $LISPLIB => -; compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1) -; compDefineCategory1(df,m,e,prefix,fal) - -(DEFUN |compDefineCategory| (|df| |m| |e| |prefix| |fal|) - (PROG (|$domainShell| |$lisplibCategory|) - (DECLARE (SPECIAL |$domainShell| |$lisplibCategory| $LISPLIB - |$insideFunctorIfTrue|)) - (RETURN - (PROGN - (SPADLET |$domainShell| NIL) - (SPADLET |$lisplibCategory| NIL) - (COND - ((AND (NULL |$insideFunctorIfTrue|) $LISPLIB) - (|compDefineLisplib| |df| |m| |e| |prefix| |fal| - '|compDefineCategory1|)) - ('T (|compDefineCategory1| |df| |m| |e| |prefix| |fal|))))))) - -;compDefineFunctor(df,m,e,prefix,fal) == -; $domainShell: local -- holds the category of the object being compiled -; $profileCompiler: local := true -; $profileAlist: local := nil -; $LISPLIB => compDefineLisplib(df,m,e,prefix,fal,'compDefineFunctor1) -; compDefineFunctor1(df,m,e,prefix,fal) - -(DEFUN |compDefineFunctor| (|df| |m| |e| |prefix| |fal|) - (PROG (|$domainShell| |$profileCompiler| |$profileAlist|) - (DECLARE (SPECIAL |$domainShell| |$profileCompiler| $LISPLIB - |$profileAlist|)) - (RETURN - (PROGN - (SPADLET |$domainShell| NIL) - (SPADLET |$profileCompiler| 'T) - (SPADLET |$profileAlist| NIL) - (COND - ($LISPLIB - (|compDefineLisplib| |df| |m| |e| |prefix| |fal| - '|compDefineFunctor1|)) - ('T (|compDefineFunctor1| |df| |m| |e| |prefix| |fal|))))))) - ;compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body], ; m,$e,$prefix,$formalArgList) == ; if NRTPARSE = true then