diff options
| -rw-r--r-- | src/ChangeLog | 11 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 12 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 16 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 2 |
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 |