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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/translate/translate.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/translate/translate.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4193 - (view) (download)

1 : jhr 3471 (* translate.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 : jhr 3476 * Translate Simple-AST code into the HighIR representation. This translation is based on the
9 : jhr 3471 * algorithm described in
10 :     *
11 :     * Single-pass generation of static single assignment form for structured languages
12 :     * ACM TOPLAS, Nov. 1994
13 :     * by Brandis and MossenBock.
14 :     *)
15 :    
16 :     structure Translate : sig
17 :    
18 : jhr 3476 val translate : Simple.program -> HighIR.program
19 : jhr 3471
20 :     end = struct
21 :    
22 :     structure S = Simple
23 :     structure Ty = SimpleTypes
24 : jhr 3485 structure SV = SimpleVar
25 :     structure VMap = SV.Map
26 :     structure VSet = SV.Set
27 : jhr 3476 structure IR = HighIR
28 : jhr 3471 structure Op = HighOps
29 : jhr 3476 structure DstTy = HighTypes
30 :     structure Census = HighCensus
31 : jhr 3493 structure Inp = Inputs
32 : jhr 3471
33 :     val cvtTy = TranslateTy.tr
34 :    
35 :     (* maps from SimpleAST variables to the current corresponding SSA variable *)
36 : jhr 3476 type env = IR.var VMap.map
37 : jhr 3471
38 :     (* +DEBUG *)
39 :     fun prEnv (prefix, env) = let
40 :     val wid = ref 0
41 :     fun pr s = (print s; wid := !wid + size s)
42 :     fun nl () = if (!wid > 0) then (print "\n"; wid := 0) else ()
43 :     fun prElem (src, dst) = let
44 :     val s = String.concat [
45 : jhr 3485 " ", SV.uniqueNameOf src, "->", IR.Var.toString dst
46 : jhr 3471 ]
47 :     in
48 :     pr s;
49 :     if (!wid >= 100) then (nl(); pr " ") else ()
50 :     end
51 :     in
52 :     pr prefix; pr " ENV: {"; nl(); pr " ";
53 :     VMap.appi prElem env;
54 :     nl(); pr "}"; nl()
55 :     end
56 :     (* -DEBUG *)
57 :    
58 : jhr 3846 (* a property to map Simple variables to High IR state variables. We need this to support
59 :     * reading the state of other strands.
60 :     *)
61 :     val {getFn=getStateVar, ...} = let
62 :     fun newSVar x = IR.StateVar.new (
63 :     SV.kindOf x = SV.StrandOutputVar,
64 :     SV.nameOf x, cvtTy(SV.typeOf x),
65 :     AnalyzeSimple.varyingStateVar x,
66 :     AnalyzeSimple.sharedStateVar x)
67 :     in
68 :     SV.newProp newSVar
69 :     end
70 :    
71 : jhr 3471 fun lookup env x = (case VMap.find (env, x)
72 :     of SOME x' => x'
73 :     | NONE => raise Fail(concat[
74 : jhr 3508 "no binding for ", SV.uniqueNameOf x, "::",
75 :     SV.kindToString(SV.kindOf x), " in environment"
76 : jhr 3471 ])
77 :     (* end case *))
78 :    
79 :     (* create a new instance of a variable *)
80 : jhr 3485 fun newVar x = IR.Var.new (SV.nameOf x, cvtTy(SV.typeOf x))
81 : jhr 3471
82 : jhr 3506 (* is a Simple AST variable mapped to an IR.global_var? *)
83 :     fun isGlobalVar x = (case SV.kindOf x
84 :     of SV.ConstVar => true
85 :     | SV.InputVar => true
86 :     | SV.GlobalVar => true
87 :     | _ => false
88 :     (* end case *))
89 :    
90 :     (* convert a global and cache the result in a property *)
91 :     local
92 :     fun new x = let
93 : jhr 3838 val kind = (case SV.kindOf x
94 :     of SV.ConstVar => IR.ConstVar
95 :     | SV.InputVar => IR.InputVar
96 :     | SV.GlobalVar => IR.GlobalVar
97 : jhr 3506 | k => raise Fail(concat[
98 :     "global variable ", SV.uniqueNameOf x,
99 :     " has kind ", SV.kindToString k
100 :     ])
101 :     (* end case *))
102 :     in
103 : jhr 3538 IR.GlobalVar.new(
104 : jhr 3838 kind, AnalyzeSimple.updatedGlobal x, SV.nameOf x, cvtTy(SV.typeOf x))
105 : jhr 3506 end
106 :     in
107 :     val {getFn = cvtGlobalVar, ...} = SV.newProp new
108 : jhr 4163 end (* local *)
109 : jhr 3506
110 : jhr 4163 (* convert a function variable and cache the result in a property *)
111 :     local
112 :     fun new f = let
113 :     val (resTy, paramTys) = SimpleFunc.typeOf f
114 :     in
115 :     IR.Func.new(SimpleFunc.nameOf f, cvtTy resTy, List.map cvtTy paramTys)
116 :     end
117 :     in
118 :     val {getFn = cvtFuncVar, ...} = SimpleFunc.newProp new
119 :     end (* local *)
120 :    
121 : jhr 3471 (* generate fresh SSA variables and add them to the environment *)
122 :     fun freshVars (env, xs) = let
123 :     fun cvtVar (x, (env, xs)) = let
124 :     val x' = newVar x
125 :     in
126 :     (VMap.insert(env, x, x'), x'::xs)
127 :     end
128 :     val (env, xs) = List.foldl cvtVar (env, []) xs
129 :     in
130 :     (env, List.rev xs)
131 :     end
132 :    
133 :     (* a pending-join node tracks the phi nodes needed to join the assignments
134 :     * that flow into the join node.
135 :     *)
136 :     datatype join = JOIN of {
137 :     env : env, (* the environment that was current at the conditional *)
138 :     (* associated with this node. *)
139 :     arity : int ref, (* actual number of predecessors *)
140 : jhr 3476 nd : IR.node, (* the CFG node for this pending join *)
141 :     phiMap : (IR.var * IR.var list) VMap.map ref,
142 : jhr 3471 (* a mapping from Simple AST variables that are assigned *)
143 :     (* to their phi nodes. *)
144 :     predKill : bool array (* killed predecessor edges (because of DIE or STABILIZE *)
145 :     }
146 :    
147 :     (* a stack of pending joins. The first component specifies the path index of the current
148 :     * path to the join.
149 :     *)
150 :     type pending_joins = (int * join) list
151 :    
152 : jhr 3504 (* create a new pending-join node for a conditional *)
153 : jhr 3471 fun newJoin (env, arity) = JOIN{
154 : jhr 3476 env = env, arity = ref arity, nd = IR.Node.mkJOIN [], phiMap = ref VMap.empty,
155 : jhr 3471 predKill = Array.array(arity, false)
156 :     }
157 :    
158 : jhr 3504 (* create a new pending-join node for a loop *)
159 : jhr 3502 fun newForeach (env, x, xs, phiVars) = let
160 : jhr 3509 fun doVar (y, (env', phiMap)) = (case VMap.find(env, y)
161 :     of SOME y' => let
162 :     val y'' = newVar y
163 : jhr 3502 in
164 : jhr 3509 (VMap.insert(env', y, y''), VMap.insert(phiMap, y, (y', [y'', y''])))
165 : jhr 3502 end
166 : jhr 3509 | NONE => raise Fail(concat["variable ", SV.uniqueNameOf y, " is not bound"])
167 : jhr 3502 (* end case *))
168 :     val (env', phiMap) = List.foldl doVar (env, VMap.empty) phiVars
169 :     in
170 :     JOIN{
171 :     env = env',
172 :     arity = ref 2,
173 :     nd = IR.Node.mkFOREACH(x, xs),
174 :     phiMap = ref phiMap,
175 : jhr 3504 predKill = Array.array(2, false)
176 : jhr 3502 }
177 :     end
178 : jhr 3500
179 : jhr 4168 (* record that a path to the top join in the stack has been killed because of RETURN,
180 :     * DIE or STABILIZE
181 :     *)
182 : jhr 3471 fun killPath ((i, JOIN{arity, predKill, ...}) :: _) = (
183 :     arity := !arity - 1;
184 :     Array.update (predKill, i, true))
185 :     | killPath _ = ()
186 :    
187 : jhr 3476 (* record an assignment to the IR variable dstVar (corresponding to the Simple AST variable
188 : jhr 3471 * srcVar) in the current pending-join node. The predIndex specifies which path into the
189 :     * JOIN node this assignment occurs on.
190 :     *)
191 :     fun recordAssign ([], _, _) = ()
192 :     | recordAssign ((predIndex, JOIN{env, phiMap, predKill, nd, ...})::_, srcVar, dstVar) = let
193 :     val arity = Array.length predKill (* the original arity before any killPath calls *)
194 :     val m = !phiMap
195 :     in
196 :     case VMap.find (env, srcVar)
197 :     of NONE => () (* local temporary *)
198 :     | SOME dstVar' => (case VMap.find (m, srcVar)
199 :     of NONE => let
200 :     val lhs = newVar srcVar
201 :     val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')
202 :     in
203 :     (*
204 : jhr 3485 print(concat["recordAssign: ", SV.uniqueNameOf srcVar, " --> ", IR.Var.toString lhs,
205 : jhr 3476 " @ ", IR.Node.toString nd, "\n"]);
206 : jhr 3471 *)
207 :     phiMap := VMap.insert (m, srcVar, (lhs, rhs))
208 :     end
209 :     | SOME(lhs, rhs) => let
210 :     fun update (i, l as x::r) = if (i = predIndex)
211 :     then dstVar::r
212 :     else x::update(i+1, r)
213 :     | update _ = raise Fail "invalid predecessor index"
214 :     in
215 :     phiMap := VMap.insert (m, srcVar, (lhs, update(0, rhs)))
216 :     end
217 :     (* end case *))
218 :     (* end case *)
219 :     end
220 :    
221 :     (* complete a pending join operation by filling in the phi nodes from the phi map and
222 :     * updating the environment.
223 :     *)
224 :     fun commitJoin (joinStk, JOIN{env, arity, nd, phiMap, predKill}) = let
225 : jhr 3509 val (preds, phis, mask) = (case IR.Node.kind nd
226 :     of IR.JOIN{preds, phis, mask, ...} => (!preds, phis, mask)
227 :     | IR.FOREACH{pred, bodyExit, phis, mask, ...} => ([!pred, !bodyExit], phis, mask)
228 :     | _ => raise Fail "invalid JOIN node"
229 :     (* end case *))
230 : jhr 3471 (* update the predKill array based on reachability *)
231 :     val _ = let
232 :     fun update (_, []) = ()
233 :     | update (i, nd::nds) = (
234 : jhr 3476 if IR.Node.isReachable nd then ()
235 : jhr 3471 else if Array.sub(predKill, i) then ()
236 :     else (arity := !arity-1; Array.update(predKill, i, true));
237 :     update (i+1, nds))
238 :     in
239 : jhr 3509 update (0, preds)
240 : jhr 3471 end
241 :     (* compute the predecessor mask *)
242 :     val mask' = Array.foldr (op ::) [] predKill
243 :     in
244 :     mask := mask';
245 :     case !arity
246 :     of 0 => env (* all incoming edges are fake *)
247 :     | 1 => let
248 :     (* there is only one path to the join, so we do not need phi nodes, but
249 :     * we still need to propogate assignments to the next join on the stack.
250 :     *)
251 :     val ix = let (* find pred index of this join *)
252 :     fun find i = if Array.sub(predKill, i) then find(i+1) else i
253 :     in
254 :     find 0
255 :     end
256 :     fun doVar (srcVar, (_, xs), env) = let
257 :     val dstVar = List.nth(xs, ix)
258 :     in
259 :     (*
260 : jhr 3485 print(concat["doVar (", SV.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);
261 : jhr 3471 *)
262 :     recordAssign (joinStk, srcVar, dstVar);
263 :     VMap.insert (env, srcVar, dstVar)
264 :     end
265 :     val env = VMap.foldli doVar env (!phiMap)
266 :     in
267 :     env
268 :     end
269 :     | nPreds => if (nPreds < Array.length predKill)
270 :     then let
271 :     (* filter out variables that correspond to fake preds from the RHS of a phi *)
272 :     fun filterPhiRHS xs = let
273 :     fun f ([], _, xs') = List.rev xs'
274 :     | f (x::xs, i, xs') = if Array.sub(predKill, i)
275 :     then f (xs, i+1, NONE :: xs')
276 :     else f (xs, i+1, (SOME x) :: xs')
277 :     in
278 :     f (xs, 0, [])
279 :     end
280 :     fun doVar (srcVar, phi as (dstVar, srcVars), (env, phis)) = (
281 :     (*
282 : jhr 3485 print(concat["doVar (", SV.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);
283 : jhr 3471 *)
284 :     recordAssign (joinStk, srcVar, dstVar);
285 :     (VMap.insert (env, srcVar, dstVar), (dstVar, filterPhiRHS srcVars) ::phis))
286 :     val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)
287 :     in
288 :     phis := phis';
289 :     env
290 :     end
291 :     else let
292 :     fun doVar (srcVar, phi as (dstVar, xs), (env, phis)) = let
293 :     val xs = List.map SOME xs
294 :     in
295 :     (*
296 : jhr 3485 print(concat["doVar (", SV.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);
297 : jhr 3471 *)
298 :     recordAssign (joinStk, srcVar, dstVar);
299 : jhr 3476 IR.Var.setBinding (dstVar, IR.VB_PHI xs);
300 : jhr 3471 (VMap.insert (env, srcVar, dstVar), (dstVar, xs)::phis)
301 :     end
302 :     val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)
303 :     in
304 :     phis := phis';
305 :     env
306 :     end
307 :     (* end case *)
308 :     end
309 :    
310 :     (* expression translation *)
311 :     fun cvtExp (env : env, lhs, exp) = (case exp
312 : jhr 3476 of S.E_Var x => [IR.ASSGN(lhs, IR.VAR(lookup env x))]
313 :     | S.E_Lit lit => [IR.ASSGN(lhs, IR.LIT lit)]
314 : jhr 4043 | S.E_Kernel h => [IR.ASSGN(lhs, IR.OP(Op.Kernel(h, 0), []))]
315 : jhr 3846 | S.E_Select(x, fld) => [IR.ASSGN(lhs, IR.STATE(SOME(lookup env x), getStateVar fld))]
316 : jhr 4163 | S.E_Apply(f, args) =>
317 :     [IR.ASSGN(lhs, IR.APPLY(cvtFuncVar f, List.map (lookup env) args))]
318 : jhr 3471 | S.E_Prim(f, tyArgs, args, ty) => let
319 :     val args' = List.map (lookup env) args
320 :     in
321 :     TranslateBasis.translate (lhs, f, tyArgs, args')
322 :     end
323 : jhr 4163 | S.E_Tensor(args, _) =>
324 :     [IR.ASSGN(lhs, IR.CONS(List.map (lookup env) args, IR.Var.ty lhs))]
325 : jhr 3476 | S.E_Seq(args, _) => [IR.ASSGN(lhs, IR.SEQ(List.map (lookup env) args, IR.Var.ty lhs))]
326 : cchiw 4155 | S.E_Slice(x, indices, ty as Ty.T_Field{diff, dim, shape}) => let
327 :     val x = lookup env x
328 :     (* extract the integer indices from the mask *)
329 :     val args' = List.mapPartial Fn.id indices
330 :     val mask' = List.map Option.isSome indices
331 :     val rator = MkOperators.sliceF(mask', args', shape, dim)
332 :     val ein = IR.EINAPP(rator, [x])
333 :     in
334 :     [IR.ASSGN(lhs, ein)]
335 :     end
336 : jhr 3471 | S.E_Slice(x, indices, ty) => let
337 :     val x = lookup env x
338 : jhr 3992 (* check the indices to the slice. There are two special cases: if all of the indices
339 :     * are NONE, then the result is just the original tensor; and if all of the indices
340 :     * are SOME ix, then the result is scalar so we use TensorIndex.
341 :     *)
342 : cchiw 3991 fun chkIndices ([], _, true, idxs) = IR.OP(Op.TensorIndex(IR.Var.ty x, rev idxs), [x])
343 : jhr 3992 | chkIndices ([], true, _, _) = IR.VAR x (* all axes *)
344 :     | chkIndices (NONE :: r, true, _, _) = chkIndices (r, true, false, [])
345 :     | chkIndices (SOME ix :: r, _, true, idxs) = chkIndices (r, false, true, ix::idxs)
346 :     | chkIndices _ = let
347 :     (* extract the integer indices from the mask *)
348 :     val args' = List.mapPartial Fn.id indices
349 :     val mask' = List.map Option.isSome indices
350 :     val rator = (case (IR.Var.ty lhs, IR.Var.ty x, ty)
351 :     of (DstTy.TensorTy rstTy, DstTy.TensorTy argTy, _) =>
352 :     MkOperators.sliceT (mask', args', rstTy, argTy)
353 :     | (_, _, Ty.T_Field{diff, dim, shape}) =>
354 :     MkOperators.sliceF(mask', args', shape, dim)
355 :     | (_, _, _ ) => raise Fail "unsupported type"
356 :     (* end case *))
357 :     in
358 :     IR.EINAPP(rator, [x])
359 :     end
360 : jhr 3471 in
361 : jhr 3992 [IR.ASSGN(lhs, chkIndices (indices, true, true, []))]
362 : jhr 3471 end
363 :     | S.E_Coerce{srcTy, dstTy, x} => (case (srcTy, dstTy)
364 :     of (Ty.T_Int, Ty.T_Tensor _) =>
365 : jhr 3476 [IR.ASSGN(lhs, IR.OP(Op.IntToReal, [lookup env x]))]
366 : jhr 3485 | (Ty.T_Sequence(ty, SOME n), Ty.T_Sequence(_, NONE)) =>
367 : jhr 3476 [IR.ASSGN(lhs, IR.OP(Op.MkDynamic(cvtTy ty, n), [lookup env x]))]
368 : jhr 3471 | (Ty.T_Field _, Ty.T_Field _) =>
369 :     (* change in continuity is a no-op *)
370 : jhr 3476 [IR.ASSGN(lhs, IR.VAR(lookup env x))]
371 : jhr 3471 | _ => raise Fail(concat[
372 :     "unsupported type coercion: ", Ty.toString srcTy,
373 :     " ==> ", Ty.toString dstTy
374 :     ])
375 :     (* end case *))
376 : jhr 3476 | S.E_LoadSeq(ty, nrrd) => [IR.ASSGN(lhs, IR.OP(Op.LoadSeq(cvtTy ty, nrrd), []))]
377 : jhr 4043 | S.E_LoadImage(_, nrrd, info) =>
378 :     [IR.ASSGN(lhs, IR.OP(Op.LoadImage(DstTy.ImageTy info, nrrd), []))]
379 :     | S.E_InsideImage(pos, img, s) => let
380 : jhr 4193 val Ty.T_Image info = SV.typeOf img
381 : jhr 4043 in
382 :     [IR.ASSGN(lhs, IR.OP(Op.Inside(info, s), [lookup env pos, lookup env img]))]
383 :     end
384 : jhr 3471 (* end case *))
385 :    
386 :     (* add nodes to save the strand state, followed by an exit node *)
387 :     fun saveStrandState (env, (srcState, dstState), exit) = let
388 :     val stateOut = List.map (lookup env) srcState
389 : jhr 3476 fun save (x, x', cfg) = IR.CFG.appendNode (cfg, IR.Node.mkSAVE(x, x'))
390 : jhr 3471 in
391 : jhr 3476 IR.CFG.appendNode (
392 :     ListPair.foldlEq save IR.CFG.empty (dstState, stateOut),
393 : jhr 3471 exit)
394 :     end
395 :     (*DEBUG*)handle ex => raise ex
396 :    
397 : jhr 4163 (* convert a block to a CFG. The parameters are:
398 :     * state -- a pair of the src/dst state variables for saving the state of a strand.
399 :     * These are empty if the block is not in a strand.
400 :     * env -- environment for mapping SimpleIR variables to HighIR locals
401 :     * joinStk -- a stack of pending joins
402 :     * blk -- the block to translate
403 :     *)
404 : jhr 3501 fun cvtBlock (state, env : env, joinStk, blk as S.Block{code, ...}) = let
405 : jhr 3471 fun cvt (env : env, cfg, []) = (cfg, env)
406 :     | cvt (env, cfg, stm::stms) = (case stm
407 : jhr 3485 of S.S_Var(x, NONE) => let
408 : jhr 3471 val x' = newVar x
409 :     in
410 :     cvt (VMap.insert (env, x, x'), cfg, stms)
411 :     end
412 : jhr 3485 | S.S_Var(x, SOME e) => let
413 :     val x' = newVar x
414 :     val assigns = cvtExp (env, x', e)
415 :     in
416 :     recordAssign (joinStk, x, x');
417 :     cvt (
418 :     VMap.insert(env, x, x'),
419 :     IR.CFG.concat(cfg, IR.CFG.mkBlock assigns),
420 :     stms)
421 :     end
422 : jhr 3471 | S.S_Assign(lhs, rhs) => let
423 : jhr 3506 val lhs' = newVar lhs
424 :     val assigns = cvtExp (env, lhs', rhs)
425 :     in
426 :     (* check for assignment to global (i.e., constant, input, or other global) *)
427 : jhr 3550 (* FIXME: for the global initialization block, we should batch up the saving of globals until
428 :     * the end so that we can properly set the bindings (i.e., so that we avoid conflicts between
429 :     * branches of an if statement).
430 :     *)
431 : jhr 3506 if isGlobalVar lhs
432 :     then cvt (
433 :     VMap.insert(env, lhs, lhs'),
434 : jhr 3618 IR.CFG.concat(
435 :     cfg,
436 :     IR.CFG.mkBlock(assigns @ [IR.GASSGN(cvtGlobalVar lhs, lhs')])),
437 : jhr 3506 stms)
438 :     else (
439 :     recordAssign (joinStk, lhs, lhs');
440 :     cvt (
441 :     VMap.insert(env, lhs, lhs'),
442 :     IR.CFG.concat(cfg, IR.CFG.mkBlock assigns),
443 :     stms))
444 :     end
445 : jhr 3471 | S.S_IfThenElse(x, b0, b1) => let
446 :     val x' = lookup env x
447 :     val join as JOIN{nd=joinNd, ...} = newJoin (env, 2)
448 :     val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, b0)
449 :     val (cfg1, _) = cvtBlock (state, env, (1, join)::joinStk, b1)
450 : jhr 3476 val cond = IR.Node.mkCOND x'
451 :     fun addEdgeToJoin nd = (case IR.Node.kind nd
452 :     of IR.EXIT{succ, ...} => (
453 : jhr 3471 succ := SOME joinNd;
454 : jhr 3476 IR.Node.setPred (joinNd, nd)) (* will be converted to fake later *)
455 :     | _ => IR.Node.addEdge(nd, joinNd)
456 : jhr 3471 (* end case *))
457 :     (* package the CFG the represents the conditional (cond, two blocks, and join) *)
458 :     val condCFG = (
459 : jhr 3476 if IR.CFG.isEmpty cfg0
460 : jhr 3471 then (
461 : jhr 3476 IR.Node.setTrueBranch (cond, joinNd);
462 :     IR.Node.setPred (joinNd, cond))
463 : jhr 3471 else (
464 : jhr 3476 IR.Node.setTrueBranch (cond, IR.CFG.entry cfg0);
465 :     IR.Node.setPred (IR.CFG.entry cfg0, cond);
466 :     addEdgeToJoin (IR.CFG.exit cfg0));
467 :     if IR.CFG.isEmpty cfg1
468 : jhr 3471 then (
469 : jhr 3476 IR.Node.setFalseBranch (cond, joinNd);
470 :     IR.Node.setPred (joinNd, cond))
471 : jhr 3471 else (
472 : jhr 3476 IR.Node.setFalseBranch (cond, IR.CFG.entry cfg1);
473 :     IR.Node.setPred (IR.CFG.entry cfg1, cond);
474 :     addEdgeToJoin (IR.CFG.exit cfg1));
475 :     IR.CFG{entry = cond, exit = joinNd})
476 : jhr 3471 val env = commitJoin (joinStk, join)
477 : jhr 4168 val cfg = IR.CFG.concat (cfg, condCFG)
478 : jhr 3471 in
479 : jhr 4168 (* add an UNREACHABLE exit node when the join is the final node in the
480 :     * graph and it is unreachable.
481 :     *)
482 :     if List.null joinStk andalso not(IR.Node.isReachable joinNd)
483 :     then (* NOTE: this case implies that stms is empty! *)
484 : jhr 4170 (IR.CFG.appendNode(cfg, IR.Node.mkUNREACHABLE()), env)
485 : jhr 4168 else cvt (env, cfg, stms)
486 : jhr 3471 end
487 : jhr 3500 | S.S_Foreach(x, xs, b) => let
488 :     val x' = newVar x
489 :     val xs' = lookup env xs
490 : jhr 3502 (* For any local variable y that is both live on exit of the block b and
491 :     * assigned to in b, we will need a phi node for y.
492 : jhr 3501 *)
493 : jhr 3505 val phiVars = VSet.listItems(
494 :     VSet.intersection(AnalyzeSimple.assignedVars b, AnalyzeSimple.liveOut b))
495 : jhr 3502 val join as JOIN{env, nd=foreachNd, ...} = newForeach (env, x', xs', phiVars)
496 : jhr 3509 val (body, _) = cvtBlock (state, VMap.insert(env, x, x'), (1, join)::joinStk, b)
497 : jhr 3754 val body = IR.CFG.appendNode (body, IR.Node.mkNEXT())
498 : jhr 3502 val env = commitJoin (joinStk, join)
499 : jhr 3500 in
500 : jhr 3501 (* link in CFG edges *)
501 : jhr 3502 IR.Node.setBodyEntry (foreachNd, IR.CFG.entry body); (* loop header to body *)
502 :     IR.Node.setPred (IR.CFG.entry body, foreachNd); (* back edge *)
503 : jhr 3837 IR.Node.setSucc (IR.CFG.exit body, foreachNd);
504 : jhr 3502 IR.Node.setBodyExit (foreachNd, IR.CFG.exit body);
505 :     (* process the rest of the block *)
506 :     cvt (env, IR.CFG.concat (cfg, IR.CFG{entry=foreachNd, exit=foreachNd}), stms)
507 : jhr 3500 end
508 : jhr 3471 | S.S_New(strandId, args) => let
509 : jhr 3476 val nd = IR.Node.mkNEW{
510 : jhr 3471 strand = strandId,
511 :     args = List.map (lookup env) args
512 :     }
513 :     in
514 : jhr 3476 cvt (env, IR.CFG.appendNode (cfg, nd), stms)
515 : jhr 3471 end
516 :     | S.S_Continue => (
517 :     killPath joinStk;
518 : jhr 3476 (IR.CFG.concat (cfg, saveStrandState (env, state, IR.Node.mkACTIVE())), env))
519 : jhr 3471 | S.S_Die => (
520 :     killPath joinStk;
521 : jhr 3476 (IR.CFG.appendNode (cfg, IR.Node.mkDIE ()), env))
522 : jhr 3471 | S.S_Stabilize => (
523 :     killPath joinStk;
524 : jhr 3476 (IR.CFG.concat (cfg, saveStrandState (env, state, IR.Node.mkSTABILIZE())), env))
525 : jhr 4164 | S.S_Return x => (
526 :     killPath joinStk;
527 :     (IR.CFG.appendNode (cfg, IR.Node.mkRETURN(SOME(lookup env x))), env))
528 : jhr 3471 | S.S_Print args => let
529 :     val args = List.map (lookup env) args
530 : jhr 3476 val nd = IR.Node.mkMASSIGN([], Op.Print(List.map IR.Var.ty args), args)
531 : jhr 3471 in
532 : jhr 3476 cvt (env, IR.CFG.appendNode (cfg, nd), stms)
533 : jhr 3471 end
534 : jhr 3505 | S.S_MapReduce{results, reductions, body, args, source} => raise Fail "FIXME"
535 : jhr 3471 (* end case *))
536 :     in
537 : jhr 3505 cvt (env, IR.CFG.empty, code)
538 : jhr 3471 end
539 :     (*DEBUG*)handle ex => raise ex
540 :    
541 : jhr 4164 (* a function for generating a block of assignments to load the globals that
542 :     * are referenced in a SimpleIR block.
543 :     *)
544 :     fun loadGlobals (env, blk) = let
545 :     fun load (x, (env, stms)) = let
546 : jhr 3506 val x' = newVar x
547 :     val stm = IR.ASSGN(x', IR.GLOBAL(cvtGlobalVar x))
548 :     val env = VMap.insert (env, x, x')
549 :     in
550 : jhr 4164 (env, stm::stms)
551 : jhr 3506 end
552 : jhr 4164 val (env, stms) = VSet.foldr load (env, []) (AnalyzeSimple.globalsOfBlock blk)
553 : jhr 3506 in
554 : jhr 4164 (IR.CFG.mkBlock stms, env)
555 : jhr 3506 end
556 :    
557 : jhr 4164 fun cvtMethod (env, isStabilize, state, svars, blk) = let
558 : jhr 3471 (* load the globals into fresh variables *)
559 : jhr 4164 val (loadGlobsCFG, env) = loadGlobals (env, blk)
560 : jhr 3471 (* load the state into fresh variables *)
561 :     val (env, loadCFG) = let
562 :     (* allocate shadow variables for the state variables *)
563 :     val (env, stateIn) = freshVars (env, state)
564 : jhr 3846 fun load (x, x') = IR.ASSGN(x, IR.STATE(NONE, x'))
565 : jhr 3476 val cfg = IR.CFG.mkBlock (ListPair.map load (stateIn, svars))
566 : jhr 3471 in
567 : jhr 3476 (env, IR.CFG.concat(loadGlobsCFG, cfg))
568 : jhr 3471 end
569 :     (* convert the body of the method *)
570 :     val (cfg, env) = cvtBlock ((state, svars), env, [], blk)
571 :     (* add the entry/exit nodes *)
572 : jhr 3476 val entry = IR.Node.mkENTRY ()
573 :     val loadCFG = IR.CFG.prependNode (entry, loadCFG)
574 : jhr 3505 val exit = if isStabilize
575 : jhr 4164 then IR.Node.mkRETURN NONE
576 : jhr 3505 else IR.Node.mkACTIVE()
577 : jhr 3476 val body = IR.CFG.concat (loadCFG, cfg)
578 : jhr 3471 (*DEBUG**val _ = prEnv (StrandUtil.nameToString name, env);*)
579 :     (* FIXME: the following code doesn't work properly *)
580 : jhr 3476 val body = if IR.Node.hasSucc(IR.CFG.exit body)
581 :     then IR.CFG.concat (body, saveStrandState (env, (state, svars), exit))
582 :     else IR.CFG{entry = IR.CFG.entry body, exit = exit}
583 : jhr 3471 in
584 : jhr 3505 body
585 : jhr 3471 end
586 : jhr 3505 (*DEBUG*)handle ex => (print "error in cvtMethod\n"; raise ex)
587 : jhr 3471
588 : jhr 3506 (* convert global code *)
589 : jhr 4164 fun cvtGlobalBlock block = let
590 : jhr 3506 (* load the globals into fresh variables *)
591 : jhr 4164 val (loadCFG, env) = loadGlobals (VMap.empty, block)
592 : jhr 3506 (* convert the code *)
593 :     val (cfg, _) = cvtBlock (([], []), env, [], block)
594 : jhr 3509 val cfg = IR.CFG.concat (loadCFG, cfg)
595 :     val cfg = IR.CFG.prependNode (IR.Node.mkENTRY(), cfg)
596 : jhr 4164 val cfg = IR.CFG.appendNode (cfg, IR.Node.mkRETURN NONE)
597 : jhr 3505 in
598 : jhr 3509 cfg
599 : jhr 3505 end
600 : jhr 3471
601 : jhr 4163 (* extend the global environment with the strand's parameters *)
602 :     fun initEnvFromParams params = let
603 :     fun cvtParam (x, (env, xs)) = let
604 :     val x' = newVar x
605 :     in
606 :     (VMap.insert(env, x, x'), x'::xs)
607 :     end
608 :     val (env, params) = List.foldl cvtParam (VMap.empty, []) params
609 :     in
610 :     (env, List.rev params)
611 :     end
612 :    
613 : jhr 3485 fun translate prog = let
614 :     val S.Program{
615 : jhr 3995 props, consts, inputs, constInit, globals, funcs,
616 :     globInit, strand, create, init, update
617 : jhr 3485 } = prog
618 : jhr 3840 val _ = AnalyzeSimple.analyze prog
619 : jhr 3506 val consts' = List.map cvtGlobalVar consts
620 :     val inputs' = List.map (Inputs.map cvtGlobalVar) inputs
621 :     val inputs = List.map Inputs.varOf inputs
622 : jhr 3525 val constInit = let
623 :     val (cfg, _) = cvtBlock (([], []), VMap.empty, [], constInit)
624 :     val cfg = IR.CFG.prependNode (IR.Node.mkENTRY(), cfg)
625 : jhr 4164 val cfg = IR.CFG.appendNode (cfg, IR.Node.mkRETURN NONE)
626 : jhr 3525 in
627 :     cfg
628 :     end
629 : jhr 3506 val globals' = List.map cvtGlobalVar globals
630 : jhr 4163 val funcs' = let
631 :     fun cvtFunc (S.Func{f, params, body}) = let
632 :     (* initialize the environment with the function's parameters *)
633 :     val (env, params) = initEnvFromParams params
634 : jhr 4164 val (loadBlk, env) = loadGlobals (env, body)
635 :     val (bodyCFG, _) = cvtBlock (([], []), env, [], body)
636 :     val cfg = IR.CFG.prependNode (IR.Node.mkENTRY(), loadBlk)
637 :     val cfg = IR.CFG.concat(cfg, bodyCFG)
638 : jhr 4163 in
639 : jhr 4164 IR.Func{name = cvtFuncVar f, params = params, body = cfg}
640 : jhr 4163 end
641 :     in
642 :     List.map cvtFunc funcs
643 :     end
644 : jhr 3471 (* create the global initialization code *)
645 : jhr 3995 val globInit = let
646 : jhr 3471 (* we start by loading the input globals, since they may be needed to compute the
647 :     * other globals
648 :     *)
649 : jhr 4164 val (loadBlk, env) = loadGlobals (VMap.empty, globInit)
650 : jhr 3995 val (globBlk, env) = cvtBlock (([], []), env, [], globInit)
651 : jhr 3506 val cfg = IR.CFG.prependNode (IR.Node.mkENTRY(), loadBlk)
652 : jhr 3476 val cfg = IR.CFG.concat(cfg, globBlk)
653 : jhr 4164 val cfg = IR.CFG.appendNode (cfg, IR.Node.mkRETURN NONE)
654 : jhr 3471 in
655 :     cfg
656 :     end
657 : jhr 4119 fun cvtStrand (S.Strand{name, params, state, stateInit, initM, updateM, stabilizeM}) =
658 :     let
659 : jhr 4163 (* initialize the environment with the strand's parameters *)
660 :     val (env, params) = initEnvFromParams params
661 : jhr 3471 (* create the state variables *)
662 : jhr 3846 val svars = List.map getStateVar state
663 : jhr 3471 (* convert the state initialization code *)
664 :     val (stateInit, env) = let
665 :     (* load globals into local variables *)
666 : jhr 4164 val (loadGlobsCFG, env) = loadGlobals (env, stateInit)
667 : jhr 3471 val (cfg, env) = cvtBlock (([], []), env, [], stateInit)
668 : jhr 3476 val cfg = IR.CFG.concat(loadGlobsCFG, cfg)
669 :     val cfg = IR.CFG.prependNode (IR.Node.mkENTRY(), cfg)
670 :     val cfg = IR.CFG.concat (cfg,
671 : jhr 4164 saveStrandState (env, (state, svars), IR.Node.mkRETURN NONE))
672 : jhr 3471 in
673 :     (cfg, env)
674 :     end
675 : jhr 3505 fun cvtMeth isStabilize blk =
676 : jhr 4164 cvtMethod (env, isStabilize, state, svars, blk)
677 : jhr 3471 in
678 : jhr 3476 IR.Strand{
679 : jhr 3471 name = name,
680 :     params = params,
681 :     state = svars,
682 :     stateInit = stateInit,
683 : jhr 3505 initM = Option.map (cvtMeth false) initM,
684 :     updateM = cvtMeth false updateM,
685 :     stabilizeM = Option.map (cvtMeth true) stabilizeM
686 : jhr 3471 }
687 :     end
688 : jhr 4164 val create = Create.map cvtGlobalBlock create
689 : jhr 3476 val prog = IR.Program{
690 : jhr 3471 props = props,
691 : jhr 3506 consts = consts',
692 :     inputs = inputs',
693 :     globals = globals',
694 : jhr 4163 funcs = funcs',
695 : jhr 3506 constInit = constInit,
696 : jhr 3995 globInit = globInit,
697 : jhr 3505 strand = cvtStrand strand,
698 :     create = create,
699 : jhr 4164 init = Option.map cvtGlobalBlock init,
700 :     update = Option.map cvtGlobalBlock update
701 : jhr 3505 }
702 : jhr 3471 in
703 :     Census.init prog;
704 :     prog
705 :     end
706 :    
707 :     end

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