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 2669, Fri Jun 13 02:08:31 2014 UTC
# Line 26  Line 26 
26    
27    end = struct    end = struct
28    
29      structure IL = LowIL  
30      structure Ty = LowILTypes      structure Src = LowIL
31        structure SrcOp = LowOps
32      structure V = LowIL.Var      structure V = LowIL.Var
33      structure StV = LowIL.StateVar      structure StV = LowIL.StateVar
34      structure Op = LowOps      structure Dst = TreeIL
35        structure DstOp = TreeOps
36        structure LowOpToTreeOp  = LowOpToTreeOp
37        structure gT=getTypes
38        structure VA = VarAnalysis
39        structure Ty = LowILTypes
40      structure Nd = LowIL.Node      structure Nd = LowIL.Node
41      structure CFG = LowIL.CFG      structure CFG = LowIL.CFG
42      structure T = TreeIL      structure TySet=TreeFunc.TySet
43      structure VA = VarAnalysis      structure OprSet=TreeFunc.OprSet
     structure ExpOp=ExpOp  
     structure OpT = TreeOps  
     structure SrcOp = LowOps  
     structure DstOp = TreeOps  
44    
         structure gT=getTypes  
         structure TreetoCFN=TreetoCFN  
45    (* create new tree IL variables *)    (* create new tree IL variables *)
46      local      local
47        val newVar = T.Var.new        val newVar = Dst.Var.new
48        val cnt = ref 0        val cnt = ref 0
49        fun genName prefix = let        fun genName prefix = let
50              val n = !cnt              val n = !cnt
# Line 59  Line 59 
59          | _ =>1          | _ =>1
60      (*end case*))      (*end case*))
61    
62        fun newGlobal x = newVar (genName("G_" ^ V.name x), Dst.VK_Global, V.ty x)
63      fun newGlobal x=newVar (genName("G_" ^ V.name x), T.VK_Global, V.ty x)      fun newParam x = newVar (genName("p_" ^ V.name x), Dst.VK_Local, V.ty x)
64      fun newParam x = newVar (genName("p_" ^ V.name x), T.VK_Local, V.ty x)      fun newLocal x = newVar (genName("l_" ^ V.name x), Dst.VK_Local, V.ty x)
65      fun newLocal x = newVar (genName("l_" ^ V.name x), T.VK_Local, V.ty x)      fun newIter x = newVar (genName("i_" ^ V.name x), Dst.VK_Local, V.ty x)
     fun newIter x = newVar (genName("i_" ^ V.name x), T.VK_Local, V.ty x)  
