aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog11
-rw-r--r--src/interp/compiler.boot12
-rw-r--r--src/interp/g-opt.boot16
-rw-r--r--src/interp/nruncomp.boot2
4 files changed, 27 insertions, 14 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 136d1d94..ad56facb 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,16 @@
2012-02-25 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/compiler.boot (compTopLevel): Do not bind $killOptimizeIfTrue.
+ (compWithMappingMode): Likewise.
+ (compUnnamedMapping): Likewise.
+ (extractCode): Simplify.
+ * interp/g-opt.boot (optClosure): New. Register.
+ (semiSimpleRelativeTo?): An abstraction is always semisimple.
+ * interp/nruncomp.boot ($killOptimizeIfTrue): Remove.
+ (optDeltaEntry): Don't test for it.
+
+2012-02-25 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/compiler.boot (extractCode): Rename from
extractCodeAndConstructTriple. Change Arity. Tidy. Adjust callers.
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 8d04a77a..52cc875d 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -92,7 +92,6 @@ compTopLevel: (%Form,%Mode,%Env) -> %Maybe %Triple
compTopLevel(x,m,e) ==
-- signals that target is derived from lhs-- see NRTmakeSlot1Info
$NRTderivedTargetIfTrue: local := false
- $killOptimizeIfTrue: local := false
$forceAdd: local:= false
-- start with a base list of domains we may want to inline.
$optimizableConstructorNames: local := $SystemInlinableConstructorNames
@@ -338,7 +337,6 @@ finishLambdaExpression(expr is ["LAMBDA",vars,.],env) ==
['%closure,fname,vec]
compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
- $killOptimizeIfTrue: local := true
e := oldE
isFunctor x =>
if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and
@@ -360,12 +358,9 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
[finishLambdaExpression(fun,e),m,oldE]
extractCode(u,vars) ==
- u is ['%call,fn,: =vars] =>
- fn is ['%apply,a] => a
- fn is [q,:.] and q in '(ELT CONST) => ['%tref,:fn.args]
- fn
- [op,:.,env] := u
- ['%closure,['%function,op],env]
+ u is ['%call,['%apply,a],: =vars] => a
+ u is ['%call,[q,:etc],: =vars] and q in '(ELT CONST) => ['%tref,:etc]
+ ['%closure,['%function,['%lambda,[:vars,'$],u]],'$]
compExpression(x,m,e) ==
$insideExpressionIfTrue: local:= true
@@ -2751,7 +2746,6 @@ compRep(["rep",x],m,e) ==
--% Lambda expressions
compUnnamedMapping(parms,source,target,body,env) ==
- $killOptimizeIfTrue: local := true
savedEnv := env
for p in parms for s in source repeat
[.,.,env] := compMakeDeclaration(p,s,env)
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 66aa756d..d9a72185 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -551,11 +551,19 @@ optCall (x is ['%call,:u]) ==
x.first := op
x.rest := a
x
- fn is [q,R,n] and q in '(ELT CONST) =>
- q is 'CONST => ['spadConstant,R,n]
- emitIndirectCall(fn,a,x)
+ fn is ['ELT,:.] => emitIndirectCall(fn,a,x)
+ fn is ['CONST,R,n] => ['spadConstant,R,n]
systemErrorHere ['optCall,x]
+optClosure(x is ['%closure,fun,env]) ==
+ fun is ['%function,['%lambda,vars,body]] =>
+ do
+ vars is [:vars',=env] =>
+ body is [op,: =vars] => x.args := [['%function,op],env]
+ not CONTAINED(env,body) => x.args := [fun,'%nil]
+ x
+ x
+
optCons (x is ["CONS",a,b]) ==
a is "NIL" =>
b is 'NIL => (x.first := 'QUOTE; x.rest := ['NIL,:'NIL]; x)
@@ -660,6 +668,7 @@ $simpleVMoperators ==
semiSimpleRelativeTo?(form,ops) ==
atomic? form => true
not symbol?(form.op) or not symbolMember?(form.op,ops) => false
+ abstraction? form.op => true -- always, regardless of body
form.op is '%when =>
and/[sideEffectFree? p and semiSimpleRelativeTo?(c,ops)
for [p,c] in form.args]
@@ -996,6 +1005,7 @@ for x in '((%call optCall) _
(%2bool opt2bool)_
(%list optList)_
(SPADCALL optSPADCALL)_
+ (%closure optClosure)_
(_| optSuchthat)_
(%scope optScope)_
(%when optCond)_
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 875fab0e..29372705 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -57,7 +57,6 @@ $NRTaddForm := nil
++
$NRTderivedTargetIfTrue := false
-$killOptimizeIfTrue := false
NRTaddDeltaCode db ==
--NOTES: This function is called from buildFunctor to initially
@@ -154,7 +153,6 @@ needToQuoteFlags?(sig,env) ==
ident? t and null get(t,"value",e)
optDeltaEntry(op,sig,dc,kind) ==
- $killOptimizeIfTrue => nil
-- references to modemaps from current domain are folded in a later
-- stage of the compilation process.
dc is '$ => nil