diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 03e9c5c..70f91a9 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1526,6 +1526,42 @@ preferred to the underlying representation -- RDJ 9/12/83 (list '|/throwAway| (|getmode| argf e) e ))))))) @ + +\defun{compColonInside}{compColonInside} +\calls{compColonInside}{addDomain} +\calls{compColonInside}{comp} +\calls{compColonInside}{coerce} +\calls{compColonInside}{stackWarning} +\calls{compColonInside}{opOf} +\calls{compColonInside}{stackSemanticError} +\usesdollar{compColonInside}{newCompilerUnionFlag} +\usesdollar{compColonInside}{EmptyMode} +<>= +(defun |compColonInside| (x m e mprime) + (let (mpp warningMessage td tprime failed) + (declare (special |$newCompilerUnionFlag| |$EmptyMode|)) + (setq e (|addDomain| mprime e)) + (when (setq td (|comp| x |$EmptyMode| e)) + (cond + ((equal (setq mpp (CADR td)) mprime) + (setq warningMessage + (list '|:| mprime '| -- should replace by @|)))) + (setq td (list (car td) mprime (caddr td))) + (when (setq tprime (|coerce| td m)) + (cond + (warningMessage (|stackWarning| warningMessage)) + ((and |$newCompilerUnionFlag| (eq (|opOf| mpp) '|Union|)) + (setq tprime + (|stackSemanticError| + (list '|cannot pretend | x '| of mode | mpp '| to mode | mprime ) + nil))) + (t + (|stackWarning| + (list '|:| mprime '| -- should replace by pretend|)))) + tprime)))) + +@ + \defun{compAtom}{compAtom} \begin{verbatim} ;compAtom(x,m,e) == @@ -2387,6 +2423,7 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 4bf14ce..f9c1e54 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20100910 tpd src/axiom-website/patches.html 20100910.02.tpd.patch +20100910 tpd src/interp/compiler.lisp treeshake compiler +20100910 tpd books/bookvol9 treeshake compiler 20100910 tpd src/axiom-website/patches.html 20100910.01.tpd.patch 20100910 tpd src/interp/compiler.lisp treeshake compiler 20100910 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index a5eac0d..2a466c5 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3113,5 +3113,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20100910.01.tpd.patch books/bookvol9 treeshake compiler
+20100910.02.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/compiler.lisp.pamphlet b/src/interp/compiler.lisp.pamphlet index fb72e44..9d13682 100644 --- a/src/interp/compiler.lisp.pamphlet +++ b/src/interp/compiler.lisp.pamphlet @@ -4035,62 +4035,6 @@ An angry JHD - August 15th., 1984 |T'|))))))))) @ -\subsection{compColonInside} -<<*>>= -;compColonInside(x,m,e,m') == -; e:= addDomain(m',e) -; T:= comp(x,$EmptyMode,e) or return nil -; if (m'':=T.mode)=m' then warningMessage:= [":",m'," -- should replace by @"] -; T:= [T.expr,m',T.env] -; T':= coerce(T,m) => -; if warningMessage -; then stackWarning warningMessage -; else -; $newCompilerUnionFlag and opOf(m'') = 'Union => -; return -; stackSemanticError(["cannot pretend ",x," of mode ",m''," to mode ",m'],nil) -; stackWarning [":",m'," -- should replace by pretend"] -; T' - -(DEFUN |compColonInside| (|x| |m| |e| |m'|) - (PROG (|m''| |warningMessage| T$ |T'|) - (declare (special |$newCompilerUnionFlag| |$EmptyMode|)) - (RETURN - (PROGN - (SPADLET |e| (|addDomain| |m'| |e|)) - (SPADLET T$ (OR (|comp| |x| |$EmptyMode| |e|) (RETURN NIL))) - (COND - ((BOOT-EQUAL (SPADLET |m''| (CADR T$)) |m'|) - (SPADLET |warningMessage| - (CONS '|:| - (CONS |m'| - (CONS '| -- should replace by @| NIL)))))) - (SPADLET T$ (CONS (CAR T$) (CONS |m'| (CONS (CADDR T$) NIL)))) - (COND - ((SPADLET |T'| (|coerce| T$ |m|)) - (PROGN - (COND - (|warningMessage| (|stackWarning| |warningMessage|)) - ((AND |$newCompilerUnionFlag| - (BOOT-EQUAL (|opOf| |m''|) '|Union|)) - (RETURN - (|stackSemanticError| - (CONS '|cannot pretend | - (CONS |x| - (CONS '| of mode | - (CONS |m''| - (CONS '| to mode | - (CONS |m'| NIL)))))) - NIL))) - ('T - (|stackWarning| - (CONS '|:| - (CONS |m'| - (CONS '| -- should replace by pretend| - NIL)))))) - |T'|))))))) - -@ \subsection{compIs} <<*>>= ;compIs(["is",a,b],m,e) ==