aboutsummaryrefslogtreecommitdiff
path: root/src/interp/macex.boot.pamphlet
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/macex.boot.pamphlet')
-rw-r--r--src/interp/macex.boot.pamphlet211
1 files changed, 211 insertions, 0 deletions
diff --git a/src/interp/macex.boot.pamphlet b/src/interp/macex.boot.pamphlet
new file mode 100644
index 00000000..a275c59b
--- /dev/null
+++ b/src/interp/macex.boot.pamphlet
@@ -0,0 +1,211 @@
+\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}
+<<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.
+
+@
+<<*>>=
+<<license>>
+
+)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}