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

Legend:
Removed from v.3828  
changed lines
  Added in v.3856

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