From 82eaa6d96dbadd85f23913a80f163544517af5b0 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Thu, 4 Mar 2010 11:15:19 +0000
Subject: 	* interp/g-opt.boot (nominateForInlining): New. 
 (optimizableDomain?): Likewise. 	(optCallSpecially): Use it 	*
 interp/compiler.boot (processInlineRequest): Likewise. 	*
 interp/nruncomp.boot (optDeltaEntry): Likewise. 	* interp/wi2.boot
 (optDeltaEntry): Likewise.

---
 src/interp/compiler.boot |  3 +--
 src/interp/g-opt.boot    | 13 +++++++++++--
 src/interp/nruncomp.boot |  2 +-
 src/interp/wi2.boot      |  2 +-
 4 files changed, 14 insertions(+), 6 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 93ae1330..12e8f363 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -2230,8 +2230,7 @@ processInlineRequest(t,e) ==
     stackAndThrow('"%1b does not designate a domain",[t])
   atom T.expr =>
     stackWarning('"inline request for type variable %1bp is meaningless",[t])
-  [ctor,:.] := T.expr
-  $optimizableConstructorNames := [ctor,:$optimizableConstructorNames]
+  nominateForInlining T.expr
 
 
 --%
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index cd095542..8110587e 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -39,6 +39,15 @@ namespace BOOT
 
 $optimizableConstructorNames := $SystemInlinableConstructorNames
 
+++ Return true if the domain `dom' is an instance of a functor
+++ that has been nominated for inlining.
+optimizableDomain? dom ==
+  opOf dom in $optimizableConstructorNames
+
+++ Register the domain `dom' for inlining.
+nominateForInlining dom ==
+  $optimizableConstructorNames := [opOf dom,:$optimizableConstructorNames]
+  
 --%
 
 ++ return the template of the instantiating functor for
@@ -174,9 +183,9 @@ optCall (x is ["call",:u]) ==
  
 optCallSpecially(q,x,n,R) ==
     y:= LASSOC(R,$specialCaseKeyList) => optSpecialCall(x,y,n)
-    MEMQ(KAR R,$optimizableConstructorNames) => optSpecialCall(x,R,n)
+    optimizableDomain? R => optSpecialCall(x,R,n)
     (y:= get(R,"value",$e)) and
-      MEMQ(opOf y.expr,$optimizableConstructorNames) =>
+      optimizableDomain? y.expr =>
         optSpecialCall(x,y.expr,n)
     (
       (y:= lookup(R,$getDomainCode)) and ([op,y,prop]:= y) and
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 5194d7b8..3dd701ca 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -160,7 +160,7 @@ optDeltaEntry(op,sig,dc,eltOrConst) ==
     atom dc and (dcval := get(dc,'value,$e)) => dcval.expr
     dc
   sig := MSUBST(ndc,dc,sig)
-  not MEMQ(KAR ndc,$optimizableConstructorNames) => nil
+  not optimizableDomain? ndc => nil
   fun := lookupDefiningFunction(op,sig,ndc)
   if fun = nil then
     -- following code is to handle selectors like first, rest
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index c2d4289e..7e9e99a5 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -667,7 +667,7 @@ optDeltaEntry(op,sig,dc,eltOrConst) ==
 --   then ndc := dcval.expr
 --   else ndc := dc
   sig := SUBST(ndc,dc,sig)
-  not MEMQ(KAR ndc,$optimizableConstructorNames) => nil
+  not optimizableDomain? ndc => nil
   dcval := optCallEval ndc
   -- MSUBST guarantees to use EQUAL testing
   sig := MSUBST(devaluate dcval, ndc, sig)
-- 
cgit v1.2.3