(* ssa.str      *)
(* Jeremy Singer *)
(* 28 May 04     *)

(* $Id: ssa.str,v 1.9 2004/06/21 18:54:27 jds31 Exp jds31 $ *)

(* transforms Tiger
 * programs to SSA
 *)

module ssa
imports Tiger lib dynamic-rules Tiger-ControlFlow2 Tiger-Needed

rules


  (**************************************************)
  (* phi fn placement rules *)


  (* insert phis at merge points after if/then/else stmts *)

  InsertPhis1:
   If(cond,then-br,else-br) ->
    Seq([If(cond,then-br,else-br)
    | <map(\ Var(v) -> Assign(Var(v), Call(Var("phi"), [Var(v),Var(v)])) \ )>defvarlist])
    where <union>(<defined>then-br, <defined>else-br) => defvarlist

  (* insert phis at merge pts after if/then stmts *)

  InsertPhis2:
   IfThen(cond,then-br) ->
    Seq([IfThen(cond,then-br)
    | <map(\ Var(v) -> Assign(Var(v), Call(Var("phi"), [Var(v),Var(v)])) \ )>defvarlist])
    where <defined>then-br => defvarlist


  (* insert phis at merge points in while stmt loop headers *)
  (* phi fns are executed as side-effect of loop condition evaluation *)

  InsertPhis3:
   While(cond,body) ->
    While(Seq(newcond),body)
    where <defined>body => defvarlist
        ; <map(\ Var(v) -> Assign(Var(v), Call(Var("phi"), [Var(v),Var(v)])) \ )>defvarlist 
          => phifns
        ; <conc>([Seq(phifns)], [cond]) => newcond


  (**************************************************)
  (* var renaming rules *)


  (* creates a new name for dst opnd of assignment stmt *)
  (* renames RHS of assignment stmt first *)

  RenameVarDef : Assign(Var(x), e1) -> Assign(Var(y), e2)
                    where new => y
                        ; <rename-expr>e1 => e2  (* before x gets new name *)
                        ; rules(RenameVar : Var(x) -> Var(y))
                        ; debug(!"adding rename rule ")

  (* creates a new name for phi dst opnd,
   * unlike RenameVarDef, does not rewrite RHS of assignment stmt *)

  RenamePhis0:
   Assign(Var(x_old), Call(Var("phi"), [y,z])) ->
        Assign(Var(x_new), Call(Var("phi"), [y,z]))
          where new => x_new

              ; rules(RenameVar : Var(x_old) -> Var(x_new))
              ; debug(!"adding rename rule ")

  (* renames first src opnd of phi fn *)

  RenamePhis1:
   Assign(a, Call(Var("phi"), [x,b])) -> Assign(a, Call(Var("phi"), [y,b]))
      where <RenameVar>x => y

  (* renames second src opnd of phi fn *)

  RenamePhis2:
   Assign(a, Call(Var("phi"), [b,x])) -> Assign(a, Call(Var("phi"), [b,y]))
      where <RenameVar>x => y


strategies

  (**************************************************)
  (* phi fn placement strategies *)

  (* bottom-up deals with phi-fn cascade problem *)	
  insert-phis = bottomup(try(InsertPhis1 + InsertPhis2 + InsertPhis3))  


  (**************************************************)
  (* var renaming strategies *)

  rename-defs = RenameVarDef

  (* handle compound exprs with embedded commands *)

  rename-expr = rename-cmd 

  (* renames simple exprs, ignoring control-flow commands etc *)

  rename-exprs = bottomupS(try(RenameVar), control-flow-ssa)

  (* phi-fn opnd renaming strategies *)
  (* usually applied to lists of phi-fns, hence bottom-up traversal *)

  rename-phis-0 = bottomup(try(RenamePhis0))
  rename-phis-1 = bottomup(try(RenamePhis1))
  rename-phis-2 = bottomup(try(RenamePhis2))


  rename-if(s) = Seq([If(rename-expr,id,id) | id]) (*rename vars in condition*)
                 ; where(save => dr-in)
                 ; Seq([If(id,s,id) | id]) (* rename then branch *)
                 ; Seq([If(id,id,id) | rename-phis-1]) (* rename phi srcs *)
                 ; where(save => dr-then; <restore> dr-in)
                 ; Seq([If(id,id,s) | id]) (* rename else branch *)
                 ; Seq([If(id,id,id) | rename-phis-2]) (* rename phi srcs *)
                 ; where (<isect> dr-then)

  rename-ifthen(s) = Seq([IfThen(rename-expr,id) | id]) (*rename vars in cond*)
                     ; Seq([IfThen(id,id) | rename-phis-2]) (*rename phi srcs*)
                     ; where(save => dr-in)
                     ; Seq([IfThen(id,s) | id]) (* rename then branch *)
                     ; Seq([IfThen(id,id) | rename-phis-1]) (*rename phi srcs*)
                     ; where (<isect> dr-in)
  

  rename-while(s) = While(Seq([Seq(rename-phis-1), id]),id) (*rename phi srcs*)
                    ; While(Seq([Seq(rename-phis-0),id]),id) (*rename phi dsts*)
                    ; While(Seq([id, rename-expr]), id) (*rename vars in condition*)
                    ; where(save => dr-in)
                    ; While(id, s) (*rename vars in body*)
                    ; While(Seq([Seq(rename-phis-2),id]),id)(*rename phi srcs*)
                    ; where (<restore> dr-in)


  rename-cmd = topdownS(try(rename-defs <+
                            rename-conditionals(rename-cmd) <+
                            rename-exprs)
                    , control-flow-ssa)

  (* only handle a limited subset of the control-flow constructs *)
  (* notably absent: for loops and break stmts *)

  control-flow-ssa(s) = Assign(id, id) +
                        If(id,id,id) +
                        IfThen(id,id) +
                        While(id,id)

  rename-conditionals(s) = rename-if(s) + rename-ifthen(s) + rename-while(s)

  (* can't deal with multiple fn declarations at the moment *)

  single-fn-ssa = insert-phis; rename-cmd

  ssa-transform = single-fn-ssa

  main = stdio(ssa-transform)




(* Definitions below stolen from Tiger-CP1 (const propn example)
 * These strategies used for management of dynamic rules
 *)

  restore  = [restore-SSA] 
  isect    = [isect-SSA] 
  updated  = [defined-SSA] 

  save  = ![<save-SSA> ()]
  clean = ![<clean-SSA>()]



//Strategies for dynamic rules 

  defined-SSA =
    save-SSA => dr;
    <filter(?(Keys(_), _))> dr;
    map(\ (Keys(x), _) -> x\ )

  save-SSA =
    <table-getlist> "RenameVar"; debug(!"saving rules ")

  clean-SSA = 
    where(<table-destroy> "RenameVar"; 
	  <table-putlist>("RenameVar", []))

  restore-SSA = ?tbl;
    where(<table-destroy> "RenameVar"; 
	  <table-putlist>("RenameVar", tbl)); debug(!"restoring rules ")

  isect-SSA = 
     map(try(?(Scopes,_)
        <+ {?(key, [Defined(_,value)|_]); 
            (where(<table-get> ("RenameVar", key) => [Defined(_,value)|_])
             <+ !(key, [Undefined]))
           })); debug(!"map ")
    ; restore-SSA

  Undef-SSAs = 
    where(
      map(try({x: ?Var(x); rules(RenameVar: Var(x) -> Undefined) }))
    )