[open-axiom-patches] Kill $killOptimizeIfTrue

[Gabriel D. R. <gd...@cs...>]

This patch removes the artificial pessimization of higher-order function
arguments.  

2012-02-25  Gabriel Dos Reis  <gd...@cs...>

	* 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.

*** src/interp/compiler.boot	(revision 22066)
--- src/interp/compiler.boot	(local)
*************** compTopLevel: (%Form,%Mode,%Env) -> %May
*** 92,98 ****
  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
--- 92,97 ----
*************** finishLambdaExpression(expr is ["LAMBDA"
*** 338,344 ****
    ['%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
--- 337,342 ----
*************** compWithMappingMode(x,m is ["Mapping",m'
*** 360,371 ****
    [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]
  
  compExpression(x,m,e) ==
    $insideExpressionIfTrue: local:= true
--- 358,366 ----
    [finishLambdaExpression(fun,e),m,oldE]
  
  extractCode(u,vars) ==
!   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
*************** compRep(["rep",x],m,e) ==
*** 2751,2757 ****
  --% 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)
--- 2746,2751 ----
*** src/interp/g-opt.boot	(revision 22066)
--- src/interp/g-opt.boot	(local)
*************** optCall (x is ['%call,:u]) ==
*** 551,561 ****
      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)
    systemErrorHere ['optCall,x]
   
  optCons (x is ["CONS",a,b]) ==
    a is "NIL" =>
      b is 'NIL => (x.first := 'QUOTE; x.rest := ['NIL,:'NIL]; x)
--- 551,569 ----
      x.first := op
      x.rest := 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)
*************** $simpleVMoperators ==
*** 660,665 ****
--- 668,674 ----
  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]
*************** for x in '((%call         optCall) _
*** 996,1001 ****
--- 1005,1011 ----
             (%2bool       opt2bool)_
             (%list        optList)_
             (SPADCALL     optSPADCALL)_
+            (%closure     optClosure)_
             (_|           optSuchthat)_
             (%scope       optScope)_
             (%when        optCond)_
*** src/interp/nruncomp.boot	(revision 22066)
--- src/interp/nruncomp.boot	(local)
*************** $NRTaddForm := nil
*** 57,63 ****
  
  ++
  $NRTderivedTargetIfTrue := false
- $killOptimizeIfTrue := false
  
  NRTaddDeltaCode db ==
  --NOTES: This function is called from buildFunctor to initially
--- 57,62 ----
*************** needToQuoteFlags?(sig,env) ==
*** 154,160 ****
        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
--- 153,158 ----