aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-02-26 21:42:03 +0000
committerdos-reis <gdr@axiomatics.org>2011-02-26 21:42:03 +0000
commite8a84fdadd3c571f757a204f019e102d038ba277 (patch)
treee0d8477b9027a5ff83236261a23a1e4b8152273a /src/interp
parent2cd5fff635d7b7954a220cf474172b4c0955cb55 (diff)
downloadopen-axiom-e8a84fdadd3c571f757a204f019e102d038ba277.tar.gz
* 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.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot27
-rw-r--r--src/interp/g-opt.boot5
-rw-r--r--src/interp/nruncomp.boot12
-rw-r--r--src/interp/wi2.boot2
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