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

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