diff --git a/changelog b/changelog index 2123d38..f0ec2f6 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090823 tpd src/axiom-website/patches.html 20090823.08.tpd.patch +20090823 tpd src/interp/Makefile move macex.boot to macex.lisp +20090823 tpd src/interp/macex.lisp added, rewritten from macex.boot +20090823 tpd src/interp/macex.boot removed, rewritten to macex.lisp 20090823 tpd src/axiom-website/patches.html 20090823.07.tpd.patch 20090823 tpd src/interp/Makefile move lisplib.boot to lisplib.lisp 20090823 tpd src/interp/lisplib.lisp added, rewritten from lisplib.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index e1dc5c5..9d63b98 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1860,5 +1860,7 @@ int-top.lisp rewrite from boot to lisp
intfile.lisp rewrite from boot to lisp
20090823.07.tpd.patch lisplib.lisp rewrite from boot to lisp
+20090823.08.tpd.patch +macex.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 40e6c82..a62e467 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -4825,44 +4825,26 @@ ${MID}/cparse.lisp: ${IN}/cparse.lisp.pamphlet @ -\subsection{macex.boot} +\subsection{macex.lisp} <>= -${OUT}/macex.${O}: ${MID}/macex.clisp - @ echo 516 making ${OUT}/macex.${O} from ${MID}/macex.clisp - @ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/macex.clisp"' \ +${OUT}/macex.${O}: ${MID}/macex.lisp + @ echo 136 making ${OUT}/macex.${O} from ${MID}/macex.lisp + @ ( cd ${MID} ; \ + if [ -z "${NOISE}" ] ; then \ + echo '(progn (compile-file "${MID}/macex.lisp"' \ ':output-file "${OUT}/macex.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/macex.clisp"' \ + echo '(progn (compile-file "${MID}/macex.lisp"' \ ':output-file "${OUT}/macex.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ - fi + fi ) @ -<>= -${MID}/macex.clisp: ${IN}/macex.boot.pamphlet - @ echo 517 making ${MID}/macex.clisp from ${IN}/macex.boot.pamphlet +<>= +${MID}/macex.lisp: ${IN}/macex.lisp.pamphlet + @ echo 137 making ${MID}/macex.lisp from ${IN}/macex.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/macex.boot.pamphlet >macex.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "${MID}/macex.boot") (${BYE}))' \ - | ${BOOTSYS} ; \ - else \ - echo '(progn (boottran::boottocl "${MID}/macex.boot") (${BYE}))' \ - | ${BOOTSYS} >${TMP}/trace ; \ - fi ; \ - rm macex.boot ) - -@ -<>= -${DOC}/macex.boot.dvi: ${IN}/macex.boot.pamphlet - @echo 518 making ${DOC}/macex.boot.dvi from ${IN}/macex.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/macex.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} macex.boot ; \ - rm -f ${DOC}/macex.boot.pamphlet ; \ - rm -f ${DOC}/macex.boot.tex ; \ - rm -f ${DOC}/macex.boot ) + ${TANGLE} ${IN}/macex.lisp.pamphlet >macex.lisp ) @ @@ -6265,8 +6247,7 @@ clean: <> <> -<> -<> +<> <> diff --git a/src/interp/macex.boot.pamphlet b/src/interp/macex.boot.pamphlet deleted file mode 100644 index a275c59..0000000 --- a/src/interp/macex.boot.pamphlet +++ /dev/null @@ -1,211 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp macex.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -)package "BOOT" - ---% Macro expansion --- Functions to transform parse forms. --- --- Global variables: --- $pfMacros is an alist [[id, state, body-pform], ...] --- (set in newcompInit). --- state is one of: mbody, mparam, mlambda --- --- $macActive is a list of the bodies being expanded. --- $posActive is a list of the parse forms where the bodies came from. - --- Beware: the name macroExpand is used by the old compiler. -macroExpanded pf == - $macActive: local := [] - $posActive: local := [] - - macExpand pf - -macExpand pf == - pfWhere? pf => macWhere pf - pfLambda? pf => macLambda pf - pfMacro? pf => macMacro pf - - pfId? pf => macId pf - pfApplication? pf => macApplication pf - pfMapParts(function macExpand, pf) - -macWhere pf == - mac(pf,$pfMacros) where - mac(pf,$pfMacros) == - -- pfWhereContext is before pfWhereExpr - pfMapParts(function macExpand, pf) - -macLambda pf == - mac(pf,$pfMacros) where - mac(pf,$pfMacros) == - pfMapParts(function macExpand, pf) - -macLambdaParameterHandling( replist , pform ) == - pfLeaf? pform => [] - pfLambda? pform => -- remove ( identifier . replacement ) from assoclist - parlist := [ pfTypedId p for p in pf0LambdaArgs pform ] -- extract parameters - for par in [ pfIdSymbol par for par in parlist ] repeat - replist := AlistRemoveQ(par,replist) - replist - pfMLambda? pform => -- construct assoclist ( identifier . replacement ) - parlist := pf0MLambdaArgs pform -- extract parameter list - [[pfIdSymbol par ,:pfLeaf( pfAbSynOp par,GENSYM(),pfLeafPosition par)] for par in parlist ] - for p in pfParts pform repeat macLambdaParameterHandling( replist , p ) - -macSubstituteId( replist , pform ) == - ex := AlistAssocQ( pfIdSymbol pform , replist ) - ex => - RPLPAIR(pform,CDR ex) - pform - pform - -macSubstituteOuter( pform ) == - mac0SubstituteOuter( macLambdaParameterHandling( [] , pform ) , pform ) - -mac0SubstituteOuter( replist , pform ) == - pfId? pform => macSubstituteId( replist , pform ) - pfLeaf? pform => pform - pfLambda? pform => - tmplist := macLambdaParameterHandling( replist , pform ) - for p in pfParts pform repeat mac0SubstituteOuter( tmplist , p ) - pform - for p in pfParts pform repeat mac0SubstituteOuter( replist , p ) - pform - --- This function adds the appropriate definition and returns --- the original Macro pform. -macMacro pf == - lhs := pfMacroLhs pf - rhs := pfMacroRhs pf - not pfId? lhs => - ncSoftError (pfSourcePosition lhs, 'S2CM0001, [%pform lhs] ) - pf - sy := pfIdSymbol lhs - - mac0Define(sy, if pfMLambda? rhs then 'mlambda else 'mbody, macSubstituteOuter rhs) - - if pfNothing? rhs then pf else pfMacro(lhs, pfNothing()) - -mac0Define(sy, state, body) == - $pfMacros := cons([sy, state, body], $pfMacros) - --- Returns [state, body] or NIL. -mac0Get sy == - IFCDR ASSOC(sy, $pfMacros) - --- Returns [sy, state] or NIL. -mac0GetName body == - name := nil - for [sy,st,bd] in $pfMacros while not name repeat - if st = 'mlambda then - bd := pfMLambdaBody bd - EQ(bd, body) => name := [sy,st] - name - -macId pf == - sy := pfIdSymbol pf - not (got := mac0Get sy) => pf - [state, body] := got - - state = 'mparam => body -- expanded already - state = 'mlambda => pfCopyWithPos( body , pfSourcePosition pf ) -- expanded later - - pfCopyWithPos( mac0ExpandBody(body, pf, $macActive, $posActive) , pfSourcePosition pf ) - -macApplication pf == - pf := pfMapParts(function macExpand, pf) - - op := pfApplicationOp pf - not pfMLambda? op => pf - - args := pf0ApplicationArgs pf - mac0MLambdaApply(op, args, pf, $pfMacros) - -mac0MLambdaApply(mlambda, args, opf, $pfMacros) == - params := pf0MLambdaArgs mlambda - body := pfMLambdaBody mlambda - #args ^= #params => - pos := pfSourcePosition opf - ncHardError(pos,'S2CM0003, [#params,#args]) - for p in params for a in args repeat - not pfId? p => - pos := pfSourcePosition opf - ncHardError(pos, 'S2CM0004, [%pform p]) - mac0Define(pfIdSymbol p, 'mparam, a) - - mac0ExpandBody( body , opf, $macActive, $posActive) - -mac0ExpandBody(body, opf, $macActive, $posActive) == - MEMQ(body,$macActive) => - [.,pf] := $posActive - posn := pfSourcePosition pf - mac0InfiniteExpansion(posn, body, $macActive) - $macActive := [body, :$macActive] - $posActive := [opf, :$posActive] - macExpand body - -mac0InfiniteExpansion(posn, body, active) == - blist := [body, :active] - [fname, :rnames] := [name b for b in blist] where - name b == - got := mac0GetName b - not got => '"???" - [sy,st] := got - st = 'mlambda => CONCAT(PNAME sy, '"(...)") - PNAME sy - ncSoftError (posn, 'S2CM0005, _ - [ [:[n,'"==>"] for n in reverse rnames], fname, %pform body ] ) - - body -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/macex.lisp.pamphlet b/src/interp/macex.lisp.pamphlet new file mode 100644 index 0000000..b3a7216 --- /dev/null +++ b/src/interp/macex.lisp.pamphlet @@ -0,0 +1,546 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp macex.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= +(IN-PACKAGE "BOOT") + +;--% Macro expansion +;-- Functions to transform parse forms. +;-- +;-- Global variables: +;-- $pfMacros is an alist [[id, state, body-pform], ...] +;-- (set in newcompInit). +;-- state is one of: mbody, mparam, mlambda +;-- +;-- $macActive is a list of the bodies being expanded. +;-- $posActive is a list of the parse forms where the bodies came from. +; +;-- Beware: the name macroExpand is used by the old compiler. +;macroExpanded pf == +; $macActive: local := [] +; $posActive: local := [] +; +; macExpand pf + +(DEFUN |macroExpanded| (|pf|) + (PROG (|$posActive| |$macActive|) + (DECLARE (SPECIAL |$posActive| |$macActive|)) + (RETURN + (PROGN + (SETQ |$macActive| NIL) + (SETQ |$posActive| NIL) + (|macExpand| |pf|))))) + +;macExpand pf == +; pfWhere? pf => macWhere pf +; pfLambda? pf => macLambda pf +; pfMacro? pf => macMacro pf +; +; pfId? pf => macId pf +; pfApplication? pf => macApplication pf +; pfMapParts(function macExpand, pf) + +(DEFUN |macExpand| (|pf|) + (PROG () + (RETURN + (COND + ((|pfWhere?| |pf|) (|macWhere| |pf|)) + ((|pfLambda?| |pf|) (|macLambda| |pf|)) + ((|pfMacro?| |pf|) (|macMacro| |pf|)) + ((|pfId?| |pf|) (|macId| |pf|)) + ((|pfApplication?| |pf|) (|macApplication| |pf|)) + ('T (|pfMapParts| #'|macExpand| |pf|)))))) + +;macWhere pf == +; mac(pf,$pfMacros) where +; mac(pf,$pfMacros) == +; -- pfWhereContext is before pfWhereExpr +; pfMapParts(function macExpand, pf) + +(DEFUN |macWhere| (|pf|) + (PROG () + (DECLARE (SPECIAL |$pfMacros|)) + (RETURN (|macWhere,mac| |pf| |$pfMacros|)))) + +(DEFUN |macWhere,mac| (|pf| |$pfMacros|) + (DECLARE (SPECIAL |$pfMacros|)) + (PROG () (RETURN (|pfMapParts| #'|macExpand| |pf|)))) + +;macLambda pf == +; mac(pf,$pfMacros) where +; mac(pf,$pfMacros) == +; pfMapParts(function macExpand, pf) + +(DEFUN |macLambda| (|pf|) + (PROG () + (DECLARE (SPECIAL |$pfMacros|)) + (RETURN (|macLambda,mac| |pf| |$pfMacros|)))) + +(DEFUN |macLambda,mac| (|pf| |$pfMacros|) + (DECLARE (SPECIAL |$pfMacros|)) + (PROG () (RETURN (|pfMapParts| #'|macExpand| |pf|)))) + +;macLambdaParameterHandling( replist , pform ) == +; pfLeaf? pform => [] +; pfLambda? pform => -- remove ( identifier . replacement ) from assoclist +; parlist := [ pfTypedId p for p in pf0LambdaArgs pform ] -- extract parameters +; for par in [ pfIdSymbol par for par in parlist ] repeat +; replist := AlistRemoveQ(par,replist) +; replist +; pfMLambda? pform => -- construct assoclist ( identifier . replacement ) +; parlist := pf0MLambdaArgs pform -- extract parameter list +; [[pfIdSymbol par ,:pfLeaf( pfAbSynOp par,GENSYM(),pfLeafPosition par)] for par in parlist ] +; for p in pfParts pform repeat macLambdaParameterHandling( replist , p ) + +(DEFUN |macLambdaParameterHandling| (|replist| |pform|) + (PROG (|parlist|) + (RETURN + (COND + ((|pfLeaf?| |pform|) NIL) + ((|pfLambda?| |pform|) + (PROGN + (SETQ |parlist| + ((LAMBDA (|bfVar#2| |bfVar#1| |p|) + (LOOP + (COND + ((OR (ATOM |bfVar#1|) + (PROGN (SETQ |p| (CAR |bfVar#1|)) NIL)) + (RETURN (NREVERSE |bfVar#2|))) + ('T + (SETQ |bfVar#2| + (CONS (|pfTypedId| |p|) |bfVar#2|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))) + NIL (|pf0LambdaArgs| |pform|) NIL)) + ((LAMBDA (|bfVar#5| |par|) + (LOOP + (COND + ((OR (ATOM |bfVar#5|) + (PROGN (SETQ |par| (CAR |bfVar#5|)) NIL)) + (RETURN NIL)) + ('T + (SETQ |replist| (|AlistRemoveQ| |par| |replist|)))) + (SETQ |bfVar#5| (CDR |bfVar#5|)))) + ((LAMBDA (|bfVar#4| |bfVar#3| |par|) + (LOOP + (COND + ((OR (ATOM |bfVar#3|) + (PROGN (SETQ |par| (CAR |bfVar#3|)) NIL)) + (RETURN (NREVERSE |bfVar#4|))) + ('T + (SETQ |bfVar#4| + (CONS (|pfIdSymbol| |par|) |bfVar#4|)))) + (SETQ |bfVar#3| (CDR |bfVar#3|)))) + NIL |parlist| NIL) + NIL) + |replist|)) + ((|pfMLambda?| |pform|) + (PROGN + (SETQ |parlist| (|pf0MLambdaArgs| |pform|)) + ((LAMBDA (|bfVar#7| |bfVar#6| |par|) + (LOOP + (COND + ((OR (ATOM |bfVar#6|) + (PROGN (SETQ |par| (CAR |bfVar#6|)) NIL)) + (RETURN (NREVERSE |bfVar#7|))) + ('T + (SETQ |bfVar#7| + (CONS (CONS (|pfIdSymbol| |par|) + (|pfLeaf| (|pfAbSynOp| |par|) + (GENSYM) + (|pfLeafPosition| |par|))) + |bfVar#7|)))) + (SETQ |bfVar#6| (CDR |bfVar#6|)))) + NIL |parlist| NIL))) + ('T + ((LAMBDA (|bfVar#8| |p|) + (LOOP + (COND + ((OR (ATOM |bfVar#8|) + (PROGN (SETQ |p| (CAR |bfVar#8|)) NIL)) + (RETURN NIL)) + ('T (|macLambdaParameterHandling| |replist| |p|))) + (SETQ |bfVar#8| (CDR |bfVar#8|)))) + (|pfParts| |pform|) NIL)))))) + +;macSubstituteId( replist , pform ) == +; ex := AlistAssocQ( pfIdSymbol pform , replist ) +; ex => +; RPLPAIR(pform,CDR ex) +; pform +; pform + +(DEFUN |macSubstituteId| (|replist| |pform|) + (PROG (|ex|) + (RETURN + (PROGN + (SETQ |ex| (|AlistAssocQ| (|pfIdSymbol| |pform|) |replist|)) + (COND + (|ex| (PROGN (RPLPAIR |pform| (CDR |ex|)) |pform|)) + ('T |pform|)))))) + +;macSubstituteOuter( pform ) == +; mac0SubstituteOuter( macLambdaParameterHandling( [] , pform ) , pform ) + +(DEFUN |macSubstituteOuter| (|pform|) + (PROG () + (RETURN + (|mac0SubstituteOuter| (|macLambdaParameterHandling| NIL |pform|) + |pform|)))) + +;mac0SubstituteOuter( replist , pform ) == +; pfId? pform => macSubstituteId( replist , pform ) +; pfLeaf? pform => pform +; pfLambda? pform => +; tmplist := macLambdaParameterHandling( replist , pform ) +; for p in pfParts pform repeat mac0SubstituteOuter( tmplist , p ) +; pform +; for p in pfParts pform repeat mac0SubstituteOuter( replist , p ) +; pform + +(DEFUN |mac0SubstituteOuter| (|replist| |pform|) + (PROG (|tmplist|) + (RETURN + (COND + ((|pfId?| |pform|) (|macSubstituteId| |replist| |pform|)) + ((|pfLeaf?| |pform|) |pform|) + ((|pfLambda?| |pform|) + (PROGN + (SETQ |tmplist| + (|macLambdaParameterHandling| |replist| |pform|)) + ((LAMBDA (|bfVar#9| |p|) + (LOOP + (COND + ((OR (ATOM |bfVar#9|) + (PROGN (SETQ |p| (CAR |bfVar#9|)) NIL)) + (RETURN NIL)) + ('T (|mac0SubstituteOuter| |tmplist| |p|))) + (SETQ |bfVar#9| (CDR |bfVar#9|)))) + (|pfParts| |pform|) NIL) + |pform|)) + ('T + (PROGN + ((LAMBDA (|bfVar#10| |p|) + (LOOP + (COND + ((OR (ATOM |bfVar#10|) + (PROGN (SETQ |p| (CAR |bfVar#10|)) NIL)) + (RETURN NIL)) + ('T (|mac0SubstituteOuter| |replist| |p|))) + (SETQ |bfVar#10| (CDR |bfVar#10|)))) + (|pfParts| |pform|) NIL) + |pform|)))))) + +;-- This function adds the appropriate definition and returns +;-- the original Macro pform. +;macMacro pf == +; lhs := pfMacroLhs pf +; rhs := pfMacroRhs pf +; not pfId? lhs => +; ncSoftError (pfSourcePosition lhs, 'S2CM0001, [%pform lhs] ) +; pf +; sy := pfIdSymbol lhs +; +; mac0Define(sy, if pfMLambda? rhs then 'mlambda else 'mbody, macSubstituteOuter rhs) +; +; if pfNothing? rhs then pf else pfMacro(lhs, pfNothing()) + +(DEFUN |macMacro| (|pf|) + (PROG (|sy| |rhs| |lhs|) + (RETURN + (PROGN + (SETQ |lhs| (|pfMacroLhs| |pf|)) + (SETQ |rhs| (|pfMacroRhs| |pf|)) + (COND + ((NULL (|pfId?| |lhs|)) + (PROGN + (|ncSoftError| (|pfSourcePosition| |lhs|) 'S2CM0001 + (LIST (|%pform| |lhs|))) + |pf|)) + ('T + (PROGN + (SETQ |sy| (|pfIdSymbol| |lhs|)) + (|mac0Define| |sy| + (COND + ((|pfMLambda?| |rhs|) '|mlambda|) + ('T '|mbody|)) + (|macSubstituteOuter| |rhs|)) + (COND + ((|pfNothing?| |rhs|) |pf|) + ('T (|pfMacro| |lhs| (|pfNothing|))))))))))) + +;mac0Define(sy, state, body) == +; $pfMacros := cons([sy, state, body], $pfMacros) + +(DEFUN |mac0Define| (|sy| |state| |body|) + (PROG () + (DECLARE (SPECIAL |$pfMacros|)) + (RETURN + (SETQ |$pfMacros| (CONS (LIST |sy| |state| |body|) |$pfMacros|))))) + +;-- Returns [state, body] or NIL. +;mac0Get sy == +; IFCDR ASSOC(sy, $pfMacros) + +(DEFUN |mac0Get| (|sy|) + (PROG () + (DECLARE (SPECIAL |$pfMacros|)) + (RETURN (IFCDR (ASSOC |sy| |$pfMacros|))))) + +;-- Returns [sy, state] or NIL. +;mac0GetName body == +; name := nil +; for [sy,st,bd] in $pfMacros while not name repeat +; if st = 'mlambda then +; bd := pfMLambdaBody bd +; EQ(bd, body) => name := [sy,st] +; name + +(DEFUN |mac0GetName| (|body|) + (PROG (|bd| |ISTMP#2| |st| |ISTMP#1| |sy| |name|) + (DECLARE (SPECIAL |$pfMacros|)) + (RETURN + (PROGN + (SETQ |name| NIL) + ((LAMBDA (|bfVar#12| |bfVar#11|) + (LOOP + (COND + ((OR (ATOM |bfVar#12|) + (PROGN (SETQ |bfVar#11| (CAR |bfVar#12|)) NIL) + |name|) + (RETURN NIL)) + ('T + (AND (CONSP |bfVar#11|) + (PROGN + (SETQ |sy| (CAR |bfVar#11|)) + (SETQ |ISTMP#1| (CDR |bfVar#11|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |st| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (EQ (CDR |ISTMP#2|) NIL) + (PROGN + (SETQ |bd| (CAR |ISTMP#2|)) + 'T))))) + (PROGN + (COND + ((EQ |st| '|mlambda|) + (SETQ |bd| (|pfMLambdaBody| |bd|)))) + (COND + ((EQ |bd| |body|) + (SETQ |name| (LIST |sy| |st|)))))))) + (SETQ |bfVar#12| (CDR |bfVar#12|)))) + |$pfMacros| NIL) + |name|)))) + +;macId pf == +; sy := pfIdSymbol pf +; not (got := mac0Get sy) => pf +; [state, body] := got +; +; state = 'mparam => body -- expanded already +; state = 'mlambda => pfCopyWithPos( body , pfSourcePosition pf ) -- expanded later +; +; pfCopyWithPos( mac0ExpandBody(body, pf, $macActive, $posActive) , pfSourcePosition pf ) + +(DEFUN |macId| (|pf|) + (PROG (|body| |state| |got| |sy|) + (DECLARE (SPECIAL |$posActive| |$macActive|)) + (RETURN + (PROGN + (SETQ |sy| (|pfIdSymbol| |pf|)) + (COND + ((NULL (SETQ |got| (|mac0Get| |sy|))) |pf|) + ('T + (PROGN + (SETQ |state| (CAR |got|)) + (SETQ |body| (CADR |got|)) + (COND + ((EQ |state| '|mparam|) |body|) + ((EQ |state| '|mlambda|) + (|pfCopyWithPos| |body| (|pfSourcePosition| |pf|))) + ('T + (|pfCopyWithPos| + (|mac0ExpandBody| |body| |pf| |$macActive| + |$posActive|) + (|pfSourcePosition| |pf|))))))))))) + +;macApplication pf == +; pf := pfMapParts(function macExpand, pf) +; +; op := pfApplicationOp pf +; not pfMLambda? op => pf +; +; args := pf0ApplicationArgs pf +; mac0MLambdaApply(op, args, pf, $pfMacros) + +(DEFUN |macApplication| (|pf|) + (PROG (|args| |op|) + (DECLARE (SPECIAL |$pfMacros|)) + (RETURN + (PROGN + (SETQ |pf| (|pfMapParts| #'|macExpand| |pf|)) + (SETQ |op| (|pfApplicationOp| |pf|)) + (COND + ((NULL (|pfMLambda?| |op|)) |pf|) + ('T + (PROGN + (SETQ |args| (|pf0ApplicationArgs| |pf|)) + (|mac0MLambdaApply| |op| |args| |pf| |$pfMacros|)))))))) + +;mac0MLambdaApply(mlambda, args, opf, $pfMacros) == +; params := pf0MLambdaArgs mlambda +; body := pfMLambdaBody mlambda +; #args ^= #params => +; pos := pfSourcePosition opf +; ncHardError(pos,'S2CM0003, [#params,#args]) +; for p in params for a in args repeat +; not pfId? p => +; pos := pfSourcePosition opf +; ncHardError(pos, 'S2CM0004, [%pform p]) +; mac0Define(pfIdSymbol p, 'mparam, a) +; +; mac0ExpandBody( body , opf, $macActive, $posActive) + +(DEFUN |mac0MLambdaApply| (|mlambda| |args| |opf| |$pfMacros|) + (DECLARE (SPECIAL |$pfMacros|)) + (PROG (|pos| |body| |params|) + (DECLARE (SPECIAL |$posActive| |$macActive|)) + (RETURN + (PROGN + (SETQ |params| (|pf0MLambdaArgs| |mlambda|)) + (SETQ |body| (|pfMLambdaBody| |mlambda|)) + (COND + ((NOT (EQL (LENGTH |args|) (LENGTH |params|))) + (PROGN + (SETQ |pos| (|pfSourcePosition| |opf|)) + (|ncHardError| |pos| 'S2CM0003 + (LIST (LENGTH |params|) (LENGTH |args|))))) + ('T + (PROGN + ((LAMBDA (|bfVar#13| |p| |bfVar#14| |a|) + (LOOP + (COND + ((OR (ATOM |bfVar#13|) + (PROGN (SETQ |p| (CAR |bfVar#13|)) NIL) + (ATOM |bfVar#14|) + (PROGN (SETQ |a| (CAR |bfVar#14|)) NIL)) + (RETURN NIL)) + ('T + (COND + ((NULL (|pfId?| |p|)) + (PROGN + (SETQ |pos| (|pfSourcePosition| |opf|)) + (|ncHardError| |pos| 'S2CM0004 + (LIST (|%pform| |p|))))) + ('T + (|mac0Define| (|pfIdSymbol| |p|) '|mparam| |a|))))) + (SETQ |bfVar#13| (CDR |bfVar#13|)) + (SETQ |bfVar#14| (CDR |bfVar#14|)))) + |params| NIL |args| NIL) + (|mac0ExpandBody| |body| |opf| |$macActive| |$posActive|)))))))) + +;mac0ExpandBody(body, opf, $macActive, $posActive) == +; MEMQ(body,$macActive) => +; [.,pf] := $posActive +; posn := pfSourcePosition pf +; mac0InfiniteExpansion(posn, body, $macActive) +; $macActive := [body, :$macActive] +; $posActive := [opf, :$posActive] +; macExpand body + +(DEFUN |mac0ExpandBody| (|body| |opf| |$macActive| |$posActive|) + (DECLARE (SPECIAL |$macActive| |$posActive|)) + (PROG (|posn| |pf|) + (DECLARE (SPECIAL |$posActive| |$macActive|)) + (RETURN + (COND + ((MEMQ |body| |$macActive|) + (PROGN + (SETQ |pf| (CADR |$posActive|)) + (SETQ |posn| (|pfSourcePosition| |pf|)) + (|mac0InfiniteExpansion| |posn| |body| |$macActive|))) + ('T + (PROGN + (SETQ |$macActive| (CONS |body| |$macActive|)) + (SETQ |$posActive| (CONS |opf| |$posActive|)) + (|macExpand| |body|))))))) + +;mac0InfiniteExpansion(posn, body, active) == +; blist := [body, :active] +; [fname, :rnames] := [name b for b in blist] where +; name b == +; got := mac0GetName b +; not got => '"???" +; [sy,st] := got +; st = 'mlambda => CONCAT(PNAME sy, '"(...)") +; PNAME sy +; ncSoftError (posn, 'S2CM0005, _ +; [ [:[n,'"==>"] for n in reverse rnames], fname, %pform body ] ) +; +; body +(DEFUN |mac0InfiniteExpansion| (|posn| |body| |active|) + (PROG (|rnames| |fname| |LETTMP#1| |blist|) + (RETURN + (PROGN + (SETQ |blist| (CONS |body| |active|)) + (SETQ |LETTMP#1| + ((LAMBDA (|bfVar#16| |bfVar#15| |b|) + (LOOP + (COND + ((OR (ATOM |bfVar#15|) + (PROGN (SETQ |b| (CAR |bfVar#15|)) NIL)) + (RETURN (NREVERSE |bfVar#16|))) + ('T + (SETQ |bfVar#16| + (CONS (|mac0InfiniteExpansion,name| |b|) + |bfVar#16|)))) + (SETQ |bfVar#15| (CDR |bfVar#15|)))) + NIL |blist| NIL)) + (SETQ |fname| (CAR |LETTMP#1|)) + (SETQ |rnames| (CDR |LETTMP#1|)) + (|ncSoftError| |posn| 'S2CM0005 + (LIST ((LAMBDA (|bfVar#18| |bfVar#17| |n|) + (LOOP + (COND + ((OR (ATOM |bfVar#17|) + (PROGN (SETQ |n| (CAR |bfVar#17|)) NIL)) + (RETURN (NREVERSE |bfVar#18|))) + ('T + (SETQ |bfVar#18| + (APPEND (REVERSE (LIST |n| "==>")) + |bfVar#18|)))) + (SETQ |bfVar#17| (CDR |bfVar#17|)))) + NIL (REVERSE |rnames|) NIL) + |fname| (|%pform| |body|))) + |body|)))) + +(DEFUN |mac0InfiniteExpansion,name| (|b|) + (PROG (|st| |sy| |got|) + (RETURN + (PROGN + (SETQ |got| (|mac0GetName| |b|)) + (COND + ((NULL |got|) "???") + ('T + (PROGN + (SETQ |sy| (CAR |got|)) + (SETQ |st| (CADR |got|)) + (COND + ((EQ |st| '|mlambda|) (CONCAT (PNAME |sy|) "(...)")) + ('T (PNAME |sy|)))))))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}