Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Diff of /branches/charisee/src/compiler/tree-il/low-to-tree-fn.sml
ViewVC logotype

Diff of /branches/charisee/src/compiler/tree-il/low-to-tree-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.2631  
changed lines
  Added in v.2791

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