Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Diff of /branches/pure-cfg/src/compiler/IL/value-numbering-fn.sml
ViewVC logotype

Diff of /branches/pure-cfg/src/compiler/IL/value-numbering-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1147, Sat May 7 03:58:34 2011 UTC revision 1148, Sat May 7 03:58:47 2011 UTC
# Line 21  Line 21 
21    end = struct    end = struct
22    
23      structure IL = D.IL      structure IL = D.IL
24      structure HC = HashCons      structure E = ExprFn (IL)
25        structure ValueMap = E.Map
26    
27      datatype exp = E of {      type expr = E.expr
         uid : word,             (* unique ID *)  
         hash : word,            (* hash value *)  
         term : exp_node  
       }  
28    
29      and exp_node    (* adjust a variable's use count *)
30        = VAR of IL.var      fun incUse (IL.V{useCnt, ...}) = (useCnt := !useCnt + 1)
31        | LIT of Literal.literal      fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)
       | OP of Op.rator * exp list  
       | APPLY of ILBasis.name * exp list  
       | CONS of IL.Ty.ty * exp list  
       | PHI of exp list  
   
     fun hashArgs (args, base) =  
           List.foldl (fn (E{uid, ...}, h) => uid+h) base args  
   
     fun hashNode (VAR x) = IL.Var.hash x  
       | hashNode (LIT l) = Literal.hash l  
       | hashNode (OP(rator, args)) = hashArgs (IL.Op.hash rator, args)  
       | hashNode (APPLY(f, args)) = hashArgs (ILBasis.hash f, args)  
       | hashNode (CONS(ty, args)) = hashArgs (IL.Ty.hash ty + 0w49, args)  
       | hashNode (PHI args) = hashArgs (0w57, args)  
   
     fun sameNode (VAR x, VAR y) = IL.Var.same(x, y)  
       | sameNode (LIT l1, LIT l2) = Literal.same(l1, l2)  
       | sameNode (OP(rator1, args1), OP(rator2, args2)) =  
           IL.Op.same(rator1, rator2) andalso ListPair.allEq sameNode (args1, args2)  
       | sameNode (APPLY(f1, args1), APPLY(f2, args2)) =  
           ILBasis.same(f1, f2) andalso ListPair.allEq sameNode (args1, args2)  
       | sameNode (CONS(ty1, args1), CONS(ty2, args2)) =  
           IL.Ty.same(ty1, ty2) andalso ListPair.allEq sameNode (args1, args2)  
       | sameNode (PHI args1, PHI args2) = ListPair.allEq sameNode (args1, args2)  
   
     structure Tbl = HashTableFn (  
       struct  
         type hash_key = (word * exp_node)  
         fun hashVal (h, _) = h  
         fun sameKey ((_, e1), (_, e2)) = sameNode(e1, e2)  
       end)  
   
   (* hashConsExp : unit -> exp_node -> exp  
    * returns the hash-consed representation of an expression.  
    *)  
     fun hashConsExp () = let  
           val uidCnt = ref 0w0  
           val tbl = Tbl.mkTable (1024, raise Fail "Value Table")  
           val find = Tbl.find tbl  
           val insert = Tbl.insert tbl  
           fun mk e = let  
                 val h = hashNode e  
                 val key = (h, e)  
                 in  
                   case find key  
                    of SOME exp => exp  
                     | NONE => let  
                         val uid = !uidCnt  
                         val exp = E{uid=uid, hash=h, term=e}  
                         in  
                           insert (key, exp);  
                           exp  
                         end  
                   (* end case *)  
                 end  
           in  
             mk  
           end  
32    
33      local      local
   
       fun compareExp (E{uid=a, ...}, E{uid=b, ...}) = Word.compare(a, b)  
   
       structure ValueSet = RedBlackSetFn (  
         struct  
           type ord_key = exp  
           val compare = compareExp  
         end)  
       structure ValueMap = RedBlackMapFn (  
         struct  
           type ord_key = exp  
           val compare = compareExp  
         end)  
   
