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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3349 - (view) (download)

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

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