aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog12
-rw-r--r--src/interp/apply.boot16
-rw-r--r--src/interp/c-doc.boot4
-rw-r--r--src/interp/c-util.boot26
-rw-r--r--src/interp/compiler.boot59
-rw-r--r--src/interp/database.boot4
-rw-r--r--src/interp/functor.boot2
-rw-r--r--src/interp/nruncomp.boot6
-rw-r--r--src/interp/package.boot2
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 10:14:30 +0000