34      (* property for mapping variables to their value number (VN), which is represented as a      (* property for mapping variables to their value number (VN), which is represented as a
35       * SSA variable.  If their VN is different from themselves, then they are redundant.       * SSA variable.  If their VN is different from themselves, then they are redundant.
36       *)       *)
37        val {getFn=getVN, setFn=setVN, clrFn=clrVN, ...} = IL.Var.newProp (fn x => x)        val {getFn=getVN, setFn=setVN, clrFn=clrVN, ...} = IL.Var.newProp (fn x => x)
38    
39      (* property for mapping value numbers to hash-consed expressions. *)      (* property for mapping value numbers to hash-consed expressions. *)
40        val {getFn : IL.var -> exp =getExp, setFn=setExp, clrFn=clrExp, ...} =        val {getFn=getExp : IL.var -> expr, setFn=setExp, clrFn=clrExp, ...} =
41              IL.Var.newProp (fn x => raise Fail "getExp")              IL.Var.newProp (fn x => raise Fail "getExp")
42    
43        datatype env = ENV of {        datatype env = ENV of {
44            avail : IL.Var ValueMap.map   (* map from expressions to their value numbers, which *)            avail : IL.var ValueMap.map   (* map from expressions to their value numbers, which *)
45                                          (* are represented as SSA vars.  The domain are those *)                                          (* are represented as SSA vars.  The domain are those *)
46                                          (* expressions that are available. *)                                          (* expressions that are available. *)
47          }          }
48      in      in
49        val emptyEnv = ENV{avail = ValueMap.empty}
50    (* map variables to their hash-consed definition *)    (* map variables to their hash-consed definition *)
51      val getVN = getVN      val getVN = getVN
52        val setVN = setVN
53      fun varToExp x = getExp(getVN x)      fun varToExp x = getExp(getVN x)
54      fun bindVarToExp (E{avail}, x, e) = (      fun bindVarToExp (ENV{avail}, x, e) = (
55            setVN(x, x); setExp(x, e);            setVN(x, x); setExp(x, e);
56            E{avail=ValueMap.insert(avail, e, x))            ENV{avail = ValueMap.insert(avail, e, x)})
57      fun expToVN (E{avail}, e) = ValueMap.find(avail, e)      fun expToVN (ENV{avail}, e) = ValueMap.find(avail, e)
58      (* rename a variable if it's value number is different than itself *)
59        fun rename x = let
60              val x' = getVN x
61              in
62                if IL.Var.same(x, x')
63                  then x
64                  else (
65    (*DEBUG*)Log.msg(concat["** rename ", IL.Var.toString x, " to ", IL.Var.toString x', "\n"]);
66                    decUse x; incUse x';
67                    x')
68              end
69      (* does a variable change? *)
70        fun changed x = not(IL.Var.same(x, getVN x))
71      (* clear properties from the variables of a node *)
72        fun clearNode nd = List.app (fn x => (clrVN x; clrExp x)) (IL.Node.defs nd)
73      end (* local *)      end (* local *)
74    
75      fun rewrite nd = (case IL.Node.kind nd      fun rewriteCFG cfg = let
76            (* in case the exit node get rewritten, we need to reset it *)
77              val exitNd = ref(IL.CFG.exit cfg)
78            (* rewrite or delete a node, if necessary.  Note that we have already rewritten the JOIN nodes *)
79              fun doNode nd = (case IL.Node.kind nd
80                     of IL.COND{pred, cond, trueBranch, falseBranch} =>
81                          if changed cond
82                            then let
83                              val newNd = IL.Node.mkCOND {
84                                      cond = rename cond,
85                                      trueBranch = !trueBranch,
86                                      falseBranch = !falseBranch
87                                    }
88                              in
89                                IL.Node.replaceInEdge {src = !pred, oldDst = nd, dst = newNd};
90                                IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !trueBranch};
91                                IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !falseBranch}
92                              end
93                            else ()
94                      | IL.ASSIGN{stm=(y, rhs), succ, ...} =>
95                          if changed y
96                            then IL.CFG.deleteNode nd (* deleting redundant assignment *)
97                          else if (List.exists changed (IL.RHS.vars rhs))
98                          (* rewrite node to rename variables *)
99                            then IL.CFG.replaceNode(nd, IL.Node.mkASSIGN(y, IL.RHS.map rename rhs))
100                            else ()
101                      | IL.NEW{strand, args, ...} =>
102                          if List.exists changed args
103                            then IL.CFG.replaceNode(nd, IL.Node.mkNEW{
104                                strand=strand, args=List.map rename args
105                              })
106                            else ()
107                      | IL.EXIT{kind, live, ...} =>
108                          if List.exists changed live
109                            then let
110                              val newNd = IL.Node.mkEXIT(kind, List.map rename live)
111                              in
112                                if IL.Node.same(nd, !exitNd)
113                                  then exitNd := newNd
114                                  else ();
115                                IL.CFG.replaceNode (nd, newNd)
116                              end
117                            else ()
118                      | _ => ()
119            (* end case *))            (* end case *))
120              val _ = List.app doNode (IL.CFG.sort cfg)
121              val cfg = IL.CFG{entry = IL.CFG.entry cfg, exit = !exitNd}
122              in
123                IL.CFG.apply clearNode cfg;
124                cfg
125              end
126    
127      fun transform prog = let      fun transformCFG (liveIn, cfg) = let
128            val hashConsExp = hashConsExp()            val tbl = E.new()
129            fun varsToExp (env, xs) = List.map (fn x => varToExp(env, x)) xs            val mkVAR = E.mkVAR tbl
130              val mkLIT = E.mkLIT tbl
131              val mkOP = E.mkOP tbl
132              val mkAPPLY = E.mkAPPLY tbl
133              val mkCONS = E.mkCONS tbl
134              val mkPHI = E.mkPHI tbl
135            (* convert a list of variables to a list of expressions *)
136              fun varsToExp (env, xs) = List.map varToExp xs
137          (* convert an SSA RHS into a hash-consed expression *)          (* convert an SSA RHS into a hash-consed expression *)
138            fun mkExp (env, rhs) = (case rhs            fun mkExp (env, rhs) = (case rhs
139                   of IL.VAR x => varToExp(env, x)                   of IL.VAR x => varToExp x
140                    | IL.LIT l => hashConsExp(LIT l)                    | IL.LIT l => mkLIT l
141                    | IL.OP(rator, args) => hashConsExp(OP(rator, varsToExp(env, args)))                    | IL.OP(rator, args) => mkOP(rator, varsToExp(env, args))
142                    | IL.APPLY(f, args) => hashConsExp(APPLY(f, varsToExp(env, args)))                    | IL.APPLY(f, args) => mkAPPLY(f, varsToExp(env, args))
143                    | IL.CONS(ty, args) => hashConsExp(CONS(ty, varsToExp(env, args)))                    | IL.CONS(ty, args) => mkCONS(ty, varsToExp(env, args))
144                  (* end case *))                  (* end case *))
145            (* walk the dominator tree computing value numbers *)
146            fun vn (env, nd) = let            fun vn (env, nd) = let
147                  val env = (case IL.Node.kind nd                  val env = (case IL.Node.kind nd
148                         of IL.JOIN{succ, phis, ...} => let                         of IL.JOIN{succ, phis, ...} => let
149                              fun doPhi ((y, xs), env) = let                              fun doPhi ((y, xs), (env, phis)) = let
150                                    val vn::vns = List.map getVN xs                                    val vn::vns = List.map getVN xs
151                                    in                                    in
152                                      if List.all (fn vn' => IL.Var.same(vn, vn')) vns                                      if List.all (fn vn' => IL.Var.same(vn, vn')) vns
153                                        then (* a meaningless phi node; map y to vn *)                                        then ((* a meaningless phi node; map y to vn *)
154    (* DEBUG *)Log.msg(concat["** meaningless phi node: ", IL.phiToString (y, xs), "\n"]);
155                                            List.map decUse xs;
156                                            setVN(y, vn);
157                                            (env, phis))
158                                        else let                                        else let
159                                          val exp = hashConsExp(PHI(varsToExp(env, args)))                                          val exp = mkPHI(varsToExp(env, xs))
160                                          in                                          in
161                                            case expToVN(env, exp)                                            case expToVN(env, exp)
162                                             of SOME x => (* a redundant phi node *)                                             of SOME vn' => ((* a redundant phi node *)
163                                              | NONE => bindVarToExp(env, y, exp)  (* DEBUG *)Log.msg(concat["** redundant phi node: ", IL.phiToString (y, xs), "\n"]);
164                                                    List.map decUse xs;
165                                                    setVN(y, vn');
166                                                    (env, phis))
167                                                | NONE => let
168                                                    val xs = List.map rename xs
169                                                    in
170                                                      (bindVarToExp(env, y, exp), (y, xs)::phis)
171                                                    end
172                                            (* end case *)                                            (* end case *)
173                                          end                                          end
174                                    end                                    end
175                                val (env, remainingPhis) = List.foldl doPhi (env, []) (!phis)
176                              in                              in
177                                List.foldl doPhi env (!phis)                                phis := List.rev remainingPhis;
178                                  env
179                              end                              end
180                          | IL.ASSIGN{stm=(y, rhs), succ, ...} => let                          | IL.ASSIGN{stm=(y, rhs), succ, ...} => let
181                              val exp = mkExp(env, rhs)                              val exp = mkExp(env, rhs)
182                              in                              in
183                                case expToVN(env, exp)                                case expToVN(env, exp)
184                                 of SOME x => (* y is redundant, so map it to x *)                                 of SOME vn => ((* y is redundant, so map it to vn *)
185                                  | NONE => bindVarToExp(env, y, exp)  (* DEBUG *)Log.msg(concat["** redundant assignment: ", IL.assignToString (y, rhs),
186    "; VN[", IL.Var.toString y, "] = ", IL.Var.toString vn, "\n"]);
187                                        setVN(y, vn);
188                                        env)
189                                    | NONE => (
190                                        bindVarToExp(env, y, exp))
191                                (* end case *)                                (* end case *)
192                              end                              end
193                          | _ => env                          | _ => env
# Line 177  Line 195 
195                  in                  in
196                    List.app (fn nd => vn (env, nd)) (D.children nd)                    List.app (fn nd => vn (env, nd)) (D.children nd)
197                  end                  end
198          (* value number a CFG *)          (* define the initial environment by mapping the liveIn variables to themselves *)
199            fun vnCFG (env, cfg) = (            val env = List.foldl (fn (x, env) => bindVarToExp(env, x, mkVAR x)) emptyEnv liveIn
200              in
201                  D.computeTree cfg;                  D.computeTree cfg;
202                  vn (env, IL.CFG.entryNode cfg);            (* compute value numbers over the dominance tree *)
203                  D.clear cfg)              vn (env, IL.CFG.entry cfg);
204                D.clear cfg;
205              (* delete and rewrite nodes as necessary *)
206                rewriteCFG cfg
207              end
208    
209        fun transform prog = let
210              val IL.Program{globalInit, initially, strands} = prog
211              val globalInit = transformCFG ([], globalInit)
212              val globals = IL.CFG.liveAtExit globalInit
213              fun transformStrand (IL.Strand{name, params, state, stateInit, methods}) = let
214                    val liveIn = params @ globals
215                    val stateInit = transformCFG (liveIn, stateInit)
216    (* FIXME: what if a state variable becomes redundant? *)
217                    fun transformMeth (IL.Method{name, stateIn, body}) = let
218                          val liveIn = stateIn @ liveIn
219                          val body = transformCFG (liveIn, body)
220                          in
221                            IL.Method{name=name, stateIn=stateIn, body=body}
222                          end
223                    in
224                      IL.Strand{
225                          name = name,
226                          params = params,
227                          state = state,
228                          stateInit = stateInit,
229                          methods = List.map transformMeth methods
230                        }
231                    end
232              val strands = List.map transformStrand strands
233            in            in
234                IL.Program{
235                    globalInit = globalInit,
236                    initially = initially,
237                    strands = strands
238                  }
239            end            end
240    
241    end    end

Legend:
Removed from v.1147  
changed lines
  Added in v.1148

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0