[open-axiom-patches] Reduce generation of PROGN forms

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

There are places where the compiler generates PROGN forms when it wants
to emit a sequence of expressions.  It wasn't using SEQ because that was
already abused and using it for this purpose would have had the wrong
semantics.  Now that we replaced SEQ with %seq with clearer semantics, we
can use %seq where PROGN was used.

Applied to trunk and 1.4.x branch.

2011-12-03  Gabriel Dos Reis  <gd...@cs...>

	* interp/compiler.boot: Use %seq in lieu of PROGN.
	* interp/g-util.boot (spliceSeqArgs): New.
	* interp/g-opt.boot (changeVariableDefinitionToStore): Call it
	before recursing on %seq forms.

*** src/interp/compiler.boot	(revision 21632)
--- src/interp/compiler.boot	(local)
*************** freeVarUsage([.,vars,body],env) ==
*** 271,277 ****
          for v in CDDR u repeat
            free := freeList(v,bound,free,e)
          free
!       op = "PROG" =>
          bound := setUnion(bound, second u)
          for v in CDDR u | cons? v repeat
            free := freeList(v,bound,free,e)
--- 271,277 ----
          for v in CDDR u repeat
            free := freeList(v,bound,free,e)
          free
!       op = 'PROG =>
          bound := setUnion(bound, second u)
          for v in CDDR u | cons? v repeat
            free := freeList(v,bound,free,e)
*************** setqMultiple(nameList,val,m,e) ==
*** 978,984 ****
    m1 is ["List",D] =>
      for y in nameList repeat 
        e:= giveVariableSomeValue(y,D,e)
