* interp/nruncomp.boot (optDeltaEntry): Don't SPADCALL the

	constant producing function.
	* interp/c-util.boot (getFunctionReplacement): Use
	comptileTimeBindingOf.
	(lookupDefiningFunction): Tidy.
	* interp/g-opt.boot (compileTimeBindingOf): Move to c-util.boot.

4 files changed, 25 insertions, 21 deletions

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 4daea645..e3218e42 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1108,13 +1108,18 @@ middleEndExpand x ==
   [a,:b]
 
 
--- A function is simple if it looks like a super combinator, and it
--- does not use its environment argument.  They can be safely replaced
--- by more efficient (hopefully) functions.
-
-getFunctionReplacement: %Symbol -> %Form
+--% A function is simple if it looks like a super combinator, and it
+--% does not use its environment argument.  They can be safely replaced
+--% by more efficient (hopefully) functions.
+
+compileTimeBindingOf u ==
+  symbol? u => u
+  null(name:= BPINAME u)  => keyedSystemError("S2OO0001",[u])
+  name="Undef" => MOAN "optimiser found unknown function"
+  name
+ 
 getFunctionReplacement name ==
-  GET(name, "SPADreplace")
+  property(compileTimeBindingOf name,'SPADreplace)
 
 ++ remove any replacement info possibly associated with `name'.
 clearReplacement name ==
@@ -1749,18 +1754,18 @@ lookupDefiningFunction(op,sig,dc) ==
   --      FIXME: However, there may be cylic dependencies
   --      such as AN ~> IAN ~> EXPR INT ~> AN that prevents
   --      us from full evaluation.  
-  null args and ctor in $SystemInlinableConstructorNames =>
+  args = nil and ctor in $SystemInlinableConstructorNames =>
     compiledLookup(op,sig,dc)
   -- 1.2. Don't look into defaulting package
   isDefaultPackageName ctor => nil
   -- 1.2. Silently give up if the constructor is just not there
   loadLibIfNotLoaded ctor
-  infovec := GET(ctor, "infovec") or return nil
+  infovec := property(ctor,'infovec) or return nil
   -- 1.3. We need information about the original domain template
   shell := first infovec               -- domain template
   opTable := second infovec            -- operator-code table
   opTableLength := #opTable
-  forgetful := infovec.4 = "lookupIncomplete"
+  forgetful := infovec.4 is 'lookupIncomplete
 
   -- 2. Get the address range of op's descriptor set
   [.,.,.,:funDesc] := fourth infovec
@@ -1781,12 +1786,12 @@ lookupDefiningFunction(op,sig,dc) ==
   loc = nil => lookupInheritedDefiningFunction(op,sig,shell,args,shell.5)
 
   -- 5. Give up if the operation is overloaded on semantics predicates.
-  loc = "ambiguous" => nil
+  loc is 'ambiguous => nil
 
   -- 6. We have a location to a function descriptor.
   fun := shell.loc
   -- 6.1. A constant producing functions?
-  fun is [.,.,[.,["dispatchFunction",fun'],.]] => fun'
+  fun is [.,.,[.,['dispatchFunction,fun'],.]] => fun'
   -- 6.2. An inherited function?
   fun is [idx,:.] => 
     not integer? idx => nil          -- a UFO?
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index e6e8b934..0afc98dd 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -286,11 +286,6 @@ optCons (x is ["CONS",a,b]) ==
     x
   x
  
-compileTimeBindingOf u ==
-  null(name:= BPINAME u)  => keyedSystemError("S2OO0001",[u])
-  name="Undef" => MOAN "optimiser found unknown function"
-  name
- 
 optMkRecord ["mkRecord",:u] ==
   u is [x] => ['%list,x]
   #u=2 => ['%pair,:u]
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 8f3c278c..48e18254 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -185,10 +185,14 @@ optDeltaEntry(op,sig,dc,eltOrConst) ==
          MKQ x
      fun := lookupDefiningFunction(op,nsig,ndc)
   fun = nil => nil
-  if cons? fun then
-    eltOrConst = "CONST" => return ['XLAM,'ignore, SPADCALL fun]
-    fun := first fun
-  getFunctionReplacement compileTimeBindingOf fun
+  fun :=
+    fun is ['makeSpadConstant,:.] and
+      (fun' := getFunctionReplacement second fun) =>
+         return fun'
+    --eltOrConst = 'CONST => return ['XLAM,nil, SPADCALL fun]
+    cons? fun => first fun
+    fun
+  getFunctionReplacement fun
 
 genDeltaEntry(opMmPair,e) ==
 --called from compApplyModemap
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index 85068b58..7330a4c5 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -641,7 +641,7 @@ optDeltaEntry(op,sig,dc,eltOrConst) ==
      hehe fn
      [op]                    -----------> return just the op here
 --   ['XLAM,'ignore,MKQ SPADCALL fn]
-  getFunctionReplacement compileTimeBindingOf first fn
+  getFunctionReplacement first fn
  
 genDeltaEntry(opMmPair,e) ==
 --called from compApplyModemap