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

SCM Repository

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

Diff of /branches/vis15/src/compiler/low-to-tree/low-to-tree.sml

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

revision 3835, Sun May 8 13:10:17 2016 UTC revision 3862, Sun May 15 15:44:30 2016 UTC
# Line 8  Line 8 
8    
9  structure LowToTree : sig  structure LowToTree : sig
10    
11      val translate : LowIR.program * TreeTypes.vec_layout -> TreeIR.program      val translate : LowIR.program * TreeIR.target_info -> TreeIR.program
12    
13    end = struct    end = struct
14    
# Line 25  Line 25 
25      structure TGV = TreeGlobalVar      structure TGV = TreeGlobalVar
26      structure TSV = TreeStateVar      structure TSV = TreeStateVar
27    
   (* translate a type for an in-memory type (i.e., the type of a global or state variable) *)  
     fun trMemoryTy ty = (case ty  
            of Ty.BoolTy => TTy.BoolTy  
             | Ty.IntTy => TTy.IntTy  
             | Ty.StringTy => TTy.StringTy  
             | Ty.TensorTy dd => TTy.TensorTy dd  
             | Ty.TupleTy tys => TTy.TupleTy(List.map trMemoryTy tys)  
             | Ty.SeqTy(ty, dim) => TTy.SeqTy(trMemoryTy ty, dim)  
             | Ty.ImageTy info => TTy.ImageTy info  
           (* end case *))  
   
