aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog12
-rw-r--r--src/interp/compiler.boot17
-rw-r--r--src/interp/g-opt.boot4
-rw-r--r--src/interp/lisplib.boot2
-rw-r--r--src/interp/nruncomp.boot4
-rw-r--r--src/testsuite/compiler/ctor-mapping.spad17
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)