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

SCM Repository

[diderot] Annotation of /branches/pure-cfg/src/compiler/codegen/low-to-tree.sml
ViewVC logotype

Annotation of /branches/pure-cfg/src/compiler/codegen/low-to-tree.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 613 - (view) (download)

1 : jhr 529 (* low-to-tree.sml
2 :     *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 : jhr 530 *
6 :     * This module translates the LowIL representation of a program (i.e., a pure CFG) to
7 :     * a block-structured AST with nested expressions.
8 :     *
9 :     * NOTE: this translation is pretty dumb about variable coalescing (i.e., it doesn't do any).
10 : jhr 529 *)
11 :    
12 :     structure LowToTree : sig
13 :    
14 :     val translate : LowIL.program -> TreeIL.program
15 :    
16 :     end = struct
17 :    
18 :     structure IL = LowIL
19 :     structure Ty = LowILTypes
20 :     structure V = LowIL.Var
21 :     structure Op = LowOps
22 :     structure Nd = LowIL.Node
23 :     structure CFG = LowIL.CFG
24 :     structure T = TreeIL
25 :    
26 :     (* create new tree IL variables *)
27 :     local
28 : jhr 531 fun newVar (name, kind, ty) = T.V{
29 : jhr 529 name = name,
30 : jhr 531 id = Stamp.new(),
31 : jhr 529 kind = kind,
32 :     ty = ty
33 :     }
34 :     val cnt = ref 0
35 :     fun genName prefix = let
36 :     val n = !cnt
37 :     in
38 :     cnt := n+1;
39 :     String.concat[prefix, "_", Int.toString n]
40 :     end
41 :     in
42 : jhr 537 fun newGlobal x = newVar ("G_" ^ V.name x, T.VK_Global, V.ty x)
43 : jhr 538 fun newStateVar (strand, x) =
44 :     newVar (concat[Atom.toString strand, "_", V.name x], T.VK_State strand, V.ty x)
45 : jhr 539 fun newParam x = newVar (genName("p_" ^ V.name x), T.VK_Local, V.ty x)
46 : jhr 537 fun newLocal x = newVar (genName("l_" ^ V.name x), T.VK_Local, V.ty x)
47 : jhr 529 end
48 :    
49 : jhr 531 fun mkBlock stms = T.Block{locals=[], body=stms}
50 :     fun mkIf (x, stms, []) = T.S_IfThen(x, mkBlock stms)
51 :     | mkIf (x, stms1, stms2) = T.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)
52 :    
53 : jhr 530 (* an environment that tracks bindings of variables to target expressions and the list
54 :     * of locals that have been defined.
55 :     *)
56 : jhr 529 local
57 : jhr 530 structure VT = V.Tbl
58 :     fun decCount (IL.V{useCnt, ...}) = let
59 :     val n = !useCnt - 1
60 :     in
61 :     useCnt := n; (n <= 0)
62 :     end
63 :     datatype target_binding
64 :     = GLOB of T.var (* variable is global *)
65 :     | TREE of T.exp (* variable bound to target expression tree *)
66 :     | DEF of T.exp (* either a target variable or constant for a defined variable *)
67 :     datatype env = E of {
68 :     tbl : target_binding VT.hash_table,
69 :     locals : T.var list
70 :     }
71 : jhr 529 in
72 : jhr 531 fun newEnv () = E{tbl = VT.mkTable (512, Fail "tbl"), locals=[]}
73 :    
74 :     fun newScope (E{tbl, ...}) = E{tbl=tbl, locals=[]}
75 :    
76 : jhr 604 (* use a variable. If it is a pending expression, we remove it from the table *)
77 : jhr 530 fun useVar (E{tbl, ...}) x = (case VT.find tbl x
78 :     of SOME(GLOB x') => T.E_Var x'
79 :     | SOME(TREE e) => (
80 : jhr 604 ignore(VT.remove tbl x);
81 :     e)
82 :     | SOME(DEF e) => (
83 :     (* if this is the last use of x, then remove it from the table *)
84 : jhr 531 if (decCount x) then ignore(VT.remove tbl x) else ();
85 : jhr 530 e)
86 : jhr 538 | NONE => raise Fail(concat ["useVar(", V.toString x, ")"])
87 : jhr 529 (* end case *))
88 :    
89 : jhr 530 (* record a local variable *)
90 :     fun addLocal (E{tbl, locals}, x) = E{tbl=tbl, locals=x::locals}
91 : jhr 529
92 : jhr 531 fun global (E{tbl, ...}, x, x') = VT.insert tbl (x, GLOB x')
93 :    
94 : jhr 604 (* insert a pending expression into the table. Note that x should only be used once! *)
95 : jhr 530 fun insert (env as E{tbl, ...}, x, exp) = (
96 :     VT.insert tbl (x, TREE exp);
97 :     env)
98 : jhr 529
99 : jhr 530 fun rename (env as E{tbl, ...}, x, x') = (
100 : jhr 531 VT.insert tbl (x, DEF(T.E_Var x'));
101 : jhr 530 env)
102 : jhr 529
103 : jhr 537 fun peekGlobal (E{tbl, ...}, x) = (case VT.find tbl x
104 :     of SOME(GLOB x') => SOME x'
105 :     | _ => NONE
106 :     (* end case *))
107 :    
108 : jhr 538 fun bindLocal (env, lhs, rhs) = if (V.useCount lhs = 1)
109 :     then (insert(env, lhs, rhs), [])
110 :     else let
111 :     val t = newLocal lhs
112 :     in
113 : jhr 541 (rename(addLocal(env, t), lhs, t), [T.S_Assign(t, rhs)])
114 : jhr 538 end
115 :    
116 : jhr 530 fun bind (env, lhs, rhs) = (case peekGlobal (env, lhs)
117 :     of SOME x => (rename(env, lhs, x), [T.S_Assign(x, rhs)])
118 : jhr 538 | NONE => bindLocal (env, lhs, rhs)
119 : jhr 529 (* end case *))
120 :    
121 : jhr 604 (* set the definition of a variable, where the RHS is either a literal constant or a variable *)
122 :     fun setDef (env as E{tbl, ...}, lhs, rhs) = (case peekGlobal (env, lhs)
123 : jhr 530 of SOME x => (rename(env, lhs, x), [T.S_Assign(x, rhs)])
124 : jhr 604 | NONE => (VT.insert tbl (lhs, DEF rhs); (env, []))
125 : jhr 529 (* end case *))
126 :    
127 : jhr 530 (* at the end of a block, we need to assign any pending expressions to locals. The
128 :     * blkStms list and the resulting statement list are in reverse order.
129 :     *)
130 :     fun endBlock (E{tbl, locals}, blkStms) = let
131 :     fun doVar (x, TREE e, (locals, stms)) = let
132 : jhr 604 val t = newLocal x
133 :     in
134 :     VT.insert tbl (x, DEF(T.E_Var t));
135 :     (t::locals, T.S_Assign(t, e)::stms)
136 :     end
137 : jhr 539 | doVar (_, _, acc) = acc
138 : jhr 531 val (locals, stms) = VT.foldi doVar (locals, blkStms) tbl
139 : jhr 530 in
140 :     (E{tbl=tbl, locals=locals}, stms)
141 :     end
142 :    
143 :     fun doPhi ((lhs, rhs), (env, predBlks : T.stm list list)) = let
144 : jhr 604 (* t will be the variable in the continuation of the JOIN *)
145 : jhr 530 val t = newLocal lhs
146 :     val predBlks = ListPair.map
147 : jhr 531 (fn (x, stms) => T.S_Assign(t, useVar env x)::stms)
148 : jhr 530 (rhs, predBlks)
149 :     in
150 : jhr 541 (rename (addLocal(env, t), lhs, t), predBlks)
151 : jhr 530 end
152 :    
153 : jhr 531 fun endScope (E{locals, ...}, stms) = T.Block{
154 :     locals = List.rev locals,
155 :     body = stms
156 :     }
157 :    
158 : jhr 530 end
159 :    
160 : jhr 529 (* translate a LowIL assignment to a list of zero or more target statements *)
161 : jhr 537 fun doAssign (env, (lhs, rhs)) = let
162 :     fun doLHS () = (case peekGlobal(env, lhs)
163 :     of SOME lhs' => (env, lhs')
164 :     | NONE => let
165 :     val t = newLocal lhs
166 :     in
167 : jhr 541 (rename (addLocal(env, t), lhs, t), t)
168 : jhr 537 end
169 :     (* end case *))
170 :     in
171 :     case rhs
172 :     of IL.VAR x => setDef (env, lhs, useVar env x)
173 :     | IL.LIT lit => setDef (env, lhs, T.E_Lit lit)
174 :     | IL.OP(Op.LoadImage info, [a]) => let
175 :     val (env, t) = doLHS()
176 :     in
177 :     (env, [T.S_LoadImage(t, ImageInfo.dim info, useVar env a)])
178 :     end
179 :     | IL.OP(Op.Input(ty, name), []) => let
180 :     val (env, t) = doLHS()
181 :     in
182 :     (env, [T.S_Input(t, name, NONE)])
183 :     end
184 :     | IL.OP(Op.InputWithDefault(ty, name), [a]) => let
185 :     val (env, t) = doLHS()
186 :     in
187 :     (env, [T.S_Input(t, name, SOME(useVar env a))])
188 :     end
189 : jhr 548 | IL.OP(rator as Op.LoadVoxels(_, 1), [a]) =>
190 :     bind (env, lhs, T.E_Op(rator, [useVar env a]))
191 :     | IL.OP(Op.LoadVoxels(info, n), [a]) => let
192 :     (* loading multiple values from memory may not be supported inline *)
193 :     val (env, t) = doLHS()
194 :     in
195 :     (env, [T.S_LoadVoxels(t, n, useVar env a)])
196 :     end
197 : jhr 537 | IL.OP(rator, args) =>
198 :     bind (env, lhs, T.E_Op(rator, List.map (useVar env) args))
199 :     | IL.CONS args => let
200 :     (* we give cons expressions names, since not all targets support them inline *)
201 :     val (env, t) = doLHS()
202 :     val rhs = List.map (useVar env) args
203 :     in
204 :     (env, [T.S_Cons(t, rhs)])
205 :     end
206 :     (* end case *)
207 :     end
208 : jhr 529
209 : jhr 604 (* In order to reconstruct the block-structure from the CFG, we keep a stack of open ifs.
210 :     * the items on this stack distinguish between when we are processing the then and else
211 :     * branches of the if.
212 :     *)
213 : jhr 542 datatype open_if
214 :     (* working on the "then" branch. The fields are statments that preceed the if, the condition,
215 :     * and the else-branch node.
216 :     *)
217 :     = THEN_BR of T.stm list * T.exp * IL.node
218 :     (* working on the "else" branch. The fields are statments that preceed the if, the condition,
219 :     * the "then" branch statements, and the node that terminated the "then" branch (will be
220 :     * a JOIN, DIE, or STABILIZE).
221 :     *)
222 :     | ELSE_BR of T.stm list * T.exp * T.stm list * IL.node_kind
223 :    
224 : jhr 563 fun trCFG (env, prefix, finish, cfg) = let
225 : jhr 542 fun join (env, [], _, IL.JOIN _) = raise Fail "JOIN with no open if"
226 :     | join (env, [], _, _) = raise Fail "no path to exit unimplemented" (* FIXME *)
227 :     | join (env, THEN_BR(stms1, cond, elseBr)::stk, stms, k) =
228 :     doNode (env, ELSE_BR(stms1, cond, stms, k)::stk, [], elseBr)
229 :     | join (env, ELSE_BR(stms, cond, stms1, k1)::stk, stms2, k2) = let
230 :     val (env, thenBlk) = endBlock (env, stms1)
231 :     val (env, elseBlk) = endBlock (env, stms2)
232 :     in
233 :     case (k1, k2)
234 :     of (IL.JOIN{phis, succ, ...}, IL.JOIN _) => let
235 :     val (env, [thenBlk, elseBlk]) =
236 :     List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)
237 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
238 :     in
239 :     doNode (env, stk, stm::stms, !succ)
240 :     end
241 :     | (IL.JOIN{phis, succ, ...}, _) => let
242 :     val (env, [thenBlk]) = List.foldl doPhi (env, [thenBlk]) (!phis)
243 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
244 :     in
245 :     doNode (env, stk, stm::stms, !succ)
246 :     end
247 :     | (_, IL.JOIN{phis, succ, ...}) => let
248 :     val (env, [elseBlk]) = List.foldl doPhi (env, [elseBlk]) (!phis)
249 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
250 :     in
251 :     doNode (env, stk, stm::stms, !succ)
252 :     end
253 :     | (_, _) => raise Fail "no path to exit unimplemented" (* FIXME *)
254 :     (* end case *)
255 :     end
256 :     and doNode (env, ifStk : open_if list, stms, nd) = (
257 : jhr 531 case Nd.kind nd
258 : jhr 529 of IL.NULL => raise Fail "unexpected NULL"
259 : jhr 542 | IL.ENTRY{succ} => doNode (env, ifStk, stms, !succ)
260 :     | k as IL.JOIN{phis, succ, ...} => join (env, ifStk, stms, k)
261 :     | IL.COND{cond, trueBranch, falseBranch, ...} =>
262 :     doNode (env, THEN_BR(stms, useVar env cond, !falseBranch)::ifStk, [], !trueBranch)
263 : jhr 529 | IL.COM {text, succ, ...} =>
264 : jhr 542 doNode (env, ifStk, T.S_Comment text :: stms, !succ)
265 : jhr 531 | IL.ASSIGN{stm, succ, ...} => let
266 :     val (env, stms') = doAssign (env, stm)
267 :     in
268 : jhr 542 doNode (env, ifStk, stms' @ stms, !succ)
269 : jhr 531 end
270 : jhr 529 | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
271 : jhr 563 | k as IL.EXIT{kind, live, ...} => (case kind
272 :     of ExitKind.RETURN => let
273 :     val suffix = finish env @ [T.S_Exit(List.map (useVar env) live)]
274 :     in
275 :     endScope (env, prefix @ List.revAppend(stms, suffix))
276 :     end
277 :     | ExitKind.ACTIVE => let
278 :     val suffix = finish env @ [T.S_Active(List.map (useVar env) live)]
279 :     in
280 :     endScope (env, prefix @ List.revAppend(stms, suffix))
281 :     end
282 :     | ExitKind.STABILIZE => let
283 :     val stms = T.S_Stabilize(List.map (useVar env) live) :: stms
284 :     in
285 :     join (env, ifStk, stms, k)
286 :     end
287 :     | ExitKind.DIE => join (env, ifStk, T.S_Die :: stms, k)
288 :     (* end case *))
289 : jhr 529 (* end case *))
290 :     in
291 : jhr 542 doNode (env, [], [], CFG.entry cfg)
292 : jhr 529 end
293 :    
294 : jhr 538 fun trMethod (env, stateVars) (IL.Method{name, stateIn, stateOut, body}) = let
295 :     fun bindStateVar (x, x', (env, stms)) = let
296 :     val (env, stms') = bindLocal(env, x, T.E_Var x')
297 :     in
298 :     (env, stms' @ stms)
299 :     end
300 :     val (env, stms) = ListPair.foldrEq bindStateVar (env, []) (stateIn, stateVars)
301 :     in
302 : jhr 563 T.Method{name = name, body = trCFG (env, stms, fn _ => [], body)}
303 : jhr 538 end
304 :    
305 :     fun trStrand env (IL.Strand{name, params, state, stateInit, methods}) = let
306 : jhr 539 val params' = List.map newParam params
307 :     val env = ListPair.foldlEq (fn (x, x', env) => rename(env, x, x')) env (params, params')
308 : jhr 541 val stateVars = List.map (fn x => newStateVar(name, x)) state
309 :     (* finish the strand initialization code by initializing the state variables *)
310 :     fun finishInit env = let
311 :     fun initVar (x, x') = T.S_Assign(x', useVar env x)
312 :     in
313 :     ListPair.mapEq initVar (state, stateVars)
314 :     end
315 : jhr 538 in
316 :     T.Strand{
317 :     name = name,
318 : jhr 539 params = params',
319 : jhr 538 state = stateVars,
320 : jhr 563 stateInit = trCFG (env, [], finishInit, stateInit),
321 : jhr 538 methods = List.map (trMethod(env, stateVars)) methods
322 :     }
323 :     end
324 :    
325 : jhr 613 fun translate (IL.Program{globals, globalInit, initially, strands}) = let
326 : jhr 531 val env = newEnv()
327 :     val globals = List.map
328 :     (fn x => let val x' = newGlobal x in global(env, x, x'); x' end)
329 :     globals
330 :     in
331 : jhr 613 (* FIXME: translate initially code *)
332 : jhr 531 T.Program{
333 :     globals = globals,
334 : jhr 563 globalInit = trCFG (env, [], fn _ => [], globalInit),
335 : jhr 538 strands = List.map (trStrand env) strands
336 : jhr 531 }
337 :     end
338 :    
339 : jhr 529 end

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