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 2693 - (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 : cchiw 2691 structure SrcV = LowIL.Var
34 :     structure SrcSV = LowIL.StateVar
35 : cchiw 2646 structure VA = VarAnalysis
36 :     structure Ty = LowILTypes
37 : jhr 1115 structure Nd = LowIL.Node
38 :     structure CFG = LowIL.CFG
39 : cchiw 2691 structure LowOpToTreeOp = LowOpToTreeOp
40 :     structure Dst = TreeIL
41 :     structure DstOp = TreeOps
42 : cchiw 2692 structure DstV = Dst.Var
43 : cchiw 2691 structure TreeToOpr=TreeToOpr
44 :     structure Fnc=TreeFunc
45 :     structure TySet= Fnc.TySet
46 :     structure OprSet= Fnc.OprSet
47 : cchiw 2688
48 : jhr 1115 (* create new tree IL variables *)
49 :     local
50 : cchiw 2646 val newVar = Dst.Var.new
51 : jhr 1115 val cnt = ref 0
52 :     fun genName prefix = let
53 : jhr 2356 val n = !cnt
54 :     in
55 :     cnt := n+1;
56 :     String.concat[prefix, "_", Int.toString n]
57 :     end
58 : jhr 1115 in
59 : cchiw 2664 val testing=1
60 : cchiw 2628 fun pntTest str=(case testing
61 :     of 1=> (print(str);1)
62 :     | _ =>1
63 :     (*end case*))
64 : jhr 2632
65 : cchiw 2691 fun newGlobal x = newVar (genName("G_" ^ SrcV.name x), Dst.VK_Global, SrcV.ty x)
66 :     fun newParam x = newVar (genName("p_" ^ SrcV.name x), Dst.VK_Local, SrcV.ty x)
67 :     fun newLocal x = newVar (genName("l_" ^ SrcV.name x), Dst.VK_Local, SrcV.ty x)
68 :     fun newIter x = newVar (genName("i_" ^ SrcV.name x), Dst.VK_Local, SrcV.ty x)
69 :     fun newTmp (x,n) = newVar (genName("l_" ^ SrcV.name x^Int.toString n), Dst.VK_Local, SrcV.ty x)
70 : cchiw 2686
71 : jhr 1115 end
72 :    
73 : jhr 1640 (* associate Tree IL state variables with Low IL variables using properties *)
74 :     local
75 : cchiw 2646 fun mkStateVar x = Dst.SV{
76 : cchiw 2691 name = SrcSV.name x,
77 : jhr 1640 id = Stamp.new(),
78 : cchiw 2691 ty = SrcSV.ty x,
79 : jhr 1640 varying = VA.isVarying x,
80 : cchiw 2691 output = SrcSV.isOutput x
81 : jhr 1640 }
82 :     in
83 : cchiw 2691 val {getFn = getStateVar, ...} = SrcSV.newProp mkStateVar
84 : jhr 1640 end
85 :    
86 : cchiw 2646 fun mkBlock stms = Dst.Block{locals=[], body=stms}
87 :     fun mkIf (x, stms, []) = Dst.S_IfThen(x, mkBlock stms)
88 :     | mkIf (x, stms1, stms2) = Dst.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)
89 : jhr 1115
90 :     (* an environment that tracks bindings of variables to target expressions and the list
91 :     * of locals that have been defined.
92 :     *)
93 :     local
94 : cchiw 2691 structure VT = SrcV.Tbl
95 : cchiw 2646 fun decCount ( Src.V{useCnt, ...}) = let
96 : jhr 2356 val n = !useCnt - 1
97 :     in
98 :     useCnt := n; (n <= 0)
99 :     end
100 : jhr 1115 datatype target_binding
101 : cchiw 2646 = GLOB of Dst.var (* variable is global *)
102 :     | TREE of Dst.exp (* variable bound to target expression tree *)
103 :     | DEF of Dst.exp (* either a target variable or constant for a defined variable *)
104 : cchiw 2637
105 :    
106 :     fun insert (key, value) d =fn s =>
107 :     if s = key then SOME value
108 :     else d s
109 :    
110 :     fun lookup k d = d k
111 :    
112 :    
113 :     structure ListSetOfInts = ListSetFn (struct
114 :     type ord_key = int
115 :     val compare = Int.compare
116 :     end)
117 :    
118 :    
119 : jhr 1115 datatype env = E of {
120 : jhr 2356 tbl : target_binding VT.hash_table,
121 : cchiw 2637 types: TySet.set,
122 :     functs : OprSet.set,
123 : cchiw 2646 locals : Dst.var list
124 : jhr 2356 }
125 : cchiw 2637
126 :    
127 : jhr 1115 in
128 :     (* DEBUG *)
129 : cchiw 2637
130 :    
131 :     fun peelEnv(E{tbl, types, functs ,locals})=(types,functs)
132 : cchiw 2691 fun peelEnvLoc(E{tbl, types, functs ,locals})=locals
133 :     fun setEnv(E{tbl, types,functs,locals},types1,functs1)= E{tbl=tbl, types=types1, functs= functs1 ,locals=locals}
134 :    
135 : cchiw 2637
136 : jhr 1115 fun bindToString binding = (case binding
137 : cchiw 2646 of GLOB y => "GLOB " ^ Dst.Var.name y
138 : jhr 2356 | TREE e => "TREE"
139 : cchiw 2688 | DEF(Dst.E_Var y) => "DEFVar " ^ Dst.Var.name y
140 : cchiw 2692 | DEF e => "DEF"^Dst.toString e
141 : jhr 1115 (* end case *))
142 :     fun dumpEnv (E{tbl, ...}) = let
143 :     fun prEntry (x, binding) =
144 : cchiw 2646 print(concat[" ", Src.Var.toString x, " --> ", bindToString binding, "\n"])
145 : jhr 1115 in
146 : jhr 2356 print "*** dump environment\n";
147 :     VT.appi prEntry tbl;
148 :     print "***\n"
149 : jhr 1115 end
150 :     (* DEBUG *)
151 :    
152 : cchiw 2637 fun newEnv () = E{tbl = VT.mkTable (512, Fail "tbl"), types=TySet.empty, functs=OprSet.empty, locals=[]}
153 : jhr 1115
154 :     (* use a variable. If it is a pending expression, we remove it from the table *)
155 : cchiw 2692 fun peek (env as E{tbl, ...}) x = (case (VT.find tbl x)
156 :     of NONE=>"none"
157 :     | SOME e=> bindToString e
158 :     (*end case *))
159 :    
160 :     fun useVar (env as E{tbl, ...}) x = (case VT.find tbl x
161 : cchiw 2646 of SOME(GLOB x') => Dst.E_Var x'
162 : jhr 2356 | SOME(TREE e) => (
163 : cchiw 2691 (*print(concat["useVar ", SrcV.toString x, " ==> TREE\n"]);*)
164 : jhr 2356 ignore(VT.remove tbl x);
165 :     e)
166 :     | SOME(DEF e) => (
167 : cchiw 2691 (*print(concat["useVar ", SrcV.toString x, " ==> ", bindToString(DEF e), "; use count = ", Int.toString(SrcV.useCount x), "\n"]);*)
168 : jhr 2356 (* if this is the last use of x, then remove it from the table *)
169 :     if (decCount x) then ignore(VT.remove tbl x) else ();
170 :     e)
171 :     | NONE => (
172 : jhr 1115 dumpEnv env;
173 : cchiw 2691 raise Fail(concat ["useVar(", SrcV.toString x, ")"])
174 : jhr 1115 )
175 : jhr 2356 (* end case *))
176 : jhr 1115
177 :     (* record a local variable *)
178 : cchiw 2692
179 :     fun getLocal(E{tbl, types,functs,locals})=let
180 :     val n=List.length locals
181 :     val _ =print ("No. of locals:" ^Int.toString n )
182 :     in
183 :     List.map (fn e=>print("\n\t VAr-"^DstV.name e)) locals
184 :    
185 :     end
186 : cchiw 2637 fun addLocal (E{tbl, types,functs,locals}, x) = E{tbl=tbl,types=types, functs=functs,locals=x::locals}
187 : cchiw 2692 fun addLocals (E{tbl, types,functs,locals}, x) =let
188 :     val n=List.length locals
189 :     val n2=List.length x
190 :     val _ =print ("No. of locals:" ^Int.toString n^" newbies " ^Int.toString n2)
191 :     val env= E{tbl=tbl,types=types, functs=functs,locals=x@locals}
192 :     val _ = getLocal env
193 :     in
194 :     env
195 :     end
196 :    
197 : cchiw 2691 fun testp t=print(String.concat t)
198 :     fun global (E{tbl, ...}, x, x') =( testp[("\n using global function "^SrcV.name x^":\n")];
199 : cchiw 2688 VT.insert tbl (x, GLOB x'))
200 : jhr 1115
201 :     (* insert a pending expression into the table. Note that x should only be used once! *)
202 :     fun insert (env as E{tbl, ...}, x, exp) = (
203 : jhr 2356 VT.insert tbl (x, TREE exp);
204 :     env)
205 : jhr 1115
206 :     fun rename (env as E{tbl, ...}, x, x') = (
207 : cchiw 2646 VT.insert tbl (x, DEF(Dst.E_Var x'));
208 : jhr 2356 env)
209 : cchiw 2687
210 : cchiw 2692 fun renameGlob (env as E{tbl, ...}, x, x') = (
211 :     VT.insert tbl (x, GLOB( x'));
212 : cchiw 2687 env)
213 : cchiw 2692
214 :     fun renameExp (env as E{tbl, ...}, x, x') = (
215 :     VT.insert tbl (x, DEF( x'));
216 :     env)
217 : cchiw 2688
218 : cchiw 2692
219 : cchiw 2688 fun peekGlobal (E{tbl, ...}, x) = (case VT.find tbl x
220 : cchiw 2691 of SOME(GLOB x') => SOME x'
221 :     | SOME e => NONE
222 :     | NONE => NONE
223 :     (* end case *))
224 : cchiw 2688
225 : cchiw 2692
226 :     (*creates load expressions if needed*)
227 :     fun bindCons (env, lhs,t, ty as Ty.TensorTy [oSize],args) =let
228 : cchiw 2693
229 : cchiw 2692 val name=SrcV.name lhs
230 :     in (case (SrcV.useCount lhs)
231 :     of _ =>let
232 :     val _=print(String.concat(["\n Global cons \n\t \t lHS-",name, "\n\t t -",DstV.name t,"\n"]))
233 :     in (env,[Dst.S_Cons(t,ty,args)]) end
234 :     (* | _ => let
235 :    
236 :    
237 :     val _=print "\n\t new envs-plain \n "
238 :     val _= dumpEnv env
239 :     val (isFill,nSize,Pieces)=Target.getVecTy oSize
240 : cchiw 2688
241 : cchiw 2692 val (xs,rhs,stmts)=LowOpToTreeOp.consArrToTree(lhs,nSize,oSize,Pieces,args,isFill)
242 :    
243 : cchiw 2693 val lhs2=(case peekGlobal (env, lhs)
244 :     of SOME x =>print ("\n\t lHS2-"^DstV.name x)
245 :     | _=> print("\n\t lHS2-nope")
246 :     (*end case*))
247 : cchiw 2692
248 :     val _ =print(String.concat(["\n\t vars: "]@ List.map (fn e=>Dst.toString(Dst.E_Var e ) )xs))
249 :    
250 :     val st=String.concatWith ",\n\t " (List.map Dst.toStringS stmts)
251 :     val _=print(String.concat(["\n Global cons \n\t ",st,"\n\t lHS-",SrcV.name lhs, "\n\t t -",DstV.name t,"\n \t RHS-" ,Dst.toString rhs,"\n "]))
252 :    
253 :     val env=renameExp(addLocals(env,xs),lhs,rhs)
254 : cchiw 2693
255 : cchiw 2692 in
256 :     (env,stmts)
257 :     end
258 :     *)
259 :     (*end case*))
260 :     end
261 :    
262 :    
263 : cchiw 2687 fun bindLocal (env, lhs, rhs) =let
264 : cchiw 2691 val n=SrcV.useCount lhs
265 : cchiw 2687 fun AL _=let
266 : jhr 2356 val t = newLocal lhs
267 : cchiw 2691 in
268 :     (rename(addLocal(env, t), lhs, t), [Dst.S_Assign([t], rhs)])
269 :     end
270 : cchiw 2693 val _=print(String.concat["\n In BindLocal: \n \t LHS: ",SrcV.name lhs, " Count \t",Int.toString n ])
271 : cchiw 2687
272 : cchiw 2688 in (case (n,rhs)
273 : cchiw 2693 of (0,_) => (print "count is just zero";AL 1)
274 :     | (1,_) => (print "count is just 1";(insert(env, lhs, rhs), []))
275 : cchiw 2688 | (_,Dst.E_Mux(A, nSize,nOrig,Tys as Ty.vectorLength tys,exps))=> let
276 : cchiw 2693 val _=print "\n\t found a mux "
277 :    
278 : cchiw 2691 val name=SrcV.name lhs
279 : cchiw 2687 val xs=List.map (fn n=> Dst.Var.new(name^Int.toString(n), Dst.VK_Local,Ty.TensorTy [n]) ) tys
280 : cchiw 2688 val rhs=Dst.E_Mux(A, nSize,nOrig,Tys,List.map (fn v=>Dst.E_Var v) xs)
281 : cchiw 2687 val stmts=ListPair.map (fn(x,e)=>Dst.S_Assign([x],e)) (xs,exps)
282 : cchiw 2692 in
283 : cchiw 2693 (renameExp(addLocals(env,xs),lhs,rhs),stmts)
284 : cchiw 2687 end
285 : cchiw 2693 |(_,_)=> (print "non-mux";AL 1)
286 : cchiw 2688 (*end case*))
287 : cchiw 2687 end
288 :    
289 : cchiw 2691
290 :     fun bind (env, lhs, rhs) =(case peekGlobal (env, lhs)
291 :     of SOME x =>(env, [Dst.S_Assign([x], rhs)])
292 :     | NONE => bindLocal (env, lhs, rhs)
293 :     (* end case *))
294 : jhr 1115
295 :     (* set the definition of a variable, where the RHS is either a literal constant or a variable *)
296 : cchiw 2691 fun bindSimple (env as E{tbl, ...}, lhs, rhs) =(case peekGlobal (env, lhs)
297 :     of SOME x => (env, [Dst.S_Assign([x], rhs)])
298 :     | NONE => (VT.insert tbl (lhs, DEF rhs); (env, []))
299 :     (* end case *))
300 : cchiw 2688
301 : jhr 1115
302 :     (* at the end of a block, we need to assign any pending expressions to locals. The
303 :     * blkStms list and the resulting statement list are in reverse order.
304 :     *)
305 : cchiw 2637 fun flushPending (E{tbl,types, functs,locals}, blkStms) = let
306 : jhr 2356 fun doVar (x, TREE e, (locals, stms)) = let
307 :     val t = newLocal x
308 :     in
309 : cchiw 2646 VT.insert tbl (x, DEF(Dst.E_Var t));
310 :     (t::locals, Dst.S_Assign([t], e)::stms)
311 : jhr 2356 end
312 :     | doVar (_, _, acc) = acc
313 :     val (locals, stms) = VT.foldi doVar (locals, blkStms) tbl
314 :     in
315 : cchiw 2637 (E{tbl=tbl, types=types,functs=functs,locals=locals}, stms)
316 : jhr 2356 end
317 : jhr 1115
318 : cchiw 2646 fun doPhi ((lhs, rhs), (env, predBlks : Dst.stm list list)) = let
319 : jhr 2356 (* t will be the variable in the continuation of the JOIN *)
320 :     val t = newLocal lhs
321 :     val predBlks = ListPair.map
322 : cchiw 2646 (fn (x, stms) => Dst.S_Assign([t], useVar env x)::stms)
323 : jhr 2356 (rhs, predBlks)
324 :     in
325 :     (rename (addLocal(env, t), lhs, t), predBlks)
326 :     end
327 : cchiw 2637 (*
328 : cchiw 2646 fun endScope (E{locals, ...}, stms) = Dst.Block{
329 : jhr 2356 locals = List.rev locals,
330 :     body = stms
331 :     }
332 : cchiw 2637 *)
333 :     fun endScope (env, stms) = let
334 :     val (types,opr)=peelEnv(env)
335 :    
336 : cchiw 2646 in Dst.Pink{
337 : cchiw 2637
338 :     locals= List.rev(peelEnvLoc env),
339 :     types= types,
340 :     opr=opr,
341 :     body = stms
342 :     }
343 :     end
344 : jhr 1115 end
345 :    
346 :     (* Certain IL operators cannot be compiled to inline expressions. Return
347 :     * false for those and true for all others.
348 :     *)
349 : cchiw 2680
350 :     (*Move operator so it's it's on variable: y=sumOP+9
351 :     x=sumOp..y=x+9, =>
352 :    
353 :     *)
354 : jhr 1115 fun isInlineOp rator = let
355 : jhr 2356 fun chkTensorTy (Ty.TensorTy[]) = true
356 :     | chkTensorTy (Ty.TensorTy[_]) = true
357 :     | chkTensorTy (Ty.TensorTy[_, _]) = Target.inlineMatrixExp
358 :     | chkTensorTy _ = false
359 : cchiw 2688
360 : jhr 2356 in
361 :     case rator
362 : cchiw 2646 of SrcOp.LoadVoxels(_, 1) => true
363 :     | SrcOp.LoadVoxels _ => false
364 :     | SrcOp.EigenVecs2x2 => false
365 :     | SrcOp.EigenVecs3x3 => false
366 :     | SrcOp.EigenVals2x2 => false
367 :     | SrcOp.EigenVals3x3 => false
368 : cchiw 2691 (* | SrcOp.Zero _ => Target.inlineMatrixExp*)
369 : cchiw 2680
370 :     (*Added here *)
371 :     | SrcOp.imgAddr _ => false
372 :     | SrcOp.imgLoad _ => false
373 :     | _ => true (*when true calls binding *)
374 : jhr 2356 (* end case *)
375 :     end
376 : jhr 1115
377 : cchiw 2669 (*HERE- since we are using arrays, nothing can be inline
378 :     Fix later if it needs to be fixed*)
379 : cchiw 2525 (* is a CONS inline? *)
380 : cchiw 2669 fun isInlineCons ty = (*(case ty
381 : cchiw 2525 of Ty.SeqTy(Ty.IntTy, _) => true
382 :     | Ty.TensorTy dd => Target.inlineCons(List.length dd)
383 :     | Ty.SeqTy _ => false
384 :     (*CCCC-? DO we have this type*)
385 : cchiw 2615 (* | Ty.DynSeqTy ty => false*)
386 : cchiw 2525 | _ => raise Fail(concat["invalid CONS<", Ty.toString ty, ">"])
387 : cchiw 2669 (* end case *))*) false
388 : cchiw 2525
389 :     (* translate a LowIL assignment to a list of zero or more target statements in reverse
390 :     * order.
391 :     *)
392 : cchiw 2688
393 :    
394 :    
395 : jhr 1115 fun doAssign (env, (lhs, rhs)) = let
396 : cchiw 2688
397 : jhr 2356 fun doLHS () = (case peekGlobal(env, lhs)
398 : cchiw 2688 of SOME lhs' => (env, lhs')
399 :     | NONE => let
400 :     val t = newLocal lhs
401 :     in
402 :     (rename (addLocal(env, t), lhs, t), t)
403 :     end
404 :     (* end case *))
405 :    
406 : jhr 2356 (* for expressions that are going to be compiled to a call statement *)
407 :     fun assignExp (env, exp) = let
408 :     (* operations that return matrices may not be supported inline *)
409 :     val (env, t) = doLHS()
410 :     in
411 : cchiw 2646 (env, [Dst.S_Assign([t], exp)])
412 : jhr 2356 end
413 : cchiw 2680
414 : jhr 2632
415 : cchiw 2525 (* force an argument to be stored in something that will be mapped to an l-value *)
416 :     fun bindVar (env, x) = (case useVar env x
417 : cchiw 2688 of x' as Dst.E_State _ =>(env, x', [])
418 :     | x' as Dst.E_Var _ => (env, x', [])
419 :     | e => let
420 : cchiw 2525 val x' = newLocal x
421 :     in
422 : cchiw 2646 (addLocal(env, x'), Dst.E_Var x', [Dst.S_Assign([x'], e)])
423 : cchiw 2525 end
424 :     (* end case *))
425 : cchiw 2692
426 :     val _=toS.ASSIGNtoString(lhs,rhs)
427 : cchiw 2688
428 : jhr 2356 in
429 :     case rhs
430 : cchiw 2688 of Src.STATE x => bindSimple (env, lhs, Dst.E_State(getStateVar x))
431 :     | Src.VAR x => bindSimple (env, lhs, useVar env x)
432 :     | Src.LIT lit => bindSimple (env, lhs, Dst.E_Lit lit)
433 : jhr 2632
434 : cchiw 2646 (*| Src.OP( SrcOp.Prepend ty, [item, seq]) => let
435 : jhr 2356 val (env, t) = doLHS()
436 : cchiw 2525 val (env, item', stms) = bindVar (env, item)
437 : cchiw 2646 val exp = Dst.E_Op( DstOp.Prepend ty, [item', useVar env seq])
438 : jhr 2356 in
439 : cchiw 2646 (env, Dst.S_Assign([t], exp) :: stms)
440 : jhr 2356 end
441 : cchiw 2646 | Src.OP( SrcOpp.Append ty, [seq, item]) => let
442 : jhr 2356 val (env, t) = doLHS()
443 : cchiw 2525 val (env, item', stms) = bindVar (env, item)
444 : cchiw 2646 val exp = Dst.E_Op( DstOp.Append ty, [useVar env seq, item'])
445 : jhr 2356 in
446 : cchiw 2646 (env, Dst.S_Assign([t], exp) :: stms)
447 : cchiw 2615 end*)
448 : jhr 2632 (*
449 : cchiw 2646 | Src.OP( SrcOp.LoadImage(ty, nrrd, info), []) => let
450 : cchiw 2525 val (env, t) = doLHS()
451 :     in
452 : cchiw 2646 (env, [Dst.S_LoadNrrd(t, ty, nrrd)])
453 : cchiw 2615 end*)
454 : cchiw 2670
455 :    
456 : cchiw 2646 | Src.OP(rator,args) =>let
457 : cchiw 2620 val args'=List.map (useVar env) args
458 : cchiw 2692
459 : cchiw 2691 fun foundVec(rator,oSize,argsS,argsV)= let
460 :     val (isFill,nSize,Pieces)=Target.getVecTy oSize
461 : cchiw 2680 val (env, t) = doLHS()
462 : cchiw 2691 val (expOpt,storeVecStatement) = LowOpToTreeOp.vecToTree(t,rator,nSize,oSize,Pieces,argsS,argsV,isFill)
463 : cchiw 2692 val n1=SrcV.useCount lhs
464 :    
465 : cchiw 2691 val (env,stmts)=(case (expOpt,storeVecStatement)
466 : cchiw 2692 of (SOME exp,_)=>let
467 :     val _ = testp ["\n **** Exp \n",Dst.toString exp,"\n******\n"]
468 :     in
469 :     bind (env, lhs, exp)
470 :     end
471 :     | (NONE,SOME stmt)=> let
472 :     val _ =testp(["\n **\nStmt- RESULT ", Dst.toStringS stmt,"\n******\n"])
473 :     in
474 :     (env,[stmt])
475 :     end
476 : cchiw 2680 (*end case*))
477 : cchiw 2691 in
478 : cchiw 2692 (env,stmts)
479 : cchiw 2680 end
480 :     in (case (rator,args')
481 :     of (SrcOp.addVec n,_) => foundVec(DstOp.addVec,n,[],args')
482 :     | (SrcOp.subVec n,_) => foundVec(DstOp.subVec,n,[],args')
483 :     | (SrcOp.prodScaV n,e1::es) => foundVec(DstOp.prodScaV ,n, [e1], es)
484 : cchiw 2691 | (SrcOp.prodVec n,_) => foundVec(DstOp.prodVec,n,[],args')
485 :     | (SrcOp.dotVec n ,_) => foundVec(DstOp.dotVec ,n,[],args')
486 :     | (SrcOp.sumVec n ,_) => foundVec(DstOp.sumVec ,n,[],args')
487 : cchiw 2680 | (SrcOp.Floor n ,_) => foundVec(DstOp.Floor ,n,[],args')
488 :     | (SrcOp.Kernel _,_) => (env, [])
489 :     | (SrcOp.LoadImage info,[a]) => let
490 :     (*Moved to outside*)
491 :     val dim = ImageInfo.dim info
492 :     val (env, t) = doLHS()
493 :     in
494 :     (env,[Dst.S_LoadImage(t, dim, a)])
495 :     end
496 :     | _ => let
497 : cchiw 2637 val Trator = LowOpToTreeOp.expandOp rator
498 : cchiw 2671 val exp = Dst.E_Op(Trator, args')
499 : cchiw 2620 in
500 : cchiw 2688 if isInlineOp rator then (bind (env, lhs, exp))
501 :     else (assignExp (env, exp))
502 : cchiw 2620 end
503 :     (*end case*))
504 :     end
505 : cchiw 2670
506 : cchiw 2646 | Src.APPLY(f, args) =>
507 :     bind (env, lhs, Dst.E_Apply(f, List.map (useVar env) args))
508 : cchiw 2692
509 :     | Src.CONS(ty as Ty.TensorTy[oSize], args) => let
510 :     (*(env,[Dst.S_Cons(x,ty,args')])-Without using Mux *)
511 :    
512 :     val _=print "\n ****************** \n found cons \n"
513 : cchiw 2693 (* val _= dumpEnv env*)
514 : cchiw 2692 val args'=List.map (useVar env) args
515 :     (*don't know how to tell if lhs of var is a local var, so we have to use assignExp first *)
516 :    
517 :    
518 :     val (envv, t) = doLHS()
519 :    
520 :     val (isFill,nSize,Pieces)=Target.getVecTy oSize
521 :    
522 :    
523 :     val (envvv,rst) =(case DstV.kind t
524 :     of TreeIL.VK_Local=> let
525 :     val exp= LowOpToTreeOp.consVecToTree(nSize,oSize,Pieces,args',isFill)
526 :     val _ =print (String.concat ["\n\t Found local Vector Cons \n",Dst.toString exp,"\n******\n"])
527 :     in
528 :     bind (envv, lhs, exp)
529 :     end
530 : cchiw 2693 | _ => (*bindCons (envv, lhs,t, ty ,args')*) (env,[Dst.S_Cons(t,ty,args')])
531 : cchiw 2692 (*end case*))
532 :    
533 : cchiw 2693
534 : cchiw 2692 val _=print( "\n end cons \n ****************** \n")
535 :    
536 :    
537 :     in
538 :     (envvv,rst)
539 :     end
540 :    
541 :     | Src.CONS(ty, args) => let
542 :     val exp = Dst.E_Cons(ty, List.map (useVar env) args)
543 :     in
544 :     if isInlineCons ty
545 :     then bind (env, lhs, exp)
546 :     else assignExp (env, exp)
547 :     end
548 :    
549 : cchiw 2646 | Src.EINAPP _=> raise Fail "EINAPP in Low-IL to Tree-IL"
550 : jhr 2356 (* end case *)
551 :     end
552 : jhr 1115
553 :     (* In order to reconstruct the block-structure from the CFG, we keep a stack of open ifs.
554 :     * the items on this stack distinguish between when we are processing the then and else
555 :     * branches of the if.
556 :     *)
557 :     datatype open_if
558 :     (* working on the "then" branch. The fields are statments that preceed the if, the condition,
559 :     * and the else-branch node.
560 :     *)
561 : cchiw 2646 = THEN_BR of Dst.stm list * Dst.exp * Src.node
562 : jhr 1115 (* working on the "else" branch. The fields are statments that preceed the if, the condition,
563 :     * the "then" branch statements, and the node that terminated the "then" branch (will be
564 :     * a JOIN, DIE, or STABILIZE).
565 :     *)
566 : cchiw 2646 | ELSE_BR of Dst.stm list * Dst.exp * Dst.stm list * Src.node_kind
567 : jhr 1115
568 : cchiw 2628
569 : cchiw 2646 fun mkBlockOrig(Dst.Pink{ locals ,types,opr,body})=Dst.Block{locals=locals ,body=body}
570 :     fun peelBlockOrig(env,Dst.Pink{ locals ,types,opr,body})=let
571 : cchiw 2688 val env= setEnv(env,types,opr)
572 :     in
573 :     (env,Dst.Block{locals=locals ,body=body})
574 :     end
575 : cchiw 2637
576 : cchiw 2688
577 : cchiw 2691
578 : jhr 1115 fun trCFG (env, prefix, finish, cfg) = let
579 : cchiw 2637
580 :    
581 : cchiw 2691 (*look at stmts and collect oprSet and tySet*)
582 : cchiw 2688 fun getFNC(env,stms)=let
583 :     val t1=peelEnv(env)
584 : cchiw 2691 val (ty2,opr2)= List.foldr (fn(e1,e2) => TreeToOpr.stmtToOpr (e2,e1)) t1 stms
585 : cchiw 2688 in
586 :     setEnv(env, ty2,opr2)
587 :     end
588 :    
589 :    
590 : cchiw 2646 fun join (env, [], _, Src.JOIN _) = raise Fail "JOIN with no open if"
591 : jhr 2356 | join (env, [], stms, _) = endScope (env, prefix @ List.rev stms)
592 :     | join (env, THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let
593 :     val (env, thenBlk) = flushPending (env, thenBlk)
594 :     in
595 :     doNode (env, ELSE_BR(stms1, cond, thenBlk, k)::stk, [], elseBr)
596 :     end
597 :     | join (env, ELSE_BR(stms, cond, thenBlk, k1)::stk, elseBlk, k2) = let
598 :     val (env, elseBlk) = flushPending (env, elseBlk)
599 :     in
600 :     case (k1, k2)
601 : cchiw 2646 of ( Src.JOIN{phis, succ, ...}, Src.JOIN _) => let
602 : jhr 2356 val (env, [thenBlk, elseBlk]) =
603 :     List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)
604 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
605 :     in
606 :     doNode (env, stk, stm::stms, !succ)
607 :     end
608 : cchiw 2646 | ( Src.JOIN{phis, succ, ...}, _) => let
609 : jhr 2356 val (env, [thenBlk]) = List.foldl doPhi (env, [thenBlk]) (!phis)
610 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
611 :     in
612 :     doNode (env, stk, stm::stms, !succ)
613 :     end
614 : cchiw 2646 | (_, Src.JOIN{phis, succ, ...}) => let
615 : jhr 2356 val (env, [elseBlk]) = List.foldl doPhi (env, [elseBlk]) (!phis)
616 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
617 :     in
618 :     doNode (env, stk, stm::stms, !succ)
619 :     end
620 :     | (_, _) => raise Fail "no path to exit unimplemented" (* FIXME *)
621 :     (* end case *)
622 :     end
623 : cchiw 2688 and doNode (env, ifStk : open_if list, stms, nd) =
624 :     (* testp ["******************* \n doNode\n ",toS.printNode (Nd.kind nd),"\n"]*)
625 :     (case Nd.kind nd
626 : cchiw 2646 of Src.NULL => raise Fail "unexpected NULL"
627 :     | Src.ENTRY{succ} => doNode (env, ifStk, stms, !succ)
628 :     | k as Src.JOIN{phis, succ, ...} => join (env, ifStk, stms, k)
629 :     | Src.COND{cond, trueBranch, falseBranch, ...} => let
630 : jhr 2356 val cond = useVar env cond
631 :     val (env, stms) = flushPending (env, stms)
632 :     in
633 :     doNode (env, THEN_BR(stms, cond, !falseBranch)::ifStk, [], !trueBranch)
634 :     end
635 : cchiw 2646 | Src.COM {text, succ, ...} =>
636 :     doNode (env, ifStk, Dst.S_Comment text :: stms, !succ)
637 :     | Src.ASSIGN{stm, succ, ...} => let
638 : jhr 2356 val (env, stms') = doAssign (env, stm)
639 :     in
640 : cchiw 2692 doNode (getFNC(env, stms') , ifStk, stms' @ stms, !succ)
641 : jhr 2356 end
642 : cchiw 2646 | Src.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
643 : cchiw 2688
644 : jhr 1640 fun doit () = let
645 :     fun doLHSVar (y, (env, ys)) = (case peekGlobal(env, y)
646 : cchiw 2688 of SOME y' => ((env, y'::ys))
647 : cchiw 2687 | NONE => let
648 : jhr 1640 val t = newLocal y
649 : cchiw 2688
650 : jhr 1640 in
651 :     (rename (addLocal(env, t), y, t), t::ys)
652 :     end
653 :     (* end case *))
654 :     val (env, ys) = List.foldr doLHSVar (env, []) ys
655 : cchiw 2637 val Trator = LowOpToTreeOp.expandOp rator
656 : cchiw 2646 val exp = Dst.E_Op(Trator, List.map (useVar env) xs)
657 :     val stm = Dst.S_Assign(ys, exp)
658 : jhr 1640 in
659 :     doNode (env, ifStk, stm :: stms, !succ)
660 :     end
661 :     in
662 :     case rator
663 : cchiw 2646 of SrcOp.Print _ => if Target.supportsPrinting()
664 : jhr 1640 then doit ()
665 :     else doNode (env, ifStk, stms, !succ)
666 :     | _ => doit()
667 :     (* end case *)
668 :     end
669 : cchiw 2646 | Src.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
670 :     | Src.SAVE{lhs, rhs, succ, ...} => let
671 : cchiw 2688 (*How to get var form stateVar?*)
672 : cchiw 2692 val _=print ("\n *********** \n FOUND SAVE \n")
673 : cchiw 2680
674 : cchiw 2693 fun cat c = peek env c
675 : cchiw 2692 val n1=SrcV.useCount rhs
676 :     fun decCount ( Src.V{useCnt, ...}) = let
677 :     val n = !useCnt - 1
678 :     in
679 :     useCnt := n; (0 >= n)
680 :     end
681 : cchiw 2693 val _ =dumpEnv env
682 : cchiw 2688
683 : cchiw 2692 val stm=(case (getStateVar lhs,useVar env rhs)
684 :     of (x,Dst.E_Mux(A,nSize, oSize,pieces,args))
685 :     =>(decCount rhs ;Dst.S_StoreVec( Dst.E_State x,A,nSize, oSize,pieces,args))
686 :    
687 :     (*table need low-il*)
688 : cchiw 2693 | (x,Dst.E_Var rhs')=>(print (String.concat["\t rhs It's a var : ",Dst.toString (Dst.E_Var rhs'),"--","Peek",cat rhs]);
689 : cchiw 2692 Dst.S_Save([x], Dst.E_Var rhs'))
690 :    
691 : cchiw 2691 | (x,rhs')=>(print (String.concat["\t rhs: ",Dst.toString rhs',"--end "]);Dst.S_Save([x], rhs'))
692 :     (*end case*))
693 :    
694 : cchiw 2692 val n2=SrcV.useCount rhs
695 :     val _=testp ["Counts ",Int.toString(n1), " to " ,Int.toString(n2),"\n"]
696 : cchiw 2691
697 : cchiw 2692
698 : cchiw 2693 val _=testp (["Src.Save\n lhs, rhs \n \t",toS.SAVEtoString(lhs,rhs),"\n new statement\n New stmt \n \t --",Dst.toStringS stm,"\n rest of statements \n\t"]@List.map Dst.toStringS stms)
699 : cchiw 2691 val stmts=stm::stms
700 : jhr 1640 in
701 : cchiw 2688 doNode (getFNC(env, stmts), ifStk, stmts, !succ)
702 : jhr 1640 end
703 : cchiw 2646 | k as Src.EXIT{kind, live, ...} => (case kind
704 : jhr 2356 of ExitKind.FRAGMENT =>
705 :     endScope (env, prefix @ List.revAppend(stms, finish env))
706 :     | ExitKind.SINIT => let
707 : jhr 1232 (* FIXME: we should probably call flushPending here! *)
708 : cchiw 2646 val suffix = finish env @ [Dst.S_Exit[]]
709 : jhr 2356 in
710 :     endScope (env, prefix @ List.revAppend(stms, suffix))
711 :     end
712 :     | ExitKind.RETURN => let
713 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
714 : cchiw 2646 val suffix = finish env @ [Dst.S_Exit(List.map (useVar env) live)]
715 : jhr 2356 in
716 :     endScope (env, prefix @ List.revAppend(stms, suffix))
717 :     end
718 :     | ExitKind.ACTIVE => let
719 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
720 : cchiw 2646 val suffix = finish env @ [Dst.S_Active]
721 : jhr 2356 in
722 :     endScope (env, prefix @ List.revAppend(stms, suffix))
723 :     end
724 :     | ExitKind.STABILIZE => let
725 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
726 : cchiw 2646 val stms = Dst.S_Stabilize :: stms
727 : jhr 2356 in
728 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
729 : jhr 2356 join (env, ifStk, stms, k)
730 :     end
731 : cchiw 2646 | ExitKind.DIE => join (env, ifStk, Dst.S_Die :: stms, k)
732 : jhr 2356 (* end case *))
733 :     (* end case *))
734 : jhr 2632
735 : cchiw 2628 val Y=doNode (env, [], [], CFG.entry cfg)
736 : cchiw 2637
737 : jhr 2632 in Y
738 : jhr 2356 end
739 : jhr 1115
740 : cchiw 2646 fun trInitially (env, Src.Initially{isArray, rangeInit, iters, create=(createInit, strand, args)}) =
741 : jhr 2356 let
742 : cchiw 2637 val iterPrefix = mkBlockOrig(trCFG (env, [], fn _ => [], rangeInit))
743 : jhr 2356 fun cvtIter ((param, lo, hi), (env, iters)) = let
744 :     val param' = newIter param
745 :     val env = rename (env, param, param')
746 :     in
747 :     (env, (param', useVar env lo, useVar env hi)::iters)
748 :     end
749 :     val (env, iters) = List.foldr cvtIter (env, []) iters
750 : cchiw 2637 val (env,createPrefix) = peelBlockOrig(env,trCFG (env, [], fn _ => [], createInit))
751 :     in (env,{
752 : jhr 2356 isArray = isArray,
753 :     iterPrefix = iterPrefix,
754 :     iters = iters,
755 :     createPrefix = createPrefix,
756 :     strand = strand,
757 :     args = List.map (useVar env) args
758 : cchiw 2637 }) end
759 : jhr 1115
760 : cchiw 2646 fun trMethod env ( Src.Method{name, body}) = Dst.Method{
761 : jhr 1640 name = name,
762 : cchiw 2637 body = mkBlockOrig(trCFG (env, [], fn _ => [], body))
763 : jhr 1640 }
764 : cchiw 2637
765 :    
766 :     fun trStrand(globalEnv, [],rest)=(globalEnv,rest)
767 : cchiw 2646 | trStrand(globalEnv ,( Src.Strand{name, params, state, stateInit, methods})::es,rest) = let
768 : cchiw 2637 val params' = List.map newParam params
769 :     val env = ListPair.foldlEq (fn (x, x', env) => rename(env, x, x')) globalEnv (params, params')
770 :     val (env',sInit) = peelBlockOrig(env,trCFG (env, [], fn _ => [], stateInit))
771 :    
772 : cchiw 2646 val strand'=Dst.Strand{
773 : cchiw 2637 name = name,
774 :     params = params',
775 :     state = List.map getStateVar state,
776 :     stateInit =sInit,
777 :     methods = List.map (trMethod env) methods
778 :     }
779 :     in trStrand(env', es, rest@[strand'])
780 :     end
781 :    
782 :    
783 : jhr 1115
784 : jhr 1301 (* split the globalInit into the part that specifies the inputs and the rest of
785 :     * the global initialization.
786 :     *)
787 :     fun splitGlobalInit globalInit = let
788 : cchiw 2525 (* FIXME: can split as soon as we see a non-Input statement! *)
789 : cchiw 2687
790 : cchiw 2688
791 : jhr 2356 fun walk (nd, lastInput, live) = (case Nd.kind nd
792 : cchiw 2646 of Src.ENTRY{succ} => walk (!succ, lastInput, live)
793 :     | Src.COM{succ, ...} => walk (!succ, lastInput, live)
794 :     | Src.ASSIGN{stm=(lhs, rhs), succ, ...} => (case rhs
795 :     of Src.OP(SrcOp.Input _, _) => walk (!succ, nd, lhs::live)
796 : jhr 2356 | _ => walk (!succ, lastInput, live)
797 :     (* end case *))
798 :     | _ => if Nd.isNULL lastInput
799 :     then let (* no inputs *)
800 :     val entry = Nd.mkENTRY()
801 :     val exit = Nd.mkEXIT(ExitKind.RETURN, [])
802 :     in
803 :     Nd.addEdge (entry, exit);
804 : cchiw 2646 {inputInit = Src.CFG{entry=entry, exit=exit}, globalInit = globalInit}
805 : jhr 2356 end
806 :     else let (* split at lastInput *)
807 :     val inputExit = Nd.mkEXIT(ExitKind.RETURN, live)
808 :     val globalEntry = Nd.mkENTRY()
809 :     val [gFirst] = Nd.succs lastInput
810 :     in
811 :     Nd.replaceInEdge {src = lastInput, oldDst = gFirst, dst = inputExit};
812 :     Nd.replaceOutEdge {oldSrc = lastInput, src = globalEntry, dst = gFirst};
813 :     {
814 : cchiw 2646 inputInit = Src.CFG{entry = Src.CFG.entry globalInit, exit = inputExit},
815 :     globalInit = Src.CFG{entry = globalEntry, exit = Src.CFG.exit globalInit}
816 : jhr 2356 }
817 :     end
818 :     (* end case *))
819 : cchiw 2637
820 : jhr 2356 in
821 : cchiw 2646 walk ( Src.CFG.entry globalInit, Nd.dummy, [])
822 : jhr 2356 end
823 : cchiw 2637 fun getInfo(env,Init)=let
824 :     val inputInit' = trCFG (env, [], fn _ => [], Init)
825 :     in
826 :     peelBlockOrig(env,inputInit')
827 :     end
828 :    
829 : jhr 1115 fun translate prog = let
830 : jhr 2356 (* first we do a variable analysis pass on the Low IL *)
831 : cchiw 2646 val prog as Src.Program{props, globalInit, initially, strands} = VA.optimize prog
832 : jhr 1115 (* FIXME: here we should do a contraction pass to eliminate unused variables that VA may have created *)
833 : jhr 2356 val _ = (* DEBUG *)
834 :     LowPP.output (Log.logFile(), "LowIL after variable analysis", prog)
835 : cchiw 2637 val envOrig = newEnv()
836 : jhr 2632 val globals = List.map
837 : cchiw 2637 (fn x => let val x' = newGlobal x in global(envOrig, x, x'); x' end)
838 : cchiw 2646 ( Src.CFG.liveAtExit globalInit)
839 : jhr 2356 val {inputInit, globalInit} = splitGlobalInit globalInit
840 : cchiw 2637
841 :     val (env,inputInit)=getInfo(envOrig,inputInit)
842 :     val (env,globalInit)=getInfo(env, globalInit)
843 :     val (env,strands) = trStrand (env, strands,[])
844 :     val (env, initially) = trInitially (env, initially)
845 :    
846 :     val (typs,opr)= peelEnv(env)
847 :     val typsList=TySet.listItems(typs);
848 :     val oprList=OprSet.listItems(opr);
849 : cchiw 2692 val _=testp[(Fnc.setListToString(typsList,oprList,"--FinalPostStrands--"))]
850 : cchiw 2637
851 : cchiw 2646 in Dst.Program{
852 : jhr 2632 props = props,
853 : cchiw 2637 types=typsList,
854 :     oprations = oprList,
855 : jhr 2632 globals = globals,
856 :     inputInit = inputInit,
857 :     globalInit = globalInit,
858 :     strands = strands,
859 : cchiw 2637 initially = initially
860 : jhr 2632 }
861 : jhr 2356 end
862 : jhr 1115
863 :     end

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