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

SCM Repository

[diderot] Annotation of /branches/vis12/src/compiler/tree-il/low-to-tree-fn.sml
ViewVC logotype

Annotation of /branches/vis12/src/compiler/tree-il/low-to-tree-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3291 - (view) (download)

1 : jhr 1115 (* low-to-tree-fn.sml
2 :     *
3 : jhr 3291 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 : jhr 1115 * All rights reserved.
7 :     *
8 :     * This module translates the LowIL representation of a program (i.e., a pure CFG) to
9 :     * a block-structured AST with nested expressions.
10 :     *
11 :     * NOTE: this translation is pretty dumb about variable coalescing (i.e., it doesn't do any).
12 :     *)
13 :    
14 :     functor LowToTreeFn (Target : sig
15 :    
16 : jhr 1640 val supportsPrinting : unit -> bool (* does the target support the Print op? *)
17 :    
18 : jhr 1115 (* tests for whether various expression forms can appear inline *)
19 : jhr 2279 val inlineCons : int -> bool (* can n'th-order tensor construction appear inline *)
20 :     val inlineMatrixExp : bool (* can matrix-valued expressions appear inline? *)
21 : jhr 1115
22 :     end) : sig
23 :    
24 :     val translate : LowIL.program -> TreeIL.program
25 :    
26 :     end = struct
27 :    
28 :     structure IL = LowIL
29 :     structure Ty = LowILTypes
30 :     structure V = LowIL.Var
31 : jhr 2796 structure GV = LowIL.GlobalVar
32 : jhr 1640 structure StV = LowIL.StateVar
33 : jhr 1115 structure Op = LowOps
34 :     structure Nd = LowIL.Node
35 :     structure CFG = LowIL.CFG
36 :     structure T = TreeIL
37 :     structure VA = VarAnalysis
38 : jhr 2012 structure InP = Inputs
39 : jhr 1115
40 : jhr 2796 (* associate Tree IL globals variables with Low IL variables using properties *)
41 : jhr 1115 local
42 : jhr 2796 fun mkGlobalVar x = T.GV{
43 :     name = GV.name x,
44 :     ty = GV.ty x,
45 :     input = GV.isInput x
46 :     }
47 : jhr 1115 in
48 : jhr 2818 val {setFn = setGlobalVar, getFn = getGlobalVar : IL.global_var -> T.global_var, ...} =
49 : jhr 2820 GV.newProp (fn x => raise Fail(concat["getGlobalVar(", GV.uniqueName x, ")"]))
50 : jhr 1115 end
51 :    
52 : jhr 1640 (* associate Tree IL state variables with Low IL variables using properties *)
53 :     local
54 :     fun mkStateVar x = T.SV{
55 :     name = StV.name x,
56 :     ty = StV.ty x,
57 :     varying = VA.isVarying x,
58 :     output = StV.isOutput x
59 :     }
60 :     in
61 :     val {getFn = getStateVar, ...} = StV.newProp mkStateVar
62 :     end
63 :    
64 : jhr 2796 (* create new tree IL variables *)
65 :     local
66 :     val newVar = T.Var.new
67 :     val cnt = ref 0
68 :     fun genName prefix = let
69 :     val n = !cnt
70 :     in
71 :     cnt := n+1;
72 :     String.concat[prefix, "_", Int.toString n]
73 :     end
74 :     in
75 :     fun newParam x = newVar (genName("p_" ^ V.name x), V.ty x)
76 :     fun newLocal x = newVar (genName("l_" ^ V.name x), V.ty x)
77 :     fun newIter x = newVar (genName("i_" ^ V.name x), V.ty x)
78 :     end
79 :    
80 : jhr 1115 fun mkBlock stms = T.Block{locals=[], body=stms}
81 :     fun mkIf (x, stms, []) = T.S_IfThen(x, mkBlock stms)
82 :     | mkIf (x, stms1, stms2) = T.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)
83 :    
84 :     (* an environment that tracks bindings of variables to target expressions and the list
85 :     * of locals that have been defined.
86 :     *)
87 :     local
88 :     structure VT = V.Tbl
89 :     fun decCount (IL.V{useCnt, ...}) = let
90 : jhr 2279 val n = !useCnt - 1
91 :     in
92 :     useCnt := n; (n <= 0)
93 :     end
94 : jhr 1115 datatype target_binding
95 : jhr 2818 = TREE of T.exp (* variable bound to target expression tree *)
96 : jhr 2279 | DEF of T.exp (* either a target variable or constant for a defined variable *)
97 : jhr 2820 | INP of T.global_var -> T.stm
98 :     (* Input statement constructor *)
99 : jhr 1115 datatype env = E of {
100 : jhr 2279 tbl : target_binding VT.hash_table,
101 :     locals : T.var list
102 :     }
103 : jhr 1115 in
104 :     (* DEBUG *)
105 :     fun bindToString binding = (case binding
106 : jhr 2818 of TREE e => "TREE"
107 : jhr 2279 | DEF(T.E_Var y) => "DEF " ^ T.Var.name y
108 :     | DEF e => "DEF"
109 : jhr 2820 | INP _ => "INP"
110 : jhr 1115 (* end case *))
111 :     fun dumpEnv (E{tbl, ...}) = let
112 :     fun prEntry (x, binding) =
113 : jhr 2279 print(concat[" ", IL.Var.toString x, " --> ", bindToString binding, "\n"])
114 : jhr 1115 in
115 : jhr 2279 print "*** dump environment\n";
116 :     VT.appi prEntry tbl;
117 :     print "***\n"
118 : jhr 1115 end
119 :     (* DEBUG *)
120 :    
121 :     fun newEnv () = E{tbl = VT.mkTable (512, Fail "tbl"), locals=[]}
122 :    
123 :     (* use a variable. If it is a pending expression, we remove it from the table *)
124 :     fun useVar (env as E{tbl, ...}) x = (case VT.find tbl x
125 : jhr 2818 of SOME(TREE e) => (
126 : jhr 1115 (*print(concat["useVar ", V.toString x, " ==> TREE\n"]);*)
127 : jhr 2279 ignore(VT.remove tbl x);
128 :     e)
129 :     | SOME(DEF e) => (
130 : jhr 1115 (*print(concat["useVar ", V.toString x, " ==> ", bindToString(DEF e), "; use count = ", Int.toString(V.useCount x), "\n"]);*)
131 : jhr 2279 (* if this is the last use of x, then remove it from the table *)
132 :     if (decCount x) then ignore(VT.remove tbl x) else ();
133 :     e)
134 : jhr 2818 | _ => (
135 : jhr 1115 dumpEnv env;
136 :     raise Fail(concat ["useVar(", V.toString x, ")"])
137 :     )
138 : jhr 2279 (* end case *))
139 : jhr 1115
140 : jhr 2818 (* check if a variable is bound to an input-statement constructor *)
141 :     fun useAsInput (env as E{tbl, ...}, x) = (case VT.find tbl x
142 : jhr 2820 of SOME(INP mk) => SOME mk
143 :     | _ => NONE
144 :     (* end case *))
145 : jhr 2818
146 : jhr 1115 (* record a local variable *)
147 :     fun addLocal (E{tbl, locals}, x) = E{tbl=tbl, locals=x::locals}
148 :    
149 :     (* insert a pending expression into the table. Note that x should only be used once! *)
150 :     fun insert (env as E{tbl, ...}, x, exp) = (
151 : jhr 2279 VT.insert tbl (x, TREE exp);
152 :     env)
153 : jhr 1115
154 :     fun rename (env as E{tbl, ...}, x, x') = (
155 : jhr 2279 VT.insert tbl (x, DEF(T.E_Var x'));
156 :     env)
157 : jhr 1115
158 : jhr 2818 fun bind (env, lhs, rhs) = if (V.useCount lhs = 1)
159 : jhr 2279 then (insert(env, lhs, rhs), [])
160 :     else let
161 :     val t = newLocal lhs
162 :     in
163 :     (rename(addLocal(env, t), lhs, t), [T.S_Assign([t], rhs)])
164 :     end
165 : jhr 1115
166 : jhr 2818 fun recordInput (env as E{tbl, ...}, lhs, mkFn) = if (V.useCount lhs > 1)
167 : jhr 2820 then raise Fail(concat[
168 :     "recordInput: useCount(", V.toString lhs, ") = ", Int.toString(V.useCount lhs)
169 :     ])
170 :     else (VT.insert tbl (lhs, INP mkFn); env)
171 : jhr 1115
172 :     (* set the definition of a variable, where the RHS is either a literal constant or a variable *)
173 :     fun bindSimple (env as E{tbl, ...}, lhs, rhs) = (
174 : jhr 2818 VT.insert tbl (lhs, DEF rhs); (env, []))
175 : jhr 1115
176 :     (* at the end of a block, we need to assign any pending expressions to locals. The
177 :     * blkStms list and the resulting statement list are in reverse order.
178 :     *)
179 :     fun flushPending (E{tbl, locals}, blkStms) = let
180 : jhr 2279 fun doVar (x, TREE e, (locals, stms)) = let
181 :     val t = newLocal x
182 :     in
183 :     VT.insert tbl (x, DEF(T.E_Var t));
184 :     (t::locals, T.S_Assign([t], e)::stms)
185 :     end
186 :     | doVar (_, _, acc) = acc
187 :     val (locals, stms) = VT.foldi doVar (locals, blkStms) tbl
188 :     in
189 :     (E{tbl=tbl, locals=locals}, stms)
190 :     end
191 : jhr 1115
192 :     fun doPhi ((lhs, rhs), (env, predBlks : T.stm list list)) = let
193 : jhr 2279 (* t will be the variable in the continuation of the JOIN *)
194 :     val t = newLocal lhs
195 :     val predBlks = ListPair.map
196 : jhr 2824 (fn (SOME x, stms) => T.S_Assign([t], useVar env x)::stms | (NONE, stms) => stms)
197 : jhr 2279 (rhs, predBlks)
198 :     in
199 :     (rename (addLocal(env, t), lhs, t), predBlks)
200 :     end
201 : jhr 1115
202 : jhr 2824 (* close off a scope by turning the stms and locals into a TreeIL block *)
203 : jhr 1115 fun endScope (E{locals, ...}, stms) = T.Block{
204 : jhr 2279 locals = List.rev locals,
205 :     body = stms
206 :     }
207 : jhr 1115
208 :     end
209 :    
210 :     (* Certain IL operators cannot be compiled to inline expressions. Return
211 :     * false for those and true for all others.
212 :     *)
213 :     fun isInlineOp rator = let
214 : jhr 2279 fun chkTensorTy (Ty.TensorTy[]) = true
215 :     | chkTensorTy (Ty.TensorTy[_]) = true
216 :     | chkTensorTy (Ty.TensorTy[_, _]) = Target.inlineMatrixExp
217 :     | chkTensorTy _ = false
218 :     in
219 :     case rator
220 :     of Op.LoadVoxels(_, 1) => true
221 :     | Op.LoadVoxels _ => false
222 :     | Op.Add ty => chkTensorTy ty
223 :     | Op.Sub ty => chkTensorTy ty
224 :     | Op.Neg ty => chkTensorTy ty
225 :     | Op.Scale ty => chkTensorTy ty
226 :     | Op.MulMatMat _ => Target.inlineMatrixExp
227 :     | Op.MulVecTen3 _ => false
228 :     | Op.MulTen3Vec _ => false
229 :     | Op.ColonMul(Ty.TensorTy dd1, Ty.TensorTy dd2) =>
230 :     (* if the result is a vector or scalar, then it is inline *)
231 :     (List.length dd1 + List.length dd2 > 5)
232 : jhr 1640 | Op.EigenVecs2x2 => false
233 :     | Op.EigenVecs3x3 => false
234 :     | Op.EigenVals2x2 => false
235 :     | Op.EigenVals3x3 => false
236 : jhr 2279 | Op.Identity _ => Target.inlineMatrixExp
237 :     | Op.Zero _ => Target.inlineMatrixExp
238 : jhr 2345 | Op.Transpose _ => false
239 : jhr 2826 | Op.Slice _ => false (* FIXME: we might be able to handle some slices *)
240 : jhr 2279 | Op.TensorToWorldSpace(_, ty) => chkTensorTy ty
241 :     | _ => true
242 :     (* end case *)
243 :     end
244 : jhr 1115
245 : jhr 2059 (* is a CONS inline? *)
246 :     fun isInlineCons ty = (case ty
247 : jhr 2279 of Ty.SeqTy(Ty.IntTy, _) => true
248 :     | Ty.TensorTy dd => Target.inlineCons(List.length dd)
249 :     | Ty.SeqTy _ => false
250 :     | Ty.DynSeqTy ty => false
251 :     | _ => raise Fail(concat["invalid CONS<", Ty.toString ty, ">"])
252 :     (* end case *))
253 : jhr 2059
254 : jhr 2343 (* translate a LowIL assignment to a list of zero or more target statements in reverse
255 :     * order.
256 :     *)
257 : jhr 1115 fun doAssign (env, (lhs, rhs)) = let
258 : jhr 2818 fun doLHS () = let
259 : jhr 2820 val t = newLocal lhs
260 :     in
261 :     (rename (addLocal(env, t), lhs, t), t)
262 :     end
263 : jhr 2279 (* for expressions that are going to be compiled to a call statement *)
264 :     fun assignExp (env, exp) = let
265 :     (* operations that return matrices may not be supported inline *)
266 :     val (env, t) = doLHS()
267 :     in
268 :     (env, [T.S_Assign([t], exp)])
269 :     end
270 : jhr 2345 (* force an argument to be stored in something that will be mapped to an l-value *)
271 :     fun bindVar (env, x) = (case useVar env x
272 : jhr 2796 of x' as T.E_Global _ => (env, x', [])
273 : jhr 2805 | x' as T.E_State _ => (env, x', [])
274 : jhr 2345 | x' as T.E_Var _ => (env, x', [])
275 :     | e => let
276 :     val x' = newLocal x
277 :     in
278 :     (addLocal(env, x'), T.E_Var x', [T.S_Assign([x'], e)])
279 :     end
280 :     (* end case *))
281 : jhr 2279 in
282 :     case rhs
283 : jhr 2796 of IL.GLOBAL x => bindSimple (env, lhs, T.E_Global(getGlobalVar x))
284 : jhr 2805 | IL.STATE x => bindSimple (env, lhs, T.E_State(getStateVar x))
285 : jhr 1640 | IL.VAR x => bindSimple (env, lhs, useVar env x)
286 : jhr 2279 | IL.LIT lit => bindSimple (env, lhs, T.E_Lit lit)
287 : jhr 2345 | IL.OP(Op.Prepend ty, [item, seq]) => let
288 :     val (env, t) = doLHS()
289 :     val (env, item', stms) = bindVar (env, item)
290 : jhr 2343 val exp = T.E_Op(Op.Prepend ty, [item', useVar env seq])
291 : jhr 2345 in
292 :     (env, T.S_Assign([t], exp) :: stms)
293 :     end
294 :     | IL.OP(Op.Append ty, [seq, item]) => let
295 :     val (env, t) = doLHS()
296 :     val (env, item', stms) = bindVar (env, item)
297 : jhr 2343 val exp = T.E_Op(Op.Append ty, [useVar env seq, item'])
298 : jhr 2345 in
299 :     (env, T.S_Assign([t], exp) :: stms)
300 :     end
301 : jhr 2279 | IL.OP(Op.LoadSeq(ty, nrrd), []) => let
302 :     val (env, t) = doLHS()
303 :     in
304 :     (env, [T.S_LoadNrrd(t, ty, nrrd)])
305 :     end
306 : jhr 2796 | IL.OP(Op.LoadImage(ty, nrrd), []) => let
307 : jhr 2279 val (env, t) = doLHS()
308 :     in
309 :     (env, [T.S_LoadNrrd(t, ty, nrrd)])
310 :     end
311 :     | IL.OP(Op.Input(InP.INP{ty=Ty.DynSeqTy _, name, desc, init}), []) => let
312 : jhr 2820 fun mkStm gv = (case init
313 :     of NONE => T.S_InputNrrd(gv, name, desc, NONE)
314 :     | SOME(InP.DynSeq nrrd) => T.S_InputNrrd(gv, name, desc, SOME nrrd)
315 :     | _ => raise Fail "bogus initialization for dynamic sequence"
316 :     (* end case *))
317 :     in
318 : jhr 2818 (recordInput (env, lhs, mkStm), [])
319 : jhr 2279 end
320 :     | IL.OP(Op.Input(InP.INP{ty=Ty.ImageTy _, name, desc, init}), []) => let
321 : jhr 2820 fun mkStm gv = (case init
322 :     of SOME(InP.Proxy(nrrd, _)) => T.S_InputNrrd(gv, name, desc, SOME nrrd)
323 :     | SOME(InP.Image _) => T.S_InputNrrd(gv, name, desc, NONE)
324 :     | _ => raise Fail "bogus initialization for image"
325 :     (* end case *))
326 : jhr 2279 in
327 : jhr 2818 (recordInput (env, lhs, mkStm), [])
328 : jhr 2279 end
329 :     | IL.OP(Op.Input(InP.INP{ty, name, desc, init=NONE}), []) => let
330 : jhr 2818 fun mkStm gv = T.S_Input(gv, name, desc, NONE)
331 : jhr 2279 in
332 : jhr 2818 (recordInput (env, lhs, mkStm), [])
333 : jhr 2279 end
334 : jhr 2813 | IL.OP(Op.InputWithDefault(InP.INP{ty, name, desc, init=NONE}), [dflt]) => let
335 : jhr 2820 val dflt = useVar env dflt
336 : jhr 2818 fun mkStm gv = T.S_Input(gv, name, desc, SOME dflt)
337 : jhr 2813 in
338 : jhr 2818 (recordInput (env, lhs, mkStm), [])
339 : jhr 2813 end
340 : jhr 2279 | IL.OP(rator, args) => let
341 :     val exp = T.E_Op(rator, List.map (useVar env) args)
342 :     in
343 :     if isInlineOp rator
344 :     then bind (env, lhs, exp)
345 :     else assignExp (env, exp)
346 :     end
347 :     | IL.APPLY(f, args) =>
348 :     bind (env, lhs, T.E_Apply(f, List.map (useVar env) args))
349 :     | IL.CONS(ty, args) => let
350 :     val exp = T.E_Cons(ty, List.map (useVar env) args)
351 :     in
352 :     if isInlineCons ty
353 :     then bind (env, lhs, exp)
354 :     else assignExp (env, exp)
355 :     end
356 :     (* end case *)
357 :     end
358 : jhr 1115
359 :     (* In order to reconstruct the block-structure from the CFG, we keep a stack of open ifs.
360 :     * the items on this stack distinguish between when we are processing the then and else
361 :     * branches of the if.
362 :     *)
363 :     datatype open_if
364 :     (* working on the "then" branch. The fields are statments that preceed the if, the condition,
365 :     * and the else-branch node.
366 :     *)
367 :     = THEN_BR of T.stm list * T.exp * IL.node
368 :     (* working on the "else" branch. The fields are statments that preceed the if, the condition,
369 : jhr 2824 * the "then" branch statements, and the node kind that terminated the "then" branch (will be
370 :     * a JOIN or EXIT(DIE, STABILIZE, or UNREACHABLE)).
371 : jhr 1115 *)
372 :     | ELSE_BR of T.stm list * T.exp * T.stm list * IL.node_kind
373 :    
374 :     fun trCFG (env, prefix, finish, cfg) = let
375 : jhr 2826 (* join (env, stk, stms, k): handle a control-flow join, where env is the
376 :     * current environment, stk is the stack of open ifs (the top of stk specifies
377 :     * which branch we are in), stms are the TreeIL statements preceding the join
378 :     * on the current path, and k is the kind of the join node (either JOIN or EXIT).
379 :     *)
380 : jhr 2279 fun join (env, [], _, IL.JOIN _) = raise Fail "JOIN with no open if"
381 :     | join (env, [], stms, _) = endScope (env, prefix @ List.rev stms)
382 :     | join (env, THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let
383 :     val (env, thenBlk) = flushPending (env, thenBlk)
384 :     in
385 :     doNode (env, ELSE_BR(stms1, cond, thenBlk, k)::stk, [], elseBr)
386 :     end
387 :     | join (env, ELSE_BR(stms, cond, thenBlk, k1)::stk, elseBlk, k2) = let
388 :     val (env, elseBlk) = flushPending (env, elseBlk)
389 :     in
390 :     case (k1, k2)
391 :     of (IL.JOIN{phis, succ, ...}, IL.JOIN _) => let
392 :     val (env, [thenBlk, elseBlk]) =
393 :     List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)
394 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
395 :     in
396 :     doNode (env, stk, stm::stms, !succ)
397 :     end
398 :     | (IL.JOIN{phis, succ, ...}, _) => let
399 :     val (env, [thenBlk]) = List.foldl doPhi (env, [thenBlk]) (!phis)
400 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
401 :     in
402 :     doNode (env, stk, stm::stms, !succ)
403 :     end
404 :     | (_, IL.JOIN{phis, succ, ...}) => let
405 :     val (env, [elseBlk]) = List.foldl doPhi (env, [elseBlk]) (!phis)
406 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
407 :     in
408 :     doNode (env, stk, stm::stms, !succ)
409 :     end
410 : jhr 2824 | (_, _) => let
411 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
412 :     in
413 : jhr 2826 endScope (env, prefix @ List.rev(stm::stms))
414 : jhr 2824 end
415 : jhr 2279 (* end case *)
416 :     end
417 :     and doNode (env, ifStk : open_if list, stms, nd) = (
418 :     case Nd.kind nd
419 :     of IL.NULL => raise Fail "unexpected NULL"
420 :     | IL.ENTRY{succ} => doNode (env, ifStk, stms, !succ)
421 :     | k as IL.JOIN{phis, succ, ...} => join (env, ifStk, stms, k)
422 :     | IL.COND{cond, trueBranch, falseBranch, ...} => let
423 :     val cond = useVar env cond
424 :     val (env, stms) = flushPending (env, stms)
425 :     in
426 :     doNode (env, THEN_BR(stms, cond, !falseBranch)::ifStk, [], !trueBranch)
427 :     end
428 :     | IL.COM {text, succ, ...} =>
429 :     doNode (env, ifStk, T.S_Comment text :: stms, !succ)
430 :     | IL.ASSIGN{stm, succ, ...} => let
431 :     val (env, stms') = doAssign (env, stm)
432 :     in
433 :     doNode (env, ifStk, stms' @ stms, !succ)
434 :     end
435 : jhr 1640 | IL.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
436 :     fun doit () = let
437 : jhr 2818 fun doLHSVar (y, (env, ys)) = let
438 : jhr 2820 val t = newLocal y
439 :     in
440 :     (rename (addLocal(env, t), y, t), t::ys)
441 :     end
442 : jhr 1640 val (env, ys) = List.foldr doLHSVar (env, []) ys
443 :     val exp = T.E_Op(rator, List.map (useVar env) xs)
444 :     val stm = T.S_Assign(ys, exp)
445 :     in
446 :     doNode (env, ifStk, stm :: stms, !succ)
447 :     end
448 :     in
449 :     case rator
450 :     of Op.Print _ => if Target.supportsPrinting()
451 :     then doit ()
452 :     else doNode (env, ifStk, stms, !succ)
453 :     | _ => doit()
454 :     (* end case *)
455 :     end
456 : jhr 2805 | IL.GASSIGN{lhs, rhs, succ, ...} => let
457 : jhr 2818 val stm = (case useAsInput(env, rhs)
458 : jhr 2820 of NONE => T.S_GAssign(getGlobalVar lhs, useVar env rhs)
459 :     | SOME mkStm => mkStm(getGlobalVar lhs)
460 :     (* end case *))
461 : jhr 2805 in
462 :     doNode (env, ifStk, stm::stms, !succ)
463 : jhr 2796 end
464 : jhr 2279 | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
465 : jhr 1640 | IL.SAVE{lhs, rhs, succ, ...} => let
466 :     val stm = T.S_Save([getStateVar lhs], useVar env rhs)
467 :     in
468 :     doNode (env, ifStk, stm::stms, !succ)
469 :     end
470 : jhr 2824 | k as IL.EXIT{kind, live, succ, ...} => (case (!succ, kind)
471 :     of (NONE, ExitKind.FRAGMENT) =>
472 : jhr 2279 endScope (env, prefix @ List.revAppend(stms, finish env))
473 : jhr 2824 | (NONE, ExitKind.SINIT) => let
474 : jhr 1232 (* FIXME: we should probably call flushPending here! *)
475 : jhr 2279 val suffix = finish env @ [T.S_Exit[]]
476 :     in
477 :     endScope (env, prefix @ List.revAppend(stms, suffix))
478 :     end
479 : jhr 2824 | (NONE, ExitKind.RETURN) => let
480 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
481 : jhr 2279 val suffix = finish env @ [T.S_Exit(List.map (useVar env) live)]
482 :     in
483 :     endScope (env, prefix @ List.revAppend(stms, suffix))
484 :     end
485 : jhr 2824 | (NONE, ExitKind.ACTIVE) => let
486 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
487 : jhr 2279 val suffix = finish env @ [T.S_Active]
488 :     in
489 :     endScope (env, prefix @ List.revAppend(stms, suffix))
490 :     end
491 : jhr 2824 | (NONE, ExitKind.STABILIZE) => let
492 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
493 : jhr 2279 val stms = T.S_Stabilize :: stms
494 :     in
495 :     join (env, ifStk, stms, k)
496 :     end
497 : jhr 2824 | (NONE, ExitKind.DIE) => join (env, ifStk, T.S_Die :: stms, k)
498 : jhr 2826 | (NONE, ExitKind.UNREACHABLE) => join (env, ifStk, stms, k)
499 : jhr 3191 | (SOME nd, ExitKind.ACTIVE) => doNode (env, ifStk, T.S_Active :: stms, nd)
500 : jhr 2826 | (SOME nd, ExitKind.STABILIZE) => doNode (env, ifStk, T.S_Stabilize :: stms, nd)
501 :     | (SOME nd, ExitKind.DIE) => doNode (env, ifStk, T.S_Die :: stms, nd)
502 :     | (SOME nd, ExitKind.UNREACHABLE) => doNode (env, ifStk, stms, nd)
503 :     | _ => raise Fail("unexpected continuation edge from "^IL.Node.toString nd)
504 : jhr 2279 (* end case *))
505 :     (* end case *))
506 :     in
507 :     doNode (env, [], [], CFG.entry cfg)
508 :     end
509 : jhr 1115
510 :     fun trInitially (env, IL.Initially{isArray, rangeInit, iters, create=(createInit, strand, args)}) =
511 : jhr 2279 let
512 :     val iterPrefix = trCFG (env, [], fn _ => [], rangeInit)
513 :     fun cvtIter ((param, lo, hi), (env, iters)) = let
514 :     val param' = newIter param
515 :     val env = rename (env, param, param')
516 :     in
517 :     (env, (param', useVar env lo, useVar env hi)::iters)
518 :     end
519 :     val (env, iters) = List.foldr cvtIter (env, []) iters
520 :     val createPrefix = trCFG (env, [], fn _ => [], createInit)
521 :     in {
522 :     isArray = isArray,
523 :     iterPrefix = iterPrefix,
524 :     iters = iters,
525 :     createPrefix = createPrefix,
526 :     strand = strand,
527 :     args = List.map (useVar env) args
528 :     } end
529 : jhr 1115
530 : jhr 1640 fun trMethod env (IL.Method{name, body}) = T.Method{
531 :     name = name,
532 :     body = trCFG (env, [], fn _ => [], body)
533 :     }
534 : jhr 1115
535 : jhr 1640 fun trStrand globalEnv (IL.Strand{name, params, state, stateInit, methods}) = let
536 : jhr 2279 val params' = List.map newParam params
537 :     val env = ListPair.foldlEq (fn (x, x', env) => rename(env, x, x')) globalEnv (params, params')
538 :     in
539 :     T.Strand{
540 :     name = name,
541 :     params = params',
542 :     state = List.map getStateVar state,
543 :     stateInit = trCFG (env, [], fn _ => [], stateInit),
544 :     methods = List.map (trMethod env) methods
545 :     }
546 :     end
547 : jhr 1115
548 :     fun translate prog = let
549 : jhr 2279 (* first we do a variable analysis pass on the Low IL *)
550 : jhr 2799 val prog as IL.Program{props, globals, inputInit, globalInit, initially, strands} = VA.optimize prog
551 : jhr 1115 (* FIXME: here we should do a contraction pass to eliminate unused variables that VA may have created *)
552 : jhr 2279 val _ = (* DEBUG *)
553 :     LowPP.output (Log.logFile(), "LowIL after variable analysis", prog)
554 :     val env = newEnv()
555 : jhr 2818 val globals = let
556 :     (* produce a list of TreeIL globals for the globals, such that each global
557 :     * has a unique name.
558 :     *)
559 : jhr 2820 fun genGlobal (gv, (cnt, globs)) = let
560 :     val name = "gv_" ^ GV.name gv
561 :     fun uniqueName (name, cnt) =
562 :     if List.exists (fn y => T.GlobalVar.name y = name) globs
563 :     then uniqueName(name ^ Int.toString cnt, cnt+1)
564 :     else (name, cnt)
565 :     val (name, cnt) = uniqueName ("gv_" ^ GV.name gv, cnt)
566 :     val gv' = T.GV{name = name, ty = GV.ty gv, input = GV.isInput gv}
567 :     in
568 :     setGlobalVar (gv, gv');
569 :     (cnt, gv'::globs)
570 :     end
571 :     val (_, globs) = List.foldl genGlobal (0, []) globals
572 :     in
573 :     List.rev globs
574 :     end
575 : jhr 2279 val strands = List.map (trStrand env) strands
576 :     in
577 :     T.Program{
578 :     props = props,
579 :     globals = globals,
580 :     inputInit = trCFG (env, [], fn _ => [], inputInit),
581 :     globalInit = trCFG (env, [], fn _ => [], globalInit),
582 :     strands = strands,
583 :     initially = trInitially (env, initially)
584 :     }
585 :     end
586 : jhr 1115
587 :     end

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