aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog9
-rw-r--r--src/interp/compiler.boot3
-rw-r--r--src/interp/g-opt.boot13
-rw-r--r--src/interp/nruncomp.boot2
-rw-r--r--src/interp/wi2.boot2
5 files changed, 23 insertions, 6 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 062afad7..fb6c0ea5 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
2010-03-04 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * 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.
+
+2010-03-04 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/c-util.boot (isSymbol): Remove.
* interp/compiler.boot (compAtom): Don't use it.
* interp/wi1.boot (compAtom): Likewise.
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)