28    (* associate Tree IL globals variables with Low IL variables using properties *)    (* associate Tree IL globals variables with Low IL variables using properties *)
29      local      local
30        val {setFn, peekFn, ...} =        val {setFn, peekFn, ...} =
# Line 45  Line 34 
34               of NONE => let               of NONE => let
35                      val x' = TGV.new {                      val x' = TGV.new {
36                              name = GV.name x,                              name = GV.name x,
37                              ty = trMemoryTy (GV.ty x),                              ty = Util.trType (GV.ty x),
38                              input = GV.isInput x,                              input = GV.isInput x,
39                              output = false, (* FIXME: change once we support output globals *)                              output = false, (* FIXME: change once we support output globals *)
40                              varying = ??,                              varying = GV.isVarying x,
41                              apiTy = ??                              apiTy = if GV.isInput x
42                                  then SOME(Util.toAPIType (GV.ty x))
43                                  else NONE
44                            }                            }
45                      in                      in
46                        setFn (x, x');                        setFn (x, x');
# Line 63  Line 54 
54      local      local
55        fun mkStateVar x = TSV.new {        fun mkStateVar x = TSV.new {
56                name = SV.name x,                name = SV.name x,
57                ty = trMemoryTy (SV.ty x),                ty = Util.trType (SV.ty x),
58                varying = VA.isVarying x,                varying = SV.isVarying x,
59                apiTy = ??                apiTy = if (SV.isOutput x)
60                    then SOME(Util.toAPIType (SV.ty x))
61                    else NONE
62              }              }
63      in      in
64      val {getFn = getStateVar, ...} = SV.newProp mkStateVar      val {getFn = getStateVar, ...} = SV.newProp mkStateVar
65      end      end
66    
67      fun mkBlock stms = T.Block{locals=[], body=stms}    (* for variables that are in an equivalence class (see UnifyVars), we use a single
68       * TreeIR variable (or vector of variables) to represent them.
69       *)
70        datatype eq_var_rep = NOEQ | VAR of TV.t | VEC of TV.t list
71        local
72          val {peekFn : IR.var -> eq_var_rep option, setFn, ...} =
73                V.newProp (fn x => raise Fail(V.toString x))
74    
75          fun repOf (env, x, x') = (case peekFn x'
76                 of SOME b => b
77                  | NONE => let
78                      val rep = (case V.ty x
79                             of Ty.TensorTy[d] => VEC(Util.newVectorVars(Env.layoutVec env d))
80                              | ty => VAR(Util.newLocalVar x)
81                            (* end case *))
82                      in
83                        setFn (x, rep);
84                        rep
85                      end
86                (* end case *))
87        in
88    
89        fun eqClassRepOf (env, x) = (case UnifyVars.eqClassOf x
90               of SOME x' => repOf (env, x, x')
91                | NONE => NOEQ
92              (* end case *))
93    
94        fun useVar env = let
95              val useV = Env.useVar env
96              in
97                fn x => (case UnifyVars.eqClassOf x
98                      of SOME x' => (case repOf (env, x, x')
99                           of VAR x => Env.TREE(T.E_Var x)
100                            | VEC xs => let
101                                val Ty.TensorTy[d] = V.ty x
102                                in
103                                  Env.VEC(Env.layoutVec env d, List.map T.E_Var xs)
104                                end
105                            | NOEQ => raise Fail "impossible"
106                          (* end case *))
107                       | NONE => useV x
108                     (* end case *))
109              end
110        end
111    
112        fun mkBlock stms = T.Block{locals = ref [], body = stms}
113      fun mkIf (x, stms, []) = T.S_IfThen(x, mkBlock stms)      fun mkIf (x, stms, []) = T.S_IfThen(x, mkBlock stms)
114        | mkIf (x, stms1, stms2) = T.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)        | mkIf (x, stms1, stms2) = T.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)
115        fun mkAssign (x, e) = T.S_Assign(false, x, e)
116        fun mkDefn (x, e) = T.S_Assign(true, x, e)
117    
118      fun cvtScalarTy Ty.BoolTy = TTy.BoolTy      fun cvtScalarTy Ty.BoolTy = TTy.BoolTy
119        | cvtScalarTy Ty.IntTy = TTy.IntTy        | cvtScalarTy Ty.IntTy = TTy.IntTy
120        | cvtScalarTy (Ty.TensorTy[]) = TTy.realTy        | cvtScalarTy (Ty.TensorTy[]) = TTy.realTy
121        | cvtScalarTy ty = raise Fail(concat["cvtScalarTy(", Ty.toString ty, ")"])        | cvtScalarTy ty = raise Fail(concat["cvtScalarTy(", Ty.toString ty, ")"])
122    
123      fun vectorArg (env, x) = (case Env.useVar env x    (* define a new local variable and bind x to it. *)
124             of Env.TREE(ty, e) => ?? (* need to unpack e *)      fun newLocal (env, x) = let
125              val x' = Util.newLocalVar x
126              in
127                Env.bindSimple (env, x, Env.TREE(T.E_Var x'));
128                x'
129              end
130    
131      (* get a variable's binding as a single argument expression.  This means that
132       * if x is bound to a vector of expressions, then we need to pack it.
133       *)
134        fun singleArg env x = (case useVar env x
135               of Env.TREE e => e
136                | Env.VEC(layout, es) => T.E_Pack(layout, es)
137              (* end case *))
138    
139        fun scalarArg env x = (case useVar env x
140               of Env.TREE e => e
141                | _ => raise Fail("expected scalar binding for " ^ IR.Var.toString x)
142              (* end case *))
143    
144        fun vectorArg (env, x) = (case useVar env x
145               of Env.TREE e => (case V.ty x
146                     of Ty.TensorTy[d] => let
147                          val layout = Env.layoutVec env d
148    (* QUESTION: can "e" be a complicated expression or are we guaranteed that it will just
149     * be a memory reference?
150     *)
151                          val es = List.tabulate (
152                                List.length(#pieces layout),
153                                fn i => T.E_VLoad(layout, e, i))
154                          in
155                            (layout, es)
156                          end
157                      | ty => raise Fail(concat[
158                            "expected ", V.toString x, " : TensorTy[_], but found " ^ Ty.toString ty
159                          ])
160                    (* end case *))
161              | Env.VEC(layout, es) => (layout, es)              | Env.VEC(layout, es) => (layout, es)
162            (* end case *))            (* end case *))
163    
# Line 96  Line 172 
172                  in                  in
173                    ListPair.mapEq (op ::) (exps, argLists)                    ListPair.mapEq (op ::) (exps, argLists)
174                  end                  end
175            val argLists = List.foldl doArg exps xs            val argLists = List.foldl doArg [exps] xs
176            in            in
177              (layout, List.map List.rev argLists)              (layout, List.map List.rev argLists)
178            end            end
179    
180      fun trOp (env, lhs, srcRator, args) = let      fun trOp (env, srcRator, args) = let
181            fun bindOp rator = Env.TREE(T.E_Op(rator, List.map (Env.useVar env) args))            fun bindOp rator = Env.TREE(T.E_Op(rator, List.map (scalarArg env) args))
182            fun bindVOp rator = let            fun bindVOp rator = let
183                  val (layout, argss) = vectorArgs (env, args)                  val (layout, argss) = vectorArgs (env, args)
184                  val exps = ListPair.map                  val exps = ListPair.map
# Line 119  Line 195 
195                | Op.IDiv => bindOp TOp.IDiv                | Op.IDiv => bindOp TOp.IDiv
196                | Op.IMod => bindOp TOp.IMod                | Op.IMod => bindOp TOp.IMod
197                | Op.INeg => bindOp TOp.INeg                | Op.INeg => bindOp TOp.INeg
198    (* QUESTION: should we just use VAdd 1, etc ?*)
199                | Op.RAdd => bindOp TOp.RAdd                | Op.RAdd => bindOp TOp.RAdd
200                | Op.RSub => bindOp TOp.RSub                | Op.RSub => bindOp TOp.RSub
201                | Op.RMul => bindOp TOp.RMul                | Op.RMul => bindOp TOp.RMul
# Line 138  Line 215 
215                | Op.RLerp => bindOp TOp.RLerp                | Op.RLerp => bindOp TOp.RLerp
216                | Op.VAdd _ => bindVOp TOp.VAdd                | Op.VAdd _ => bindVOp TOp.VAdd
217                | Op.VSub _ => bindVOp TOp.VSub                | Op.VSub _ => bindVOp TOp.VSub
218                | Op.VScale _ => bindVOp TOp.VScale                | Op.VScale _ => let
219                      val [s, v] = args
220                      val s = scalarArg env s
221                      val (layout, vs) = vectorArg (env, v)
222                      val exps = ListPair.map
223                          (fn (w, x) => T.E_Op(TOp.VScale w, [s, x]))
224                            (#pieces layout, vs)
225                      in
226                        Env.VEC(layout, exps)
227                      end
228                | Op.VMul _ => bindVOp TOp.VMul                | Op.VMul _ => bindVOp TOp.VMul
229                | Op.VNeg _ => bindVOp TOp.VNeg                | Op.VNeg _ => bindVOp TOp.VNeg
230                | Op.VSum _ => ??                | Op.VSum _ => let
231                | Op.VProj(d, i) => ??                    val [v] = args
232                | Op.VClamp n => bindVOp TOp.VClamp                    val ({pieces, ...}, es) = vectorArg (env, v)
233                      val e::es = ListPair.map (fn (w, v) => T.E_Op(TOp.VSum w, [v])) (pieces, es)
234                      in
235                        Env.TREE(List.foldr (fn (e, es) => T.E_Op(TOp.RAdd, [e, es])) e es)
236                      end
237                  | Op.VIndex(_, i) => let
238                      val [v] = args
239    (* FIXME: more efficient to lookup the variable and avoid expanding TREE args *)
240                      val ({pieces, ...}, es) = vectorArg (env, v)
241                      fun select (i, w::ws, e::es) =
242                            if (i < w)
243                              then Env.TREE(T.E_Op(TOp.VIndex(w, i), [e]))
244                              else select (i-w, ws, es)
245                        | select _ = raise Fail("bogus " ^ Op.toString srcRator)
246                      in
247                        select (i, pieces, es)
248                      end
249                  | Op.VClamp n => let
250                      val [v, lo, hi] = args
251                      val (layout, vs) = vectorArg (env, v)
252                      val lo = scalarArg env lo
253                      val hi = scalarArg env hi
254                      val exps = ListPair.map
255                          (fn (w, x) => T.E_Op(TOp.VClamp w, [x, lo, hi]))
256                            (#pieces layout, vs)
257                      in
258                        Env.VEC(layout, exps)
259                      end
260                | Op.VMapClamp n => bindVOp TOp.VMapClamp                | Op.VMapClamp n => bindVOp TOp.VMapClamp
261                | Op.VLerp n => bindVOp TOp.VLerp                | Op.VLerp n => bindVOp TOp.VLerp
262                | Op.TensorIndex(ty, idxs) => ??                | Op.TensorIndex(ty, idxs) => bindOp(TOp.TensorIndex(Util.trType ty, idxs))
263                | Op.ProjectLast(ty, idxs) => ??                | Op.ProjectLast(ty, idxs) => bindOp(TOp.ProjectLast(Util.trType ty, idxs))
264                | Op.EigenVecs2x2 => ??                | Op.Zero ty => bindOp (TOp.Zero(Util.trType ty))
265                | Op.EigenVecs3x3 => ??                | Op.Select(ty, i) => bindOp (TOp.Select(Util.trType ty, i))
266                | Op.EigenVals2x2 => ??                | Op.Subscript ty => bindOp (TOp.Subscript(Util.trType ty))
267                | Op.EigenVals3x3 => ??                | Op.MkDynamic(ty, n) => bindOp (TOp.MkDynamic(Util.trType ty, n))
268                | Op.Zero ty => ??                | Op.Append ty => bindOp (TOp.Append(Util.trType ty))
269                | Op.Select(Ty.TupleTy tys, i) => ??                | Op.Prepend ty => bindOp (TOp.Prepend(Util.trType ty))
270                | Op.Subscript(Ty.SeqTy(ty, NONE)) => ??                | Op.Concat ty => bindOp (TOp.Concat(Util.trType ty))
271                | Op.Subscript(Ty.SeqTy(ty, SOME _)) => ??                | Op.Range => bindOp TOp.Range
272                | Op.MkDynamic(ty, n) => ??                | Op.Length ty => bindOp (TOp.Length(Util.trType ty))
273                | Op.Append ty => ??                | Op.SphereQuery(ty1, ty2) => raise Fail "FIXME: SphereQuery"
               | Op.Prepend ty => ??  
               | Op.Concat ty => ??  
               | Op.Range => ??  
               | Op.Length ty => ??  
               | Op.SphereQuery(ty1, ty2) => ??  
274                | Op.Sqrt => bindOp TOp.Sqrt                | Op.Sqrt => bindOp TOp.Sqrt
275                | Op.Cos => bindOp TOp.Cos                | Op.Cos => bindOp TOp.Cos
276                | Op.ArcCos => bindOp TOp.ArcCos                | Op.ArcCos => bindOp TOp.ArcCos
# Line 171  Line 279 
279                | Op.Tan => bindOp TOp.Tan                | Op.Tan => bindOp TOp.Tan
280                | Op.ArcTan => bindOp TOp.ArcTan                | Op.ArcTan => bindOp TOp.ArcTan
281                | Op.Ceiling 1 => bindOp (TOp.Ceiling 1)                | Op.Ceiling 1 => bindOp (TOp.Ceiling 1)
282                | Op.Ceiling d => ??                | Op.Ceiling d => bindVOp TOp.Ceiling
283                | Op.Floor 1 => bindOp (TOp.Floor 1)                | Op.Floor 1 => bindOp (TOp.Floor 1)
284                | Op.Floor d => ??                | Op.Floor d => bindVOp TOp.Floor
285                | Op.Round 1 => bindOp (TOp.Floor 1)                | Op.Round 1 => bindOp (TOp.Round 1)
286                | Op.Round d => ??                | Op.Round d => bindVOp TOp.Round
287                | Op.Trunc 1 => bindOp (TOp.Trunc 1)                | Op.Trunc 1 => bindOp (TOp.Trunc 1)
288                | Op.Trunc d => ??                | Op.Trunc d => bindVOp TOp.Trunc
289                | Op.IntToReal => bindOp TOp.IntToReal                | Op.IntToReal => bindOp TOp.IntToReal
290                | Op.RealToInt 1 => ??                | Op.RealToInt 1 => bindOp (TOp.RealToInt 1)
291                | Op.RealToInt d => ??                | Op.RealToInt d => Env.TREE(T.E_Op(TOp.RealToInt d, List.map (singleArg env) args))
292    (* FIXME
293                | Op.R_All ty => ??                | Op.R_All ty => ??
294                | Op.R_Exists ty => ??                | Op.R_Exists ty => ??
295                | Op.R_Max ty => ??                | Op.R_Max ty => ??
# Line 189  Line 298 
298                | Op.R_Product ty => ??                | Op.R_Product ty => ??
299                | Op.R_Mean ty => ??                | Op.R_Mean ty => ??
300                | Op.R_Variance ty => ??                | Op.R_Variance ty => ??
301                | Op.Transform info => ??  *)
302                | Op.Translate info => ??                | Op.Transform info => bindOp (TOp.Transform info)
303                | Op.ControlIndex(info, ctl, d) => ??                | Op.Translate info => bindOp (TOp.Translate info)
304                | Op.LoadVoxel info => ??                | Op.ControlIndex(info, ctl, d) => bindOp (TOp.ControlIndex(info, ctl, d))
305                | Op.Inside(info, s) => ??                | Op.LoadVoxel info => bindOp (TOp.LoadVoxel info)
306                  | Op.Inside(info, s) => bindOp (TOp.Inside(info, s))
307                | Op.ImageDim(info, d) => bindOp(TOp.ImageDim(info, d))                | Op.ImageDim(info, d) => bindOp(TOp.ImageDim(info, d))
308                | Op.LoadSeq(ty, file) => ??                | Op.LoadSeq(ty, file) => bindOp(TOp.LoadSeq(Util.trType ty, file))
309                | Op.LoadImage(ty, file) => ??                | Op.LoadImage(ty, file) => bindOp(TOp.LoadImage(Util.trType ty, file))
310                | Op.MathFn f => bindOp (TOp.MathFn f)                | Op.MathFn f => bindOp (TOp.MathFn f)
311                | rator => raise Fail("bogus operator " ^ Op.toString rator)                | rator => raise Fail("bogus operator " ^ Op.toString srcRator)
312              (* end case *)              (* end case *)
313            end            end
314    
315    (* cases:
316            x in EqClass
317                    issue assignment; lhs is binding of representative (could be multiple vars)
318            useCount(x) > 1 and rhs is not simple
319            rhs is simple
320            rhs is vector
321    *)
322      fun trAssign (env, lhs, rhs) = let      fun trAssign (env, lhs, rhs) = let
323            (* simple binding for lhs variable; we check to see if it is part of an merged
324             * equivalence class, in which case we need to generate the assigment.
325             *)
326              fun bindSimple rhs = (case eqClassRepOf(env, lhs)
327                     of NOEQ => (Env.bindSimple (env, lhs, Env.TREE rhs); [])
328                      | VAR x' => [mkAssign(x', rhs)]
329                      | VEC _ => raise Fail "unexpected VEC"
330                    (* end case *))
331              fun assignOp (rator, args) = (case eqClassRepOf(env, lhs)
332                     of NOEQ =>
333                          [mkDefn(newLocal (env, lhs), T.E_Op(rator, List.map (scalarArg env) args))]
334                      | VAR x' => [mkAssign(x', T.E_Op(rator, List.map (scalarArg env) args))]
335                      | VEC _ => raise Fail "unexpected VEC"
336                    (* end case *))
337            in            in
338              case rhs              case rhs
339               of IR.GLOBAL x => ??               of IR.GLOBAL x => bindSimple (T.E_Global(mkGlobalVar x))
340                | IR.STATE x => ??                | IR.STATE(NONE, fld) =>
341                | IR.VAR x => ??                    bindSimple (T.E_State(NONE, getStateVar fld))
342                | IR.LIT lit => ??                | IR.STATE(SOME x, fld) =>
343                | IR.OP(rator, args) => ??                    bindSimple (T.E_State(SOME(scalarArg env x), getStateVar fld))
344                | IR.CONS(args, ty) => ??                | IR.VAR x => raise Fail "FIXME: VAR"
345                | IR.SEQ(args, ty) => ??                | IR.LIT lit => bindSimple (T.E_Lit lit)
346                | IR.EINAPP _ => raise Fail "unexpected EINAPP in LowIR code"                | IR.OP(Op.EigenVecs2x2, args) => assignOp (TOp.EigenVecs2x2, args)
347                  | IR.OP(Op.EigenVecs3x3, args) => assignOp (TOp.EigenVecs3x3, args)
348                  | IR.OP(Op.EigenVals2x2, args) => assignOp (TOp.EigenVals2x2, args)
349                  | IR.OP(Op.EigenVals3x3, args) => assignOp (TOp.EigenVals3x3, args)
350                  | IR.OP(rator, args) => let
351                      val rhs = trOp (env, rator, args)
352                      val needAssignment = (V.useCount lhs > 1) orelse (Env.isInlineOp env rator)
353                      in
354                        case (rhs, eqClassRepOf(env, lhs), needAssignment)
355                         of (_, NOEQ, false) => (Env.bindSimple (env, lhs, rhs); [])
356                          | (Env.TREE e, NOEQ, true) => [mkDefn(newLocal(env, lhs), e)]
357                          | (Env.TREE e, VAR x', _) => [mkAssign(x', e)]
358                          | (Env.VEC(layout, es), NOEQ, true) => let
359                              val vs = Util.newVectorVars layout
360                              in
361                                Env.bindSimple (env, lhs, Env.VEC(layout, List.map T.E_Var vs));
362                                ListPair.mapEq mkDefn (vs, es)
363                              end
364                          | (Env.VEC(layout, es), VEC xs, _) => ListPair.mapEq mkAssign (xs, es)
365                          | _ => raise Fail "inconsistent"
366                        (* end case *)
367                      end
368                  | IR.CONS(args, Ty.TensorTy[d]) => let
369                      val layout = Env.layoutVec env d
370                      fun mkVecs (args, w::ws) = let
371                          (* take arguments from args to build a vector value of width w; pad as
372                           * necessary.
373                           *)
374                            fun take (0, args, es) = T.E_Vec(w, List.rev es) :: mkVecs (args, ws)
375                              | take (i, [], es) = if #padded layout andalso null ws
376                                  then [T.E_Vec(w, List.rev es)]
377                                  else raise Fail "too few arguments for CONS"
378                              | take (i, arg::args, es) = take (i-1, args, scalarArg env arg :: es)
379                            in
380                              take (w, args, [])
381                            end
382                        | mkVecs ([], []) = []
383                        | mkVecs (_, []) = raise Fail "too many arguments for CONS"
384                      val es = mkVecs (args, #pieces layout)
385                      in
386                        case (eqClassRepOf(env, lhs), V.useCount lhs > 1)
387                         of (NOEQ, false) => (Env.bindVar(env, lhs, Env.VEC(layout, es)); [])
388                          | (NOEQ, true) => let
389                              val vs = Util.newVectorVars layout
390                              in
391                                Env.bindSimple (env, lhs, Env.VEC(layout, List.map T.E_Var vs));
392                                ListPair.mapEq mkDefn (vs, es)
393                              end
394                          | (VEC xs, _) => ListPair.mapEq mkAssign (xs, es)
395                          | _ => raise Fail "inconsistent"
396              (* end case *)              (* end case *)
397            end            end
398                  | IR.CONS(args, ty) => [
399                        mkDefn (
400                          newLocal(env, lhs),
401                          T.E_Cons(List.map (singleArg env) args, Util.trType ty))
402                      ]
403                  | IR.SEQ(args, ty) => [
404                        mkDefn (
405                          newLocal(env, lhs),
406                          T.E_Seq(List.map (singleArg env) args, Util.trType ty))
407                      ]
408                  | rhs => raise Fail(concat["unexpected ", IR.RHS.toString rhs, " in LowIR code"])
409                (* end case *)
410              end
411    handle ex => (
412    print(concat["trAssign: ", V.toString lhs, " = ", IR.RHS.toString rhs, "\n"]);
413    raise ex)
414    
415    (* In order to reconstruct the block-structure from the CFG, we keep a stack of open ifs.    (* In order to reconstruct the block-structure from the CFG, we keep a stack of open ifs.
416     * the items on this stack distinguish between when we are processing the then and else     * the items on this stack distinguish between when we are processing the then and else
# Line 231  Line 427 
427       *)       *)
428        | ELSE_BR of T.stm list * T.exp * T.stm list * IR.node_kind        | ELSE_BR of T.stm list * T.exp * T.stm list * IR.node_kind
429    
430      fun trCFGWithEnv (env, prefix, cfg) = let      fun trCFGWithEnv (env, cfg) = let
431            fun useScalar x = (case Env.useVar env x            fun useScalar x = (case useVar env x
432                   of Env.TREE e => e                   of Env.TREE e => e
433                    | _ => raise Fail("expected scalar binding for " ^ V.toString x)                    | _ => raise Fail("expected scalar binding for " ^ V.toString x)
434                  (* end case *))                  (* end case *))
435            val _ = UnifyVars.analyze cfg            val _ = UnifyVars.analyze cfg
436          (* join (env, stk, stms, k): handle a control-flow join, where env is the          (* join (stk, stms, k): handle a control-flow join, where env is the
437           * current environment, stk is the stack of open ifs (the top of stk specifies           * current environment, stk is the stack of open ifs (the top of stk specifies
438           * which branch we are in), stms are the TreeIL statements preceding the join           * which branch we are in), stms are the TreeIL statements preceding the join
439           * on the current path, and k is the kind of the join node (either JOIN or EXIT).           * on the current path, and k is the kind of the join node (either JOIN or EXIT).
440           *)           *)
441            fun join (env, [], _, IR.JOIN _) = raise Fail "JOIN with no open if"            fun join ([], _, IR.JOIN _) = raise Fail "JOIN with no open if"
442              | join (env, [], stms, _) = Env.endScope (env, prefix @ List.rev stms)              | join ([], stms, _) = mkBlock (List.rev stms)
443              | join (env, THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let              | join (THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let
444                  val (env, thenBlk) = flushPending (env, thenBlk)                  val thenBlk = Env.flushPending (env, thenBlk)
445                  in                  in
446                    doNode (env, elseBr, ELSE_BR(stms1, cond, thenBlk, k)::stk, [])                    doNode (elseBr, ELSE_BR(stms1, cond, thenBlk, k)::stk, [])
447                  end                  end
448              | join (env, ELSE_BR(stms, cond, thenBlk, k1)::stk, elseBlk, k2) = let              | join (ELSE_BR(stms, cond, thenBlk, k1)::stk, elseBlk, k2) = let
449                  val (env, elseBlk) = Env.flushPending (env, elseBlk)                  val elseBlk = Env.flushPending (env, elseBlk)
450                  in                  in
451                    case (k1, k2)                    case (k1, k2)
452                     of (IR.JOIN{phis, succ, ...}, IR.JOIN _) => let                     of (IR.JOIN{succ, ...}, IR.JOIN _) => let
                         val (env, [thenBlk, elseBlk]) =  
                               List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)  
453                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
454                          in                          in
455                            doNode (env, !succ, stk, stm::stms)                            doNode (!succ, stk, stm::stms)
456                          end                          end
457                      | (IR.JOIN{phis, succ, ...}, _) => let                      | (IR.JOIN{succ, ...}, _) => let
                         val (env, [thenBlk]) = List.foldl doPhi (env, [thenBlk]) (!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
460                            doNode (env, !succ, stk, stm::stms)                            doNode (!succ, stk, stm::stms)
461                          end                          end
462                      | (_, IR.JOIN{phis, succ, ...}) => let                      | (_, IR.JOIN{succ, ...}) => let
                         val (env, [elseBlk]) = List.foldl doPhi (env, [elseBlk]) (!phis)  
463                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
464                          in                          in
465                            doNode (env, !succ, stk, stm::stms)                            doNode (!succ, stk, stm::stms)
466                          end                          end
467                      | (_, _) => let                      | (_, _) => let
468                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
469                          in                          in
470                            Env.endScope (env, prefix @ List.rev(stm::stms))                            mkBlock (List.rev(stm::stms))
471                          end                          end
472                    (* end case *)                    (* end case *)
473                  end                  end
474            and doNode (env, nd : IR.node, ifStk : open_if list, stms) = (case IR.Node.kind nd            and doNode (nd : IR.node, ifStk : open_if list, stms) = (case IR.Node.kind nd
475                   of IR.NULL => raise Fail "unexpected NULL"                   of IR.NULL => raise Fail "unexpected NULL"
476                    | IR.ENTRY{succ} => doNode (env, !succ, ifStk, stms)                    | IR.ENTRY{succ} => doNode (!succ, ifStk, stms)
477                    | k as IR.JOIN _ => join (env, ifStk, stms, k)                    | k as IR.JOIN _ => join (ifStk, stms, k)
478                    | IR.COND{cond, trueBranch, falseBranch, ...} => let                    | IR.COND{cond, trueBranch, falseBranch, ...} => let
479                        val cond = useScalar (!cond)                        val cond = useScalar (!cond)
480                        val (env, stms) = flushPending (env, stms)                        val stms = Env.flushPending (env, stms)
481                        in                        in
482                          doNode (env, !trueBranch, THEN_BR(stms, cond, !falseBranch)::ifStk, [])                          doNode (!trueBranch, THEN_BR(stms, cond, !falseBranch)::ifStk, [])
483                        end                        end
484                    | IR.FOREACH{var, src, bodyEntry, succ, ...} => let                    | IR.FOREACH{var, src, bodyEntry, succ, ...} => let
485                        val src = useScalar (!src)                        val src = useScalar (!src)
486                        val var = ??                        val var' = Util.newIterVar var
487                        val (env, stms) = flushPending (env, stms)                        val stms = Env.flushPending (env, stms)
488                        val body = doNode (env, !bodyEntry, [], [])                        val _ = Env.bindSimple (env, var, Env.TREE(T.E_Var var'))
489                        val stm = T.S_Foreach(var, src, body)                        val body = doNode (!bodyEntry, [], [])
490                          val stm = T.S_Foreach(var', src, body)
491                        in                        in
492                          doNode (env, !succ, ifStk, stm::stms)                          doNode (!succ, ifStk, stm::stms)
493                        end                        end
494                    | IR.NEXT _ => Env.endScope (env, List.rev stms)                    | IR.NEXT _ => mkBlock (List.rev stms)
495                    | IR.COM {text, succ, ...} =>                    | IR.COM {text, succ, ...} =>
496                        doNode (env, !succ, ifStk, T.S_Comment text :: stms)                        doNode (!succ, ifStk, T.S_Comment text :: stms)
497                    | IR.ASSIGN{stm=(lhs, rhs), succ, ...} => let                    | IR.ASSIGN{stm=(lhs, rhs), succ, ...} => let
498                        val (env, stms') = doAssign (env, lhs, rhs)                        val stms' = trAssign (env, lhs, rhs)
499                        in                        in
500                          doNode (env, !succ, ifStk, stms' @ stms)                          doNode (!succ, ifStk, stms' @ stms)
501                        end                        end
502                    | IR.MASSIGN{stm=(ys, rator, xs), succ, ...} => let                    | IR.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
503                        fun doit () = let                        fun doLHSVar (y, ys) = newLocal (env, y) :: ys
504                              fun doLHSVar (y, (env, ys)) = let                        val ys = List.foldr doLHSVar [] ys
505                                    val t = newLocal y                        val rator = (case rator
506                                 of Op.Print tys => TOp.Print(List.map Util.trType tys)
507                                  | _ => raise Fail(concat[
508                                        "unexepected operator ", Op.toString rator, " for MASSIGN"
509                                      ])
510                                (* end case *))
511                          val stm = T.S_MAssign(ys, T.E_Op(rator, List.map (singleArg env) xs))
512                                    in                                    in
513                                      (rename (addLocal(env, t), y, t), t::ys)                          doNode (!succ, ifStk, stm :: stms)
514                                    end                                    end
515                              val (env, ys) = List.foldr doLHSVar (env, []) ys                    | IR.GASSIGN{lhs, rhs, succ, ...} => let
516  (* FIXME: need to translate the operator *)                        val stm = T.S_GAssign(mkGlobalVar lhs, singleArg env rhs)
                             val exp = T.E_Op(rator, List.map (useVar env) xs)  
                             val stm = T.S_Assign(ys, exp)  
517                              in                              in
518                                doNode (env, !succ, ifStk, stm :: stms)                          doNode (!succ, ifStk, stm::stms)
519                              end                              end
520                      | IR.NEW{strand, args, succ, ...} => let
521                          val stm = T.S_New(strand, List.map (singleArg env) args)
522                        in                        in
523                          case rator                          doNode (!succ, ifStk, stm::stms)
                          of Op.Print _ => if Target.supportsPrinting()  
                               then doit ()  
                               else doNode (env, !succ, ifStk, stms)  
                           | _ => doit()  
                         (* end case *)  
524                        end                        end
                   | IR.GASSIGN{lhs, rhs, succ, ...} => let  
                       val stm = (case useAsInput(env, rhs)  
                              of NONE => T.S_GAssign(getGlobalVar lhs, useVar env rhs)  
                               | SOME mkStm => mkStm(getGlobalVar lhs)  
                             (* end case *))  
                       in  
                         doNode (env, !succ, ifStk, stm::stms)  
                       end  
                   | IR.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"  
525                    | IR.SAVE{lhs, rhs, succ, ...} => let                    | IR.SAVE{lhs, rhs, succ, ...} => let
526                        val stm = T.S_Save([getStateVar lhs], useVar env rhs)                        val stm = T.S_Save(getStateVar lhs, singleArg env rhs)
527                        in                        in
528                          doNode (env, !succ, ifStk, stm::stms)                          doNode (!succ, ifStk, stm::stms)
529                        end                        end
530                    | k as IR.EXIT{kind, succ, ...} => (case (!succ, kind)                    | k as IR.EXIT{kind, succ, ...} => (case (!succ, kind)
531                         of (NONE, ExitKind.RETURN) => let                         of (NONE, ExitKind.RETURN) => mkBlock (List.rev(T.S_Exit :: stms))
532                              val suffix = [T.S_Exit]                          | (NONE, ExitKind.ACTIVE) => mkBlock (List.rev(T.S_Active :: stms))
                             in  
                               Env.endScope (env, prefix @ List.revAppend(stms, suffix))  
                             end  
                         | (NONE, ExitKind.ACTIVE) => let  
                             val suffix = [T.S_Active]  
                             in  
                               Env.endScope  (env, prefix @ List.revAppend(stms, suffix))  
                             end  
533                          | (NONE, ExitKind.STABILIZE) => let                          | (NONE, ExitKind.STABILIZE) => let
534                              val stms = T.S_Stabilize :: stms                              val stms = T.S_Stabilize :: stms
535                              in                              in
536                                join (env, ifStk, stms, k)                                join (ifStk, stms, k)
537                              end                              end
538                          | (NONE, ExitKind.DIE) => join (env, ifStk, T.S_Die :: stms, k)                          | (NONE, ExitKind.DIE) => join (ifStk, T.S_Die :: stms, k)
539                          | (NONE, ExitKind.UNREACHABLE) => join (env, ifStk, stms, k)                          | (NONE, ExitKind.UNREACHABLE) => join (ifStk, stms, k)
540                          | (SOME nd, ExitKind.ACTIVE) => doNode (env, nd, ifStk, T.S_Active :: stms)                          | (SOME nd, ExitKind.ACTIVE) => doNode (nd, ifStk, T.S_Active :: stms)
541                          | (SOME nd, ExitKind.STABILIZE) => doNode (env, nd, ifStk, T.S_Stabilize :: stms)                          | (SOME nd, ExitKind.STABILIZE) => doNode (nd, ifStk, T.S_Stabilize :: stms)
542                          | (SOME nd, ExitKind.DIE) => doNode (env, nd, ifStk, T.S_Die :: stms)                          | (SOME nd, ExitKind.DIE) => doNode (nd, ifStk, T.S_Die :: stms)
543                          | (SOME nd, ExitKind.UNREACHABLE) => doNode (env, nd, ifStk, stms)                          | (SOME nd, ExitKind.UNREACHABLE) => doNode (nd, ifStk, stms)
544                          | _ => raise Fail("unexpected continuation edge from "^IR.Node.toString nd)                          | _ => raise Fail("unexpected continuation edge from "^IR.Node.toString nd)
545                        (* end case *))                        (* end case *))
546                  (* end case *))                  (* end case *))
547            in            in
548              doNode (Env.new(), CFG.entry cfg, [], [])              doNode (IR.CFG.entry cfg, [], [])
549            end            end
550    
551      fun trCFG (prefix, cfg) = trCFGWithEnv (Env.new(), prefix, cfg)      fun trCFG info cfg = ScopeVars.assignScopes ([], trCFGWithEnv (Env.new info, cfg))
552    
553      fun trStrand strand = let      fun trStrand info strand = let
554              val trCFG = trCFG info
555            val IR.Strand{name, params, state, stateInit, initM, updateM, stabilizeM} = strand            val IR.Strand{name, params, state, stateInit, initM, updateM, stabilizeM} = strand
556            val params' = List.map newParam params            val params' = List.map Util.newParamVar params
           val env = ListPair.foldlEq  
                 (fn (x, x', env) => rename(env, x, x')) ?? (params, params')  
557            val state' = List.map getStateVar state            val state' = List.map getStateVar state
558              val stateInit' = let
559                    val env = Env.new info
560                    in
561                      ListPair.appEq
562                        (fn (x, x') => Env.bindSimple (env, x, Env.TREE(T.E_Var x')))
563                          (params, params');
564                      ScopeVars.assignScopes (params', trCFGWithEnv (env, stateInit))
565                    end
566            in            in
567              T.Strand{              T.Strand{
568                  name = name,                  name = name,
569                  params = params',                  params = params',
570                  state = state',                  state = state',
571                  stateInit = trCFGWithEnv (env, stateInit),                  stateInit = stateInit',
572                  initM = Option.map (fn cfg => trCFG ([], cfg)) initM,                  initM = Option.map trCFG initM,
573                  updateM = trCFG ([], updateM),                  updateM = trCFG updateM,
574                  stabilizeM = Option.map (fn cfg => trCFG ([], cfg)) stabilizeM                  stabilizeM = Option.map trCFG stabilizeM
575                }                }
576            end            end
577    
578      fun translate (prog, vecLayout) = let      fun translate (prog, info) = let
579            val LowIR.Program{            val LowIR.Program{
580                    props, consts, inputs, constInit, globals, globalInit, strand, create, update                    props, consts, inputs, constInit, globals, globalInit, strand, create, update
581                  } = prog                  } = prog
582              val trCFG = trCFG info
583            in            in
584              TreeIR.Program{              TreeIR.Program{
585                  props = props,                  props = props,
586                  consts = ??,                  target = info,
587                  inputs = ??,                  consts = List.map mkGlobalVar consts,
588                  constInit = ??,                  inputs = List.map (Inputs.map mkGlobalVar) inputs,
589                  globals = ??,                  constInit = trCFG constInit,
590                  globalInit = ??,                  globals = List.map mkGlobalVar globals,
591                  strand = ??,                  globalInit = trCFG globalInit,
592                  create = ??,                  strand = trStrand info strand,
593                  update = ??                  create = let
594                      val IR.Create{dim, code} = create
595                      in
596                        T.Create{dim = dim, code = trCFG code}
597                      end,
598                    update = Option.map trCFG update
599                }                }
600            end            end
601    

Legend:
Removed from v.3835  
changed lines
  Added in v.3862

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