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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 740 - (view) (download)

1 : jhr 740 (* 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 exp list
38 :    
39 :     fun hashArgs (args, base) =
40 :     List.foldl (fn (E{uid, ...}, h) => uid+h) base args
41 :    
42 :     fun hashNode (VAR x) = IL.Var.hash x
43 :     | hashNode (LIT l) = Literal.hash l
44 :     | hashNode (OP(rator, args)) = hashArgs (IL.Op.hash rator, args)
45 :     | hashNode (APPLY(f, args)) = hashArgs (ILBasis.hash f, args)
46 :     | hashNode (CONS args) = hashArgs (0w49, args)
47 :    
48 :     fun sameNode (VAR x, VAR y) = IL.Var.same(x, y)
49 :     | sameNode (LIT l1, LIT l2) = Literal.same(l1, l2)
50 :     | sameNode (OP(rator1, args1), OP(rator2, args2)) =
51 :     | sameNode (APPLY(f1, args1), APPLY(f2, args2)) =
52 :     | sameNode (CONS args1, CONS args2) =
53 :    
54 :     structure Tbl = HashTableFn (
55 :     struct
56 :     type hash_key = (word * exp_node)
57 :     fun hashVal (h, _) = h
58 :     fun sameKey ((_, e1), (_, e2)) = sameNode(e1, e2)
59 :     end)
60 :    
61 :     (* hashConsExp : unit -> exp_node -> exp
62 :     * returns the hash-consed representation of an expression.
63 :     *)
64 :     fun hashConsExp () = let
65 :     val uidCnt = ref 0w0
66 :     val tbl = Tbl.mkTable (1024, raise Fail "Value Table")
67 :     val find = Tbl.find tbl
68 :     val insert = Tbl.insert tbl
69 :     fun mk e = let
70 :     val h = hashNode e
71 :     val key = (h, e)
72 :     in
73 :     case find key
74 :     of SOME exp => exp
75 :     | NONE => let
76 :     val uid = !uidCnt
77 :     val exp = E{uid=uid, hash=h, term=e}
78 :     in
79 :     insert (key, exp);
80 :     exp
81 :     end
82 :     (* end case *)
83 :     end
84 :     in
85 :     mk
86 :     end
87 :    
88 :     local
89 :    
90 :     fun compareExp (E{uid=a, ...}, E{uid=b, ...}) = Word.compare(a, b)
91 :    
92 :     structure ValueSet = RedBlackSetFn (
93 :     struct
94 :     type ord_key = exp
95 :     val compare = compareExp
96 :     end)
97 :     structure ValueMap = RedBlackMapFn (
98 :     struct
99 :     type ord_key = exp
100 :     val compare = compareExp
101 :     end)
102 :    
103 :     (* property for mapping variables to their value number (VN), which is represented as a
104 :     * SSA variable. If their VN is different from themselves, then they are redundant.
105 :     *)
106 :     val {getFn=getVN, setFn=setVN, clrFn=clrVN, ...} = IL.Var.newProp (fn x => x)
107 :    
108 :     (* property for mapping value numbers to hash-consed expressions. *)
109 :     val {getFn : IL.var -> exp =getExp, setFn=setExp, clrFn=clrExp, ...} =
110 :     IL.Var.newProp (fn x => raise Fail "getExp")
111 :    
112 :     datatype env = ENV of {
113 :     avail : IL.Var ValueMap.map (* map from expressions to their value numbers, which *)
114 :     (* are represented as SSA vars. The domain are those *)
115 :     (* expressions that are available. *)
116 :     }
117 :     in
118 :     (* map variables to their hash-consed definition *)
119 :     fun varToExp x = getExp(getVN x)
120 :     fun bindVarToExp (E{avail}, x, e) = (
121 :     setVN(x, x); setExp(x, e);
122 :     E{avail=ValueMap.insert(avail, e, x))
123 :     fun expToVN (E{avail}, e) = ValueMap.find(avail, e)
124 :     end (* local *)
125 :    
126 :     fun rewrite nd = (case IL.Node.kind nd
127 :     (* end case *))
128 :    
129 :     fun transform prog = let
130 :     val hashConsExp = hashConsExp()
131 :     fun varsToExp (env, xs) = List.map (fn x => varToExp(env, x)) xs
132 :     (* convert an SSA RHS into a hash-consed expression *)
133 :     fun mkExp (env, rhs) = (case rhs
134 :     of IL.VAR x => varToExp(env, x)
135 :     | IL.LIT l => hashConsExp(LIT l)
136 :     | IL.OP(rator, args) => hashConsExp(OP(rator, varsToExp(env args)))
137 :     | IL.APPLY(f, args) => hashConsExp(APPLY(f, varsToExp(env args)))
138 :     | IL.CONS args => hashConsExp(CONS(varsToExp(env args)))
139 :     (* end case *))
140 :     fun vn (env, nd) = let
141 :     val env = (case IL.Node.kind nd
142 :     of IL.JOIN{succ, ...} =>
143 :     | IL.ASSIGN{stm=(y, rhs), succ, ...} => let
144 :     val exp = mkExp(env, rhs)
145 :     in
146 :     case expToVN(env, exp)
147 :     of SOME x => (* y is redundant, so map it to x *)
148 :     | NONE => bindVarToExp(env, y, exp)
149 :     (* end case *)
150 :     end
151 :     | _ => env
152 :     (* end case *))
153 :     in
154 :     List.app (fn nd => vn (env, nd)) (D.children nd)
155 :     end
156 :     (* value number a CFG *)
157 :     fun vnCFG (env, cfg) = (
158 :     D.computeTree cfg;
159 :     vn (env, IL.CFG.entryNode cfg);
160 :     D.clear cfg)
161 :     in
162 :     end
163 :    
164 :     end

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