1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. 2-- All rights reserved. 3-- 4-- Redistribution and use in source and binary forms, with or without 5-- modification, are permitted provided that the following conditions are 6-- met: 7-- 8-- - Redistributions of source code must retain the above copyright 9-- notice, this list of conditions and the following disclaimer. 10-- 11-- - Redistributions in binary form must reproduce the above copyright 12-- notice, this list of conditions and the following disclaimer in 13-- the documentation and/or other materials provided with the 14-- distribution. 15-- 16-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the 17-- names of its contributors may be used to endorse or promote products 18-- derived from this software without specific prior written permission. 19-- 20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 32 33)package "BOOT" 34 35--% Macro expansion 36-- Functions to transform parse forms. 37-- 38-- Global variables: 39-- $pfMacros is an alist [[id, state, body-pform], ...] 40-- (set in newcompInit). 41-- state is one of: mbody, mparam, mlambda 42-- 43-- $macActive is a list of the bodies being expanded. 44-- $posActive is a list of the parse forms where the bodies came from. 45 46-- Beware: the name macroExpand is used by the old compiler. 47macroExpanded pf == 48 $macActive: local := [] 49 $posActive: local := [] 50 51 macExpand pf 52 53macExpand pf == 54 pfWhere? pf => macWhere pf 55 pfLambda? pf => macLambda pf 56 pfMacro? pf => macMacro pf 57 58 pfId? pf => macId pf 59 pfApplication? pf => macApplication pf 60 pfMapParts(function macExpand, pf) 61 62macWhere pf == 63 mac(pf,$pfMacros) where 64 mac(pf,$pfMacros) == 65 -- pfWhereContext is before pfWhereExpr 66 pfMapParts(function macExpand, pf) 67 68macLambda pf == 69 mac(pf,$pfMacros) where 70 mac(pf,$pfMacros) == 71 pfMapParts(function macExpand, pf) 72 73macLambdaParameterHandling( replist , pform ) == 74 pfLeaf? pform => [] 75 pfLambda? pform => -- remove ( identifier . replacement ) from assoclist 76 parlist := [ pfTypedId p for p in pf0LambdaArgs pform ] -- extract parameters 77 for par in [ pfIdSymbol par for par in parlist ] repeat 78 replist := AlistRemoveQ(par,replist) 79 replist 80 pfMLambda? pform => -- construct assoclist ( identifier . replacement ) 81 parlist := pf0MLambdaArgs pform -- extract parameter list 82 [[pfIdSymbol par ,:pfLeaf( pfAbSynOp par,GENSYM(),pfLeafPosition par)] for par in parlist ] 83 for p in pfParts pform repeat macLambdaParameterHandling( replist , p ) 84 85macSubstituteId( replist , pform ) == 86 ex := AlistAssocQ( pfIdSymbol pform , replist ) 87 ex => 88 RPLPAIR(pform, rest ex) 89 pform 90 pform 91 92macSubstituteOuter( pform ) == 93 mac0SubstituteOuter( macLambdaParameterHandling( [] , pform ) , pform ) 94 95mac0SubstituteOuter( replist , pform ) == 96 pfId? pform => macSubstituteId( replist , pform ) 97 pfLeaf? pform => pform 98 pfLambda? pform => 99 tmplist := macLambdaParameterHandling( replist , pform ) 100 for p in pfParts pform repeat mac0SubstituteOuter( tmplist , p ) 101 pform 102 for p in pfParts pform repeat mac0SubstituteOuter( replist , p ) 103 pform 104 105-- This function adds the appropriate definition and returns 106-- the original Macro pform. 107macMacro pf == 108 lhs := pfMacroLhs pf 109 rhs := pfMacroRhs pf 110 not pfId? lhs => 111 ncSoftError (pfSourcePosition lhs, 'S2CM0001, [%pform lhs] ) 112 pf 113 sy := pfIdSymbol lhs 114 115 mac0Define(sy, if pfMLambda? rhs then 'mlambda else 'mbody, macSubstituteOuter rhs) 116 117 if pfNothing? rhs then pf else pfMacro(lhs, pfNothing()) 118 119mac0Define(sy, state, body) == 120 $pfMacros := cons([sy, state, body], $pfMacros) 121 122-- Returns [state, body] or NIL. 123mac0Get sy == 124 IFCDR ASSOC(sy, $pfMacros) 125 126-- Returns [sy, state] or NIL. 127mac0GetName body == 128 name := nil 129 for [sy,st,bd] in $pfMacros while not name repeat 130 if st = 'mlambda then 131 bd := pfMLambdaBody bd 132 EQ(bd, body) => name := [sy,st] 133 name 134 135macId pf == 136 sy := pfIdSymbol pf 137 not (got := mac0Get sy) => pf 138 [state, body] := got 139 140 state = 'mparam => body -- expanded already 141 state = 'mlambda => pfCopyWithPos( body , pfSourcePosition pf ) -- expanded later 142 143 pfCopyWithPos( mac0ExpandBody(body, pf, $macActive, $posActive) , pfSourcePosition pf ) 144 145macApplication pf == 146 pf := pfMapParts(function macExpand, pf) 147 148 op := pfApplicationOp pf 149 not pfMLambda? op => pf 150 151 args := pf0ApplicationArgs pf 152 mac0MLambdaApply(op, args, pf, $pfMacros) 153 154mac0MLambdaApply(mlambda, args, opf, $pfMacros) == 155 params := pf0MLambdaArgs mlambda 156 body := pfMLambdaBody mlambda 157 #args ~= #params => 158 pos := pfSourcePosition opf 159 ncHardError(pos,'S2CM0003, [#params,#args]) 160 for p in params for a in args repeat 161 not pfId? p => 162 pos := pfSourcePosition opf 163 ncHardError(pos, 'S2CM0004, [%pform p]) 164 mac0Define(pfIdSymbol p, 'mparam, a) 165 166 mac0ExpandBody( body , opf, $macActive, $posActive) 167 168mac0ExpandBody(body, opf, $macActive, $posActive) == 169 MEMQ(body,$macActive) => 170 [.,pf] := $posActive 171 posn := pfSourcePosition pf 172 mac0InfiniteExpansion(posn, body, $macActive) 173 $macActive := [body, :$macActive] 174 $posActive := [opf, :$posActive] 175 macExpand body 176 177mac0InfiniteExpansion(posn, body, active) == 178 blist := [body, :active] 179 [fname, :rnames] := [name b for b in blist] where 180 name b == 181 got := mac0GetName b 182 not got => '"???" 183 [sy,st] := got 184 st = 'mlambda => CONCAT(PNAME sy, '"(...)") 185 PNAME sy 186 ncSoftError (posn, 'S2CM0005, _ 187 [ [:[n,'"==>"] for n in reverse rnames], fname, %pform body ] ) 188 189 body 190