!     coerce([["PROGN",x,["%LET",nameList,g],g],m',e],m)
    -- 3. For a cross, do it by hand here instead of general mm.  FIXME.
    m1 is ['Cross,:.] =>
      n := #m1.args
--- 978,984 ----
    m1 is ["List",D] =>
      for y in nameList repeat 
        e:= giveVariableSomeValue(y,D,e)
!     coerce([['%seq,x,["%LET",nameList,g],g],m',e],m)
    -- 3. For a cross, do it by hand here instead of general mm.  FIXME.
    m1 is ['Cross,:.] =>
      n := #m1.args
*************** setqMultiple(nameList,val,m,e) ==
*** 988,994 ****
      for y in nameList for t in m1.args for i in 0.. repeat
        e := giveVariableSomeValue(y,t,e)
        stmts := [['%LET,y,['%call,eltRecordFun(n,i),g,i]],:stmts]
!     coerce([['PROGN,x,:reverse! stmts,g],m1,e],m)
    -- 4. verify that the #nameList = number of parts of right-hand-side
    selectorModePairs:=
                                                  --list of modes
--- 988,994 ----
      for y in nameList for t in m1.args for i in 0.. repeat
        e := giveVariableSomeValue(y,t,e)
        stmts := [['%LET,y,['%call,eltRecordFun(n,i),g,i]],:stmts]
!     coerce([['%seq,x,:reverse! stmts,g],m1,e],m)
    -- 4. verify that the #nameList = number of parts of right-hand-side
    selectorModePairs:=
                                                  --list of modes
*************** setqMultiple(nameList,val,m,e) ==
*** 1005,1011 ****
      [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr
        for x in nameList for [y,:z] in selectorModePairs]
    assignList="failed" => nil
!   [mkpf([x,:assignList,g],'PROGN),m',e]
  
  setqMultipleExplicit(nameList,valList,m,e) ==
    #nameList~=#valList =>
--- 1005,1011 ----
      [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr
        for x in nameList for [y,:z] in selectorModePairs]
    assignList="failed" => nil
!   [['%seq,x,:assignList,g],m',e]
  
  setqMultipleExplicit(nameList,valList,m,e) ==
    #nameList~=#valList =>
*************** setqMultipleExplicit(nameList,valList,m,
*** 1020,1026 ****
      [[.,.,e]:= compSetq1(name,g,$EmptyMode,e) or return "failed"
        for g in gensymList for name in nameList]
    reAssignList="failed" => nil
!   [["PROGN",:[T.expr for T in assignList],:[T.expr for T in reAssignList]],
      $NoValueMode, last(reAssignList).env]
  
  --% Quasiquotation
--- 1020,1026 ----
      [[.,.,e]:= compSetq1(name,g,$EmptyMode,e) or return "failed"
        for g in gensymList for name in nameList]
    reAssignList="failed" => nil
!   [['%seq,:[T.expr for T in assignList],:[T.expr for T in reAssignList]],
      $NoValueMode, last(reAssignList).env]
  
  --% Quasiquotation
*************** coerceEasy(T,m) ==
*** 1781,1788 ****
    m=$NoValueMode or m=$Void => [T.expr,m,T.env]
    T.mode =m => T
    T.mode =$Exit =>
!       [["PROGN", T.expr, ["userError", '"Did not really exit."]],
!         m,T.env]
    T.mode=$EmptyMode or modeEqualSubst(T.mode,m,T.env) =>
      [T.expr,m,T.env]
  
--- 1781,1787 ----
    m=$NoValueMode or m=$Void => [T.expr,m,T.env]
    T.mode =m => T
    T.mode =$Exit =>
!       [['%seq,T.expr,["userError", '"Did not really exit."]],m,T.env]
    T.mode=$EmptyMode or modeEqualSubst(T.mode,m,T.env) =>
      [T.expr,m,T.env]
  
*************** compRetractGuard(x,t,sn,sm,e) ==
*** 2141,2147 ****
      -- the condition and the body of the alternative, so just use 
      -- assignment here and let the rest of the compiler deal with it.
      z := gensym()
!     caseCode := ["PROGN",["%LET",z,retractCode],['%ieq,['%head,z],0]]
      restrictCode := ["%tail",z]
    -- 1.3. Everything else failed; nice try.
    else return stackAndThrow('"%1bp is not retractable to %2bp",[sm,t])
--- 2140,2146 ----
      -- the condition and the body of the alternative, so just use 
      -- assignment here and let the rest of the compiler deal with it.
      z := gensym()
!     caseCode := ['%seq,["%LET",z,retractCode],['%ieq,['%head,z],0]]
      restrictCode := ["%tail",z]
    -- 1.3. Everything else failed; nice try.
    else return stackAndThrow('"%1bp is not retractable to %2bp",[sm,t])
*************** compRecoverGuard(x,t,sn,sm,e) ==
*** 2213,2219 ****
      [def,.,e] := compOrCroak(varDef,$EmptyMode,e)
      [hasTest,.,e] := compOrCroak(["has",var',cat'],$EmptyMode,e)
      [guard,inits,e,envFalse] := compRecoverDomain(x,var',sn,e)
!     [["PROGN",def,hasTest],inits,e,envFalse]
    -- 2. Hand it to whoever is in charge.
    compRecoverDomain(x,t,sn,e)
  
--- 2212,2218 ----
      [def,.,e] := compOrCroak(varDef,$EmptyMode,e)
      [hasTest,.,e] := compOrCroak(["has",var',cat'],$EmptyMode,e)
      [guard,inits,e,envFalse] := compRecoverDomain(x,var',sn,e)
!     [['%seq,def,hasTest],inits,e,envFalse]
    -- 2. Hand it to whoever is in charge.
    compRecoverDomain(x,t,sn,e)
  
*** src/interp/g-opt.boot	(revision 21632)
--- src/interp/g-opt.boot	(local)
*************** changeVariableDefinitionToStore(form,var
*** 136,141 ****
--- 136,143 ----
      vars
    form is ['%loop,:iters,body,val] =>
      changeLoopVarDefsToStore(iters,body,val,vars)
+   if form is ['%seq,:.] then
+     form.args := spliceSeqArgs form.args
    for x in form repeat
      vars := changeVariableDefinitionToStore(x,vars)
    vars
*** src/interp/g-util.boot	(revision 21632)
--- src/interp/g-util.boot	(local)
*************** module g_-util where
*** 45,50 ****
--- 45,51 ----
    usedSymbol?: (%Symbol,%Code) -> %Boolean
    isDefaultPackageName: %Symbol -> %Boolean
    makeDefaultPackageName: %String -> %Symbol
+   spliceSeqArgs: %List %Code -> %Code
  
  --%
  
*************** mkBind(inits,expr) ==
*** 67,73 ****
      mkBind([:inits,:inits'],expr')
    ['%bind,inits,expr]
  
! 
  
  --%
  
--- 68,87 ----
      mkBind([:inits,:inits'],expr')
    ['%bind,inits,expr]
  
! ++ We have a list `l' of expressions to be executed sequentially.
! ++ Splice in any directly-embedded sequence of expressions.
! ++ NOTES: This function should not be called on any program with
! ++        an %exit-form in it.  In particular, it should be called
! ++        (if at all) before any call to simplifyVMForm.
! spliceSeqArgs l ==
!   atomic? l => l
!   l is [['%seq,:stmts],:.] =>
!     stmts = nil => spliceSeqArgs rest l
!     lastNode(stmts).rest := spliceSeqArgs rest l
!     stmts
!   rest l = nil => l
!   l.rest := spliceSeqArgs rest l
!   l
  
  --%