diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index cc03f5a..93f03d1 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1034,6 +1034,167 @@ and mode. (t (|compOrCroak| x m e))))) @ +Given: +\begin{verbatim} +CohenCategory(): Category == SetCategory with + + kind:(CExpr)->Boolean + operand:(CExpr,Integer)->CExpr + numberOfOperand:(CExpr)->Integer + construct:(CExpr,CExpr)->CExpr + +\end{verbatim} +the resulting call looks like: +\begin{verbatim} + (|compOrCroak| + (DEF (|CohenCategory|) + ((|Category|)) + (NIL) + (|Join| + (|SetCategory|) + (CATEGORY |package| + (SIGNATURE |kind| ((|Boolean|) |CExpr|)) + (SIGNATURE |operand| (|CExpr| |CExpr| (|Integer|))) + (SIGNATURE |numberOfOperand| ((|Integer|) |CExpr|)) + (SIGNATURE |construct| (|CExpr| |CExpr| |CExpr|))))) + |$EmptyMode| + ((( + (|$DomainsInScope| + (FLUID . |true|) + (|special| |$EmptyMode| |$NoValueMode|)))))) +\end{verbatim} + +This compiler call expects the first argument {\tt x} +to be a {\tt DEF} form to compile, +The second argument, {\tt m}, is the mode. +The third argument, {\tt e}, is the environment. + +In the call to {\tt compOrCroak1} the fourth argument {\tt comp} +is the function to call. + +\defun{compOrCroak}{compOrCroak} +\calls{compOrCroak}{compOrCroak1} +<>= +(defun |compOrCroak| (x m e) + (|compOrCroak1| x m e '|comp|)) + +@ + +Which results in the call: +\begin{verbatim} +(|compOrCroak1| + (DEF (|CohenCategory|) + ((|Category|)) + (NIL) + (|Join| + (|SetCategory|) + (CATEGORY |package| + (SIGNATURE |kind| ((|Boolean|) |CExpr|)) + (SIGNATURE |operand| (|CExpr| |CExpr| (|Integer|))) + (SIGNATURE |numberOfOperand| ((|Integer|) |CExpr|)) + (SIGNATURE |construct| (|CExpr| |CExpr| |CExpr|))))) + |$EmptyMode| + (((( + |$DomainsInScope| + (FLUID . |true|) + (|special| |$EmptyMode| |$NoValueMode|))))) + |comp|) +\end{verbatim} +\defun{compOrCroak1}{compOrCroak1} +\calls{compOrCroak1}{compOrCroak1,fn} +This call expects the first argument {\tt x} +to be a {\tt DEF} form to compile, +The second argument, {\tt m}, is the mode. +The third argument, {\tt e}, is the environment. +The fourth argument {\tt comp} is the function to call. +<>= +(defun |compOrCroak1| (x m e compFn) + (|compOrCroak1,fn| x m e nil nil compFn)) + +@ + +This results in a call to the inner function with +\begin{verbatim} +(|compOrCroak1,fn| + (DEF (|CohenCategory|) + ((|Category|)) + (NIL) + (|Join| + (|SetCategory|) + (CATEGORY |package| + (SIGNATURE |kind| ((|Boolean|) |CExpr|)) + (SIGNATURE |operand| (|CExpr| |CExpr| (|Integer|))) + (SIGNATURE |numberOfOperand| ((|Integer|) |CExpr|)) + (SIGNATURE |construct| (|CExpr| |CExpr| |CExpr|))))) + |$EmptyMode| + (((( + |$DomainsInScope| + (FLUID . |true|) + (|special| |$EmptyMode| |$NoValueMode|))))) + NIL + NIL + |comp|) +\end{verbatim} +The inner function augments the environment with information +from the compiler stack {\tt \$compStack} and +{\tt \$compErrorMessageStack}. + +\defun{compOrCroak1,fn}{compOrCroak1,fn} +\calls{compOrCroak1,fn}{comp} +\calls{compOrCroak1,fn}{compOrCroak1,compactify} +\calls{compOrCroak1,fn}{stackSemanticError} +\calls{compOrCroak1,fn}{mkErrorExpr} +\calls{compOrCroak1,fn}{displaySemanticErrors} +\calls{compOrCroak1,fn}{say} +\calls{compOrCroak1,fn}{displayComp} +\calls{compOrCroak1,fn}{userError} +\usesdollar{compOrCroak1,fn}{compStack} +\usesdollar{compOrCroak1,fn}{compErrorMessageStack} +\usesdollar{compOrCroak1,fn}{level} +\usesdollar{compOrCroak1,fn}{s} +\usesdollar{compOrCroak1,fn}{scanIfTrue} +\usesdollar{compOrCroak1,fn}{exitModeStack} +\catches{compOrCroak1,fn}{compOrCroak} +<>= +(defun |compOrCroak1,fn| (x m e |$compStack| |$compErrorMessageStack| compFn) + (declare (special |$compStack| |$compErrorMessageStack|)) + (prog (td errorMessage) + (declare (special |$level| |$s| |$scanIfTrue| |$exitModeStack|)) + (return + (seq + (if + (setq td (catch '|compOrCroak| (funcall compFn x m e))) + (exit td)) + (setq |$compStack| (cons (list x m e |$exitModeStack|) |$compStack|)) + (setq |$s| (|compOrCroak1,compactify| |$compStack|)) + (setq |$level| (|#| |$s|)) + (setq errorMessage + (if |$compErrorMessageStack| + (car |$compErrorMessageStack|) + '|unspecified error|)) + (if |$scanIfTrue| + (exit + (seq + (|stackSemanticError| errorMessage (|mkErrorExpr| |$level|)) + (exit (list '|failedCompilation| m e ))))) + (|displaySemanticErrors|) + (say "****** comp fails at level " |$level| " with expression: ******") + (|displayComp| |$level|) + (exit (|userError| errorMessage)))))) + +@ + +\defun{compOrCroak1,compactify}{compOrCroak1,compactify} +\calls{compOrCroak1,compactify}{compOrCroak1,compactify} +<>= +(defun |compOrCroak1,compactify| (al) + (cond + ((null al) nil) + ((lassoc (caar al) (cdr al)) (|compOrCroak1,compactify| (cdr al))) + (t (cons (car al) (|compOrCroak1,compactify| (cdr al)))))) + +@ + \defun{ncINTERPFILE}{Compiler/Interpreter interface} \calls{ncINTERPFILE}{SpadInterpretStream(5)} \usesdollar{ncINTERPFILE}{EchoLines} @@ -1238,6 +1399,10 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> +<> +<> +<> <> <> diff --git a/changelog b/changelog index e5b701f..7e5d8a2 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20100829 tpd src/axiom-website/patches.html 20100829.02.tpd.patch +20100829 tpd src/interp/compiler.lisp treeshake compiler +20100829 tpd books/bookvol9 treeshake compiler 20100829 tpd src/axiom-website/patches.html 20100829.01.tpd.patch 20100829 tpd Makefile always run help extractions in parallel 20100828 tpd src/axiom-website/patches.html 20100828.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 720a686..d1286d1 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3091,5 +3091,7 @@ src/interp/Makefile remove nspadaux,mark,pspad1,pspad2
books/bookvol9 treeshake the compiler
20100829.01.tpd.patch Makefile always run help extractions in parallel
+20100829.02.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/compiler.lisp.pamphlet b/src/interp/compiler.lisp.pamphlet index fbe1b9b..d8d2602 100644 --- a/src/interp/compiler.lisp.pamphlet +++ b/src/interp/compiler.lisp.pamphlet @@ -33,177 +33,6 @@ (CATCH '|compUniquely| (|comp| |x| |m| |e|)))))) @ -Given: -\begin{verbatim} -CohenCategory(): Category == SetCategory with - - kind:(CExpr)->Boolean - ++ kind(CExpr) - operand:(CExpr,Integer)->CExpr - ++ operand:(CExpr,Integer) - numberOfOperand:(CExpr)->Integer - ++ numberOfOperand:(CExpr)->Integer - construct:(CExpr,CExpr)->CExpr - ++ construct:(CExpr,CExpr)->CExpr - -\end{verbatim} -the resulting call looks like: -\begin{verbatim} - (|compOrCroak| - (DEF (|CohenCategory|) - ((|Category|)) - (NIL) - (|Join| - (|SetCategory|) - (CATEGORY |package| - (SIGNATURE |kind| ((|Boolean|) |CExpr|)) - (SIGNATURE |operand| (|CExpr| |CExpr| (|Integer|))) - (SIGNATURE |numberOfOperand| ((|Integer|) |CExpr|)) - (SIGNATURE |construct| (|CExpr| |CExpr| |CExpr|))))) - |$EmptyMode| - ((( - (|$DomainsInScope| - (FLUID . |true|) - (|special| |$EmptyMode| |$NoValueMode|)))))) -\end{verbatim} - -This is compiler call expects the first argument {\tt x} -to be a {\tt DEF} form to compile, -The second argument, {\tt m}, is the mode. -The third argument, {\tt e}, is the environment. - -In the call to {\tt compOrCroak1} the fourth argument {\tt comp} -is the function to call. -\subsection{compOrCroak} -<<*>>= -;compOrCroak(x,m,e) == compOrCroak1(x,m,e,'comp) - -(DEFUN |compOrCroak| (|x| |m| |e|) - (|compOrCroak1| |x| |m| |e| '|comp|)) - -@ -Which results in the call: -\begin{verbatim} -(|compOrCroak1| - (DEF (|CohenCategory|) - ((|Category|)) - (NIL) - (|Join| - (|SetCategory|) - (CATEGORY |package| - (SIGNATURE |kind| ((|Boolean|) |CExpr|)) - (SIGNATURE |operand| (|CExpr| |CExpr| (|Integer|))) - (SIGNATURE |numberOfOperand| ((|Integer|) |CExpr|)) - (SIGNATURE |construct| (|CExpr| |CExpr| |CExpr|))))) - |$EmptyMode| - (((( - |$DomainsInScope| - (FLUID . |true|) - (|special| |$EmptyMode| |$NoValueMode|))))) - |comp|) -\end{verbatim} -This results into a call to the inner function -\begin{verbatim} -(|compOrCroak1,fn| - (DEF (|CohenCategory|) - ((|Category|)) - (NIL) - (|Join| - (|SetCategory|) - (CATEGORY |package| - (SIGNATURE |kind| ((|Boolean|) |CExpr|)) - (SIGNATURE |operand| (|CExpr| |CExpr| (|Integer|))) - (SIGNATURE |numberOfOperand| ((|Integer|) |CExpr|)) - (SIGNATURE |construct| (|CExpr| |CExpr| |CExpr|))))) - |$EmptyMode| - (((( - |$DomainsInScope| - (FLUID . |true|) - (|special| |$EmptyMode| |$NoValueMode|))))) - NIL - NIL - |comp|) -\end{verbatim} -This is compiler call expects the first argument {\tt x} -to be a {\tt DEF} form to compile, -The second argument, {\tt m}, is the mode. -The third argument, {\tt e}, is the environment. -The fourth argument {\tt comp} is the function to call. - -The inner function augments the environment with information -from the compiler stack {\tt \$compStack} and -{\tt \$compErrorMessageStack}. - -\subsection{compOrCroak1} -<<*>>= -;compOrCroak1(x,m,e,compFn) == -; fn(x,m,e,nil,nil,compFn) where -; fn(x,m,e,$compStack,$compErrorMessageStack,compFn) == -; T:= CATCH("compOrCroak",FUNCALL(compFn,x,m,e)) => T -; --stackAndThrow here and moan in UT LISP K does the appropriate THROW -; $compStack:= [[x,m,e,$exitModeStack],:$compStack] -; $s:= -; compactify $compStack where -; compactify al == -; null al => nil -; LASSOC(first first al,rest al) => compactify rest al -; [first al,:compactify rest al] -; $level:= #$s -; errorMessage:= -; if $compErrorMessageStack -; then first $compErrorMessageStack -; else "unspecified error" -; $scanIfTrue => -; stackSemanticError(errorMessage,mkErrorExpr $level) -; ["failedCompilation",m,e] -; displaySemanticErrors() -; SAY("****** comp fails at level ",$level," with expression: ******") -; displayComp $level -; userError errorMessage - -(DEFUN |compOrCroak1,compactify| (|al|) - (SEQ (IF (NULL |al|) (EXIT NIL)) - (IF (LASSOC (CAR (CAR |al|)) (CDR |al|)) - (EXIT (|compOrCroak1,compactify| (CDR |al|)))) - (EXIT (CONS (CAR |al|) (|compOrCroak1,compactify| (CDR |al|)))))) - -(DEFUN |compOrCroak1,fn| - (|x| |m| |e| |$compStack| |$compErrorMessageStack| |compFn|) - (DECLARE (SPECIAL |$compStack| |$compErrorMessageStack|)) - (PROG (T$ |errorMessage|) - (DECLARE (SPECIAL |$level| |$s| |$scanIfTrue| |$exitModeStack|)) - (RETURN - (SEQ (IF (SPADLET T$ - (CATCH '|compOrCroak| - (FUNCALL |compFn| |x| |m| |e|))) - (EXIT T$)) - (SPADLET |$compStack| - (CONS (CONS |x| - (CONS |m| - (CONS |e| - (CONS |$exitModeStack| NIL)))) - |$compStack|)) - (SPADLET |$s| (|compOrCroak1,compactify| |$compStack|)) - (SPADLET |$level| (|#| |$s|)) - (SPADLET |errorMessage| - (IF |$compErrorMessageStack| - (CAR |$compErrorMessageStack|) - '|unspecified error|)) - (IF |$scanIfTrue| - (EXIT (SEQ (|stackSemanticError| |errorMessage| - (|mkErrorExpr| |$level|)) - (EXIT (CONS '|failedCompilation| - (CONS |m| (CONS |e| NIL))))))) - (|displaySemanticErrors|) - (SAY "****** comp fails at level " |$level| - " with expression: ******") - (|displayComp| |$level|) - (EXIT (|userError| |errorMessage|)))))) - -(DEFUN |compOrCroak1| (|x| |m| |e| |compFn|) - (|compOrCroak1,fn| |x| |m| |e| NIL NIL |compFn|)) - -@ \subsection{tc} <<*>>= ;tc() ==