\documentclass{article} \usepackage{axiom} \title{\File{src/interp/apply.boot} Papmhlet} \author{The Axiom Team} \begin{document} \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" oldCompilerAutoloadOnceTrigger() == nil compAtomWithModemap(x,m,e,v) == Tl := [[transImplementation(x,map,fn),target,e] for map in v | map is [[.,target],[.,fn]]] => --accept only monadic operators T:= or/[t for (t:= [.,target,.]) in Tl | modeEqual(m,target)] => T 1=#(Tl:= [y for t in Tl | (y:= convert(t,m))]) => first Tl 0<#Tl and m=$NoValueMode => first Tl nil transImplementation(op,map,fn) == --+ fn := genDeltaEntry [op,:map] fn is ["XLAM",:.] => [fn] ["call",fn] compApply(sig,varl,body,argl,m,e) == argTl:= [[.,.,e]:= comp(x,$EmptyMode,e) for x in argl] contour:= [Pair(x,[["mode",m'],["value",removeEnv comp(a,m',e)]]) for x in varl for m' in sig.source for a in argl] code:= [["LAMBDA",varl,body'],:[T.expr for T in argTl]] m':= resolve(m,sig.target) body':= (comp(body,m',addContour(contour,e))).expr [code,m',e] compToApply(op,argl,m,e) == T:= compNoStacking(op,$EmptyMode,e) or return nil m1:= T.mode T.expr is ["QUOTE", =m1] => nil compApplication(op,argl,m,T.env,T) compApplication(op,argl,m,e,T) == T.mode is ['Mapping, retm, :argml] => #argl ^= #argml => nil retm := resolve(m, retm) retm = $Category or isCategoryForm(retm,e) => nil -- not handled argTl := [[.,.,e] := comp(x,m,e) or return "failed" for x in argl for m in argml] argTl = "failed" => nil form:= not (member(op,$formalArgList) or member(T.expr,$formalArgList)) and ATOM T.expr => nprefix := $prefix or -- following needed for referencing local funs at capsule level getAbbreviation($op,#rest $form) [op',:[a.expr for a in argTl],"$"] where op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem T.expr) ['call, ['applyFun, T.expr], :[a.expr for a in argTl]] coerce([form, retm, e],resolve(retm,m)) op = 'elt => nil eltForm := ['elt, op, :argl] comp(eltForm, m, e) compFormWithModemap(form is [op,:argl],m,e,modemap) == [map:= [.,target,:.],[pred,impl]]:= modemap -- this fails if the subsuming modemap is conditional --impl is ['Subsumed,:.] => nil if isCategoryForm(target,e) and isFunctor op then [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil [map:= [.,target,:.],:cexpr]:= modemap sv:=listOfSharpVars map if sv then -- SAY [ "compiling ", op, " in compFormWithModemap, -- mode= ",map," sharp vars=",sv] for x in argl for ss in $FormalMapVariableList repeat if ss in sv then [map:= [.,target,:.],:cexpr]:= modemap :=SUBST(x,ss,modemap) -- SAY ["new map is",map] not (target':= coerceable(target,m,e)) => nil map:= [target',:rest map] [f,Tl,sl]:= compApplyModemap(form,modemap,e,nil) or return nil --generate code; return T:= [x',m',e'] where m':= SUBLIS(sl,map.(1)) x':= form':= [f,:[t.expr for t in Tl]] m'=$Category or isCategoryForm(m',e) => form' -- try to deal with new-style Unions where we know the conditions op = "elt" and f is ['XLAM,:.] and IDENTP(z:=CAR argl) and (c:=get(z,'condition,e)) and c is [['case,=z,c1]] and (c1 is ['_:,=(CADR argl),=m] or EQ(c1,CADR argl) ) => -- first is a full tag, as placed by getInverseEnvironment -- second is what getSuccessEnvironment will place there ["CDR",z] ["call",:form'] e':= Tl => (LAST Tl).env e convert(T,m) -- This version tends to give problems with #1 and categories -- applyMapping([op,:argl],m,e,ml) == -- #argl^=#ml-1 => nil -- mappingHasCategoryTarget := -- isCategoryForm(first ml,e) => --is op a functor? -- form:= [op,:argl'] -- pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList] -- ml:= SUBLIS(pairlis,ml) -- true -- false -- argl':= -- [T.expr for x in argl for m' in rest ml] where -- T() == [.,.,e]:= comp(x,m',e) or return "failed" -- if argl'="failed" then return nil -- mappingHasCategoryTarget => convert([form,first ml,e],m) -- form:= -- not member(op,$formalArgList) and ATOM op => -- [op',:argl',"$"] where -- op':= INTERN STRCONC(STRINGIMAGE $prefix,";",STRINGIMAGE op) -- ["call",["applyFun",op],:argl'] -- pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] -- convert([form,SUBLIS(pairlis,first ml),e],m) applyMapping([op,:argl],m,e,ml) == #argl^=#ml-1 => nil isCategoryForm(first ml,e) => --is op a functor? pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList] ml' := SUBLIS(pairlis, ml) argl':= [T.expr for x in argl for m' in rest ml'] where T() == [.,.,e]:= comp(x,m',e) or return "failed" if argl'="failed" then return nil form:= [op,:argl'] convert([form,first ml',e],m) argl':= [T.expr for x in argl for m' in rest ml] where T() == [.,.,e]:= comp(x,m',e) or return "failed" if argl'="failed" then return nil form:= not member(op,$formalArgList) and ATOM op and not get(op,'value,e) => nprefix := $prefix or -- following needed for referencing local funs at capsule level getAbbreviation($op,#rest $form) [op',:argl',"$"] where op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem op) ['call,['applyFun,op],:argl'] pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] convert([form,SUBLIS(pairlis,first ml),e],m) --% APPLY MODEMAPS compApplyModemap(form,modemap,$e,sl) == [op,:argl] := form --form to be compiled [[mc,mr,:margl],:fnsel] := modemap --modemap we are testing -- $e is the current environment -- sl substitution list, nil means bottom-up, otherwise top-down -- 0. fail immediately if #argl=#margl if #argl^=#margl then return nil -- 1. use modemap to evaluate arguments, returning failed if -- not possible lt:= [[.,m',$e]:= comp(y,g,$e) or return "failed" where g:= SUBLIS(sl,m) where sl:= pmatchWithSl(m',m,sl) for y in argl for m in margl] lt="failed" => return nil -- 2. coerce each argument to final domain, returning failed -- if not possible lt':= [coerce(y,d) or return "failed" for y in lt for d in SUBLIS(sl,margl)] lt'="failed" => return nil -- 3. obtain domain-specific function, if possible, and return --$bindings is bound by compMapCond [f,$bindings]:= compMapCond(op,mc,sl,fnsel) or return nil --+ can no longer trust what the modemap says for a reference into --+ an exterior domain (it is calculating the displacement based on view --+ information which is no longer valid; thus ignore this index and --+ store the signature instead. --$NRTflag=true and f is [op1,d,.] and NE(d,'$) and member(op1,'(ELT CONST)) => f is [op1,d,.] and member(op1,'(ELT CONST Subsumed)) => [genDeltaEntry [op,:modemap],lt',$bindings] [f,lt',$bindings] compMapCond(op,mc,$bindings,fnsel) == or/[compMapCond'(u,op,mc,$bindings) for u in fnsel] compMapCond'([cexpr,fnexpr],op,dc,bindings) == compMapCond''(cexpr,dc) => compMapCondFun(fnexpr,op,dc,bindings) stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d] compMapCond''(cexpr,dc) == cexpr=true => true --cexpr = "true" => true cexpr is ["AND",:l] => and/[compMapCond''(u,dc) for u in l] cexpr is ["OR",:l] => or/[compMapCond''(u,dc) for u in l] cexpr is ["not",u] => not compMapCond''(u,dc) cexpr is ["has",name,cat] => (knownInfo cexpr => true; false) --for the time being we'll stop here - shouldn't happen so far --$disregardConditionIfTrue => true --stackSemanticError(("not known that",'%b,name, -- '%d,"has",'%b,cat,'%d),nil) --now it must be an attribute member(["ATTRIBUTE",dc,cexpr],get("$Information","special",$e)) => true --for the time being we'll stop here - shouldn't happen so far stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d] false compMapCondFun(fnexpr,op,dc,bindings) == [fnexpr,bindings] @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}