66      end      end
67    
68    (* associate Tree IL state variables with Low IL variables using properties *)    (* associate Tree IL state variables with Low IL variables using properties *)
69      local      local
70        fun mkStateVar x = T.SV{        fun mkStateVar x = Dst.SV{
71                name = StV.name x,                name = StV.name x,
72                id = Stamp.new(),                id = Stamp.new(),
73                ty = StV.ty x,                ty = StV.ty x,
# Line 79  Line 78 
78      val {getFn = getStateVar, ...} = StV.newProp mkStateVar      val {getFn = getStateVar, ...} = StV.newProp mkStateVar
79      end      end
80    
81      fun mkBlock stms = T.Block{locals=[], body=stms}      fun mkBlock stms = Dst.Block{locals=[], body=stms}
82      fun mkIf (x, stms, []) = T.S_IfThen(x, mkBlock stms)      fun mkIf (x, stms, []) = Dst.S_IfThen(x, mkBlock stms)
83        | mkIf (x, stms1, stms2) = T.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)        | mkIf (x, stms1, stms2) = Dst.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)
84    
85    (* 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
86     * of locals that have been defined.     * of locals that have been defined.
87     *)     *)
88      local      local
89        structure VT = V.Tbl        structure VT = V.Tbl
90        fun decCount (IL.V{useCnt, ...}) = let        fun decCount ( Src.V{useCnt, ...}) = let
91              val n = !useCnt - 1              val n = !useCnt - 1
92              in              in
93                useCnt := n;  (n <= 0)                useCnt := n;  (n <= 0)
94              end              end
95        datatype target_binding        datatype target_binding
96          = GLOB of T.var         (* variable is global *)          = GLOB of Dst.var         (* variable is global *)
97          | TREE of T.exp         (* variable bound to target expression tree *)          | TREE of Dst.exp         (* variable bound to target expression tree *)
98          | 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 *)
99    
100    
101        fun insert (key, value) d =fn s =>
102            if s = key then SOME value
103            else d s
104    
105        fun lookup k d = d k
106    
107    
108        structure ListSetOfInts = ListSetFn (struct
109            type ord_key = int
110            val compare = Int.compare
111            end)
112    
113    
114        datatype env = E of {        datatype env = E of {
115            tbl : target_binding VT.hash_table,            tbl : target_binding VT.hash_table,
116            locals : T.var list            types:  TySet.set,
117              functs : OprSet.set,
118              locals : Dst.var list
119          }          }
120    
121    
122      in      in
123  (* DEBUG *)  (* DEBUG *)
124    
125    
126          fun peelEnv(E{tbl, types, functs ,locals})=(types,functs)
127          fun setEnv(E{tbl, types,functs,locals},types1,functs1)=
128                      E{tbl=tbl, types=types1, functs= functs1 ,locals=locals}
129    
130           fun peelEnvLoc(E{tbl, types, functs ,locals})=locals
131    
132  fun bindToString binding = (case binding  fun bindToString binding = (case binding
133         of GLOB y => "GLOB " ^ T.Var.name y         of GLOB y => "GLOB " ^ Dst.Var.name y
134          | TREE e => "TREE"          | TREE e => "TREE"
135          | DEF(T.E_Var y) => "DEF " ^ T.Var.name y          | DEF(Dst.E_Var y) => "DEF " ^ Dst.Var.name y
136          | DEF e => "DEF"          | DEF e => "DEF"
137        (* end case *))        (* end case *))
138  fun dumpEnv (E{tbl, ...}) = let  fun dumpEnv (E{tbl, ...}) = let
139        fun prEntry (x, binding) =        fun prEntry (x, binding) =
140              print(concat["  ", IL.Var.toString x, " --> ", bindToString binding, "\n"])              print(concat["  ", Src.Var.toString x, " --> ", bindToString binding, "\n"])
141        in        in
142          print "*** dump environment\n";          print "*** dump environment\n";
143          VT.appi prEntry tbl;          VT.appi prEntry tbl;
# Line 119  Line 145 
145        end        end
146  (* DEBUG *)  (* DEBUG *)
147    
148      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=[]}
149    
150    (* 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 *)
151      fun useVar (env as E{tbl, ...}) x = (case VT.find tbl x      fun useVar (env as E{tbl, ...}) x = (case VT.find tbl x
152             of SOME(GLOB x') => T.E_Var x'             of SOME(GLOB x') => Dst.E_Var x'
153              | SOME(TREE e) => (              | SOME(TREE e) => (
154  (*print(concat["useVar ", V.toString x, " ==> TREE\n"]);*)  (*print(concat["useVar ", V.toString x, " ==> TREE\n"]);*)
155                  ignore(VT.remove tbl x);                  ignore(VT.remove tbl x);
# Line 140  Line 166 
166            (* end case *))            (* end case *))
167    
168    (* record a local variable *)    (* record a local variable *)
169      fun addLocal (E{tbl, locals}, x) = E{tbl=tbl, locals=x::locals}      fun addLocal (E{tbl, types,functs,locals}, x) = E{tbl=tbl,types=types, functs=functs,locals=x::locals}
170    
171      fun global (E{tbl, ...}, x, x') = VT.insert tbl (x, GLOB x')      fun global (E{tbl, ...}, x, x') = VT.insert tbl (x, GLOB x')
172    
# Line 150  Line 176 
176            env)            env)
177    
178      fun rename (env as E{tbl, ...}, x, x') = (      fun rename (env as E{tbl, ...}, x, x') = (
179            VT.insert tbl (x, DEF(T.E_Var x'));            VT.insert tbl (x, DEF(Dst.E_Var x'));
180            env)            env)
181    
182      fun peekGlobal (E{tbl, ...}, x) = (case VT.find tbl x      fun peekGlobal (E{tbl, ...}, x) = (case VT.find tbl x
# Line 163  Line 189 
189            else let            else let
190              val t = newLocal lhs              val t = newLocal lhs
191              in              in
192                (rename(addLocal(env, t), lhs, t), [T.S_Assign([t], rhs)])                (rename(addLocal(env, t), lhs, t), [Dst.S_Assign([t], rhs)])
193              end              end
194    
195      fun bind (env, lhs, rhs) = (case peekGlobal (env, lhs)      fun bind (env, lhs, rhs) = (case peekGlobal (env, lhs)
196             of SOME x => (env, [T.S_Assign([x], rhs)])             of SOME x => (env, [Dst.S_Assign([x], rhs)])
197              | NONE => bindLocal (env, lhs, rhs)              | NONE => bindLocal (env, lhs, rhs)
198            (* end case *))            (* end case *))
199    
200    (* 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 *)
201      fun bindSimple (env as E{tbl, ...}, lhs, rhs) = (      fun bindSimple (env as E{tbl, ...}, lhs, rhs) = (
202            case peekGlobal (env, lhs)            case peekGlobal (env, lhs)
203             of SOME x => (env, [T.S_Assign([x], rhs)])             of SOME x => (env, [Dst.S_Assign([x], rhs)])
204              | NONE => (VT.insert tbl (lhs, DEF rhs); (env, []))              | NONE => (VT.insert tbl (lhs, DEF rhs); (env, []))
205            (* end case *))            (* end case *))
206    
207    (* 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
208     * blkStms list and the resulting statement list are in reverse order.     * blkStms list and the resulting statement list are in reverse order.
209     *)     *)
210      fun flushPending (E{tbl, locals}, blkStms) = let      fun flushPending (E{tbl,types, functs,locals}, blkStms) = let
211            fun doVar (x, TREE e, (locals, stms)) = let            fun doVar (x, TREE e, (locals, stms)) = let
212                  val t = newLocal x                  val t = newLocal x
213                  in                  in
214                    VT.insert tbl (x, DEF(T.E_Var t));                    VT.insert tbl (x, DEF(Dst.E_Var t));
215                    (t::locals, T.S_Assign([t], e)::stms)                    (t::locals, Dst.S_Assign([t], e)::stms)
216                  end                  end
217              | doVar (_, _, acc) = acc              | doVar (_, _, acc) = acc
218            val (locals, stms) = VT.foldi doVar (locals, blkStms) tbl            val (locals, stms) = VT.foldi doVar (locals, blkStms) tbl
219            in            in
220              (E{tbl=tbl, locals=locals}, stms)              (E{tbl=tbl, types=types,functs=functs,locals=locals}, stms)
221            end            end
222    
223      fun doPhi ((lhs, rhs), (env, predBlks : T.stm list list)) = let      fun doPhi ((lhs, rhs), (env, predBlks : Dst.stm list list)) = let
224          (* t will be the variable in the continuation of the JOIN *)          (* t will be the variable in the continuation of the JOIN *)
225            val t = newLocal lhs            val t = newLocal lhs
226            val predBlks = ListPair.map            val predBlks = ListPair.map
227                  (fn (x, stms) => T.S_Assign([t], useVar env x)::stms)                  (fn (x, stms) => Dst.S_Assign([t], useVar env x)::stms)
228                    (rhs, predBlks)                    (rhs, predBlks)
229            in            in
230              (rename (addLocal(env, t), lhs, t), predBlks)              (rename (addLocal(env, t), lhs, t), predBlks)
231            end            end
232    (*
233      fun endScope (E{locals, ...}, stms) = T.Block{      fun endScope (E{locals, ...}, stms) = Dst.Block{
234              locals = List.rev locals,              locals = List.rev locals,
235              body = stms              body = stms
236            }            }
237    *)
238            fun endScope (env, stms) = let
239                    val (types,opr)=peelEnv(env)
240    
241                 in    Dst.Pink{
242    
243                      locals= List.rev(peelEnvLoc env),
244                      types= types,
245                      opr=opr,
246                      body = stms
247                      }
248                end
249      end      end
250    
251    (* Certain IL operators cannot be compiled to inline expressions.  Return    (* Certain IL operators cannot be compiled to inline expressions.  Return
# Line 221  Line 258 
258              | chkTensorTy _ = false              | chkTensorTy _ = false
259            in            in
260             case rator             case rator
261               of Op.LoadVoxels(_, 1) => true               of  SrcOp.LoadVoxels(_, 1) => true
262                | Op.LoadVoxels _ => false                |  SrcOp.LoadVoxels _ => false
263    
264                    (*not removed add, sub, neg, scal, mul*)                    (*not removed add, sub, neg, scal, mul*)
265    
266                | Op.EigenVecs2x2 => false                |  SrcOp.EigenVecs2x2 => false
267                | Op.EigenVecs3x3 => false                |  SrcOp.EigenVecs3x3 => false
268                | Op.EigenVals2x2 => false                |  SrcOp.EigenVals2x2 => false
269                | Op.EigenVals3x3 => false                |  SrcOp.EigenVals3x3 => false
270    
271  (*              | Op.Zero _ => Target.inlineMatrixExp*)  (*              | SrcOp.Zero _ => Target.inlineMatrixExp*)
272    
273                | _ => true                | _ => true
274              (* end case *)              (* end case *)
275            end            end
276    
277        (*HERE- since we are using arrays, nothing can be inline
278        Fix later if it needs to be fixed*)
279    (* is a CONS inline? *)    (* is a CONS inline? *)
280      fun isInlineCons ty = (case ty      fun isInlineCons ty = (*(case ty
281             of Ty.SeqTy(Ty.IntTy, _) => true             of Ty.SeqTy(Ty.IntTy, _) => true
282              | Ty.TensorTy dd => Target.inlineCons(List.length dd)              | Ty.TensorTy dd => Target.inlineCons(List.length dd)
283              | Ty.SeqTy _ => false              | Ty.SeqTy _ => false
284     (*CCCC-? DO we have this type*)     (*CCCC-? DO we have this type*)
285             (* | Ty.DynSeqTy ty => false*)             (* | Ty.DynSeqTy ty => false*)
286              | _ => raise Fail(concat["invalid CONS<", Ty.toString ty, ">"])              | _ => raise Fail(concat["invalid CONS<", Ty.toString ty, ">"])
287            (* end case *))            (* end case *))*) false
288    
289    (* 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
290     * order.     * order.
# Line 264  Line 303 
303                (* operations that return matrices may not be supported inline *)                (* operations that return matrices may not be supported inline *)
304                  val (env, t) = doLHS()                  val (env, t) = doLHS()
305                  in                  in
306                    (env, [T.S_Assign([t], exp)])                    (env, [Dst.S_Assign([t], exp)])
307                  end                  end
308    
309    
# Line 273  Line 312 
312            val isVecTy= Target.isVecTy            val isVecTy= Target.isVecTy
313    
314          (*foundVec: Found low-IL vector*)          (*foundVec: Found low-IL vector*)
315           fun foundVec(lhs,rator,n,argsS, argsV,nextfn)= let           fun foundVec(lhs,rator,n,argsS, argsV)= let
316    
317              (*Looks for next largest length supported*)              (*Looks for next largest length supported*)
318              fun fillVec vn =(case (isVecTy vn)              fun fillVec vn =(case (isVecTy vn)
319                  of true => (vn,[vn])                  of true => (true,vn,[vn])
320                  | false => fillVec(vn+1))                  | false => fillVec(vn+1))
321              val (newSize,Pieces)= (case (isVecTy n)              val (aligned,newSize,Pieces)= (case (isVecTy n)
322                  of true=> (n,[n])                  of true=> (false,n,[n])
323                  | false=>(case isHwVec n                  | false=>(case isHwVec n
324                      of false=> (n,(getPieces n))                      of false=> (false,n,(getPieces n))
325                      | true=> fillVec (n+1)                      | true=> fillVec (n+1)
326                      (*end case*))                      (*end case*))
327                  (*end case*))                  (*end case*))
# Line 290  Line 329 
329                  of 1=>(print(String.concat["\n ***********\n ",DstOp.toString(rator n) ,"\n \t =>"]);1)                  of 1=>(print(String.concat["\n ***********\n ",DstOp.toString(rator n) ,"\n \t =>"]);1)
330                  | _=>1)                  | _=>1)
331              in              in
332                  nextfn(lhs,rator,newSize,n,Pieces,argsS,argsV)                  LowOpToTreeOp.creatLd(lhs,rator,newSize,n,Pieces,argsS,argsV,aligned)
333              end              end
334    
335    
336          (* 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 *)
337            fun bindVar (env, x) = (case useVar env x            fun bindVar (env, x) = (case useVar env x
338                   of x' as T.E_State _ => (env, x', [])                   of x' as Dst.E_State _ => (env, x', [])
339                    | x' as T.E_Var _ => (env, x', [])                    | x' as Dst.E_Var _ => (env, x', [])
340                    | e => let                    | e => let
341                        val x' = newLocal x                        val x' = newLocal x
342                        in                        in
343                          (addLocal(env, x'), T.E_Var x', [T.S_Assign([x'], e)])                          (addLocal(env, x'), Dst.E_Var x', [Dst.S_Assign([x'], e)])
344                        end                        end
345                  (* end case *))                  (* end case *))
346    
347            in            in
348              case rhs              case rhs
349               of IL.STATE x => bindSimple (env, lhs, T.E_State(getStateVar x))               of Src.STATE x => bindSimple (env, lhs, Dst.E_State(getStateVar x))
350                | IL.VAR x => bindSimple (env, lhs, useVar env x)                | Src.VAR x => bindSimple (env, lhs, useVar env x)
351                | IL.LIT lit => bindSimple (env, lhs, T.E_Lit lit)                | Src.LIT lit => bindSimple (env, lhs, Dst.E_Lit lit)
352    
353                  (*| IL.OP(Op.Prepend ty, [item, seq]) => let                  (*| Src.OP( SrcOp.Prepend ty, [item, seq]) => let
354                    val (env, t) = doLHS()                    val (env, t) = doLHS()
355                    val (env, item', stms) = bindVar (env, item)                    val (env, item', stms) = bindVar (env, item)
356                    val exp = T.E_Op(Op.Prepend ty, [item', useVar env seq])                    val exp = Dst.E_Op( DstOp.Prepend ty, [item', useVar env seq])
357                    in                    in
358                      (env, T.S_Assign([t], exp) :: stms)                      (env, Dst.S_Assign([t], exp) :: stms)
359                    end                    end
360                | IL.OP(Op.Append ty, [seq, item]) => let                | Src.OP( SrcOpp.Append ty, [seq, item]) => let
361                    val (env, t) = doLHS()                    val (env, t) = doLHS()
362                    val (env, item', stms) = bindVar (env, item)                    val (env, item', stms) = bindVar (env, item)
363                    val exp = T.E_Op(Op.Append ty, [useVar env seq, item'])                    val exp = Dst.E_Op( DstOp.Append ty, [useVar env seq, item'])
364                    in                    in
365                      (env, T.S_Assign([t], exp) :: stms)                      (env, Dst.S_Assign([t], exp) :: stms)
366                    end*)                    end*)
367             (*             (*
368                | IL.OP(Op.LoadImage(ty, nrrd, info), []) => let                | Src.OP( SrcOp.LoadImage(ty, nrrd, info), []) => let
369                    val (env, t) = doLHS()                    val (env, t) = doLHS()
370                    in                    in
371                      (env, [T.S_LoadNrrd(t, ty, nrrd)])                      (env, [Dst.S_LoadNrrd(t, ty, nrrd)])
372                    end*)                    end*)
373                | IL.OP(rator,args) =>let                | Src.OP(rator,args) =>let
374                      (*Target.isHwVec*)                      (*Target.isHwVec*)
375                  val args'=List.map (useVar env) args                  val args'=List.map (useVar env) args
376                  val (env, t) = doLHS()                  val (env, t) = doLHS()
377                  in (case rator                  in (case rator
378                       of SrcOp.addVec n   => (env, foundVec(t,DstOp.addVec,n,[],args',ExpOp.creatLd))                       of SrcOp.addVec n   => (env, foundVec(t,DstOp.addVec,n,[],args'))
379                       | SrcOp.subVec n    => (env, foundVec(t,DstOp.subVec,n,[],args',ExpOp.creatLd))                       | SrcOp.subVec n    => (env, foundVec(t,DstOp.subVec,n,[],args'))
380                       | SrcOp.prodScaV n  => (env, foundVec(t,DstOp.prodScaV ,n, [hd(args')], tl(args'),ExpOp.creatLd))                       | SrcOp.prodScaV n  => (env, foundVec(t,DstOp.prodScaV ,n, [hd(args')], tl(args')))
381                       | SrcOp.prodVec n   => (env, foundVec(t,DstOp.prodVec,n,[],args',ExpOp.creatLd))                       | SrcOp.prodVec n   => (env, foundVec(t,DstOp.prodVec,n,[],args'))
382                       | SrcOp.sumVec n    => (env, foundVec(t,DstOp.sumVec ,n,[],args',ExpOp.creatLd))                       | SrcOp.sumVec n    => (env, foundVec(t,DstOp.sumVec ,n,[],args'))
                      | SrcOp.C c         => (env,[T.S_Assign([t],T.E_Lit(Literal.Int 0))])  
383                       | _ => let                       | _ => let
384                          val Trator = ExpOp.expandOp rator                          val Trator = LowOpToTreeOp.expandOp rator
385                          val exp = T.E_Op(Trator,  args')                          val exp = Dst.E_Op(Trator,  args')
386                          in                          in
387                              if isInlineOp rator then bind (env, lhs, exp)                              if isInlineOp rator then bind (env, lhs, exp)
388                              else assignExp (env, exp)                              else assignExp (env, exp)
# Line 352  Line 390 
390                      (*end case*))                      (*end case*))
391                   end                   end
392    
393                | IL.APPLY(f, args) =>                | Src.APPLY(f, args) =>
394                    bind (env, lhs, T.E_Apply(f, List.map (useVar env) args))                    bind (env, lhs, Dst.E_Apply(f, List.map (useVar env) args))
395                | IL.CONS(ty, args) => let                | Src.CONS(ty, args) => let
396                    val exp = T.E_Cons(ty, List.map (useVar env) args)                    val exp = Dst.E_Cons(ty, List.map (useVar env) args)
397                    in                    in
398                      if isInlineCons ty                      if isInlineCons ty
399                        then bind (env, lhs, exp)                        then bind (env, lhs, exp)
400                        else assignExp (env, exp)                        else assignExp (env, exp)
401                    end                    end
402               | IL.EINAPP _=> raise Fail "EINAPP in Low-IL to Tree-IL"               | Src.EINAPP _=> raise Fail "EINAPP in Low-IL to Tree-IL"
403              (* end case *)              (* end case *)
404            end            end
405    
# Line 373  Line 411 
411      (* 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,
412       * and the else-branch node.       * and the else-branch node.
413       *)       *)
414        = THEN_BR of T.stm list * T.exp * IL.node        = THEN_BR of Dst.stm list * Dst.exp * Src.node
415      (* 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,
416       * 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
417       * a JOIN, DIE, or STABILIZE).       * a JOIN, DIE, or STABILIZE).
418       *)       *)
419        | 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
420    
421    
422        fun mkBlockOrig(Dst.Pink{ locals ,types,opr,body})=Dst.Block{locals=locals ,body=body}
423        fun peelBlockOrig(env,Dst.Pink{ locals ,types,opr,body})=let
424                val env= setEnv(env,types,opr)
425                in
426                    (env,Dst.Block{locals=locals ,body=body})
427                 end
428    
429      fun trCFG (env, prefix, finish, cfg) = let      fun trCFG (env, prefix, finish, cfg) = let
430           val typesAll=ref []  
431           val namesAll=ref []  
432            fun join (env, [], _, IL.JOIN _) = raise Fail "JOIN with no open if"            fun join (env, [], _, Src.JOIN _) = raise Fail "JOIN with no open if"
433              | join (env, [], stms, _) = endScope (env, prefix @ List.rev stms)              | join (env, [], stms, _) = endScope (env, prefix @ List.rev stms)
434              | join (env, THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let              | join (env, THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let
435                  val (env, thenBlk) = flushPending (env, thenBlk)                  val (env, thenBlk) = flushPending (env, thenBlk)
# Line 396  Line 440 
440                  val (env, elseBlk) = flushPending (env, elseBlk)                  val (env, elseBlk) = flushPending (env, elseBlk)
441                  in                  in
442                    case (k1, k2)                    case (k1, k2)
443                     of (IL.JOIN{phis, succ, ...}, IL.JOIN _) => let                     of ( Src.JOIN{phis, succ, ...}, Src.JOIN _) => let
444                          val (env, [thenBlk, elseBlk]) =                          val (env, [thenBlk, elseBlk]) =
445                                List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)                                List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)
446                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
447                          in                          in
448                            doNode (env, stk, stm::stms, !succ)                            doNode (env, stk, stm::stms, !succ)
449                          end                          end
450                      | (IL.JOIN{phis, succ, ...}, _) => let                      | ( Src.JOIN{phis, succ, ...}, _) => let
451                          val (env, [thenBlk]) = List.foldl doPhi (env, [thenBlk]) (!phis)                          val (env, [thenBlk]) = List.foldl doPhi (env, [thenBlk]) (!phis)
452                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
453                          in                          in
454                            doNode (env, stk, stm::stms, !succ)                            doNode (env, stk, stm::stms, !succ)
455                          end                          end
456                      | (_, IL.JOIN{phis, succ, ...}) => let                      | (_, Src.JOIN{phis, succ, ...}) => let
457                          val (env, [elseBlk]) = List.foldl doPhi (env, [elseBlk]) (!phis)                          val (env, [elseBlk]) = List.foldl doPhi (env, [elseBlk]) (!phis)
458                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
459                          in                          in
# Line 420  Line 464 
464                  end                  end
465            and doNode (env, ifStk : open_if list, stms, nd) = (            and doNode (env, ifStk : open_if list, stms, nd) = (
466                  case Nd.kind nd                  case Nd.kind nd
467                   of IL.NULL => raise Fail "unexpected NULL"                   of Src.NULL => raise Fail "unexpected NULL"
468                    | IL.ENTRY{succ} => doNode (env, ifStk, stms, !succ)                    | Src.ENTRY{succ} => doNode (env, ifStk, stms, !succ)
469                    | k as IL.JOIN{phis, succ, ...} => join (env, ifStk, stms, k)                    | k as Src.JOIN{phis, succ, ...} => join (env, ifStk, stms, k)
470                    | IL.COND{cond, trueBranch, falseBranch, ...} => let                    | Src.COND{cond, trueBranch, falseBranch, ...} => let
471                        val cond = useVar env cond                        val cond = useVar env cond
472                        val (env, stms) = flushPending (env, stms)                        val (env, stms) = flushPending (env, stms)
473                        in                        in
474                          doNode (env, THEN_BR(stms, cond, !falseBranch)::ifStk, [], !trueBranch)                          doNode (env, THEN_BR(stms, cond, !falseBranch)::ifStk, [], !trueBranch)
475                        end                        end
476                    | IL.COM {text, succ, ...} =>                    | Src.COM {text, succ, ...} =>
477                        doNode (env, ifStk, T.S_Comment text :: stms, !succ)                        doNode (env, ifStk, Dst.S_Comment text :: stms, !succ)
478                    | IL.ASSIGN{stm, succ, ...} => let                    | Src.ASSIGN{stm, succ, ...} => let
479                        val (env, stms') = doAssign (env, stm)                        val (env, stms') = doAssign (env, stm)
480                          (*Printing out types*)                          (*Printing out types*)
481                          val types=(case testing                          val (typesAll,oprAll)= peelEnv(env)
                                 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))  
482    
483                          val _=List.map TreetoCFN.ExptoCfnPnt stms'                          val t1=(typesAll,oprAll)
484                            val (ty2,opr2)= List.foldr (fn(e1,e2) => gT.getTypesFiltered (e2,e1)) t1 stms'
485                             val env'=setEnv(env, ty2,opr2)
486                        in                        in
487                              doNode (env, ifStk, stms' @ stms, !succ)                              doNode (env', ifStk, stms' @ stms, !succ)
488                        end                        end
489                    | IL.MASSIGN{stm=(ys, rator, xs), succ, ...} => let                    | Src.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
490                        fun doit () = let                        fun doit () = let
491                              fun doLHSVar (y, (env, ys)) = (case peekGlobal(env, y)                              fun doLHSVar (y, (env, ys)) = (case peekGlobal(env, y)
492                                     of SOME y' => (env, y'::ys)                                     of SOME y' => (env, y'::ys)
# Line 458  Line 497 
497                                          end                                          end
498                                    (* end case *))                                    (* end case *))
499                              val (env, ys) = List.foldr doLHSVar (env, []) ys                              val (env, ys) = List.foldr doLHSVar (env, []) ys
500                               val Trator =  ExpOp.expandOp rator                               val Trator =  LowOpToTreeOp.expandOp rator
501                              val exp = T.E_Op(Trator, List.map (useVar env) xs)                              val exp = Dst.E_Op(Trator, List.map (useVar env) xs)
502                              val stm = T.S_Assign(ys, exp)                              val stm = Dst.S_Assign(ys, exp)
503                              in                              in
504                                doNode (env, ifStk, stm :: stms, !succ)                                doNode (env, ifStk, stm :: stms, !succ)
505                              end                              end
506                        in                        in
507                          case rator                          case rator
508                           of Op.Print _ => if Target.supportsPrinting()                           of SrcOp.Print _ => if Target.supportsPrinting()
509                                then doit ()                                then doit ()
510                                else doNode (env, ifStk, stms, !succ)                                else doNode (env, ifStk, stms, !succ)
511                            | _ => doit()                            | _ => doit()
512                          (* end case *)                          (* end case *)
513                        end                        end
514                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"                    | Src.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
515                    | IL.SAVE{lhs, rhs, succ, ...} => let                    | Src.SAVE{lhs, rhs, succ, ...} => let
516                        val stm = T.S_Save([getStateVar lhs], useVar env rhs)                        val stm = Dst.S_Save([getStateVar lhs], useVar env rhs)
517                        in                        in
518                          doNode (env, ifStk, stm::stms, !succ)                          doNode (env, ifStk, stm::stms, !succ)
519                        end                        end
520                    | k as IL.EXIT{kind, live, ...} => (case kind                    | k as Src.EXIT{kind, live, ...} => (case kind
521                         of ExitKind.FRAGMENT =>                         of ExitKind.FRAGMENT =>
522                              endScope (env, prefix @ List.revAppend(stms, finish env))                              endScope (env, prefix @ List.revAppend(stms, finish env))
523                          | ExitKind.SINIT => let                          | ExitKind.SINIT => let
524  (* FIXME: we should probably call flushPending here! *)  (* FIXME: we should probably call flushPending here! *)
525                              val suffix = finish env @ [T.S_Exit[]]                              val suffix = finish env @ [Dst.S_Exit[]]
526                              in                              in
527                                endScope (env, prefix @ List.revAppend(stms, suffix))                                endScope (env, prefix @ List.revAppend(stms, suffix))
528                              end                              end
529                          | ExitKind.RETURN => let                          | ExitKind.RETURN => let
530  (* FIXME: we should probably call flushPending here! *)  (* FIXME: we should probably call flushPending here! *)
531                              val suffix = finish env @ [T.S_Exit(List.map (useVar env) live)]                              val suffix = finish env @ [Dst.S_Exit(List.map (useVar env) live)]
532                              in                              in
533                                endScope (env, prefix @ List.revAppend(stms, suffix))                                endScope (env, prefix @ List.revAppend(stms, suffix))
534                              end                              end
535                          | ExitKind.ACTIVE => let                          | ExitKind.ACTIVE => let
536  (* FIXME: we should probably call flushPending here! *)  (* FIXME: we should probably call flushPending here! *)
537                              val suffix = finish env @ [T.S_Active]                              val suffix = finish env @ [Dst.S_Active]
538                              in                              in
539                                endScope (env, prefix @ List.revAppend(stms, suffix))                                endScope (env, prefix @ List.revAppend(stms, suffix))
540                              end                              end
541                          | ExitKind.STABILIZE => let                          | ExitKind.STABILIZE => let
542  (* FIXME: we should probably call flushPending here! *)  (* FIXME: we should probably call flushPending here! *)
543                              val stms = T.S_Stabilize :: stms                              val stms = Dst.S_Stabilize :: stms
544                              in                              in
545  (* FIXME: we should probably call flushPending here! *)  (* FIXME: we should probably call flushPending here! *)
546                                join (env, ifStk, stms, k)                                join (env, ifStk, stms, k)
547                              end                              end
548                          | ExitKind.DIE => join (env, ifStk, T.S_Die :: stms, k)                          | ExitKind.DIE => join (env, ifStk, Dst.S_Die :: stms, k)
549                        (* end case *))                        (* end case *))
550                  (* end case *))                  (* end case *))
551    
552            val Y=doNode (env, [], [], CFG.entry cfg)            val Y=doNode (env, [], [], CFG.entry cfg)
553            val _=gT.gotFiltered(!typesAll)  
           val _=fnNames.gotFiltered(!namesAll)  
