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 3169 - (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 : jhr 3169 (* FIXME: isHwVec, isVecTy, and getPieces do not appear to be used *)
20 : jhr 3060 val isHwVec : int -> bool
21 :     val isVecTy : int -> bool
22 :     val getPieces : int -> int list
23 : jhr 3169 (* FIXME: what does this function do? what are its results? *)
24 : jhr 3060 val getVecTy : int -> bool * int * int list
25 :    
26 : jhr 1115 end) : sig
27 :    
28 :     val translate : LowIL.program -> TreeIL.program
29 :    
30 :     end = struct
31 :    
32 : cchiw 2646 structure Src = LowIL
33 :     structure SrcOp = LowOps
34 : cchiw 2691 structure SrcV = LowIL.Var
35 :     structure SrcSV = LowIL.StateVar
36 : cchiw 2646 structure VA = VarAnalysis
37 : jhr 3060 structure InP = Inputs
38 : cchiw 2646 structure Ty = LowILTypes
39 : jhr 1115 structure Nd = LowIL.Node
40 :     structure CFG = LowIL.CFG
41 : jhr 3060 structure LowOpToTreeOp = LowOpToTreeOp
42 : cchiw 2691 structure Dst = TreeIL
43 :     structure DstOp = TreeOps
44 : cchiw 2838 structure DstSV = Dst.StateVar
45 : cchiw 2844 structure SrcTy = LowILTypes
46 :     structure DstTy = TreeILTypes
47 :     structure DstV = Dst.Var
48 : jhr 3060 structure TreeToOpr = TreeToOpr
49 :     structure Fnc = TreeFunc
50 :     structure TySet = Fnc.TySet
51 :     structure OprSet = Fnc.OprSet
52 :     structure LowToS = LowToString
53 : cchiw 2688
54 : jhr 1115 (* create new tree IL variables *)
55 :     local
56 : cchiw 2646 val newVar = Dst.Var.new
57 : jhr 1115 val cnt = ref 0
58 :     fun genName prefix = let
59 : jhr 2356 val n = !cnt
60 :     in
61 :     cnt := n+1;
62 :     String.concat[prefix, "_", Int.toString n]
63 :     end
64 : jhr 1115 in
65 : cchiw 2842 val testing=0
66 : cchiw 2838 fun testp str=(case testing
67 :     of 1=> (print(String.concat str);1)
68 : cchiw 2628 | _ =>1
69 :     (*end case*))
70 : cchiw 2844 fun iTos n =Int.toString n
71 : cchiw 2838
72 : jhr 2632
73 : cchiw 2691 fun newGlobal x = newVar (genName("G_" ^ SrcV.name x), Dst.VK_Global, SrcV.ty x)
74 :     fun newParam x = newVar (genName("p_" ^ SrcV.name x), Dst.VK_Local, SrcV.ty x)
75 :     fun newLocal x = newVar (genName("l_" ^ SrcV.name x), Dst.VK_Local, SrcV.ty x)
76 :     fun newIter x = newVar (genName("i_" ^ SrcV.name x), Dst.VK_Local, SrcV.ty x)
77 : cchiw 2844 fun newTmp (x,n) = newVar (genName("l_" ^ iTos n^SrcV.name x), Dst.VK_Local, SrcV.ty x)
78 : cchiw 2827 fun newLocalPtrTy (name,ty)= newVar(genName("l_rp_"^name), Dst.VK_Local,ty)
79 : cchiw 2844 fun newLocalWithTy (name,n)= newVar(genName("l_"^iTos n^name), Dst.VK_Local,Ty.TensorTy [n])
80 :     fun newGlobalWithTy (name,n)= newVar(genName("G_"^iTos n^name), Dst.VK_Global,Ty.TensorTy [n])
81 : cchiw 2827
82 : jhr 1115 end
83 :    
84 : jhr 1640 (* associate Tree IL state variables with Low IL variables using properties *)
85 :     local
86 : cchiw 2646 fun mkStateVar x = Dst.SV{
87 : cchiw 2691 name = SrcSV.name x,
88 : jhr 1640 id = Stamp.new(),
89 : cchiw 2691 ty = SrcSV.ty x,
90 : jhr 1640 varying = VA.isVarying x,
91 : cchiw 2691 output = SrcSV.isOutput x
92 : jhr 1640 }
93 :     in
94 : cchiw 2691 val {getFn = getStateVar, ...} = SrcSV.newProp mkStateVar
95 : jhr 1640 end
96 :    
97 : cchiw 2646 fun mkBlock stms = Dst.Block{locals=[], body=stms}
98 :     fun mkIf (x, stms, []) = Dst.S_IfThen(x, mkBlock stms)
99 :     | mkIf (x, stms1, stms2) = Dst.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)
100 : jhr 1115
101 :     (* an environment that tracks bindings of variables to target expressions and the list
102 :     * of locals that have been defined.
103 :     *)
104 :     local
105 : cchiw 2691 structure VT = SrcV.Tbl
106 : cchiw 2646 fun decCount ( Src.V{useCnt, ...}) = let
107 : jhr 2356 val n = !useCnt - 1
108 :     in
109 :     useCnt := n; (n <= 0)
110 :     end
111 : cchiw 2637
112 : jhr 3060 datatype target_binding
113 :     = GLOB of Dst.var (* variable is global *)
114 :     | TREE of Dst.exp (* variable bound to target expression tree *)
115 :     | DEF of Dst.exp (* either a target variable or constant for a defined variable *)
116 :    
117 : cchiw 2637 structure ListSetOfInts = ListSetFn (struct
118 :     type ord_key = int
119 :     val compare = Int.compare
120 :     end)
121 :    
122 : cchiw 2844 (*changed env to add sets Tys and Oprs*)
123 : jhr 1115 datatype env = E of {
124 : jhr 2356 tbl : target_binding VT.hash_table,
125 : jhr 3060 (* FIXME: perhaps the types and functs should be set refs, since they are global? *)
126 :     types : TySet.set,
127 : cchiw 2637 functs : OprSet.set,
128 : cchiw 2646 locals : Dst.var list
129 : jhr 2356 }
130 : cchiw 2637
131 : jhr 1115 in
132 : jhr 3060
133 :     fun peelEnv (E{tbl, types, functs, locals}) = (types,functs)
134 :     fun peelEnvLoc (E{tbl, types, functs, locals}) = locals
135 :     fun setEnv (E{tbl, types,functs,locals}, types1, functs1) =
136 :     E{tbl=tbl, types=types1, functs= functs1 ,locals=locals}
137 : cchiw 2637
138 : cchiw 2844 (*addOprFromExp: env* TreeIL.Exp-> env
139 :     * get new opr and type set and store it into the environment
140 :     *)
141 : jhr 3060 fun addOprFromExp(env, exp)=let
142 :     val t1 = peelEnv env
143 :     val (ty2, opr2) = TreeToOpr.expToOpr (t1,exp)
144 :     in
145 :     setEnv(env, ty2,opr2)
146 :     end
147 :    
148 : cchiw 2844 (*addOprFromStmt: env* TreeIL.Stmt-> env
149 :     * get new opr and type set and store it into the environment
150 :     *)
151 : jhr 3060 fun addOprFromStmt (env, stms)=let
152 :     val t1=peelEnv(env)
153 :     val (ty2,opr2)= TreeToOpr.stmtsToOpr ( t1 ,stms)
154 :     in
155 :     setEnv(env, ty2,opr2)
156 :     end
157 :    
158 : jhr 1115 (* DEBUG *)
159 : jhr 3060 fun bindToString binding = (case binding
160 :     of GLOB y => "GLOB " ^ Dst.Var.name y
161 :     | TREE e => "TREE"
162 :     | DEF(Dst.E_Var y) => "DEFVar " ^ Dst.Var.name y
163 :     | DEF e => "DEF"^Dst.toString e
164 :     (* end case *))
165 : jhr 1115
166 : jhr 3060 fun dumpEnv (E{tbl, ...}) = let
167 :     fun prEntry (x, binding) =
168 :     testp[" ", Src.Var.toString x, " --> ", bindToString binding, "\n"]
169 :     in
170 :     (* print "\n *** dump environment\n";
171 :     VT.appi prEntry tbl;
172 :     print "***\n"*) print ""
173 :     end
174 :     (* DEBUG *)
175 :    
176 : cchiw 2637 fun newEnv () = E{tbl = VT.mkTable (512, Fail "tbl"), types=TySet.empty, functs=OprSet.empty, locals=[]}
177 : jhr 1115
178 :     (* use a variable. If it is a pending expression, we remove it from the table *)
179 : jhr 3060 fun peek (env as E{tbl, ...}) x = (case (VT.find tbl x)
180 :     of NONE=>"none"
181 :     | SOME e=> bindToString e
182 :     (*end case *))
183 : cchiw 2692
184 :     fun useVar (env as E{tbl, ...}) x = (case VT.find tbl x
185 : cchiw 2791 of SOME(GLOB x') => ( (*print ("\n usevar found Glob "^SrcV.name x^"\n") ;*)Dst.E_Var x')
186 : jhr 2356 | SOME(TREE e) => (
187 : cchiw 2691 (*print(concat["useVar ", SrcV.toString x, " ==> TREE\n"]);*)
188 : jhr 2356 ignore(VT.remove tbl x);
189 :     e)
190 :     | SOME(DEF e) => (
191 : cchiw 2691 (*print(concat["useVar ", SrcV.toString x, " ==> ", bindToString(DEF e), "; use count = ", Int.toString(SrcV.useCount x), "\n"]);*)
192 : jhr 2356 (* if this is the last use of x, then remove it from the table *)
193 : cchiw 2791 (*if (decCount x) then ignore(VT.remove tbl x) else ();*)
194 :     (*print ("\n found Def "^SrcV.name x^"\n");*)
195 : jhr 2356 e)
196 :     | NONE => (
197 : jhr 1115 dumpEnv env;
198 : cchiw 2691 raise Fail(concat ["useVar(", SrcV.toString x, ")"])
199 : jhr 1115 )
200 : jhr 2356 (* end case *))
201 : jhr 1115
202 : cchiw 2844 (* record a local variable *)
203 : cchiw 2637 fun addLocal (E{tbl, types,functs,locals}, x) = E{tbl=tbl,types=types, functs=functs,locals=x::locals}
204 : cchiw 2844 fun addLocals (E{tbl, types,functs,locals}, x) = E{tbl=tbl,types=types, functs=functs,locals=x@locals}
205 : jhr 3060 fun global (E{tbl, ...}, x, x') = (VT.insert tbl (x, GLOB x'))
206 : jhr 1115
207 :     (* insert a pending expression into the table. Note that x should only be used once! *)
208 :     fun insert (env as E{tbl, ...}, x, exp) = (
209 : jhr 2356 VT.insert tbl (x, TREE exp);
210 :     env)
211 : jhr 1115
212 :     fun rename (env as E{tbl, ...}, x, x') = (
213 : cchiw 2646 VT.insert tbl (x, DEF(Dst.E_Var x'));
214 : jhr 2356 env)
215 : cchiw 2687
216 : cchiw 2692 fun renameGlob (env as E{tbl, ...}, x, x') = (
217 :     VT.insert tbl (x, GLOB( x'));
218 : cchiw 2687 env)
219 : cchiw 2692
220 : cchiw 2789 fun renameExp (env as E{tbl, ...}, x, x') = (
221 : cchiw 2692 VT.insert tbl (x, DEF( x'));
222 :     env)
223 : cchiw 2688
224 : cchiw 2692
225 : cchiw 2688 fun peekGlobal (E{tbl, ...}, x) = (case VT.find tbl x
226 : cchiw 2691 of SOME(GLOB x') => SOME x'
227 :     | SOME e => NONE
228 :     | NONE => NONE
229 :     (* end case *))
230 : cchiw 2838
231 : cchiw 2844 (*bindLocal: env*SrcV*Dst.Exp-> env*Dst.S list
232 :     * if lhs variable is used once then it is inserted
233 :     * else if lhs is used multiple times then new local variables are created
234 :     * when exp is a mux more ops are used
235 :     *)
236 : cchiw 2687 fun bindLocal (env, lhs, rhs) =let
237 : cchiw 2691 val n=SrcV.useCount lhs
238 : cchiw 2844 val _=testp ["\n In BindLocal: \n \t LHS: ",SrcV.name lhs, " Count \t",Int.toString n," rhs:", Dst.toString rhs ,"\n"]
239 : cchiw 2688 in (case (n,rhs)
240 : cchiw 2791 of (0,_) => (env,[])
241 : cchiw 2844 | (1,_) => (insert(addOprFromExp(env,rhs), lhs, rhs), [])
242 : cchiw 2795 | (_,Dst.E_Mux(A,isFill, nOrig,Tys as Ty.vectorLength tys,exps))=> let
243 : cchiw 2789 val name=SrcV.name lhs
244 : cchiw 2791 val vs=List.map (fn n=> newLocalWithTy(name,n) ) tys
245 : cchiw 2795 val rhs=Dst.E_Mux(A, isFill,nOrig,Tys,List.map (fn v=>Dst.E_Var v) vs)
246 : cchiw 2791 val stmts=ListPair.map (fn(x,e)=>Dst.S_Assign([x],e)) (vs,exps)
247 : cchiw 2692 in
248 : cchiw 2791 (renameExp(addLocals(env,vs),lhs,rhs),stmts)
249 : cchiw 2687 end
250 : cchiw 2838 |(_,_)=> let
251 :     val t = newLocal lhs
252 :     in
253 :     (rename(addLocal(env, t), lhs, t), [Dst.S_Assign([t], rhs)])
254 :     end
255 : cchiw 2688 (*end case*))
256 : cchiw 2687 end
257 :    
258 : cchiw 2691
259 :     fun bind (env, lhs, rhs) =(case peekGlobal (env, lhs)
260 : cchiw 2844 of SOME x =>((env, [Dst.S_Assign([x], rhs)]))
261 :     | NONE => (bindLocal (env, lhs, rhs))
262 : cchiw 2691 (* end case *))
263 : jhr 1115
264 :     (* set the definition of a variable, where the RHS is either a literal constant or a variable *)
265 : cchiw 2691 fun bindSimple (env as E{tbl, ...}, lhs, rhs) =(case peekGlobal (env, lhs)
266 :     of SOME x => (env, [Dst.S_Assign([x], rhs)])
267 :     | NONE => (VT.insert tbl (lhs, DEF rhs); (env, []))
268 :     (* end case *))
269 : cchiw 2688
270 : jhr 1115
271 :     (* at the end of a block, we need to assign any pending expressions to locals. The
272 :     * blkStms list and the resulting statement list are in reverse order.
273 :     *)
274 : cchiw 2637 fun flushPending (E{tbl,types, functs,locals}, blkStms) = let
275 : jhr 2356 fun doVar (x, TREE e, (locals, stms)) = let
276 :     val t = newLocal x
277 :     in
278 : cchiw 2646 VT.insert tbl (x, DEF(Dst.E_Var t));
279 :     (t::locals, Dst.S_Assign([t], e)::stms)
280 : jhr 2356 end
281 :     | doVar (_, _, acc) = acc
282 :     val (locals, stms) = VT.foldi doVar (locals, blkStms) tbl
283 :     in
284 : cchiw 2637 (E{tbl=tbl, types=types,functs=functs,locals=locals}, stms)
285 : jhr 2356 end
286 : jhr 1115
287 : cchiw 2646 fun doPhi ((lhs, rhs), (env, predBlks : Dst.stm list list)) = let
288 : jhr 2356 (* t will be the variable in the continuation of the JOIN *)
289 :     val t = newLocal lhs
290 :     val predBlks = ListPair.map
291 : cchiw 2646 (fn (x, stms) => Dst.S_Assign([t], useVar env x)::stms)
292 : jhr 2356 (rhs, predBlks)
293 :     in
294 :     (rename (addLocal(env, t), lhs, t), predBlks)
295 :     end
296 : cchiw 2844
297 :    
298 :     (*
299 :     fun endScope (E{locals, ...}, stms) = Dst.Block{
300 : jhr 2356 locals = List.rev locals,
301 :     body = stms
302 : cchiw 2844 }
303 :     *)
304 : cchiw 2637 fun endScope (env, stms) = let
305 : cchiw 2844 val env'=addOprFromStmt(env, stms)
306 :     val (types,opr)=peelEnv(env')
307 :     in Dst.BlockWithOpr{
308 : cchiw 2637 locals= List.rev(peelEnvLoc env),
309 :     types= types,
310 :     opr=opr,
311 :     body = stms
312 :     }
313 :     end
314 : jhr 1115 end
315 :    
316 :     (* Certain IL operators cannot be compiled to inline expressions. Return
317 :     * false for those and true for all others.
318 :     *)
319 : cchiw 2680
320 : jhr 1115 fun isInlineOp rator = let
321 : jhr 2356 fun chkTensorTy (Ty.TensorTy[]) = true
322 :     | chkTensorTy (Ty.TensorTy[_]) = true
323 :     | chkTensorTy (Ty.TensorTy[_, _]) = Target.inlineMatrixExp
324 :     | chkTensorTy _ = false
325 : cchiw 2688
326 : jhr 2356 in
327 :     case rator
328 : cchiw 2646 of SrcOp.LoadVoxels(_, 1) => true
329 :     | SrcOp.LoadVoxels _ => false
330 :     | SrcOp.EigenVecs2x2 => false
331 :     | SrcOp.EigenVecs3x3 => false
332 :     | SrcOp.EigenVals2x2 => false
333 :     | SrcOp.EigenVals3x3 => false
334 : cchiw 2691 (* | SrcOp.Zero _ => Target.inlineMatrixExp*)
335 : cchiw 2680 | _ => true (*when true calls binding *)
336 : jhr 2356 (* end case *)
337 :     end
338 : jhr 1115
339 : cchiw 2669 (*HERE- since we are using arrays, nothing can be inline
340 :     Fix later if it needs to be fixed*)
341 : cchiw 2525 (* is a CONS inline? *)
342 : cchiw 2669 fun isInlineCons ty = (*(case ty
343 : cchiw 2525 of Ty.SeqTy(Ty.IntTy, _) => true
344 :     | Ty.TensorTy dd => Target.inlineCons(List.length dd)
345 :     | Ty.SeqTy _ => false
346 :     (*CCCC-? DO we have this type*)
347 : cchiw 2615 (* | Ty.DynSeqTy ty => false*)
348 : cchiw 2525 | _ => raise Fail(concat["invalid CONS<", Ty.toString ty, ">"])
349 : cchiw 2669 (* end case *))*) false
350 : cchiw 2525
351 :     (* translate a LowIL assignment to a list of zero or more target statements in reverse
352 :     * order.
353 :     *)
354 : cchiw 2688
355 : jhr 3060 (* translate input-variable initialization to a TreeIL expression *)
356 :     fun trInitialization (InP.String s) = ([], Dst.E_Lit(Literal.String s))
357 :     | trInitialization (InP.Int n) = ([], Dst.E_Lit(Literal.Int n))
358 :     | trInitialization (InP.Real f) = ([], Dst.E_Lit(Literal.Float f))
359 :     | trInitialization (InP.Bool b) = ([], Dst.E_Lit(Literal.Bool b))
360 : jhr 3169 | trInitialization (InP.Tensor([d], vs)) = let
361 :     (* make a literal expression for i'th initializer *)
362 :     fun mk i = Dst.E_Lit(Literal.Float(Vector.sub(vs, i)))
363 :     (* get representation of the the vector type *)
364 :     val (isPadded, wid, pieces) = Target.getVecTy d
365 :     val exp = LowOpToTreeOp.consVecToTree(wid, d, pieces, List.tabulate(Vector.length vs, mk), isPadded)
366 :     in
367 :     ([], exp)
368 :     end
369 : jhr 3060 (*
370 :     | trInitialization (InP.Tensor(shp, vs)) = let
371 :     fun mk i = Dst.E_Lit(Literal.Float(Vector.sub(vs, i)))
372 :     fun mkCons (i, [d]) =
373 :     (Dst.E_Cons(Ty.TensorTy[d], List.tabulate(d, fn j => mk(i+j))), i+d)
374 :     | mkCons (i, d::dd) = let
375 :     fun f (i, j, args) = if (j < d)
376 :     then let
377 :     val (arg, i) = mkCons(i, dd)
378 :     in
379 :     f (i, j+1, arg::args)
380 :     end
381 :     else (List.rev args, i)
382 :     val (args, i) = f (i, 0, [])
383 :     val cons = Dst.E_Cons(Ty.TensorTy(d::dd), args)
384 :     in
385 :     if Target.inlineCons(List.length dd + 1)
386 :     then (cons, i)
387 :     else raise Fail "non-inline initialization not supported yet"
388 :     end
389 :     val (exp, _) = mkCons(0, shp)
390 :     in
391 :     ([], exp)
392 :     end
393 :     *)
394 :     | trInitialization (InP.Tensor _) = raise Fail "trInitialization: Tensor"
395 :     | trInitialization (InP.Seq vs) = raise Fail "trInitialization: Seq"
396 :     | trInitialization _ = raise Fail "trInitialization: impossible"
397 : cchiw 2688
398 : jhr 3060 (* translate a LowIL assignment to a list of zero or more target statements in reverse
399 :     * order.
400 :     *)
401 : jhr 1115 fun doAssign (env, (lhs, rhs)) = let
402 : jhr 2356 fun doLHS () = (case peekGlobal(env, lhs)
403 : jhr 3168 of SOME lhs' => (env, lhs')
404 :     | NONE => let
405 :     val t = newLocal lhs
406 :     in
407 :     (rename (addLocal(env, t), lhs, t), t)
408 :     end
409 :     (* end case *))
410 : jhr 2356 (* for expressions that are going to be compiled to a call statement *)
411 :     fun assignExp (env, exp) = let
412 :     (* operations that return matrices may not be supported inline *)
413 :     val (env, t) = doLHS()
414 :     in
415 : cchiw 2646 (env, [Dst.S_Assign([t], exp)])
416 : jhr 2356 end
417 : cchiw 2525 (* force an argument to be stored in something that will be mapped to an l-value *)
418 :     fun bindVar (env, x) = (case useVar env x
419 : cchiw 2688 of x' as Dst.E_State _ =>(env, x', [])
420 :     | x' as Dst.E_Var _ => (env, x', [])
421 :     | e => let
422 : cchiw 2525 val x' = newLocal x
423 :     in
424 : cchiw 2646 (addLocal(env, x'), Dst.E_Var x', [Dst.S_Assign([x'], e)])
425 : cchiw 2525 end
426 :     (* end case *))
427 : jhr 3060 val _= LowToS.ASSIGNtoString(lhs,rhs)
428 : cchiw 2844 (* opToString:LowIL.Ops* LowIL.Var list-> int
429 :     *Just used to print information about the op
430 :     *)
431 : cchiw 2830 fun opToString (rator,arg)= let
432 :     val r=SrcOp.toString rator
433 :     val a= String.concatWith " , " (List.map (fn e=> Dst.toString e) arg)
434 :     in
435 : cchiw 2844 testp[ "\n ***** New Op**** \n ",r,"\n Args(",a,")"]
436 : cchiw 2838 end
437 : jhr 2356 in
438 :     case rhs
439 : cchiw 2838 of Src.STATE x =>let
440 : cchiw 2844 (* Hmm, what to do with State nodes.
441 :     * They get represented like globals but their other operations register their kind as local
442 :     * Leads to trouble in their representation
443 :     * Fix me, once we change representation of state and local vars
444 :     * currently we load 1 piece when it is a local var.
445 :     * fun iter([],_)=[]
446 :     * | iter(e1::es,counter)=[Dst.E_LoadArr(isFill ,e1,oSize, t , Dst.E_Lit(Literal.Int counter))]@
447 :     * | iter(es,counter+ IntInf.fromInt e1)
448 : jhr 3169 * val ops=iter(pieces,0)
449 : cchiw 2844 *)
450 :     val (env, vt) = doLHS()
451 :     val t=Dst.E_State(getStateVar x)
452 :     val exp=(case (DstV.kind vt, DstV.ty vt)
453 : cchiw 2838 of (Dst.VK_Local,DstTy.TensorTy [oSize])=>let
454 : jhr 3169 val (isFill,nSize,pieces)=Target.getVecTy oSize
455 : cchiw 2838 val op1= Dst.E_LoadArr(false ,nSize,oSize, t , Dst.E_Lit(Literal.Int 0))
456 : jhr 3169 val splitTy=DstTy.vectorLength pieces
457 : cchiw 2838 in Dst.E_Mux(false,isFill,oSize,splitTy,[op1])
458 :     end
459 :     | _ => t
460 :     (*end case *))
461 : cchiw 2844 in
462 :     bindSimple (env, lhs,exp)
463 :     end
464 : cchiw 2688 | Src.VAR x => bindSimple (env, lhs, useVar env x)
465 :     | Src.LIT lit => bindSimple (env, lhs, Dst.E_Lit lit)
466 : jhr 3060 | Src.OP(SrcOp.Kernel _, _) => (env, [])
467 :     | Src.OP(SrcOp.LoadImage(ty, nrrd, info), []) => let
468 :     val (env, t) = doLHS()
469 :     in
470 :     (env, [Dst.S_LoadNrrd(t, ty, nrrd)])
471 :     end
472 :     | Src.OP(SrcOp.Input(InP.INP{ty=Ty.ImageTy _, name, desc, init}), []) => let
473 :     val (env, t) = doLHS()
474 :     in
475 :     case init
476 :     of SOME(InP.Proxy(nrrd, _)) => (env, [Dst.S_InputNrrd(t, name, desc, SOME nrrd)])
477 :     | SOME(InP.Image _) => (env, [Dst.S_InputNrrd(t, name, desc, NONE)])
478 :     | _ => raise Fail "bogus initialization for image"
479 :     (* end case *)
480 :     end
481 :     | Src.OP(SrcOp.Input(InP.INP{ty, name, desc, init=NONE}), []) => let
482 :     val (env, t) = doLHS()
483 :     in
484 :     (env, [Dst.S_Input(t, name, desc, NONE)])
485 :     end
486 :     | Src.OP(SrcOp.Input(InP.INP{ty, name, desc, init=SOME init}), []) => let
487 :     val (env, t) = doLHS()
488 :     val (stms, exp) = trInitialization init
489 :     in
490 :     (env, stms@[Dst.S_Input(t, name, desc, SOME exp)])
491 :     end
492 :     | Src.OP(SrcOp.Inside(info, s), args) => let
493 : cchiw 2838 val [a,b]=List.map (useVar env) args
494 :     val size=(case (ImageInfo.dim info)
495 : jhr 3060 of 1 => raise Fail"Inside of 1-D dimension"
496 :     | 2 => 2
497 :     | 3 => 4
498 : cchiw 2844 (*end case*))
499 :     (*separated the position to make it look cleaner*)
500 :     val k=newLocalWithTy ("Pos_"^SrcV.name lhs ,size)
501 : cchiw 2838 val s1= Dst.S_Assign([k],a)
502 :     val rhs=Dst.E_Op(DstOp.Inside(info,s),[Dst.E_Var k,b])
503 :     val (env,s)=bind(addLocal(env,k),lhs,rhs)
504 :     in
505 :     (env,[s1]@s)
506 :     end
507 :     | Src.OP(SrcOp.Translate v, [a])=> let
508 : cchiw 2844 (*Result is a vector so we have to use Mux*)
509 : cchiw 2838 val dim = ImageInfo.dim v
510 :     val splitTy=DstTy.vectorLength [dim]
511 :     val op1= Dst.E_Op(DstOp.Translate v,[(useVar env a)])
512 :     val exp= (case dim
513 :     of 1=> op1
514 : cchiw 2844 | 2 => Dst.E_Mux(true,false,dim,splitTy,[op1])
515 : cchiw 2838 | 3=> Dst.E_Mux(false,false,dim,splitTy,[op1])
516 :     (*end case*))
517 : cchiw 2844 in
518 :     bind(env,lhs,exp)
519 :     end
520 : cchiw 2838 | Src.OP(SrcOp.Transform v,args) => let
521 : cchiw 2844 (*Result is an array so we have to use Store*)
522 : cchiw 2838 val (env2, t) = doLHS()
523 :     val V=Dst.E_Var t
524 :     val dim = ImageInfo.dim v
525 :     val ty=DstTy.TensorTy [dim,dim]
526 :     val args'=List.map (useVar env) args
527 :     val a=List.tabulate(dim,(fn n=> Dst.E_Op(DstOp.Transform(v,n),args')))
528 :     val (env2,stmt)= (case dim
529 :     of 1=> bind(env2,lhs,Dst.E_Op(DstOp.Transform (v,1),args'))
530 :     | 2 =>(env2,[Dst.S_StoreVec(V,0,true,false,dim,ty,DstTy.vectorLength [2,2],a)])
531 :     | 3 =>(env2,[Dst.S_StoreVec(V,0,false,true,dim,ty,DstTy.vectorLength [4,4,4] ,a)])
532 :     (*end case*))
533 :     in
534 :     (env2,stmt)
535 :     end
536 :     | Src.OP(SrcOp.imgLoad(info,dim,oSize),[a])=>let
537 : cchiw 2844 (*create ptr variable vp and index it with stride*)
538 : cchiw 2838 val vp= newLocalPtrTy(SrcV.name lhs,DstTy.AddrTy info)
539 :     val stmt=Dst.S_Assign([vp], useVar env a)
540 :     val stride = ImageInfo.stride info
541 : cchiw 2844 val IndexArgs= List.tabulate(oSize,
542 :     fn n=> Dst.E_Op(DstOp.IndexTensor(false,Ty.indexTy [n*stride],Ty.TensorTy [oSize]),[Dst.E_Var vp]))
543 : cchiw 2838 (*create cons expressions*)
544 : jhr 3169 val (isFill,nSize,pieces)=Target.getVecTy oSize
545 :     val exp=LowOpToTreeOp.consVecToTree(nSize,oSize,pieces,IndexArgs,isFill)
546 : cchiw 2838 (*increase use count so it is easier to read c-file*)
547 :     fun incUse (Src.V{useCnt, ...}) = (useCnt := !useCnt + 1)
548 : cchiw 2844 val _ = incUse lhs
549 :     val (env2,stmt2)=bind (addLocal(env, vp), lhs,exp)
550 : cchiw 2838 in
551 :     (env2, List.rev stmt2@[stmt])
552 :     end
553 : cchiw 2844 | Src.OP(SrcOp.IndexTensor e,[a])=> let
554 :     (*IndexTensor operation is int*ty*ty
555 :     * The first ty is the list of indexed position and second ty is the type of the argument
556 :     * When the rhs is a mux(matrix.. or larger arg) then we look for the right argument to index
557 :     * Otherwise we just pass the variable kind to the tree-il op and let c-util decide how/where to index
558 :     * The kind of variable decides if there is cast in the c-code
559 :     *)
560 :     val a'=(useVar env a)
561 :     val exp=(case ((SrcOp.IndexTensor e),a') of
562 :     (SrcOp.IndexTensor(_ ,Ty.indexTy [i],_),Dst.E_Mux(_,_,_,DstTy.vectorLength pieces,ops))=> let
563 :     fun findLocal(c,i,indexAt,v::vs,a1::args)=let
564 :     val newsize=c+v
565 :     in if(newsize>i) then Dst.E_Op(DstOp.IndexTensor(true,Ty.indexTy [indexAt],Ty.TensorTy [v]), [a1])
566 :     else findLocal(newsize,i,indexAt-v,vs,args)
567 :     end
568 :     val exp =findLocal(0,i,i,pieces,ops)
569 :     in
570 :     exp
571 :     end
572 :     | (SrcOp.IndexTensor( _ , indTy,argTy),Dst.E_Var v) => (case (DstV.kind v)
573 :     of TreeIL.VK_Local=>Dst.E_Op(DstOp.IndexTensor(true ,indTy,argTy),[a'])
574 :     | _ =>Dst.E_Op(DstOp.IndexTensor(false ,indTy,argTy),[a'])
575 :     (*end case*))
576 :     | (SrcOp.IndexTensor( _ , indTy,argTy),_) => Dst.E_Op(DstOp.IndexTensor(true ,indTy,argTy),[a'])
577 :    
578 :     (*end case*))
579 :     in
580 :     bind (env, lhs, exp)
581 :     end
582 : cchiw 2838
583 : jhr 3168 | Src.OP(rator,args) => let
584 : cchiw 2795 val args'=List.map (useVar env) args
585 : cchiw 2845 val _ =testp[ "\n ***** New Op \n \t\t",SrcV.name lhs,"-",SrcOp.toString rator,Int.toString(length(args))
586 :     , " Args(\n\t",String.concatWith"\n\t\t," (List.map (fn e=> Dst.toString e) args'),")"]
587 : cchiw 2844 (*foundVec:SrcOp.op* DstOP.ops*int*DstVar list *DstVar list
588 :     * Found a vector operation.
589 :     * Rewrites to correctly-sized vector operations
590 :     *)
591 : cchiw 2827 fun foundVec(origrator,rator,oSize,argsS,argsV)= let
592 : jhr 3169 val (isFill,nSize,pieces)=Target.getVecTy oSize
593 : cchiw 2827 val (env, t) = doLHS()
594 : jhr 3169 val stmt = LowOpToTreeOp.vecToTree(t,origrator,rator,nSize,oSize,pieces,argsS,argsV,isFill)
595 : cchiw 2827 val (envv,stmts)=(case stmt
596 :     of Dst.S_Assign(_,exp)=> bind (env, lhs, exp)
597 :     | stmt=> (env,[stmt])
598 :     (*end case*))
599 : cchiw 2844 val _ = testp["\n \n\t",Dst.toStringS stmt]
600 : cchiw 2827 in
601 :     (envv,stmts)
602 :     end
603 : jhr 3168 in case (rator,args')
604 : cchiw 2838 of (SrcOp.addVec n,_) => foundVec(rator,DstOp.addVec,n,[],args')
605 :     | (SrcOp.subVec n,_) => foundVec(rator,DstOp.subVec,n,[],args')
606 :     | (SrcOp.prodScaV n,e1::es) => foundVec(rator,DstOp.prodScaV ,n, [e1], es)
607 :     | (SrcOp.prodVec n,_) => foundVec(rator,DstOp.prodVec,n,[],args')
608 :     | (SrcOp.sumVec n ,_) => foundVec(rator,DstOp.addVec ,n,[],args')
609 :     | (SrcOp.Floor n ,_) => foundVec(rator,DstOp.Floor ,n,[],args')
610 :     | (SrcOp.ProjectTensor(_,n,_,_),_) => foundVec(rator,DstOp.addVec ,n,[],args')
611 : cchiw 2830 | (SrcOp.Clamp (Ty.TensorTy[n]) ,_) => foundVec(rator,DstOp.clampVec ,n,[],args')
612 : cchiw 2838 | (SrcOp.Lerp (Ty.TensorTy[n]) ,[a,b,c]) => foundVec(rator,DstOp.lerpVec ,n,[c],[a,b])
613 : cchiw 2844 | (SrcOp.Normalize n,_) => foundVec(rator,DstOp.Normalize ,n,[],args')
614 :     | (SrcOp.addSca ,[a,Dst.E_Lit (Literal.Int 0)]) => assignExp (env,a)
615 :     | (SrcOp.addSca ,[Dst.E_Lit (Literal.Int 0),a]) => assignExp (env,a)
616 :     | (SrcOp.subSca ,[a,Dst.E_Lit (Literal.Int 0)]) => assignExp (env,a)
617 : cchiw 2680 | _ => let
618 : cchiw 2637 val Trator = LowOpToTreeOp.expandOp rator
619 : cchiw 2671 val exp = Dst.E_Op(Trator, args')
620 : cchiw 2620 in
621 : cchiw 2688 if isInlineOp rator then (bind (env, lhs, exp))
622 :     else (assignExp (env, exp))
623 : cchiw 2620 end
624 : jhr 3168 (*end case *)
625 : cchiw 2827 end
626 : cchiw 2646 | Src.APPLY(f, args) =>
627 :     bind (env, lhs, Dst.E_Apply(f, List.map (useVar env) args))
628 : cchiw 2692 | Src.CONS(ty as Ty.TensorTy[oSize], args) => let
629 : jhr 3168 (* CONS of a vector with real arguments
630 : cchiw 2844 * If lhs is a local var then we assume lhs will be represented with vectors
631 :     * and we use Mux and E_ConsVec on pieces, much like a vector op
632 :     * Otherwise, assume it's an array and use S_Cons
633 : cchiw 2845 * testp["\n ****** here **\n ",LowToS.rhsToString (Src.CONS(ty , args)),
634 : cchiw 2844 "\n\t* lhs " ,SrcV.name lhs,"type",Ty.toString(SrcV.ty lhs),
635 :     "\nt",DstV.name t,"-kind:",Dst.kindToString (DstV.kind t),"\n"]
636 :     *)
637 : jhr 3168 val args' = List.map (useVar env) args
638 : cchiw 2844 val (env2, t) = doLHS()
639 : jhr 3168 in case DstV.kind t
640 : cchiw 2844 of TreeIL.VK_Local=> let
641 : jhr 3169 val (isFill,nSize,pieces)=Target.getVecTy oSize
642 :     val exp = LowOpToTreeOp.consVecToTree(nSize,oSize,pieces,args',isFill)
643 : cchiw 2844 val _ =testp["\nExp\n",Dst.toString exp]
644 :     in
645 : jhr 3168 bind (env2, lhs, exp)
646 : cchiw 2844 end
647 : jhr 3168 | _ => (env2, [Dst.S_Cons(t, oSize, args')])
648 :     (*end case*)
649 : cchiw 2844 end
650 : cchiw 2845 (*| Src.CONS(ty as Ty.TensorTy [_,2], args)=>let
651 :     val args'=List.map (useVar env) args
652 :     val _=case args'
653 :    
654 :     val _=(case )
655 :     val (env2, t) = doLHS()
656 :     in
657 :     (env2,[Dst.S_Cons(t,4,args')])
658 :     end*)
659 : cchiw 2838 | Src.CONS(ty as Ty.TensorTy [_,j], args) =>let
660 : cchiw 2844 (* Cons is a matrix with vector arguments
661 :     * Each Vector Arg could be a global, local or state variable
662 :     * Which means their representation could be different
663 :     * when it is a global or state then we copy it S_Copy
664 :     * when it is a local or other then we use S_Store
665 :     *)
666 : cchiw 2791 val args' = List.map (useVar env) args
667 : cchiw 2844 val _ =testp["******************************\n CONS_Matrix \n With Args", Dst.toStrings args']
668 :     val (env2, t) = doLHS()
669 : cchiw 2838
670 : cchiw 2844
671 :     (*Vector params for last matrix index. Retrieved in case we use S_Store*)
672 : jhr 3169 val (isFill,nSize,pieces)=Target.getVecTy j
673 :     val splitTy=LowILTypes.vectorLength pieces
674 :     val n=length pieces
675 : cchiw 2844 val A =LowOpToTreeOp.isAlignedStore(isFill,n)
676 : cchiw 2827 fun f ([], _ ) = []
677 : cchiw 2844 | f (e1::es,count)=let
678 :     val t=(case e1
679 :     of Dst.E_State v=> Dst.S_Copy(Dst.E_Var t, e1, count,j)
680 :     | Dst.E_Var v=>(case (DstV.kind v)
681 :     of TreeIL.VK_Global => Dst.S_Copy(Dst.E_Var t, e1, count,j)
682 :     | _ =>
683 :     Dst.S_StoreVec(Dst.E_Var t,count,A,isFill,j,ty,splitTy, [e1])
684 :     (*end case*))
685 :     | _ => Dst.S_StoreVec(Dst.E_Var t,count,A,isFill,j,ty,splitTy, [e1])
686 : cchiw 2827 (*end case*))
687 : cchiw 2844 in
688 :     [t]@f(es,count+j)
689 :     end
690 : cchiw 2827 val stmts=f (args',0)
691 : cchiw 2844 val _ =testp["\n returning statements \n",Dst.toStringSs stmts,"\n end ******************************\n"]
692 : cchiw 2827 in
693 :     (env2, List.rev stmts)
694 : cchiw 2838 end
695 :     | Src.CONS(ty as Ty.TensorTy [_,i,j], args) =>let
696 : cchiw 2844 (* CONS is larger tensor with non-vector arguments
697 :     * Hooray! We can assume everything is an array and S_Copy everything
698 :     *)
699 : cchiw 2838 val args' = List.map (useVar env) args
700 : cchiw 2857 val _ =testp["******************************\n CONS_Matrix \n ",
701 :     "Number of args",Int.toString (length args),"---\n",Dst.toStrings args']
702 : cchiw 2838 val (env2, t) = doLHS()
703 : cchiw 2844 val shift=j*i (*New row index shift *)
704 : cchiw 2838 fun f ([], _ ) = []
705 :     | f (e1::es,count)= [Dst.S_Copy(Dst.E_Var t, e1, count,shift)]@ f(es,count+shift)
706 :     val stmts=f (args',0)
707 : cchiw 2857 val _ =testp["\n returning statements \n"^Dst.toStringSs stmts,"\n end ******************************\n"]
708 : cchiw 2838 in
709 :     (env2, List.rev stmts)
710 :     end
711 :    
712 : cchiw 2646 | Src.EINAPP _=> raise Fail "EINAPP in Low-IL to Tree-IL"
713 : jhr 2356 (* end case *)
714 :     end
715 : jhr 1115
716 :     (* In order to reconstruct the block-structure from the CFG, we keep a stack of open ifs.
717 :     * the items on this stack distinguish between when we are processing the then and else
718 :     * branches of the if.
719 :     *)
720 :     datatype open_if
721 :     (* working on the "then" branch. The fields are statments that preceed the if, the condition,
722 :     * and the else-branch node.
723 :     *)
724 : cchiw 2646 = THEN_BR of Dst.stm list * Dst.exp * Src.node
725 : jhr 1115 (* working on the "else" branch. The fields are statments that preceed the if, the condition,
726 :     * the "then" branch statements, and the node that terminated the "then" branch (will be
727 :     * a JOIN, DIE, or STABILIZE).
728 :     *)
729 : cchiw 2646 | ELSE_BR of Dst.stm list * Dst.exp * Dst.stm list * Src.node_kind
730 : jhr 1115
731 : cchiw 2628
732 : cchiw 2844 fun mkBlockOrig(Dst.BlockWithOpr{ locals ,types,opr,body})= Dst.Block{locals=locals ,body=body}
733 : cchiw 2830
734 : cchiw 2844 fun peelBlockOrig(env,Dst.BlockWithOpr{ locals ,types,opr,body})=let
735 : cchiw 2688 val env= setEnv(env,types,opr)
736 :     in
737 : jhr 3169 (env,Dst.Block{locals=locals ,body=body})
738 : cchiw 2688 end
739 : cchiw 2637
740 : cchiw 2844 fun decCount ( Src.V{useCnt, ...}) = let
741 :     val n = !useCnt - 1
742 :     in
743 : jhr 3169 useCnt := n; (0 >= n)
744 : cchiw 2844 end
745 : cchiw 2688
746 : jhr 1115 fun trCFG (env, prefix, finish, cfg) = let
747 : cchiw 2646 fun join (env, [], _, Src.JOIN _) = raise Fail "JOIN with no open if"
748 : cchiw 2830 | join (env, [], stms, _) = let
749 : cchiw 2844 val env'=addOprFromStmt(env, stms)
750 : cchiw 2838 in endScope (env', prefix @ List.rev stms) end
751 : jhr 2356 | join (env, THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let
752 : cchiw 2830
753 : jhr 2356 val (env, thenBlk) = flushPending (env, thenBlk)
754 : cchiw 2844 val env'=addOprFromStmt(env, stms1)
755 : jhr 2356 in
756 : cchiw 2838 doNode (env', ELSE_BR(stms1, cond, thenBlk, k)::stk, [], elseBr)
757 : jhr 2356 end
758 :     | join (env, ELSE_BR(stms, cond, thenBlk, k1)::stk, elseBlk, k2) = let
759 : cchiw 2830
760 : jhr 2356 val (env, elseBlk) = flushPending (env, elseBlk)
761 :     in
762 :     case (k1, k2)
763 : cchiw 2646 of ( Src.JOIN{phis, succ, ...}, Src.JOIN _) => let
764 : jhr 2356 val (env, [thenBlk, elseBlk]) =
765 :     List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)
766 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
767 : cchiw 2830
768 : cchiw 2844 val env'=addOprFromStmt(env, stm::stms)
769 : jhr 2356 in
770 : cchiw 2830 doNode (env', stk, stm::stms, !succ)
771 : jhr 2356 end
772 : cchiw 2646 | ( Src.JOIN{phis, succ, ...}, _) => let
773 : jhr 2356 val (env, [thenBlk]) = List.foldl doPhi (env, [thenBlk]) (!phis)
774 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
775 : cchiw 2830 in
776 : cchiw 2844 doNode (addOprFromStmt(env, [stm]), stk, stm::stms, !succ)
777 : jhr 2356 end
778 : cchiw 2646 | (_, Src.JOIN{phis, succ, ...}) => let
779 : jhr 2356 val (env, [elseBlk]) = List.foldl doPhi (env, [elseBlk]) (!phis)
780 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
781 : cchiw 2830
782 :    
783 : jhr 2356 in
784 : cchiw 2844 doNode (addOprFromStmt(env, [stm]), stk, stm::stms, !succ)
785 : jhr 2356 end
786 :     | (_, _) => raise Fail "no path to exit unimplemented" (* FIXME *)
787 :     (* end case *)
788 :     end
789 : jhr 3169 and doNode (env, ifStk : open_if list, stms, nd) = (
790 : cchiw 2845 (* testp ["******************* \n doNode\n ",LowToS.printNode (Nd.kind nd),"\n"]*)
791 : jhr 3169 case Nd.kind nd
792 : cchiw 2646 of Src.NULL => raise Fail "unexpected NULL"
793 :     | Src.ENTRY{succ} => doNode (env, ifStk, stms, !succ)
794 : cchiw 2830 | k as Src.JOIN{phis, succ, ...} => (join (env, ifStk, stms, k))
795 : cchiw 2646 | Src.COND{cond, trueBranch, falseBranch, ...} => let
796 : jhr 2356 val cond = useVar env cond
797 :     val (env, stms) = flushPending (env, stms)
798 :     in
799 :     doNode (env, THEN_BR(stms, cond, !falseBranch)::ifStk, [], !trueBranch)
800 :     end
801 : cchiw 2646 | Src.COM {text, succ, ...} =>
802 :     doNode (env, ifStk, Dst.S_Comment text :: stms, !succ)
803 :     | Src.ASSIGN{stm, succ, ...} => let
804 : cchiw 2838
805 : jhr 2356 val (env, stms') = doAssign (env, stm)
806 : cchiw 2838
807 : jhr 2356 in
808 : cchiw 2844 doNode (addOprFromStmt(env, stms') , ifStk, stms' @ stms, !succ)
809 : jhr 2356 end
810 : cchiw 2646 | Src.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
811 : cchiw 2688
812 : jhr 1640 fun doit () = let
813 :     fun doLHSVar (y, (env, ys)) = (case peekGlobal(env, y)
814 : cchiw 2688 of SOME y' => ((env, y'::ys))
815 : cchiw 2687 | NONE => let
816 : jhr 1640 val t = newLocal y
817 : cchiw 2688
818 : jhr 1640 in
819 :     (rename (addLocal(env, t), y, t), t::ys)
820 :     end
821 :     (* end case *))
822 :     val (env, ys) = List.foldr doLHSVar (env, []) ys
823 : cchiw 2637 val Trator = LowOpToTreeOp.expandOp rator
824 : cchiw 2646 val exp = Dst.E_Op(Trator, List.map (useVar env) xs)
825 :     val stm = Dst.S_Assign(ys, exp)
826 : jhr 1640 in
827 :     doNode (env, ifStk, stm :: stms, !succ)
828 :     end
829 :     in
830 :     case rator
831 : cchiw 2646 of SrcOp.Print _ => if Target.supportsPrinting()
832 : jhr 1640 then doit ()
833 :     else doNode (env, ifStk, stms, !succ)
834 :     | _ => doit()
835 :     (* end case *)
836 :     end
837 : cchiw 2646 | Src.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
838 : cchiw 2844 | Src.SAVE{lhs, rhs, succ, ...} => let
839 :     (* There is a Save and lhs is an array,
840 :     * Stmt depends on how rhs exp is stored
841 :     * If rhs is stored as a vector then use S_StoreVec(Mux, or Local Vector)
842 :     * If rhs is an array uses S_copy (higher order tensors)
843 :     * otherwise regular save
844 :     *)
845 :     val x=getStateVar lhs
846 :     val rhs2=useVar env rhs
847 :     val _ =testp["\n *********** \n FOUND SAVE \n\t StateVar: ",Dst.stateVarToString x,
848 :     ": Rest rhs: ",Dst.toString rhs2,"--end "]
849 :     fun size n=foldl (fn (a,b) => b*a) 1 n
850 :     val stm=(case rhs2
851 :     of Dst.E_Mux(A,isFill, oSize,splitTy,args) =>
852 :     (decCount rhs ;Dst.S_StoreVec( Dst.E_State x,0, A,isFill, oSize,Ty.TensorTy [oSize],splitTy,args))
853 :     | Dst.E_Var rhs3 => (case (DstV.kind rhs3,DstV.rTy rhs3)
854 :     of ( _ ,Ty.TensorTy []) => Dst.S_Save([x], rhs2)
855 :     | (Dst.VK_Local,Ty.TensorTy [oSize]) =>let
856 : jhr 3169 val (isFill,nSize,pieces)=Target.getVecTy oSize
857 :     in Dst.S_StoreVec( Dst.E_State x,0, false,isFill, oSize,Ty.TensorTy [oSize],Ty.vectorLength pieces,[rhs2])
858 : cchiw 2692 end
859 : cchiw 2844 | (_,Ty.TensorTy xs) => Dst.S_Copy( Dst.E_State x, rhs2,0,size xs)
860 :     | _ => Dst.S_Save([x], rhs2)
861 :     (*end case*))
862 :     | Dst.E_State rhs3 => (case (DstSV.ty rhs3)
863 :     of Ty.TensorTy xs => Dst.S_Copy( Dst.E_State x, rhs2,0,size xs)
864 : cchiw 2838 | _ => Dst.S_Save([x], rhs2)
865 :     (*end case*))
866 : cchiw 2844 | _ => Dst.S_Save([x], rhs2)
867 : cchiw 2838 (*end case*))
868 : cchiw 2845 val _ = testp [" \nSrc.Save: ",LowToS.SAVEtoString(lhs,rhs),"\n New stmt --",
869 : cchiw 2844 Dst.toStringS stm,"\nend save **************\n"]
870 : cchiw 2691 val stmts=stm::stms
871 : jhr 1640 in
872 : cchiw 2844 doNode (addOprFromStmt(env, stmts), ifStk, stmts, !succ)
873 : jhr 1640 end
874 : cchiw 2646 | k as Src.EXIT{kind, live, ...} => (case kind
875 : jhr 2356 of ExitKind.FRAGMENT =>
876 :     endScope (env, prefix @ List.revAppend(stms, finish env))
877 :     | ExitKind.SINIT => let
878 : jhr 1232 (* FIXME: we should probably call flushPending here! *)
879 : cchiw 2646 val suffix = finish env @ [Dst.S_Exit[]]
880 : jhr 2356 in
881 :     endScope (env, prefix @ List.revAppend(stms, suffix))
882 :     end
883 :     | ExitKind.RETURN => let
884 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
885 : cchiw 2646 val suffix = finish env @ [Dst.S_Exit(List.map (useVar env) live)]
886 : jhr 2356 in
887 :     endScope (env, prefix @ List.revAppend(stms, suffix))
888 :     end
889 :     | ExitKind.ACTIVE => let
890 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
891 : cchiw 2646 val suffix = finish env @ [Dst.S_Active]
892 : jhr 2356 in
893 :     endScope (env, prefix @ List.revAppend(stms, suffix))
894 :     end
895 :     | ExitKind.STABILIZE => let
896 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
897 : cchiw 2646 val stms = Dst.S_Stabilize :: stms
898 : jhr 2356 in
899 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
900 : cchiw 2830 (join (env, ifStk, stms, k))
901 : jhr 2356 end
902 : cchiw 2830 | ExitKind.DIE => (join (env, ifStk, Dst.S_Die :: stms, k))
903 : jhr 2356 (* end case *))
904 :     (* end case *))
905 : jhr 2632
906 : cchiw 2844 in
907 :     doNode (env, [], [], CFG.entry cfg)
908 : jhr 2356 end
909 : jhr 1115
910 : cchiw 2646 fun trInitially (env, Src.Initially{isArray, rangeInit, iters, create=(createInit, strand, args)}) =
911 : jhr 2356 let
912 : cchiw 2838 val (env2,iterPrefix) = peelBlockOrig(env,trCFG (env, [], fn _ => [], rangeInit))
913 :     (*val (iterPrefix) = mkBlockOrig(trCFG (env, [], fn _ => [], rangeInit))*)
914 :    
915 : jhr 2356 fun cvtIter ((param, lo, hi), (env, iters)) = let
916 :     val param' = newIter param
917 :     val env = rename (env, param, param')
918 :     in
919 :     (env, (param', useVar env lo, useVar env hi)::iters)
920 :     end
921 :     val (env, iters) = List.foldr cvtIter (env, []) iters
922 : cchiw 2637 val (env,createPrefix) = peelBlockOrig(env,trCFG (env, [], fn _ => [], createInit))
923 :     in (env,{
924 : jhr 2356 isArray = isArray,
925 :     iterPrefix = iterPrefix,
926 :     iters = iters,
927 :     createPrefix = createPrefix,
928 :     strand = strand,
929 :     args = List.map (useVar env) args
930 : cchiw 2637 }) end
931 : jhr 1115
932 : jhr 3060 fun trMethod (env, Src.Method{name, body}) = let
933 :     val (env, blk) = peelBlockOrig(env, trCFG (env, [], fn _ => [], body))
934 :     (*val (blk)=mkBlockOrig(trCFG (env, [], fn _ => [], body))*)
935 :     in
936 :     (env, Dst.Method{name = name, body = blk})
937 :     end
938 : cchiw 2830
939 : jhr 3060 fun trStrands (env, strands) = let
940 :     fun tr (Src.Strand{name, params, state, stateInit, methods}, (env, strands')) = let
941 :     val params' = List.map newParam params
942 :     val env = ListPair.foldlEq (fn (x, x', env) => rename(env, x, x')) env (params, params')
943 :     val (env', sInit) = peelBlockOrig(env,trCFG (env, [], fn _ => [], stateInit))
944 :     fun callmethod (env, [], M) = (env,M)
945 :     | callmethod (env, b::es, Ms) = let
946 :     val (env2,M1) = trMethod(env,b)
947 :     in callmethod(env2, es, [M1]@Ms) end
948 :     val (env', methods) = callmethod(env',methods,[])
949 :     val strand' = Dst.Strand{
950 :     name = name,
951 :     params = params',
952 :     state = List.map getStateVar state,
953 :     stateInit =sInit,
954 :     methods = methods
955 :     }
956 :     in
957 :     (env', strand'::strands')
958 :     end
959 :     val (env', strands') = List.foldl tr (env, []) strands
960 :     in
961 :     (env', List.rev strands')
962 :     end
963 : jhr 1115
964 : jhr 1301 (* split the globalInit into the part that specifies the inputs and the rest of
965 :     * the global initialization.
966 :     *)
967 :     fun splitGlobalInit globalInit = let
968 : cchiw 2525 (* FIXME: can split as soon as we see a non-Input statement! *)
969 : jhr 2356 fun walk (nd, lastInput, live) = (case Nd.kind nd
970 : cchiw 2646 of Src.ENTRY{succ} => walk (!succ, lastInput, live)
971 :     | Src.COM{succ, ...} => walk (!succ, lastInput, live)
972 :     | Src.ASSIGN{stm=(lhs, rhs), succ, ...} => (case rhs
973 :     of Src.OP(SrcOp.Input _, _) => walk (!succ, nd, lhs::live)
974 : jhr 2356 | _ => walk (!succ, lastInput, live)
975 :     (* end case *))
976 :     | _ => if Nd.isNULL lastInput
977 :     then let (* no inputs *)
978 :     val entry = Nd.mkENTRY()
979 :     val exit = Nd.mkEXIT(ExitKind.RETURN, [])
980 :     in
981 :     Nd.addEdge (entry, exit);
982 : cchiw 2646 {inputInit = Src.CFG{entry=entry, exit=exit}, globalInit = globalInit}
983 : jhr 2356 end
984 :     else let (* split at lastInput *)
985 :     val inputExit = Nd.mkEXIT(ExitKind.RETURN, live)
986 :     val globalEntry = Nd.mkENTRY()
987 :     val [gFirst] = Nd.succs lastInput
988 :     in
989 :     Nd.replaceInEdge {src = lastInput, oldDst = gFirst, dst = inputExit};
990 :     Nd.replaceOutEdge {oldSrc = lastInput, src = globalEntry, dst = gFirst};
991 :     {
992 : cchiw 2646 inputInit = Src.CFG{entry = Src.CFG.entry globalInit, exit = inputExit},
993 :     globalInit = Src.CFG{entry = globalEntry, exit = Src.CFG.exit globalInit}
994 : jhr 2356 }
995 :     end
996 :     (* end case *))
997 :     in
998 : cchiw 2646 walk ( Src.CFG.entry globalInit, Nd.dummy, [])
999 : jhr 2356 end
1000 : jhr 3060
1001 : cchiw 2637 fun getInfo(env,Init)=let
1002 :     val inputInit' = trCFG (env, [], fn _ => [], Init)
1003 :     in
1004 :     peelBlockOrig(env,inputInit')
1005 :     end
1006 :    
1007 : jhr 1115 fun translate prog = let
1008 : jhr 2356 (* first we do a variable analysis pass on the Low IL *)
1009 : cchiw 2646 val prog as Src.Program{props, globalInit, initially, strands} = VA.optimize prog
1010 : jhr 1115 (* FIXME: here we should do a contraction pass to eliminate unused variables that VA may have created *)
1011 : jhr 2356 val _ = (* DEBUG *)
1012 :     LowPP.output (Log.logFile(), "LowIL after variable analysis", prog)
1013 : cchiw 2637 val envOrig = newEnv()
1014 : jhr 2632 val globals = List.map
1015 : cchiw 2637 (fn x => let val x' = newGlobal x in global(envOrig, x, x'); x' end)
1016 : cchiw 2646 ( Src.CFG.liveAtExit globalInit)
1017 : jhr 2356 val {inputInit, globalInit} = splitGlobalInit globalInit
1018 : jhr 3169 val (env, inputInit) = getInfo(envOrig,inputInit)
1019 :     val (env, globalInit) = getInfo(env, globalInit)
1020 : jhr 3060 val (env, strands) = trStrands (env, strands)
1021 :     val (env, initially) = trInitially (env, initially)
1022 : jhr 3169 val (typs, opr) = peelEnv(env)
1023 :     val typsList = TySet.listItems(typs);
1024 :     val oprList = OprSet.listItems(opr);
1025 :     val _ = testp[(Fnc.setListToString(typsList,oprList,"--FinalPostStrands--"))]
1026 :     in
1027 :     Dst.Program{
1028 :     props = props,
1029 :     types=typsList,
1030 :     operations = oprList,
1031 :     globals = globals,
1032 :     inputInit = inputInit,
1033 :     globalInit = globalInit,
1034 :     strands = strands,
1035 :     initially = initially
1036 :     }
1037 : jhr 2356 end
1038 : jhr 1115
1039 :     end

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