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

SCM Repository

[diderot] Annotation of /trunk/src/compiler/IL/value-numbering-fn.sml
ViewVC logotype

Annotation of /trunk/src/compiler/IL/value-numbering-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1115 - (view) (download)

1 : jhr 1115 (* value-numbering-fn.sml
2 :     *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * This file contains an implementation of the hash-based value numbering
7 :     * algorithm described in
8 :     *
9 :     * Value Numbering
10 :     * by Preston Briggs, Keith Cooper, and Taylor Simpson
11 :     * CRPC-TR94517-S
12 :     * November 1994
13 :     *)
14 :    
15 :     functor ValueNumberingFn (D : DOMINANCE_TREE) : sig
16 :    
17 :     structure IL : SSA
18 :    
19 :     val transform : IL.program -> IL.program
20 :    
21 :     end = struct
22 :    
23 :     structure IL = D.IL
24 :     structure HC = HashCons
25 :    
26 :     datatype exp = E of {
27 :     uid : word, (* unique ID *)
28 :     hash : word, (* hash value *)
29 :     term : exp_node
30 :     }
31 :    
32 :     and exp_node
33 :     = VAR of IL.var
34 :     | LIT of Literal.literal
35 :     | OP of Op.rator * exp list
36 :     | APPLY of ILBasis.name * exp list
37 :     | CONS of IL.Ty.ty * exp list
38 :     | PHI of exp list
39 :    
40 :     fun hashArgs (args, base) =
41 :     List.foldl (fn (E{uid, ...}, h) => uid+h) base args
42 :    
43 :     fun hashNode (VAR x) = IL.Var.hash x
44 :     | hashNode (LIT l) = Literal.hash l
45 :     | hashNode (OP(rator, args)) = hashArgs (IL.Op.hash rator, args)
46 :     | hashNode (APPLY(f, args)) = hashArgs (ILBasis.hash f, args)
47 :     | hashNode (CONS(ty, args)) = hashArgs (IL.Ty.hash ty + 0w49, args)
48 :     | hashNode (PHI args) = hashArgs (0w57, args)
49 :    
50 :     fun sameNode (VAR x, VAR y) = IL.Var.same(x, y)
51 :     | sameNode (LIT l1, LIT l2) = Literal.same(l1, l2)
52 :     | sameNode (OP(rator1, args1), OP(rator2, args2)) =
53 :     IL.Op.same(rator1, rator2) andalso ListPair.allEq sameNode (args1, args2)
54 :     | sameNode (APPLY(f1, args1), APPLY(f2, args2)) =
55 :     ILBasis.same(f1, f2) andalso ListPair.allEq sameNode (args1, args2)
56 :     | sameNode (CONS(ty1, args1), CONS(ty2, args2)) =
57 :     IL.Ty.same(ty1, ty2) andalso ListPair.allEq sameNode (args1, args2)
58 :     | sameNode (PHI args1, PHI args2) = ListPair.allEq sameNode (args1, args2)
59 :    
60 :     structure Tbl = HashTableFn (
61 :     struct
62 :     type hash_key = (word * exp_node)
63 :     fun hashVal (h, _) = h
64 :     fun sameKey ((_, e1), (_, e2)) = sameNode(e1, e2)
65 :     end)
66 :    
67 :     (* hashConsExp : unit -> exp_node -> exp
68 :     * returns the hash-consed representation of an expression.
69 :     *)
70 :     fun hashConsExp () = let
71 :     val uidCnt = ref 0w0
72 :     val tbl = Tbl.mkTable (1024, raise Fail "Value Table")
73 :     val find = Tbl.find tbl
74 :     val insert = Tbl.insert tbl
75 :     fun mk e = let
76 :     val h = hashNode e
77 :     val key = (h, e)
78 :     in
79 :     case find key
80 :     of SOME exp => exp
81 :     | NONE => let
82 :     val uid = !uidCnt
83 :     val exp = E{uid=uid, hash=h, term=e}
84 :     in
85 :     insert (key, exp);
86 :     exp
87 :     end
88 :     (* end case *)
89 :     end
90 :     in
91 :     mk
92 :     end
93 :    
94 :     local
95 :    
96 :     fun compareExp (E{uid=a, ...}, E{uid=b, ...}) = Word.compare(a, b)
97 :    
98 :     structure ValueSet = RedBlackSetFn (
99 :     struct
100 :     type ord_key = exp
101 :     val compare = compareExp
102 :     end)
103 :     structure ValueMap = RedBlackMapFn (
104 :     struct
105 :     type ord_key = exp
106 :     val compare = compareExp
107 :     end)
108 :    
109 :     (* property for mapping variables to their value number (VN), which is represented as a
110 :     * SSA variable. If their VN is different from themselves, then they are redundant.
111 :     *)
112 :     val {getFn=getVN, setFn=setVN, clrFn=clrVN, ...} = IL.Var.newProp (fn x => x)
113 :    
114 :     (* property for mapping value numbers to hash-consed expressions. *)
115 :     val {getFn : IL.var -> exp =getExp, setFn=setExp, clrFn=clrExp, ...} =
116 :     IL.Var.newProp (fn x => raise Fail "getExp")
117 :    
118 :     datatype env = ENV of {
119 :     avail : IL.Var ValueMap.map (* map from expressions to their value numbers, which *)
120 :     (* are represented as SSA vars. The domain are those *)
121 :     (* expressions that are available. *)
122 :     }
123 :     in
124 :     (* map variables to their hash-consed definition *)
125 :     val getVN = getVN
126 :     fun varToExp x = getExp(getVN x)
127 :     fun bindVarToExp (E{avail}, x, e) = (
128 :     setVN(x, x); setExp(x, e);
129 :     E{avail=ValueMap.insert(avail, e, x))
130 :     fun expToVN (E{avail}, e) = ValueMap.find(avail, e)
131 :     end (* local *)
132 :    
133 :     fun rewrite nd = (case IL.Node.kind nd
134 :     (* end case *))
135 :    
136 :     fun transform prog = let
137 :     val hashConsExp = hashConsExp()
138 :     fun varsToExp (env, xs) = List.map (fn x => varToExp(env, x)) xs
139 :     (* convert an SSA RHS into a hash-consed expression *)
140 :     fun mkExp (env, rhs) = (case rhs
141 :     of IL.VAR x => varToExp(env, x)
142 :     | IL.LIT l => hashConsExp(LIT l)
143 :     | IL.OP(rator, args) => hashConsExp(OP(rator, varsToExp(env, args)))
144 :     | IL.APPLY(f, args) => hashConsExp(APPLY(f, varsToExp(env, args)))
145 :     | IL.CONS(ty, args) => hashConsExp(CONS(ty, varsToExp(env, args)))
146 :     (* end case *))
147 :     fun vn (env, nd) = let
148 :     val env = (case IL.Node.kind nd
149 :     of IL.JOIN{succ, phis, ...} => let
150 :     fun doPhi ((y, xs), env) = let
151 :     val vn::vns = List.map getVN xs
152 :     in
153 :     if List.all (fn vn' => IL.Var.same(vn, vn')) vns
154 :     then (* a meaningless phi node; map y to vn *)
155 :     else let
156 :     val exp = hashConsExp(PHI(varsToExp(env, args)))
157 :     in
158 :     case expToVN(env, exp)
159 :     of SOME x => (* a redundant phi node *)
160 :     | NONE => bindVarToExp(env, y, exp)
161 :     (* end case *)
162 :     end
163 :     end
164 :     in
165 :     List.foldl doPhi env (!phis)
166 :     end
167 :     | IL.ASSIGN{stm=(y, rhs), succ, ...} => let
168 :     val exp = mkExp(env, rhs)
169 :     in
170 :     case expToVN(env, exp)
171 :     of SOME x => (* y is redundant, so map it to x *)
172 :     | NONE => bindVarToExp(env, y, exp)
173 :     (* end case *)
174 :     end
175 :     | _ => env
176 :     (* end case *))
177 :     in
178 :     List.app (fn nd => vn (env, nd)) (D.children nd)
179 :     end
180 :     (* value number a CFG *)
181 :     fun vnCFG (env, cfg) = (
182 :     D.computeTree cfg;
183 :     vn (env, IL.CFG.entryNode cfg);
184 :     D.clear cfg)
185 :     in
186 :     end
187 :    
188 :     end

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