554            in Y            in Y
555            end            end
556    
557      fun trInitially (env, IL.Initially{isArray, rangeInit, iters, create=(createInit, strand, args)}) =      fun trInitially (env, Src.Initially{isArray, rangeInit, iters, create=(createInit, strand, args)}) =
558            let            let
559            val iterPrefix = trCFG (env, [], fn _ => [], rangeInit)            val iterPrefix = mkBlockOrig(trCFG (env, [], fn _ => [], rangeInit))
560            fun cvtIter ((param, lo, hi), (env, iters)) = let            fun cvtIter ((param, lo, hi), (env, iters)) = let
561                  val param' = newIter param                  val param' = newIter param
562                  val env = rename (env, param, param')                  val env = rename (env, param, param')
# Line 526  Line 564 
564                    (env, (param', useVar env lo, useVar env hi)::iters)                    (env, (param', useVar env lo, useVar env hi)::iters)
565                  end                  end
566            val (env, iters) = List.foldr cvtIter (env, []) iters            val (env, iters) = List.foldr cvtIter (env, []) iters
567            val createPrefix = trCFG (env, [], fn _ => [], createInit)            val (env,createPrefix) = peelBlockOrig(env,trCFG (env, [], fn _ => [], createInit))
568            in {            in (env,{
569              isArray = isArray,              isArray = isArray,
570              iterPrefix = iterPrefix,              iterPrefix = iterPrefix,
571              iters = iters,              iters = iters,
572              createPrefix = createPrefix,              createPrefix = createPrefix,
573              strand = strand,              strand = strand,
574              args = List.map (useVar env) args              args = List.map (useVar env) args
575            } end            }) end
576    
577      fun trMethod env (IL.Method{name, body}) = T.Method{      fun trMethod env ( Src.Method{name, body}) = Dst.Method{
578              name = name,              name = name,
579              body = trCFG (env, [], fn _ => [], body)              body = mkBlockOrig(trCFG (env, [], fn _ => [], body))
580            }            }
581    
582      fun trStrand globalEnv (IL.Strand{name, params, state, stateInit, methods}) = let  
583            fun trStrand(globalEnv, [],rest)=(globalEnv,rest)
584              | trStrand(globalEnv ,( Src.Strand{name, params, state, stateInit, methods})::es,rest) = let
585            val params' = List.map newParam params            val params' = List.map newParam params
586            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')
587            in                  val (env',sInit) = peelBlockOrig(env,trCFG (env, [], fn _ => [], stateInit))
588              T.Strand{  
589                    val strand'=Dst.Strand{
590                  name = name,                  name = name,
591                  params = params',                  params = params',
592                  state = List.map getStateVar state,                  state = List.map getStateVar state,
593                  stateInit = trCFG (env, [], fn _ => [], stateInit),                      stateInit =sInit,
594                  methods = List.map (trMethod env) methods                  methods = List.map (trMethod env) methods
595                }                }
596                    in trStrand(env', es, rest@[strand'])
597            end            end
598    
599    
600    
601    (* 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
602     * the global initialization.     * the global initialization.
603     *)     *)
604      fun splitGlobalInit globalInit = let      fun splitGlobalInit globalInit = let
605  (* FIXME: can split as soon as we see a non-Input statement! *)  (* FIXME: can split as soon as we see a non-Input statement! *)
606            fun walk (nd, lastInput, live) = (case Nd.kind nd            fun walk (nd, lastInput, live) = (case Nd.kind nd
607                   of IL.ENTRY{succ} => walk (!succ, lastInput, live)                   of Src.ENTRY{succ} => walk (!succ, lastInput, live)
608                    | IL.COM{succ, ...} => walk (!succ, lastInput, live)                    | Src.COM{succ, ...} => walk (!succ, lastInput, live)
609                    | IL.ASSIGN{stm=(lhs, rhs), succ, ...} => (case rhs                    | Src.ASSIGN{stm=(lhs, rhs), succ, ...} => (case rhs
610                         of IL.OP(Op.Input _, _) => walk (!succ, nd, lhs::live)                         of Src.OP(SrcOp.Input _, _) => walk (!succ, nd, lhs::live)
611                          | _ => walk (!succ, lastInput, live)                          | _ => walk (!succ, lastInput, live)
612                        (* end case *))                        (* end case *))
613                    | _ => if Nd.isNULL lastInput                    | _ => if Nd.isNULL lastInput
# Line 572  Line 616 
616                          val exit = Nd.mkEXIT(ExitKind.RETURN, [])                          val exit = Nd.mkEXIT(ExitKind.RETURN, [])
617                          in                          in
618                            Nd.addEdge (entry, exit);                            Nd.addEdge (entry, exit);
619                            {inputInit = IL.CFG{entry=entry, exit=exit}, globalInit = globalInit}                            {inputInit = Src.CFG{entry=entry, exit=exit}, globalInit = globalInit}
620                          end                          end
621                        else let (* split at lastInput *)                        else let (* split at lastInput *)
622                          val inputExit = Nd.mkEXIT(ExitKind.RETURN, live)                          val inputExit = Nd.mkEXIT(ExitKind.RETURN, live)
# Line 582  Line 626 
626                            Nd.replaceInEdge {src = lastInput, oldDst = gFirst, dst = inputExit};                            Nd.replaceInEdge {src = lastInput, oldDst = gFirst, dst = inputExit};
627                            Nd.replaceOutEdge {oldSrc = lastInput, src = globalEntry, dst = gFirst};                            Nd.replaceOutEdge {oldSrc = lastInput, src = globalEntry, dst = gFirst};
628                            {                            {
629                              inputInit = IL.CFG{entry = IL.CFG.entry globalInit, exit = inputExit},                              inputInit = Src.CFG{entry = Src.CFG.entry globalInit, exit = inputExit},
630                              globalInit = IL.CFG{entry = globalEntry, exit = IL.CFG.exit globalInit}                              globalInit = Src.CFG{entry = globalEntry, exit = Src.CFG.exit globalInit}
631                            }                            }
632                          end                          end
633                  (* end case *))                  (* end case *))
634    
635            in            in
636              walk (IL.CFG.entry globalInit, Nd.dummy, [])              walk ( Src.CFG.entry globalInit, Nd.dummy, [])
637              end
638        fun getInfo(env,Init)=let
639            val inputInit' = trCFG (env, [], fn _ => [], Init)
640            in
641                peelBlockOrig(env,inputInit')
642            end            end
643    
644      fun translate prog = let      fun translate prog = let
645          (* first we do a variable analysis pass on the Low IL *)          (* first we do a variable analysis pass on the Low IL *)
646            val prog as IL.Program{props, globalInit, initially, strands} = VA.optimize prog            val prog as Src.Program{props, globalInit, initially, strands} = VA.optimize prog
647  (* 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 *)
648            val _ = (* DEBUG *)            val _ = (* DEBUG *)
649                  LowPP.output (Log.logFile(), "LowIL after variable analysis", prog)                  LowPP.output (Log.logFile(), "LowIL after variable analysis", prog)
650            val env = newEnv()            val envOrig = newEnv()
651            val globals =List.map            val globals =List.map
652                  (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)
653                    (IL.CFG.liveAtExit globalInit)                    ( Src.CFG.liveAtExit globalInit)
654            val {inputInit, globalInit} = splitGlobalInit globalInit            val {inputInit, globalInit} = splitGlobalInit globalInit
           val strands = List.map (trStrand env) strands  
655    
656            val HH=            val (env,inputInit)=getInfo(envOrig,inputInit)
657              T.Program{            val (env,globalInit)=getInfo(env, globalInit)
658              val (env,strands) = trStrand (env, strands,[])
659              val (env, initially) = trInitially (env, initially)
660    
661              val (typs,opr)= peelEnv(env)
662              val typsList=TySet.listItems(typs);
663              val oprList=OprSet.listItems(opr);
664              val _=print(gT.prnTyFinal(typsList,oprList,"--FinalPostStrands--"))
665    
666              in  Dst.Program{
667                  props = props,                  props = props,
668                      types=typsList,
669                      oprations = oprList,
670                  globals = globals,                  globals = globals,
671                  inputInit = trCFG (env, [], fn _ => [], inputInit),                    inputInit = inputInit,
672                  globalInit = trCFG (env, [], fn _ => [], globalInit),                    globalInit = globalInit,
673                  strands = strands,                  strands = strands,
674                  initially = trInitially (env, initially)                    initially = initially
675                }                }
                 in (print "\n \t ---------------- Target Code --------------\n";HH)  
676            end            end
677    
678    end    end

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

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