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 2692 - (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 :     val _=print "\n In bind cons ----\n"
229 :     val _= dumpEnv env
230 :     val _="\n ----\n"
231 :     val _= dumpEnv env
232 :     val name=SrcV.name lhs
233 :     in (case (SrcV.useCount lhs)
234 :     of _ =>let
235 :     val _=print(String.concat(["\n Global cons \n\t \t lHS-",name, "\n\t t -",DstV.name t,"\n"]))
236 :     in (env,[Dst.S_Cons(t,ty,args)]) end
237 :     (* | _ => let
238 :    
239 :    
240 :     val _=print "\n\t new envs-plain \n "
241 :     val _= dumpEnv env
242 :     val (isFill,nSize,Pieces)=Target.getVecTy oSize
243 : cchiw 2688
244 : cchiw 2692 val (xs,rhs,stmts)=LowOpToTreeOp.consArrToTree(lhs,nSize,oSize,Pieces,args,isFill)
245 :    
246 :    
247 :    
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 :    
255 :     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 2687
271 : cchiw 2688 in (case (n,rhs)
272 :     of (0,_) => AL 1
273 :     | (1,_) => (insert(env, lhs, rhs), [])
274 :     | (_,Dst.E_Mux(A, nSize,nOrig,Tys as Ty.vectorLength tys,exps))=> let
275 : cchiw 2691 val name=SrcV.name lhs
276 : cchiw 2687 val xs=List.map (fn n=> Dst.Var.new(name^Int.toString(n), Dst.VK_Local,Ty.TensorTy [n]) ) tys
277 : cchiw 2688 val rhs=Dst.E_Mux(A, nSize,nOrig,Tys,List.map (fn v=>Dst.E_Var v) xs)
278 : cchiw 2687 val stmts=ListPair.map (fn(x,e)=>Dst.S_Assign([x],e)) (xs,exps)
279 : cchiw 2692 val env'=addLocals(env,xs)
280 :     val env''=renameExp(env',lhs,rhs)
281 :     val _= dumpEnv env
282 :     val _=getLocal env
283 :     val _=print "\n\t new env"
284 :     val _= dumpEnv env'
285 :     in
286 :     (env',stmts)
287 : cchiw 2687 end
288 : cchiw 2688 |(_,_)=> AL 1
289 :     (*end case*))
290 : cchiw 2687 end
291 :    
292 : cchiw 2691
293 :     fun bind (env, lhs, rhs) =(case peekGlobal (env, lhs)
294 :     of SOME x =>(env, [Dst.S_Assign([x], rhs)])
295 :     | NONE => bindLocal (env, lhs, rhs)
296 :     (* end case *))
297 : jhr 1115
298 :     (* set the definition of a variable, where the RHS is either a literal constant or a variable *)
299 : cchiw 2691 fun bindSimple (env as E{tbl, ...}, lhs, rhs) =(case peekGlobal (env, lhs)
300 :     of SOME x => (env, [Dst.S_Assign([x], rhs)])
301 :     | NONE => (VT.insert tbl (lhs, DEF rhs); (env, []))
302 :     (* end case *))
303 : cchiw 2688
304 : jhr 1115
305 :     (* at the end of a block, we need to assign any pending expressions to locals. The
306 :     * blkStms list and the resulting statement list are in reverse order.
307 :     *)
308 : cchiw 2637 fun flushPending (E{tbl,types, functs,locals}, blkStms) = let
309 : jhr 2356 fun doVar (x, TREE e, (locals, stms)) = let
310 :     val t = newLocal x
311 :     in
312 : cchiw 2646 VT.insert tbl (x, DEF(Dst.E_Var t));
313 :     (t::locals, Dst.S_Assign([t], e)::stms)
314 : jhr 2356 end
315 :     | doVar (_, _, acc) = acc
316 :     val (locals, stms) = VT.foldi doVar (locals, blkStms) tbl
317 :     in
318 : cchiw 2637 (E{tbl=tbl, types=types,functs=functs,locals=locals}, stms)
319 : jhr 2356 end
320 : jhr 1115
321 : cchiw 2646 fun doPhi ((lhs, rhs), (env, predBlks : Dst.stm list list)) = let
322 : jhr 2356 (* t will be the variable in the continuation of the JOIN *)
323 :     val t = newLocal lhs
324 :     val predBlks = ListPair.map
325 : cchiw 2646 (fn (x, stms) => Dst.S_Assign([t], useVar env x)::stms)
326 : jhr 2356 (rhs, predBlks)
327 :     in
328 :     (rename (addLocal(env, t), lhs, t), predBlks)
329 :     end
330 : cchiw 2637 (*
331 : cchiw 2646 fun endScope (E{locals, ...}, stms) = Dst.Block{
332 : jhr 2356 locals = List.rev locals,
333 :     body = stms
334 :     }
335 : cchiw 2637 *)
336 :     fun endScope (env, stms) = let
337 :     val (types,opr)=peelEnv(env)
338 :    
339 : cchiw 2646 in Dst.Pink{
340 : cchiw 2637
341 :     locals= List.rev(peelEnvLoc env),
342 :     types= types,
343 :     opr=opr,
344 :     body = stms
345 :     }
346 :     end
347 : jhr 1115 end
348 :    
349 :     (* Certain IL operators cannot be compiled to inline expressions. Return
350 :     * false for those and true for all others.
351 :     *)
352 : cchiw 2680
353 :     (*Move operator so it's it's on variable: y=sumOP+9
354 :     x=sumOp..y=x+9, =>
355 :    
356 :     *)
357 : jhr 1115 fun isInlineOp rator = let
358 : jhr 2356 fun chkTensorTy (Ty.TensorTy[]) = true
359 :     | chkTensorTy (Ty.TensorTy[_]) = true
360 :     | chkTensorTy (Ty.TensorTy[_, _]) = Target.inlineMatrixExp
361 :     | chkTensorTy _ = false
362 : cchiw 2688
363 : jhr 2356 in
364 :     case rator
365 : cchiw 2646 of SrcOp.LoadVoxels(_, 1) => true
366 :     | SrcOp.LoadVoxels _ => false
367 :     | SrcOp.EigenVecs2x2 => false
368 :     | SrcOp.EigenVecs3x3 => false
369 :     | SrcOp.EigenVals2x2 => false
370 :     | SrcOp.EigenVals3x3 => false
371 : cchiw 2691 (* | SrcOp.Zero _ => Target.inlineMatrixExp*)
372 : cchiw 2680
373 :     (*Added here *)
374 :     | SrcOp.imgAddr _ => false
375 :     | SrcOp.imgLoad _ => false
376 :     | _ => true (*when true calls binding *)
377 : jhr 2356 (* end case *)
378 :     end
379 : jhr 1115
380 : cchiw 2669 (*HERE- since we are using arrays, nothing can be inline
381 :     Fix later if it needs to be fixed*)
382 : cchiw 2525 (* is a CONS inline? *)
383 : cchiw 2669 fun isInlineCons ty = (*(case ty
384 : cchiw 2525 of Ty.SeqTy(Ty.IntTy, _) => true
385 :     | Ty.TensorTy dd => Target.inlineCons(List.length dd)
386 :     | Ty.SeqTy _ => false
387 :     (*CCCC-? DO we have this type*)
388 : cchiw 2615 (* | Ty.DynSeqTy ty => false*)
389 : cchiw 2525 | _ => raise Fail(concat["invalid CONS<", Ty.toString ty, ">"])
390 : cchiw 2669 (* end case *))*) false
391 : cchiw 2525
392 :     (* translate a LowIL assignment to a list of zero or more target statements in reverse
393 :     * order.
394 :     *)
395 : cchiw 2688
396 :    
397 :    
398 : jhr 1115 fun doAssign (env, (lhs, rhs)) = let
399 : cchiw 2688
400 : jhr 2356 fun doLHS () = (case peekGlobal(env, lhs)
401 : cchiw 2688 of SOME lhs' => (env, lhs')
402 :     | NONE => let
403 :     val t = newLocal lhs
404 :     in
405 :     (rename (addLocal(env, t), lhs, t), t)
406 :     end
407 :     (* end case *))
408 :    
409 : jhr 2356 (* for expressions that are going to be compiled to a call statement *)
410 :     fun assignExp (env, exp) = let
411 :     (* operations that return matrices may not be supported inline *)
412 :     val (env, t) = doLHS()
413 :     in
414 : cchiw 2646 (env, [Dst.S_Assign([t], exp)])
415 : jhr 2356 end
416 : cchiw 2680
417 : jhr 2632
418 : cchiw 2525 (* force an argument to be stored in something that will be mapped to an l-value *)
419 :     fun bindVar (env, x) = (case useVar env x
420 : cchiw 2688 of x' as Dst.E_State _ =>(env, x', [])
421 :     | x' as Dst.E_Var _ => (env, x', [])
422 :     | e => let
423 : cchiw 2525 val x' = newLocal x
424 :     in
425 : cchiw 2646 (addLocal(env, x'), Dst.E_Var x', [Dst.S_Assign([x'], e)])
426 : cchiw 2525 end
427 :     (* end case *))
428 : cchiw 2692
429 :     val _=toS.ASSIGNtoString(lhs,rhs)
430 : cchiw 2688
431 : jhr 2356 in
432 :     case rhs
433 : cchiw 2688 of Src.STATE x => bindSimple (env, lhs, Dst.E_State(getStateVar x))
434 :     | Src.VAR x => bindSimple (env, lhs, useVar env x)
435 :     | Src.LIT lit => bindSimple (env, lhs, Dst.E_Lit lit)
436 : jhr 2632
437 : cchiw 2646 (*| Src.OP( SrcOp.Prepend ty, [item, seq]) => let
438 : jhr 2356 val (env, t) = doLHS()
439 : cchiw 2525 val (env, item', stms) = bindVar (env, item)
440 : cchiw 2646 val exp = Dst.E_Op( DstOp.Prepend ty, [item', useVar env seq])
441 : jhr 2356 in
442 : cchiw 2646 (env, Dst.S_Assign([t], exp) :: stms)
443 : jhr 2356 end
444 : cchiw 2646 | Src.OP( SrcOpp.Append ty, [seq, item]) => let
445 : jhr 2356 val (env, t) = doLHS()
446 : cchiw 2525 val (env, item', stms) = bindVar (env, item)
447 : cchiw 2646 val exp = Dst.E_Op( DstOp.Append ty, [useVar env seq, item'])
448 : jhr 2356 in
449 : cchiw 2646 (env, Dst.S_Assign([t], exp) :: stms)
450 : cchiw 2615 end*)
451 : jhr 2632 (*
452 : cchiw 2646 | Src.OP( SrcOp.LoadImage(ty, nrrd, info), []) => let
453 : cchiw 2525 val (env, t) = doLHS()
454 :     in
455 : cchiw 2646 (env, [Dst.S_LoadNrrd(t, ty, nrrd)])
456 : cchiw 2615 end*)
457 : cchiw 2670
458 :    
459 : cchiw 2646 | Src.OP(rator,args) =>let
460 : cchiw 2620 val args'=List.map (useVar env) args
461 : cchiw 2692
462 : cchiw 2691 fun foundVec(rator,oSize,argsS,argsV)= let
463 :     val (isFill,nSize,Pieces)=Target.getVecTy oSize
464 : cchiw 2680 val (env, t) = doLHS()
465 : cchiw 2691 val (expOpt,storeVecStatement) = LowOpToTreeOp.vecToTree(t,rator,nSize,oSize,Pieces,argsS,argsV,isFill)
466 : cchiw 2692 val n1=SrcV.useCount lhs
467 :    
468 : cchiw 2691 val (env,stmts)=(case (expOpt,storeVecStatement)
469 : cchiw 2692 of (SOME exp,_)=>let
470 :     val _ = testp ["\n **** Exp \n",Dst.toString exp,"\n******\n"]
471 :     in
472 :     bind (env, lhs, exp)
473 :     end
474 :     | (NONE,SOME stmt)=> let
475 :     val _ =testp(["\n **\nStmt- RESULT ", Dst.toStringS stmt,"\n******\n"])
476 :     in
477 :     (env,[stmt])
478 :     end
479 : cchiw 2680 (*end case*))
480 : cchiw 2691 in
481 : cchiw 2692 (env,stmts)
482 : cchiw 2680 end
483 :     in (case (rator,args')
484 :     of (SrcOp.addVec n,_) => foundVec(DstOp.addVec,n,[],args')
485 :     | (SrcOp.subVec n,_) => foundVec(DstOp.subVec,n,[],args')
486 :     | (SrcOp.prodScaV n,e1::es) => foundVec(DstOp.prodScaV ,n, [e1], es)
487 : cchiw 2691 | (SrcOp.prodVec n,_) => foundVec(DstOp.prodVec,n,[],args')
488 :     | (SrcOp.dotVec n ,_) => foundVec(DstOp.dotVec ,n,[],args')
489 :     | (SrcOp.sumVec n ,_) => foundVec(DstOp.sumVec ,n,[],args')
490 : cchiw 2680 | (SrcOp.Floor n ,_) => foundVec(DstOp.Floor ,n,[],args')
491 :     | (SrcOp.Kernel _,_) => (env, [])
492 :     | (SrcOp.LoadImage info,[a]) => let
493 :     (*Moved to outside*)
494 :     val dim = ImageInfo.dim info
495 :     val (env, t) = doLHS()
496 :     in
497 :     (env,[Dst.S_LoadImage(t, dim, a)])
498 :     end
499 :     | _ => let
500 : cchiw 2637 val Trator = LowOpToTreeOp.expandOp rator
501 : cchiw 2671 val exp = Dst.E_Op(Trator, args')
502 : cchiw 2620 in
503 : cchiw 2688 if isInlineOp rator then (bind (env, lhs, exp))
504 :     else (assignExp (env, exp))
505 : cchiw 2620 end
506 :     (*end case*))
507 :     end
508 : cchiw 2670
509 : cchiw 2646 | Src.APPLY(f, args) =>
510 :     bind (env, lhs, Dst.E_Apply(f, List.map (useVar env) args))
511 : cchiw 2692
512 :     | Src.CONS(ty as Ty.TensorTy[oSize], args) => let
513 :     (*(env,[Dst.S_Cons(x,ty,args')])-Without using Mux *)
514 :    
515 :     val _=print "\n ****************** \n found cons \n"
516 :     val _= dumpEnv env
517 :     val args'=List.map (useVar env) args
518 :     (*don't know how to tell if lhs of var is a local var, so we have to use assignExp first *)
519 :    
520 :    
521 :     val (envv, t) = doLHS()
522 :    
523 :     val (isFill,nSize,Pieces)=Target.getVecTy oSize
524 :    
525 :    
526 :     val (envvv,rst) =(case DstV.kind t
527 :     of TreeIL.VK_Local=> let
528 :     val exp= LowOpToTreeOp.consVecToTree(nSize,oSize,Pieces,args',isFill)
529 :     val _ =print (String.concat ["\n\t Found local Vector Cons \n",Dst.toString exp,"\n******\n"])
530 :     in
531 :     bind (envv, lhs, exp)
532 :     end
533 :     | _ => bindCons (envv, lhs,t, ty ,args')
534 :     (*end case*))
535 :    
536 :     val _= dumpEnv envvv
537 :     val _=print( "\n end cons \n ****************** \n")
538 :    
539 :    
540 :     in
541 :     (envvv,rst)
542 :     end
543 :    
544 :     | Src.CONS(ty, args) => let
545 :     val exp = Dst.E_Cons(ty, List.map (useVar env) args)
546 :     in
547 :     if isInlineCons ty
548 :     then bind (env, lhs, exp)
549 :     else assignExp (env, exp)
550 :     end
551 :    
552 : cchiw 2646 | Src.EINAPP _=> raise Fail "EINAPP in Low-IL to Tree-IL"
553 : jhr 2356 (* end case *)
554 :     end
555 : jhr 1115
556 :     (* In order to reconstruct the block-structure from the CFG, we keep a stack of open ifs.
557 :     * the items on this stack distinguish between when we are processing the then and else
558 :     * branches of the if.
559 :     *)
560 :     datatype open_if
561 :     (* working on the "then" branch. The fields are statments that preceed the if, the condition,
562 :     * and the else-branch node.
563 :     *)
564 : cchiw 2646 = THEN_BR of Dst.stm list * Dst.exp * Src.node
565 : jhr 1115 (* working on the "else" branch. The fields are statments that preceed the if, the condition,
566 :     * the "then" branch statements, and the node that terminated the "then" branch (will be
567 :     * a JOIN, DIE, or STABILIZE).
568 :     *)
569 : cchiw 2646 | ELSE_BR of Dst.stm list * Dst.exp * Dst.stm list * Src.node_kind
570 : jhr 1115
571 : cchiw 2628
572 : cchiw 2646 fun mkBlockOrig(Dst.Pink{ locals ,types,opr,body})=Dst.Block{locals=locals ,body=body}
573 :     fun peelBlockOrig(env,Dst.Pink{ locals ,types,opr,body})=let
574 : cchiw 2688 val env= setEnv(env,types,opr)
575 :     in
576 :     (env,Dst.Block{locals=locals ,body=body})
577 :     end
578 : cchiw 2637
579 : cchiw 2688
580 : cchiw 2691
581 : jhr 1115 fun trCFG (env, prefix, finish, cfg) = let
582 : cchiw 2637
583 :    
584 : cchiw 2691 (*look at stmts and collect oprSet and tySet*)
585 : cchiw 2688 fun getFNC(env,stms)=let
586 :     val t1=peelEnv(env)
587 : cchiw 2691 val (ty2,opr2)= List.foldr (fn(e1,e2) => TreeToOpr.stmtToOpr (e2,e1)) t1 stms
588 : cchiw 2688 in
589 :     setEnv(env, ty2,opr2)
590 :     end
591 :    
592 :    
593 : cchiw 2646 fun join (env, [], _, Src.JOIN _) = raise Fail "JOIN with no open if"
594 : jhr 2356 | join (env, [], stms, _) = endScope (env, prefix @ List.rev stms)
595 :     | join (env, THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let
596 :     val (env, thenBlk) = flushPending (env, thenBlk)
597 :     in
598 :     doNode (env, ELSE_BR(stms1, cond, thenBlk, k)::stk, [], elseBr)
599 :     end
600 :     | join (env, ELSE_BR(stms, cond, thenBlk, k1)::stk, elseBlk, k2) = let
601 :     val (env, elseBlk) = flushPending (env, elseBlk)
602 :     in
603 :     case (k1, k2)
604 : cchiw 2646 of ( Src.JOIN{phis, succ, ...}, Src.JOIN _) => let
605 : jhr 2356 val (env, [thenBlk, elseBlk]) =
606 :     List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)
607 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
608 :     in
609 :     doNode (env, stk, stm::stms, !succ)
610 :     end
611 : cchiw 2646 | ( Src.JOIN{phis, succ, ...}, _) => let
612 : jhr 2356 val (env, [thenBlk]) = List.foldl doPhi (env, [thenBlk]) (!phis)
613 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
614 :     in
615 :     doNode (env, stk, stm::stms, !succ)
616 :     end
617 : cchiw 2646 | (_, Src.JOIN{phis, succ, ...}) => let
618 : jhr 2356 val (env, [elseBlk]) = List.foldl doPhi (env, [elseBlk]) (!phis)
619 :     val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
620 :     in
621 :     doNode (env, stk, stm::stms, !succ)
622 :     end
623 :     | (_, _) => raise Fail "no path to exit unimplemented" (* FIXME *)
624 :     (* end case *)
625 :     end
626 : cchiw 2688 and doNode (env, ifStk : open_if list, stms, nd) =
627 :     (* testp ["******************* \n doNode\n ",toS.printNode (Nd.kind nd),"\n"]*)
628 :     (case Nd.kind nd
629 : cchiw 2646 of Src.NULL => raise Fail "unexpected NULL"
630 :     | Src.ENTRY{succ} => doNode (env, ifStk, stms, !succ)
631 :     | k as Src.JOIN{phis, succ, ...} => join (env, ifStk, stms, k)
632 :     | Src.COND{cond, trueBranch, falseBranch, ...} => let
633 : jhr 2356 val cond = useVar env cond
634 :     val (env, stms) = flushPending (env, stms)
635 :     in
636 :     doNode (env, THEN_BR(stms, cond, !falseBranch)::ifStk, [], !trueBranch)
637 :     end
638 : cchiw 2646 | Src.COM {text, succ, ...} =>
639 :     doNode (env, ifStk, Dst.S_Comment text :: stms, !succ)
640 :     | Src.ASSIGN{stm, succ, ...} => let
641 : jhr 2356 val (env, stms') = doAssign (env, stm)
642 :     in
643 : cchiw 2692 doNode (getFNC(env, stms') , ifStk, stms' @ stms, !succ)
644 : jhr 2356 end
645 : cchiw 2646 | Src.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
646 : cchiw 2688
647 : jhr 1640 fun doit () = let
648 :     fun doLHSVar (y, (env, ys)) = (case peekGlobal(env, y)
649 : cchiw 2688 of SOME y' => ((env, y'::ys))
650 : cchiw 2687 | NONE => let
651 : jhr 1640 val t = newLocal y
652 : cchiw 2688
653 : jhr 1640 in
654 :     (rename (addLocal(env, t), y, t), t::ys)
655 :     end
656 :     (* end case *))
657 :     val (env, ys) = List.foldr doLHSVar (env, []) ys
658 : cchiw 2637 val Trator = LowOpToTreeOp.expandOp rator
659 : cchiw 2646 val exp = Dst.E_Op(Trator, List.map (useVar env) xs)
660 :     val stm = Dst.S_Assign(ys, exp)
661 : jhr 1640 in
662 :     doNode (env, ifStk, stm :: stms, !succ)
663 :     end
664 :     in
665 :     case rator
666 : cchiw 2646 of SrcOp.Print _ => if Target.supportsPrinting()
667 : jhr 1640 then doit ()
668 :     else doNode (env, ifStk, stms, !succ)
669 :     | _ => doit()
670 :     (* end case *)
671 :     end
672 : cchiw 2646 | Src.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
673 :     | Src.SAVE{lhs, rhs, succ, ...} => let
674 : cchiw 2688 (*How to get var form stateVar?*)
675 : cchiw 2692 val _=print ("\n *********** \n FOUND SAVE \n")
676 : cchiw 2680
677 : cchiw 2692 fun cat c = print (peek env c)
678 :     val n1=SrcV.useCount rhs
679 :     fun decCount ( Src.V{useCnt, ...}) = let
680 :     val n = !useCnt - 1
681 :     in
682 :     useCnt := n; (0 >= n)
683 :     end
684 : cchiw 2688
685 : cchiw 2692 val stm=(case (getStateVar lhs,useVar env rhs)
686 :     of (x,Dst.E_Mux(A,nSize, oSize,pieces,args))
687 :     =>(decCount rhs ;Dst.S_StoreVec( Dst.E_State x,A,nSize, oSize,pieces,args))
688 :    
689 :     (*table need low-il*)
690 :     | (x,Dst.E_Var rhs')=>(print (String.concat["\t rhs: ",Dst.toString (Dst.E_Var rhs'),"--"]);cat rhs;
691 :     Dst.S_Save([x], Dst.E_Var rhs'))
692 :    
693 : cchiw 2691 | (x,rhs')=>(print (String.concat["\t rhs: ",Dst.toString rhs',"--end "]);Dst.S_Save([x], rhs'))
694 :     (*end case*))
695 :    
696 : cchiw 2692 val n2=SrcV.useCount rhs
697 :     val _=testp ["Counts ",Int.toString(n1), " to " ,Int.toString(n2),"\n"]
698 : cchiw 2691
699 : cchiw 2692
700 :     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)
701 :    
702 :    
703 : cchiw 2691 val stmts=stm::stms
704 : jhr 1640 in
705 : cchiw 2688 doNode (getFNC(env, stmts), ifStk, stmts, !succ)
706 : jhr 1640 end
707 : cchiw 2646 | k as Src.EXIT{kind, live, ...} => (case kind
708 : jhr 2356 of ExitKind.FRAGMENT =>
709 :     endScope (env, prefix @ List.revAppend(stms, finish env))
710 :     | ExitKind.SINIT => let
711 : jhr 1232 (* FIXME: we should probably call flushPending here! *)
712 : cchiw 2646 val suffix = finish env @ [Dst.S_Exit[]]
713 : jhr 2356 in
714 :     endScope (env, prefix @ List.revAppend(stms, suffix))
715 :     end
716 :     | ExitKind.RETURN => let
717 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
718 : cchiw 2646 val suffix = finish env @ [Dst.S_Exit(List.map (useVar env) live)]
719 : jhr 2356 in
720 :     endScope (env, prefix @ List.revAppend(stms, suffix))
721 :     end
722 :     | ExitKind.ACTIVE => let
723 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
724 : cchiw 2646 val suffix = finish env @ [Dst.S_Active]
725 : jhr 2356 in
726 :     endScope (env, prefix @ List.revAppend(stms, suffix))
727 :     end
728 :     | ExitKind.STABILIZE => let
729 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
730 : cchiw 2646 val stms = Dst.S_Stabilize :: stms
731 : jhr 2356 in
732 : jhr 1115 (* FIXME: we should probably call flushPending here! *)
733 : jhr 2356 join (env, ifStk, stms, k)
734 :     end
735 : cchiw 2646 | ExitKind.DIE => join (env, ifStk, Dst.S_Die :: stms, k)
736 : jhr 2356 (* end case *))
737 :     (* end case *))
738 : jhr 2632
739 : cchiw 2628 val Y=doNode (env, [], [], CFG.entry cfg)
740 : cchiw 2637
741 : jhr 2632 in Y
742 : jhr 2356 end
743 : jhr 1115
744 : cchiw 2646 fun trInitially (env, Src.Initially{isArray, rangeInit, iters, create=(createInit, strand, args)}) =
745 : jhr 2356 let
746 : cchiw 2637 val iterPrefix = mkBlockOrig(trCFG (env, [], fn _ => [], rangeInit))
747 : jhr 2356 fun cvtIter ((param, lo, hi), (env, iters)) = let
748 :     val param' = newIter param
749 :     val env = rename (env, param, param')
750 :     in
751 :     (env, (param', useVar env lo, useVar env hi)::iters)
752 :     end
753 :     val (env, iters) = List.foldr cvtIter (env, []) iters
754 : cchiw 2637 val (env,createPrefix) = peelBlockOrig(env,trCFG (env, [], fn _ => [], createInit))
755 :     in (env,{
756 : jhr 2356 isArray = isArray,
757 :     iterPrefix = iterPrefix,
758 :     iters = iters,
759 :     createPrefix = createPrefix,
760 :     strand = strand,
761 :     args = List.map (useVar env) args
762 : cchiw 2637 }) end
763 : jhr 1115
764 : cchiw 2646 fun trMethod env ( Src.Method{name, body}) = Dst.Method{
765 : jhr 1640 name = name,
766 : cchiw 2637 body = mkBlockOrig(trCFG (env, [], fn _ => [], body))
767 : jhr 1640 }
768 : cchiw 2637
769 :    
770 :     fun trStrand(globalEnv, [],rest)=(globalEnv,rest)
771 : cchiw 2646 | trStrand(globalEnv ,( Src.Strand{name, params, state, stateInit, methods})::es,rest) = let
772 : cchiw 2637 val params' = List.map newParam params
773 :     val env = ListPair.foldlEq (fn (x, x', env) => rename(env, x, x')) globalEnv (params, params')
774 :     val (env',sInit) = peelBlockOrig(env,trCFG (env, [], fn _ => [], stateInit))
775 :    
776 : cchiw 2646 val strand'=Dst.Strand{
777 : cchiw 2637 name = name,
778 :     params = params',
779 :     state = List.map getStateVar state,
780 :     stateInit =sInit,
781 :     methods = List.map (trMethod env) methods
782 :     }
783 :     in trStrand(env', es, rest@[strand'])
784 :     end
785 :    
786 :    
787 : jhr 1115
788 : jhr 1301 (* split the globalInit into the part that specifies the inputs and the rest of
789 :     * the global initialization.
790 :     *)
791 :     fun splitGlobalInit globalInit = let
792 : cchiw 2525 (* FIXME: can split as soon as we see a non-Input statement! *)
793 : cchiw 2687
794 : cchiw 2688
795 : jhr 2356 fun walk (nd, lastInput, live) = (case Nd.kind nd
796 : cchiw 2646 of Src.ENTRY{succ} => walk (!succ, lastInput, live)
797 :     | Src.COM{succ, ...} => walk (!succ, lastInput, live)
798 :     | Src.ASSIGN{stm=(lhs, rhs), succ, ...} => (case rhs
799 :     of Src.OP(SrcOp.Input _, _) => walk (!succ, nd, lhs::live)
800 : jhr 2356 | _ => walk (!succ, lastInput, live)
801 :     (* end case *))
802 :     | _ => if Nd.isNULL lastInput
803 :     then let (* no inputs *)
804 :     val entry = Nd.mkENTRY()
805 :     val exit = Nd.mkEXIT(ExitKind.RETURN, [])
806 :     in
807 :     Nd.addEdge (entry, exit);
808 : cchiw 2646 {inputInit = Src.CFG{entry=entry, exit=exit}, globalInit = globalInit}
809 : jhr 2356 end
810 :     else let (* split at lastInput *)
811 :     val inputExit = Nd.mkEXIT(ExitKind.RETURN, live)
812 :     val globalEntry = Nd.mkENTRY()
813 :     val [gFirst] = Nd.succs lastInput
814 :     in
815 :     Nd.replaceInEdge {src = lastInput, oldDst = gFirst, dst = inputExit};
816 :     Nd.replaceOutEdge {oldSrc = lastInput, src = globalEntry, dst = gFirst};
817 :     {
818 : cchiw 2646 inputInit = Src.CFG{entry = Src.CFG.entry globalInit, exit = inputExit},
819 :     globalInit = Src.CFG{entry = globalEntry, exit = Src.CFG.exit globalInit}
820 : jhr 2356 }
821 :     end
822 :     (* end case *))
823 : cchiw 2637
824 : jhr 2356 in
825 : cchiw 2646 walk ( Src.CFG.entry globalInit, Nd.dummy, [])
826 : jhr 2356 end
827 : cchiw 2637 fun getInfo(env,Init)=let
828 :     val inputInit' = trCFG (env, [], fn _ => [], Init)
829 :     in
830 :     peelBlockOrig(env,inputInit')
831 :     end
832 :    
833 : jhr 1115 fun translate prog = let
834 : jhr 2356 (* first we do a variable analysis pass on the Low IL *)
835 : cchiw 2646 val prog as Src.Program{props, globalInit, initially, strands} = VA.optimize prog
836 : jhr 1115 (* FIXME: here we should do a contraction pass to eliminate unused variables that VA may have created *)
837 : jhr 2356 val _ = (* DEBUG *)
838 :     LowPP.output (Log.logFile(), "LowIL after variable analysis", prog)
839 : cchiw 2637 val envOrig = newEnv()
840 : jhr 2632 val globals = List.map
841 : cchiw 2637 (fn x => let val x' = newGlobal x in global(envOrig, x, x'); x' end)
842 : cchiw 2646 ( Src.CFG.liveAtExit globalInit)
843 : jhr 2356 val {inputInit, globalInit} = splitGlobalInit globalInit
844 : cchiw 2637
845 :     val (env,inputInit)=getInfo(envOrig,inputInit)
846 :     val (env,globalInit)=getInfo(env, globalInit)
847 :     val (env,strands) = trStrand (env, strands,[])
848 :     val (env, initially) = trInitially (env, initially)
849 :    
850 :     val (typs,opr)= peelEnv(env)
851 :     val typsList=TySet.listItems(typs);
852 :     val oprList=OprSet.listItems(opr);
853 : cchiw 2692 val _=testp[(Fnc.setListToString(typsList,oprList,"--FinalPostStrands--"))]
854 : cchiw 2637
855 : cchiw 2646 in Dst.Program{
856 : jhr 2632 props = props,
857 : cchiw 2637 types=typsList,
858 :     oprations = oprList,
859 : jhr 2632 globals = globals,
860 :     inputInit = inputInit,
861 :     globalInit = globalInit,
862 :     strands = strands,
863 : cchiw 2637 initially = initially
864 : jhr 2632 }
865 : jhr 2356 end
866 : jhr 1115
867 :     end

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