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 3700 - (view) (download)

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

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