From 3f8bdbabb7bfcf9b021fe1529e603e931b57bf13 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 23 Feb 2010 05:22:37 +0000
Subject: 	Expand support for domain inlining to non-niladic functors. 
 * interp/compiler.boot (processInlineRequest): Now accept any 	functor. 
 * interp/c-util.boot (lookupFunctionInstance): New. 	(isFormal): Likewise. 
 (expandFormTemplate): Likewise. 	(equalFormTemplate): Likewise. 
 (getFunctionTemplate): Likewise. 	(lookupInheritedDefiningFunction):
 Likewise. 	(lookupDefiningFunction): Likewise. 	* interp/nruncomp.boot
 (optDeltaEntry): Tidy.  Use 	lookupDefiningFunction.

---
 src/interp/nruncomp.boot | 22 ++++++++--------------
 1 file changed, 8 insertions(+), 14 deletions(-)

(limited to 'src/interp/nruncomp.boot')

diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 1b969ae2..dce086dc 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -161,16 +161,8 @@ optDeltaEntry(op,sig,dc,eltOrConst) ==
     dc
   sig := MSUBST(ndc,dc,sig)
   not MEMQ(KAR ndc,$optimizableConstructorNames) => nil
-  dcval := optCallEval ndc
-  -- MSUBST guarantees to use EQUAL testing
-  sig := MSUBST(devaluate dcval, ndc, sig)
-  if rest ndc then
-     for new in rest devaluate dcval for old in rest ndc repeat
-       sig := MSUBST(new,old,sig)
-     -- optCallEval sends (List X) to (LIst (Integer)) etc,
-     -- so we should make the same transformation
-  fn := compiledLookup(op,sig,dcval)
-  if null fn then
+  fun := lookupDefiningFunction(op,sig,ndc)
+  if fun = nil then
     -- following code is to handle selectors like first, rest
      nsig := [quoteSelector tt for tt in sig] where
        quoteSelector(x) ==
@@ -178,10 +170,12 @@ optDeltaEntry(op,sig,dc,eltOrConst) ==
          get(x,'value,$e) => x
          x='$ => x
          MKQ x
-     fn := compiledLookup(op,nsig,dcval)
-     if null fn then return nil
-  eltOrConst="CONST" => ['XLAM,'ignore, SPADCALL fn]
-  GETL(compileTimeBindingOf first fn,'SPADreplace)
+     fun := lookupDefiningFunction(op,nsig,ndc)
+  fun = nil => nil
+  if CONSP fun then
+    eltOrConst = "CONST" => return ['XLAM,'ignore, SPADCALL fun]
+    fun := first fun
+  GETL(compileTimeBindingOf fun,'SPADreplace)
 
 genDeltaEntry opMmPair ==
 --called from compApplyModemap
-- 
cgit v1.2.3