* 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.

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)