diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 41c203c..f488f0d 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -6039,7 +6039,64 @@ $\rightarrow$ \item \verb|where| \refto{compWhere}(form mode eInit) $\rightarrow$ \end{itemize} -\section{Direct called comp routines} +\section{Functions which handle == statements} + +\defun{compDefineAddSignature}{compDefineAddSignature} +\calls{compDefineAddSignature}{hasFullSignature} +\calls{compDefineAddSignature}{assoc} +\calls{compDefineAddSignature}{lassoc} +\calls{compDefineAddSignature}{getProplist} +\calls{compDefineAddSignature}{comp} +\usesdollar{compDefineAddSignature}{EmptyMode} +\begin{chunk}{defun compDefineAddSignature} +(defun |compDefineAddSignature| (form signature env) + (let (sig declForm) + (declare (special |$EmptyMode|)) + (if + (and (setq sig (|hasFullSignature| (rest form) signature env)) + (null (|assoc| (cons '$ sig) + (lassoc '|modemap| (|getProplist| (car form) env))))) + (progn + (setq declForm + (list '|:| + (cons (car form) + (loop for x in (rest form) + for m in (rest sig) + collect (list '|:| x m))) + (car signature))) + (third (|comp| declForm |$EmptyMode| env))) + env))) + +\end{chunk} + +\defun{hasFullSignature}{hasFullSignature} +\tpdhere{test with BASTYPE} +\calls{hasFullSignature}{get} +\begin{chunk}{defun hasFullSignature} +(defun |hasFullSignature| (argl signature env) + (let (target ml u) + (setq target (first signature)) + (setq ml (rest signature)) + (when target + (setq u + (loop for x in argl for m in ml + collect (or m (|get| x '|mode| env) (return 'failed)))) + (unless (eq u 'failed) (cons target u))))) + +\end{chunk} + +\defun{addEmptyCapsuleIfNecessary}{addEmptyCapsuleIfNecessary} +\calls{addEmptyCapsuleIfNecessary}{kar} +\usesdollar{addEmptyCapsuleIfNecessary}{SpecialDomainNames} +\begin{chunk}{defun addEmptyCapsuleIfNecessary} +(defun |addEmptyCapsuleIfNecessary| (target rhs) + (declare (special |$SpecialDomainNames|) (ignore target)) + (if (member (kar rhs) |$SpecialDomainNames|) + rhs + (list '|add| rhs (list 'capsule)))) + +\end{chunk} + \section{Indirect called comp routines} In the {\bf compExpression} function there is the code: \begin{verbatim} @@ -6052,7 +6109,7 @@ In the {\bf compExpression} function there is the code: \defplist{@}{compAdd plist} \begin{chunk}{postvars} (eval-when (eval load) - (setf (get '|add| 'special) '|compAdd|)) + (setf (get '|add| 'special) 'compAdd)) \end{chunk} @@ -6095,7 +6152,7 @@ in the body of the add. \usesdollar{compAdd}{functorForm} \usesdollar{compAdd}{bootStrapMode} \begin{chunk}{defun compAdd} -(defun |compAdd| (form mode env) +(defun compAdd (form mode env) (let (|$addForm| |$addFormLhs| code domainForm predicate tmp3 tmp4) (declare (special |$addForm| |$addFormLhs| |$EmptyMode| |$NRTaddForm| |$packagesUsed| |$functorForm| |$bootStrapMode| /editfile)) @@ -6161,7 +6218,7 @@ in the body of the add. \defplist{@}{compAtSign plist} \begin{chunk}{postvars} (eval-when (eval load) - (setf (get '|@| 'special) '|compAtSign|)) + (setf (get '|@| 'special) 'compAtSign)) \end{chunk} @@ -6170,7 +6227,7 @@ in the body of the add. \calls{compAtSign}{comp} \calls{compAtSign}{coerce} \begin{chunk}{defun compAtSign} -(defun |compAtSign| (form mode env) +(defun compAtSign (form mode env) (let ((newform (second form)) (mprime (third form)) tmp) (setq env (|addDomain| mprime env)) (when (setq tmp (|comp| newform mprime env)) (|coerce| tmp mode)))) @@ -7234,7 +7291,7 @@ An angry JHD - August 15th., 1984 (cond (sig1 (setq ress - (|compAtSign| + (compAtSign (list '@ (list '+-> arg1 body) (cons '|Mapping| (cons target sig1))) mode env)) @@ -7973,7 +8030,7 @@ An angry JHD - August 15th., 1984 (when (setq tmp1 (|comp| p |$Boolean| env)) (setq pp (first tmp1)) (setq env (third tmp1)) - (setq e (|put| xp '|condition| pp env)) + (setq env (|put| xp '|condition| pp env)) (list xp mp env))))) \end{chunk} @@ -15145,6 +15202,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun action} \getchunk{defun addclose} +\getchunk{defun addEmptyCapsuleIfNecessary} \getchunk{defun add-parens-and-semis-to-line} \getchunk{defun Advance-Char} \getchunk{defun advance-token} @@ -15183,6 +15241,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun compConstructorCategory} \getchunk{defun compDefine} \getchunk{defun compDefine1} +\getchunk{defun compDefineAddSignature} \getchunk{defun compElt} \getchunk{defun compExit} \getchunk{defun compExpression} @@ -15267,6 +15326,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun hackforis1} \getchunk{defun hasAplExtension} \getchunk{defun hasFormalMapVariable} +\getchunk{defun hasFullSignature} \getchunk{defun indent-pos} \getchunk{defun infixtok} diff --git a/changelog b/changelog index 0f0140e..c9833aa 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20110515 tpd src/axiom-website/patches.html 20110515.01.tpd.patch +20110515 tpd src/interp/define.lisp treeshake compiler +20110515 tpd books/bookvol9 treeshake compiler 20110514 tpd src/axiom-website/patches.html 20110514.02.tpd.patch 20110514 tpd books/bookvol9 normalize argument names to top level functions 20110514 tpd src/axiom-website/patches.html 20110514.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 38da88e..8c41447 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3474,5 +3474,7 @@ books/bookvol9 treeshake compiler
books/bookvol* set textlength 400
20110514.02.tpd.patch books/bookvol9 normalize argument names to top level functions
+20110515.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/define.lisp.pamphlet b/src/interp/define.lisp.pamphlet index d7c669e..433445f 100644 --- a/src/interp/define.lisp.pamphlet +++ b/src/interp/define.lisp.pamphlet @@ -14,118 +14,6 @@ ;--% FUNCTIONS WHICH MUNCH ON == STATEMENTS ; -;compDefineAddSignature([op,:argl],signature,e) == -; (sig:= hasFullSignature(argl,signature,e)) and -; not ASSOC(['$,:sig],LASSOC('modemap,getProplist(op,e))) => -; declForm:= -; [":",[op,:[[":",x,m] for x in argl for m in rest sig]],first signature] -; [.,.,e]:= comp(declForm,$EmptyMode,e) -; e -; e - -(DEFUN |compDefineAddSignature| (G166127 |signature| |e|) - (PROG (|op| |argl| |sig| |declForm| |LETTMP#1|) - (declare (special |$EmptyMode|)) - (RETURN - (SEQ (PROGN - (SPADLET |op| (CAR G166127)) - (SPADLET |argl| (CDR G166127)) - (COND - ((AND (SPADLET |sig| - (|hasFullSignature| |argl| |signature| - |e|)) - (NULL (|assoc| (CONS '$ |sig|) - (LASSOC '|modemap| - (|getProplist| |op| |e|))))) - (SPADLET |declForm| - (CONS '|:| - (CONS (CONS |op| - (PROG (G166144) - (SPADLET G166144 NIL) - (RETURN - (DO - ((G166150 |argl| - (CDR G166150)) - (|x| NIL) - (G166151 (CDR |sig|) - (CDR G166151)) - (|m| NIL)) - ((OR (ATOM G166150) - (PROGN - (SETQ |x| - (CAR G166150)) - NIL) - (ATOM G166151) - (PROGN - (SETQ |m| - (CAR G166151)) - NIL)) - (NREVERSE0 G166144)) - (SEQ - (EXIT - (SETQ G166144 - (CONS - (CONS '|:| - (CONS |x| - (CONS |m| NIL))) - G166144)))))))) - (CONS (CAR |signature|) NIL)))) - (SPADLET |LETTMP#1| - (|comp| |declForm| |$EmptyMode| |e|)) - (SPADLET |e| (CADDR |LETTMP#1|)) |e|) - ('T |e|))))))) - -;hasFullSignature(argl,[target,:ml],e) == -; target => -; u:= [m or get(x,"mode",e) or return 'failed for x in argl for m in ml] -; u^='failed => [target,:u] - -(DEFUN |hasFullSignature| (|argl| G166171 |e|) - (PROG (|target| |ml| |u|) - (RETURN - (SEQ (PROGN - (SPADLET |target| (CAR G166171)) - (SPADLET |ml| (CDR G166171)) - (COND - (|target| - (PROGN - (SPADLET |u| - (PROG (G166185) - (SPADLET G166185 NIL) - (RETURN - (DO ((G166191 |argl| - (CDR G166191)) - (|x| NIL) - (G166192 |ml| (CDR G166192)) - (|m| NIL)) - ((OR (ATOM G166191) - (PROGN - (SETQ |x| (CAR G166191)) - NIL) - (ATOM G166192) - (PROGN - (SETQ |m| (CAR G166192)) - NIL)) - (NREVERSE0 G166185)) - (SEQ - (EXIT - (SETQ G166185 - (CONS - (OR |m| (|get| |x| '|mode| |e|) - (RETURN '|failed|)) - G166185)))))))) - (COND - ((NEQUAL |u| '|failed|) (CONS |target| |u|))))))))))) - -;addEmptyCapsuleIfNecessary(target,rhs) == -; MEMQ(KAR rhs,$SpecialDomainNames) => rhs -; ['add,rhs,['CAPSULE]] - -(DEFUN |addEmptyCapsuleIfNecessary| (|target| |rhs|) - (declare (special |$SpecialDomainNames|) (ignore |target|)) - (COND - ((member (KAR |rhs|) |$SpecialDomainNames|) |rhs|) - ('T (CONS '|add| (CONS |rhs| (CONS (CONS 'CAPSULE NIL) NIL)))))) ;getTargetFromRhs(lhs,rhs,e) == ; --undeclared target mode obtained from rhs expression