diff options
author | dos-reis <gdr@axiomatics.org> | 2008-07-04 21:06:40 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-07-04 21:06:40 +0000 |
commit | 415433683b1755b161092170b6b39c381c96c850 (patch) | |
tree | 22f22cc1f52e5cc6dc95e5e57ad408d4386d7a2d | |
parent | 1a3f6eae6f2ef30a6b9249e595c2f37e0ebd002b (diff) | |
download | open-axiom-415433683b1755b161092170b6b39c381c96c850.tar.gz |
* interp/compiler.boot (compFormMatch): Tidy.
(getFormModemaps): Likewise.
(compComma): New.
* interp/c-util.boot (isTupleInstance): New.
(isHomoegenousVarargSignature): Likewise.
(enoughArguments): Likewise.
(wantArgumentsAsTuple): Likewise.
* interp/apply.boot (reshapeArgumentList): New.
(compFormWithModemap): Use it.
-rw-r--r-- | src/ChangeLog | 12 | ||||
-rw-r--r-- | src/interp/apply.boot | 16 | ||||
-rw-r--r-- | src/interp/c-doc.boot | 4 | ||||
-rw-r--r-- | src/interp/c-util.boot | 26 | ||||
-rw-r--r-- | src/interp/compiler.boot | 59 | ||||
-rw-r--r-- | src/interp/database.boot | 4 | ||||
-rw-r--r-- | src/interp/functor.boot | 2 | ||||
-rw-r--r-- | src/interp/nruncomp.boot | 6 | ||||
-rw-r--r-- | src/interp/package.boot | 2 |
9 files changed, 108 insertions, 23 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index d4ecb0cc..fdfd0d57 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,17 @@ 2008-07-04 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/compiler.boot (compFormMatch): Tidy. + (getFormModemaps): Likewise. + (compComma): New. + * interp/c-util.boot (isTupleInstance): New. + (isHomoegenousVarargSignature): Likewise. + (enoughArguments): Likewise. + (wantArgumentsAsTuple): Likewise. + * interp/apply.boot (reshapeArgumentList): New. + (compFormWithModemap): Use it. + +2008-07-04 Gabriel Dos Reis <gdr@cs.tamu.edu> + Fix AW/429 * algebra/multpoly.spad.pamphlet (IndexedExponents): Fix comment type. diff --git a/src/interp/apply.boot b/src/interp/apply.boot index 19b812ae..942f102c 100644 --- a/src/interp/apply.boot +++ b/src/interp/apply.boot @@ -92,11 +92,19 @@ compApplication(op,argl,m,e,T) == eltForm := ['elt, op, :argl] comp(eltForm, m, e) +++ `form' is a call to a operation described by the signature `sig'. +++ Massage the call so that homogeneous variable length argument lists +++ are properly tuplified. +reshapeArgumentList: (%Form,%Signature) -> %Form +reshapeArgumentList(form,sig) == + [op,:args] := form + wantArgumentsAsTuple(args,sig) => [op,["%Comma",:args]] + form + compFormWithModemap: (%Form,%Mode,%Env,%Modemap) -> %Maybe %Triple -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 +compFormWithModemap(form,m,e,modemap) == + [map:= [.,target,:sig],[pred,impl]]:= modemap + [op,:argl] := form := reshapeArgumentList(form,sig) if isCategoryForm(target,e) and isFunctor op then [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil [map:= [.,target,:.],:cexpr]:= modemap diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index fdf34936..5c199b50 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -45,12 +45,12 @@ getDoc(conName,op,modemap) == [dc,target,sl,pred,D] := simplifyModemap modemap sig := [target,:sl] null atom dc => - sig := substitute('$,dc,sig) + sig := MSUSBT('$,dc,sig) sig := SUBLISLIS($FormalMapVariableList,rest dc,sig) getDocForDomain(conName,op,sig) if argList := IFCDR getOfCategoryArgument pred then SUBLISLIS($FormalMapArgumentList,argList,sig) - sig := substitute('$,dc,sig) + sig := MSUBST('$,dc,sig) getDocForCategory(conName,op,sig) ++ Given a preidcate `pred' for a modemap, returns the first diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 05dd92c4..e8983fb2 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -52,6 +52,32 @@ substituteDollarIfRepHack m == $useRepresentationHack => substitute("$","Rep",m) m + +++ Returns true if the form `t' is an instance of the Tuple constructor. +isTupleInstance: %Form -> %Boolean +isTupleInstance t == + t is ["Tuple",.] + +++ Returns true if the signature `sig' describes a function that can +++ accept a homogeneous variable length argument list. +isHomoegenousVarargSignature: %Signature -> %Boolean +isHomoegenousVarargSignature sig == + #sig = 1 and isTupleInstance first sig + +++ Returns true if the arguments list `args' match in shape the +++ parameter type list `sig'. This means that either the number +++ of arguments is exactly the number of parameters, or that the +++ signature describes a homogeneous vararg operation. +enoughArguments: (%List,%Signature) -> %Boolean +enoughArguments(args,sig) == + #args = #sig or isHomoegenousVarargSignature sig + +++ Returns true if the operation described by the signature `sig' +++ wants its arguments as a Tuple object. +wantArgumentsAsTuple: (%List,%Signature) -> %Boolean +wantArgumentsAsTuple(args,sig) == + isHomoegenousVarargSignature sig and #args ^= #sig + --% Debugging Functions --CONTINUE() == continue() diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 2204a0f7..c759bafa 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -479,17 +479,23 @@ compForm2(form is [op,:argl],m,e,modemapList) == compForm3(form,m,e,modemapList) compForm3(form,m,e,modemapList) +++ We are about to compile a call. Returns true if each argument +++ partially matches (as could be determined by type inference) the +++ corresponding expected type in the callee's modemap. +compFormMatch: (%Modemap,%List) -> %Boolean +compFormMatch(mm,partialModeList) == main where + main() == + mm is [[.,.,:argModeList],:.] and match(argModeList,partialModeList) + or wantArgumentsAsTuple(partialModeList,argModeList) + match(a,b) == + null b => true + null first b => match(rest a,rest b) + first a=first b and match(rest a,rest b) + compFormPartiallyBottomUp(form,m,e,modemapList,partialModeList) == mmList:= [mm for mm in modemapList | compFormMatch(mm,partialModeList)] => compForm3(form,m,e,mmList) -compFormMatch(mm,partialModeList) == - mm is [[.,.,:argModeList],:.] and match(argModeList,partialModeList) where - match(a,b) == - null b => true - null first b => match(rest a,rest b) - first a=first b and match(rest a,rest b) - compForm3(form is [op,:argl],m,e,modemapList) == T:= or/ @@ -501,12 +507,19 @@ compForm3(form is [op,:argl],m,e,modemapList) == T T +++ Returns the list of candidate modemaps for a form. A modemap +++ is candidate for a form if its signature has the same number +++ of paramter types as arguments supplied to the form. A special +++ case is made for a modemap whose sole parameter type is a Tuple. +++ In that case, it matches any number of supplied arguments. getFormModemaps: (%Form,%Env) -> %List getFormModemaps(form is [op,:argl],e) == op is ["elt",domain,op1] => [x for x in getFormModemaps([op1,:argl],e) | x is [[ =domain,:.],:.]] - null atom op => nil + not atom op => nil modemapList:= get(op,"modemap",e) + -- Within default implementations, modemaps cannot mention the + -- current domain. if $insideCategoryPackageIfTrue then modemapList := [x for x in modemapList | x is [[dom,:.],:.] and dom ^= '$] if op="elt" @@ -515,7 +528,8 @@ getFormModemaps(form is [op,:argl],e) == if op="setelt" then modemapList:= seteltModemapFilter(CADR argl,modemapList,e) or return nil nargs:= #argl - finalModemapList:= [mm for (mm:= [[.,.,:sig],:.]) in modemapList | #sig=nargs] + finalModemapList:= [mm for (mm:= [[.,.,:sig],:.]) in modemapList + | enoughArguments(argl,sig)] modemapList and null finalModemapList => stackMessage('"no modemap for %1b with %2 arguments", [op,nargs]) finalModemapList @@ -1255,7 +1269,7 @@ coerce(T,m) == keyedSystemError("S2GE0016",['"coerce", '"function coerce called from the interpreter."]) if $useRepresentationHack then - rplac(CADR T,substitute("$",$Rep,CADR T)) + rplac(CADR T,MSUBST("$",$Rep,CADR T)) T':= coerceEasy(T,m) => T' T':= coerceSubset(T,m) => T' T':= coerceHard(T,m) => T' @@ -1409,6 +1423,30 @@ autoCoerceByModemap([x,source,e],target) == [x,source,target]) [["call",genDeltaEntry ["autoCoerce", :fn],x],target,e] + +++ Compile a comma separated expression list. These typically are +++ tuple objects, or argument list in a call to a homogeneous +++ vararg operations. +compComma: (%Form,%Mode,%Env) -> %Maybe %Triple +compComma(form,m,e) == + form isnt ["%Comma",:argl] => systemErrorHere "compComma" + Tl := [comp(a,$EmptyMode,e) or return "failed" for a in argl] + Tl = "failed" => nil + -- ??? Ideally, we would like to compile to a Cross type, then + -- convert to the target type. However, the current compiler and + -- runtime data structures are not regular enough in their interfaces; + -- so we make a special rule when compiling with a Tuple as target, + -- we do the convertion here (instead of calling convert). Semantically, + -- there should be no difference, but it makes the compiler code + -- less regular, with duplicated effort. + m is ["Tuple",t] => + Tl' := [convert(T,t) or return "failed" for T in Tl] + Tl' = "failed" => nil + [["asTupleNew0", [T.expr for T in Tl']], m, e] + T := [["LIST2VEC", [T.expr for T in Tl]], + ["Cross",:[T.mode for T in Tl]], e] + convert(T,m) + --% Very old resolve -- should only be used in the old (preWATT) compiler @@ -1704,5 +1742,6 @@ for x in [["|", :"compSuchthat"],_ ["Mapping", :"compCat"],_ ["UnionCategory", :"compConstructorCategory"],_ ["where", :"compWhere"],_ + ["%Comma",:"compComma"],_ ["[||]", :"compileQuasiquote"]] repeat MAKEPROP(first x, "SPECIAL", rest x) diff --git a/src/interp/database.boot b/src/interp/database.boot index d2dd49a4..47cd3ec7 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -429,9 +429,9 @@ substVars(pred,patternAlist,patternVarList) == --make pattern variable substitutions domainPredicates := nil for [[patVar,:value],:.] in tails patternAlist repeat - pred := substitute(patVar,value,pred) + pred := MSUBST(patVar,value,pred) patternAlist := nsubst(patVar,value,patternAlist) - domainPredicates := substitute(patVar,value,domainPredicates) + domainPredicates := MSUBST(patVar,value,domainPredicates) if ^MEMQ(value,$FormalMapVariableList) then domainPredicates := [["isDomain",patVar,value],:domainPredicates] everything := [pred,patternAlist,domainPredicates] diff --git a/src/interp/functor.boot b/src/interp/functor.boot index e955078a..e735ed17 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -420,7 +420,7 @@ mkDomainConstructor x == setVector4(catNames,catsig,conditions) == if $HackSlot4 then for ['LET,name,cond,:.] in $getDomainCode repeat - $HackSlot4:=substitute(name,cond,$HackSlot4) + $HackSlot4:=MSUSBT(name,cond,$HackSlot4) code:= --+ ['SETELT,'$,4,'TrueDomain] diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 3fffd59f..9e7572db 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -96,7 +96,7 @@ deltaTran(item,compItem) == [op,:modemap] := item [dcSig,[.,[kind,:.]]] := modemap [dc,:sig] := dcSig - sig := substitute('$,dc,substitute("$$",'$,sig)) + sig := MSUBST('$,dc,substitute("$$",'$,sig)) dcCode := dc = '$ => 0 dc = $NRTaddForm => 5 @@ -153,7 +153,7 @@ optDeltaEntry(op,sig,dc,eltOrConst) == dc = '$ => $functorForm atom dc and (dcval := get(dc,'value,$e)) => dcval.expr dc - sig := substitute(ndc,dc,sig) + sig := MSUBST(ndc,dc,sig) not MEMQ(KAR ndc,$optimizableConstructorNames) => nil dcval := optCallEval ndc -- MSUBST guarantees to use EQUAL testing @@ -187,7 +187,7 @@ genDeltaEntry opMmPair == if eltOrConst = 'Subsumed then eltOrConst := 'ELT if atom dc then dc = "$" => nsig := sig - if NUMBERP nsig then nsig := substitute('$,dc,substitute("$$","$",sig)) + if NUMBERP nsig then nsig := MSUBST('$,dc,substitute("$$","$",sig)) newimp := optDeltaEntry(op,nsig,dc,eltOrConst) => newimp setDifference(listOfBoundVars dc,$functorLocalParameters) ^= [] => ['applyFun,['compiledLookupCheck,MKQ op, diff --git a/src/interp/package.boot b/src/interp/package.boot index baf88ac7..6217d639 100644 --- a/src/interp/package.boot +++ b/src/interp/package.boot @@ -200,7 +200,7 @@ optPackageCall(x,["PAC",packageVariableOrForm,functionName],arglist) == encodeFunctionName(fun,package is [packageName,:arglist],signature,sep,count) == - signature':= substitute("$",package,signature) + signature':= MSUBST("$",package,signature) reducedSig:= mkRepititionAssoc [:rest signature',first signature'] encodedSig:= ("STRCONC"/[encodedPair for [n,:x] in reducedSig]) where |