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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2624 - (view) (download)

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

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