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

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

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