diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 17 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 4 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 2 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 4 | ||||
| -rw-r--r-- | src/testsuite/compiler/ctor-mapping.spad | 17 |
6 files changed, 50 insertions, 6 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 4b805bc3..c6af32cc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,17 @@ 2011-11-10 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/compiler.boot (applyMapping): Emit special call for + domain producing mapping variables. + (compWithMappingMode): Coerce constructors to function objets. + (compFormWithModemap): Constructor calls are direct calls. + Everything else is ordinary indirect call. + * interp/g-opt.boot (optCall): Handle function objects. + * interp/nruncomp.boot (NRTencode): Encode the elaboration of + atomic forms, not the source level form. + * testsuite/compiler/ctor-mapping.spad: New. + +2011-11-10 Gabriel Dos Reis <gdr@cs.tamu.edu> + * algebra/boolean.spad.pamphlet (IndexedBits) [Not, Or, And]: Remove. Implement ~. \/, and /\ instead. * algebra/si.spad.pamphlet (SingleInteger): Likewise. diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 5ab502a0..aecd95aa 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -224,8 +224,12 @@ applyMapping([op,:argl],m,e,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'] + argl' is "failed" => nil + form := + ident? op and symbolMember?(op,$formalArgList) => + -- this domain form is given by a general function application + ['%funcall,op,:argl'] -- constructor call linkage is special + [op,:argl'] convert([form,first ml',e],m) argl':= [T.expr for x in argl for m' in rest ml] where @@ -328,7 +332,8 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == isFunctor x => if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl] - ) and extendsCategoryForm("$",target,m') then return [x,m,e] + ) and extendsCategoryForm("$",target,m') then + return [['%function,x],m,e] x is ["+->",:.] => compLambda(x,m,oldE) if string? x then x := makeSymbol x for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat @@ -603,7 +608,11 @@ compFormWithModemap(form,m,e,modemap) == [x',target,e'] where x':= form':= [f,:[t.expr for t in Tl]] - target=$Category or isCategoryForm(target,e) => form' + target = $Category or isCategoryForm(target,e) => + -- Constructor instantiations are direct calls + ident? f and constructorDB f ~= nil => form' + -- Otherwise, this is an indirect call + ['%call,:form'] -- try to deal with new-style Unions where we know the conditions op = "elt" and f is ['XLAM,:.] and ident?(z := first argl) and (c := get(z,'condition,e)) and diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index a4561beb..0a7d1678 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -309,6 +309,10 @@ optCall (x is ['%call,:u]) == x.first := op x.rest := [:a,env] x + fn is ['%function,op] => + x.first := op + x.rest := a + x fn is [q,R,n] and q in '(ELT CONST) => q is 'CONST => ['spadConstant,R,n] emitIndirectCall(fn,a,x) diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index beebddb8..49fa50cf 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -72,7 +72,7 @@ predicateBitIndex(x,e) == pn(x,flag,e) == u := simpBool transHasCode(x,e) u is 'T => 0 - u = nil => -1 + u is false => -1 p := valuePosition(u,$NRTslot1PredicateList) => p + 1 not flag => pn(predicateBitIndexRemop x,true,e) systemError nil diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 2ccdbd25..e67fb6da 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -130,7 +130,9 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == v x is "$" => x x is "$$" => x - quote x + compForm is [.,:.] => + ["NRTEVAL",NRTreplaceAllLocalReferences copyTree simplifyVMForm compForm] + quote compForm --------------FUNCTIONS CALLED DURING CAPSULE FUNCTION COMPILATION------------- listOfBoundVars form == diff --git a/src/testsuite/compiler/ctor-mapping.spad b/src/testsuite/compiler/ctor-mapping.spad new file mode 100644 index 00000000..4f7a58d2 --- /dev/null +++ b/src/testsuite/compiler/ctor-mapping.spad @@ -0,0 +1,17 @@ +++ Contributed by Gabriel Dos Reis; November 2011. +++ Test conversion of constructors to function objects and +++ elaboration of domain producting function parameters. + +)abbrev package BAR Bar +Bar(F: Type -> Type): Public == Private where + Public == Type with + bar: () -> Type + Private == add + bar() == F Integer + + +)abbrev package FOO Foo +Foo(): Type with + foo: () -> Type + == add + foo() == bar()$Bar(List) |