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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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