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

6 files changed, 35 insertions, 22 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 90e2b934..a4cd090e 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
 2011-02-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* 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.
+
+2011-02-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/g-opt.boot (canInlineVarDefinition): Observe order of
 	evaluation. 
 
diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp
index c4eb8f59..da35ba66 100644
--- a/src/algebra/strap/INS-.lsp
+++ b/src/algebra/strap/INS-.lsp
@@ -29,7 +29,7 @@
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
                 |INS-;rational?;SB;8|)) 
 
-(PUT '|INS-;rational?;SB;8| '|SPADreplace| '(XLAM (|x|) T)) 
+(PUT '|INS-;rational?;SB;8| '|SPADreplace| '(XLAM (|x|) |%true|)) 
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
                 |INS-;euclideanSize;SNni;9|)) 
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