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 3843, Tue May 10 15:10:58 2016 UTC revision 3852, Fri May 13 15:00:57 2016 UTC
# Line 8  Line 8 
8    
9  structure LowToTree : sig  structure LowToTree : sig
10    
11      val translate : LowIR.program * (int -> TreeTypes.vec_layout) -> TreeIR.program      val translate : LowIR.program * Env.target_info -> TreeIR.program
12    
13    end = struct    end = struct
14    
# Line 64  Line 64 
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}      fun mkBlock stms = T.Block{locals = ref [], body = stms}
68      fun mkIf (x, stms, []) = T.S_IfThen(x, mkBlock stms)      fun mkIf (x, stms, []) = T.S_IfThen(x, mkBlock stms)
69        | mkIf (x, stms1, stms2) = T.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)        | mkIf (x, stms1, stms2) = T.S_IfThenElse(x, mkBlock stms1, mkBlock stms2)
70    
# Line 73  Line 73 
73        | cvtScalarTy (Ty.TensorTy[]) = TTy.realTy        | cvtScalarTy (Ty.TensorTy[]) = TTy.realTy
74        | cvtScalarTy ty = raise Fail(concat["cvtScalarTy(", Ty.toString ty, ")"])        | cvtScalarTy ty = raise Fail(concat["cvtScalarTy(", Ty.toString ty, ")"])
75    
76      (* get a variable's binding as a single argument expression.  This means that
77       * if x is bound to a vector of expressions, then we need to pack it.
78       *)
79        fun singleArg env x = (case Env.useVar env x
80               of Env.TREE e => e
81                | Env.VEC(layout, es) => T.E_Pack(layout, es)
82              (* end case *))
83    
84        fun scalarArg env x = (case Env.useVar env x
85               of Env.TREE e => e
86                | _ => raise Fail("expected scalar binding for " ^ IR.Var.toString x)
87              (* end case *))
88    
89      fun vectorArg (env, x) = (case Env.useVar env x      fun vectorArg (env, x) = (case Env.useVar env x
90             of Env.TREE e => (case IR.Var.ty x             of Env.TREE e => (case IR.Var.ty x
91                   of Ty.TensorTy[d] => let                   of Ty.TensorTy[d] => let
# Line 107  Line 120 
120              (layout, List.map List.rev argLists)              (layout, List.map List.rev argLists)
121            end            end
122    
123      fun trOp (env, lhs, srcRator, args) = let      fun trOp (env, srcRator, args) = let
124            fun bindOp rator = let  (* FIXME: if the use count of lhs is > 1, then we should bind to a local variable *)
125                  fun getBinding x = (case Env.useVar env x            fun bindOp rator = Env.TREE(T.E_Op(rator, List.map (scalarArg env) args))
                        of Env.TREE e => e  
                         | _ => raise Fail("expected single binding for " ^ IR.Var.toString x)  
                       (* end case *))  
                 in  
                   Env.TREE(T.E_Op(rator, List.map getBinding args))  
                 end  
126            fun bindVOp rator = let            fun bindVOp rator = let
127                  val (layout, argss) = vectorArgs (env, args)                  val (layout, argss) = vectorArgs (env, args)
128                  val exps = ListPair.map                  val exps = ListPair.map
# Line 155  Line 162 
162                | Op.VScale _ => bindVOp TOp.VScale                | Op.VScale _ => bindVOp TOp.VScale
163                | Op.VMul _ => bindVOp TOp.VMul                | Op.VMul _ => bindVOp TOp.VMul
164                | Op.VNeg _ => bindVOp TOp.VNeg                | Op.VNeg _ => bindVOp TOp.VNeg
165                | Op.VSum _ => ??                | Op.VSum _ => raise Fail "FIXME: VSum"
166                | Op.VIndex(d, i) => ??                | Op.VIndex(_, i) => let
167    (* FIXME: more efficient to lookup the variable and avoid expanding TREE args *)
168                      val ({pieces, ...}, es) = vectorArg (env, hd args)
169                      fun select (i, w::ws, e::es) =
170                            if (i < w)
171    (* FIXME: what if lhs is used more than once? *)
172                              then Env.TREE(T.E_Op(TOp.VIndex(w, i), [e]))
173                              else select (i-w, ws, es)
174                        | select _ = raise Fail("bogus " ^ Op.toString srcRator)
175                      in
176                        select (i, pieces, es)
177                      end
178                | Op.VClamp n => bindVOp TOp.VClamp                | Op.VClamp n => bindVOp TOp.VClamp
179                | Op.VMapClamp n => bindVOp TOp.VMapClamp                | Op.VMapClamp n => bindVOp TOp.VMapClamp
180                | Op.VLerp n => bindVOp TOp.VLerp                | Op.VLerp n => bindVOp TOp.VLerp
181                | Op.TensorIndex(ty, idxs) => ??                | Op.TensorIndex(ty, idxs) => ??
182                | Op.ProjectLast(ty, idxs) => ??                | Op.ProjectLast(ty, idxs) => ??
               | Op.EigenVecs2x2 => ??  
               | Op.EigenVecs3x3 => ??  
               | Op.EigenVals2x2 => ??  
               | Op.EigenVals3x3 => ??  
183                | Op.Zero ty => ??                | Op.Zero ty => ??
184                | Op.Select(Ty.TupleTy tys, i) => ??                | Op.Select(Ty.TupleTy tys, i) => ??
185                | Op.Subscript(Ty.SeqTy(ty, NONE)) => ??                | Op.Subscript(Ty.SeqTy(ty, NONE)) => ??
# Line 176  Line 190 
190                | Op.Concat ty => ??                | Op.Concat ty => ??
191                | Op.Range => ??                | Op.Range => ??
192                | Op.Length ty => ??                | Op.Length ty => ??
193                | Op.SphereQuery(ty1, ty2) => ??                | Op.SphereQuery(ty1, ty2) => raise Fail "FIXME: SphereQuery"
194                | Op.Sqrt => bindOp TOp.Sqrt                | Op.Sqrt => bindOp TOp.Sqrt
195                | Op.Cos => bindOp TOp.Cos                | Op.Cos => bindOp TOp.Cos
196                | Op.ArcCos => bindOp TOp.ArcCos                | Op.ArcCos => bindOp TOp.ArcCos
# Line 185  Line 199 
199                | Op.Tan => bindOp TOp.Tan                | Op.Tan => bindOp TOp.Tan
200                | Op.ArcTan => bindOp TOp.ArcTan                | Op.ArcTan => bindOp TOp.ArcTan
201                | Op.Ceiling 1 => bindOp (TOp.Ceiling 1)                | Op.Ceiling 1 => bindOp (TOp.Ceiling 1)
202                | Op.Ceiling d => ??                | Op.Ceiling d => bindVOp TOp.Ceiling
203                | Op.Floor 1 => bindOp (TOp.Floor 1)                | Op.Floor 1 => bindOp (TOp.Floor 1)
204                | Op.Floor d => ??                | Op.Floor d => bindVOp TOp.Floor
205                | Op.Round 1 => bindOp (TOp.Floor 1)                | Op.Round 1 => bindOp (TOp.Round 1)
206                | Op.Round d => ??                | Op.Round d => bindVOp TOp.Round
207                | Op.Trunc 1 => bindOp (TOp.Trunc 1)                | Op.Trunc 1 => bindOp (TOp.Trunc 1)
208                | Op.Trunc d => ??                | Op.Trunc d => bindVOp TOp.Trunc
209                | Op.IntToReal => bindOp TOp.IntToReal                | Op.IntToReal => bindOp TOp.IntToReal
210                | Op.RealToInt 1 => ??                | Op.RealToInt 1 => bindOp (TOp.RealToInt 1)
211                | Op.RealToInt d => ??                | Op.RealToInt d => ??
212    (* FIXME
213                | Op.R_All ty => ??                | Op.R_All ty => ??
214                | Op.R_Exists ty => ??                | Op.R_Exists ty => ??
215                | Op.R_Max ty => ??                | Op.R_Max ty => ??
# Line 203  Line 218 
218                | Op.R_Product ty => ??                | Op.R_Product ty => ??
219                | Op.R_Mean ty => ??                | Op.R_Mean ty => ??
220                | Op.R_Variance ty => ??                | Op.R_Variance ty => ??
221                | Op.Transform info => ??  *)
222                | Op.Translate info => ??                | Op.Transform info => bindOp (TOp.Transform info)
223                | Op.ControlIndex(info, ctl, d) => ??                | Op.Translate info => bindOp (TOp.Translate info)
224                | Op.LoadVoxel info => ??                | Op.ControlIndex(info, ctl, d) => bindOp (TOp.ControlIndex(info, ctl, d))
225                | Op.Inside(info, s) => ??                | Op.LoadVoxel info => bindOp (TOp.LoadVoxel info)
226                  | Op.Inside(info, s) => bindOp (TOp.Inside(info, s))
227                | Op.ImageDim(info, d) => bindOp(TOp.ImageDim(info, d))                | Op.ImageDim(info, d) => bindOp(TOp.ImageDim(info, d))
228                | Op.LoadSeq(ty, file) => ??                | Op.LoadSeq(ty, file) => ??
229                | Op.LoadImage(ty, file) => ??                | Op.LoadImage(ty, file) => ??
230                | Op.MathFn f => bindOp (TOp.MathFn f)                | Op.MathFn f => bindOp (TOp.MathFn f)
231                | rator => raise Fail("bogus operator " ^ Op.toString rator)                | rator => raise Fail("bogus operator " ^ Op.toString srcRator)
232              (* end case *)              (* end case *)
233            end            end
234    
235    (* cases:
236            x in EqClass
237                    issue assignment; lhs is binding of representative (could be multiple vars)
238            useCount(x) > 1 and rhs is not simple
239            rhs is simple
240            rhs is vector
241    *)
242      fun trAssign (env, lhs, rhs) = let      fun trAssign (env, lhs, rhs) = let
243          (* simple binding for lhs variable; we check to see if it is part of an merged          (* simple binding for lhs variable; we check to see if it is part of an merged
244           * equivalence class, in which case we need to generate the assigment.           * equivalence class, in which case we need to generate the assigment.
245           *)           *)
246            fun bindSimple rhs = (case UnifyVars.eqClassOf lhs            fun bindSimple rhs = (case UnifyVars.eqClassOf lhs
247                   of SOME x => ??                   of SOME x => [T.S_Assign(x', rhs)]
248                    | NONE => (Env.bindSimple (env, lhs, rhs); (env, []))                    | NONE => (Env.bindSimple (env, lhs, Env.TREE rhs); [])
249                  (* end case *))                  (* end case *))
250              fun assignOp (rator, args) = let
251    (* FIXME: what if lhs is EqClass var? *)
252                    val t = Util.newLocalVar lhs
253                    val stm = T.S_Assign(t, T.E_Op(rator, List.map (scalarArg env) args))
254                    in
255                      Env.bindSimple (env, lhs, Env.TREE(T.E_Var t));
256                      [stm]
257                    end
258            in            in
259              case rhs              case rhs
260               of IR.GLOBAL x => bindSimple (T.E_Global(getGlobalVar x))               of IR.GLOBAL x => bindSimple (T.E_Global(mkGlobalVar x))
261                | IR.STATE x => bindSimple (T.E_State(getStateVar x))                | IR.STATE(NONE, fld) =>
262                      bindSimple (T.E_State(NONE, getStateVar fld))
263                  | IR.STATE(SOME x, fld) =>
264                      bindSimple (T.E_State(SOME(scalarArg env x), getStateVar fld))
265                | IR.VAR x => (case Env.useVar env x                | IR.VAR x => (case Env.useVar env x
266                     of Env.TREE e => ??                     of Env.TREE e => ??
267                      | Env.VEC(layout, es) => ??                      | Env.VEC(layout, es) => ??
268                    (* end case *))                    (* end case *))
269                | IR.LIT lit => bindSimple (env, lhs, T.E_Lit lit)                | IR.LIT lit => bindSimple (T.E_Lit lit)
270                | IR.OP(rator, args) => ??                | IR.OP(Op.EigenVecs2x2, args) => assignOp (TOp.EigenVecs2x2, args)
271                | IR.CONS(args, ty) => ??                | IR.OP(Op.EigenVecs3x3, args) => assignOp (TOp.EigenVecs3x3, args)
272                  | IR.OP(Op.EigenVals2x2, args) => assignOp (TOp.EigenVals2x2, args)
273                  | IR.OP(Op.EigenVals3x3, args) => assignOp (TOp.EigenVals3x3, args)
274                  | IR.OP(rator, args) => let
275                      val rhs = trOp (env, rator, args)
276                      in
277                        if Env.isInlineOp env rator
278                          then (case (rhs, UnifyVars.eqClassOf lhs, useCount lhs > 1)
279                              of (_, NONE, false) => (Env.bindSimple (env, lhs, rhs); [])
280                               | (Env.TREE e, NONE, true) => let
281                                    val t = Util.newLocalVar lhs
282                                    in
283                                      Env.bindSimple (env, lhs, Env.TREE(T.E_Var t));
284                                      [T.S_Assign(t, e)]
285                                    end
286                               | (Env.TREE e, SOME x, _) => [T.S_Assign(x', e)]
287                               | (Env.VEC(layout, es), NONE, true) => let
288                                    val vs = Util.newVectorVars layout
289                                    in
290                                      Env.bindSimple (env, lhs, Env.VEC(layout, List.map T.E_Var vs));
291                                      ListPair.mapEq T.S_Assign (vs, es)
292                                    end
293                               | (Env.VEC(layout, es), SOME x, _) => ??
294                             (* end case *))
295                          else ??
296                      end
297                  | IR.CONS(args, Ty.TensorTy[d]) => let
298                      val {padded, pieces, ...} = Env.layoutVec env d
299                      in
300                        ??
301                      end
302                  | IR.CONS(args, Ty.TensorTy shape) => ??
303                | IR.SEQ(args, ty) => ??                | IR.SEQ(args, ty) => ??
304                | IR.EINAPP _ => raise Fail "unexpected EINAPP in LowIR code"                | rhs => raise Fail(concat["unexpected ", IR.RHS.toString rhs, " in LowIR code"])
305              (* end case *)              (* end case *)
306            end            end
307    
# Line 255  Line 320 
320       *)       *)
321        | 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
322    
323      fun trCFGWithEnv (env, prefix, cfg) = let      fun trCFGWithEnv (env, cfg) = let
324            fun useScalar x = (case Env.useVar env x            fun useScalar x = (case Env.useVar env x
325                   of Env.TREE e => e                   of Env.TREE e => e
326                    | _ => raise Fail("expected scalar binding for " ^ V.toString x)                    | _ => raise Fail("expected scalar binding for " ^ V.toString x)
327                  (* end case *))                  (* end case *))
328            val _ = UnifyVars.analyze cfg            val _ = UnifyVars.analyze cfg
329          (* 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
330           * 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
331           * 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
332           * 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).
333           *)           *)
334            fun join (env, [], _, IR.JOIN _) = raise Fail "JOIN with no open if"            fun join ([], _, IR.JOIN _) = raise Fail "JOIN with no open if"
335              | join (env, [], stms, _) = Env.endScope (env, prefix @ List.rev stms)              | join ([], stms, _) = mkBlock (List.rev stms)
336              | join (env, THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let              | join (THEN_BR(stms1, cond, elseBr)::stk, thenBlk, k) = let
337                  val (env, thenBlk) = Env.flushPending (env, thenBlk)                  val thenBlk = Env.flushPending (env, thenBlk)
338                  in                  in
339                    doNode (env, elseBr, ELSE_BR(stms1, cond, thenBlk, k)::stk, [])                    doNode (elseBr, ELSE_BR(stms1, cond, thenBlk, k)::stk, [])
340                  end                  end
341              | join (env, ELSE_BR(stms, cond, thenBlk, k1)::stk, elseBlk, k2) = let              | join (ELSE_BR(stms, cond, thenBlk, k1)::stk, elseBlk, k2) = let
342                  val (env, elseBlk) = Env.flushPending (env, elseBlk)                  val elseBlk = Env.flushPending (env, elseBlk)
343                  in                  in
344                    case (k1, k2)                    case (k1, k2)
345                     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)  
346                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
347                          in                          in
348                            doNode (env, !succ, stk, stm::stms)                            doNode (!succ, stk, stm::stms)
349                          end                          end
350                      | (IR.JOIN{phis, succ, ...}, _) => let                      | (IR.JOIN{succ, ...}, _) => let
                         val (env, [thenBlk]) = List.foldl doPhi (env, [thenBlk]) (!phis)  
351                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
352                          in                          in
353                            doNode (env, !succ, stk, stm::stms)                            doNode (!succ, stk, stm::stms)
354                          end                          end
355                      | (_, IR.JOIN{phis, succ, ...}) => let                      | (_, IR.JOIN{succ, ...}) => let
                         val (env, [elseBlk]) = List.foldl doPhi (env, [elseBlk]) (!phis)  
356                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
357                          in                          in
358                            doNode (env, !succ, stk, stm::stms)                            doNode (!succ, stk, stm::stms)
359                          end                          end
360                      | (_, _) => let                      | (_, _) => let
361                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                          val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
362                          in                          in
363                            Env.endScope (env, prefix @ List.rev(stm::stms))                            mkBlock (List.rev(stm::stms))
364                          end                          end
365                    (* end case *)                    (* end case *)
366                  end                  end
367            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
368                   of IR.NULL => raise Fail "unexpected NULL"                   of IR.NULL => raise Fail "unexpected NULL"
369                    | IR.ENTRY{succ} => doNode (env, !succ, ifStk, stms)                    | IR.ENTRY{succ} => doNode (!succ, ifStk, stms)
370                    | k as IR.JOIN _ => join (env, ifStk, stms, k)                    | k as IR.JOIN _ => join (ifStk, stms, k)
371                    | IR.COND{cond, trueBranch, falseBranch, ...} => let                    | IR.COND{cond, trueBranch, falseBranch, ...} => let
372                        val cond = useScalar (!cond)                        val cond = useScalar (!cond)
373                        val (env, stms) = Env.flushPending (env, stms)                        val stms = Env.flushPending (env, stms)
374                        in                        in
375                          doNode (env, !trueBranch, THEN_BR(stms, cond, !falseBranch)::ifStk, [])                          doNode (!trueBranch, THEN_BR(stms, cond, !falseBranch)::ifStk, [])
376                        end                        end
377                    | IR.FOREACH{var, src, bodyEntry, succ, ...} => let                    | IR.FOREACH{var, src, bodyEntry, succ, ...} => let
378                        val src = useScalar (!src)                        val src = useScalar (!src)
379                        val var = ??                        val var = Util.newIterVar var
380                        val (env, stms) = Env.flushPending (env, stms)                        val stms = Env.flushPending (env, stms)
381                        val body = doNode (env, !bodyEntry, [], [])                        val body = doNode (!bodyEntry, [], [])
382                        val stm = T.S_Foreach(var, src, body)                        val stm = T.S_Foreach(var, src, body)
383                        in                        in
384                          doNode (env, !succ, ifStk, stm::stms)                          doNode (!succ, ifStk, stm::stms)
385                        end                        end
386                    | IR.NEXT _ => Env.endScope (env, List.rev stms)                    | IR.NEXT _ => mkBlock (List.rev stms)
387                    | IR.COM {text, succ, ...} =>                    | IR.COM {text, succ, ...} =>
388                        doNode (env, !succ, ifStk, T.S_Comment text :: stms)                        doNode (!succ, ifStk, T.S_Comment text :: stms)
389                    | IR.ASSIGN{stm=(lhs, rhs), succ, ...} => let                    | IR.ASSIGN{stm=(lhs, rhs), succ, ...} => let
390                        val (env, stms') = doAssign (env, lhs, rhs)                        val stms' = trAssign (env, lhs, rhs)
391                        in                        in
392                          doNode (env, !succ, ifStk, stms' @ stms)                          doNode (!succ, ifStk, stms' @ stms)
393                        end                        end
394                    | IR.MASSIGN{stm=(ys, rator, xs), succ, ...} => let                    | IR.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
395                        fun doit () = let                        fun doLHSVar (y, ys) = let
396                              fun doLHSVar (y, (env, ys)) = let                              val t = Util.newLocalVar y
                                   val t = newLocal y  
397                                    in                                    in
398                                      (rename (addLocal(env, t), y, t), t::ys)                                Env.bindSimple (env, y, Env.TREE(T.E_Var t));
399                                  t::ys
400                                    end                                    end
401                              val (env, ys) = List.foldr doLHSVar (env, []) ys                        val ys = List.foldr doLHSVar [] ys
402  (* FIXME: need to translate the operator *)                        val rator = (case rator
403                              val exp = T.E_Op(rator, List.map (useVar env) xs)                               of Op.Print tys => TOp.Print(List.map Util.trType tys)
404                              val stm = T.S_Assign(ys, exp)                                | _ => raise Fail(concat[
405                                        "unexepected operator ", Op.toString rator, " for MASSIGN"
406                                      ])
407                                (* end case *))
408                          val stm = T.S_MAssign(ys, T.E_Op(rator, List.map (singleArg env) xs))
409                              in                              in
410                                doNode (env, !succ, ifStk, stm :: stms)                          doNode (!succ, ifStk, stm :: stms)
411                              end                              end
412                      | IR.GASSIGN{lhs, rhs, succ, ...} => let
413                          val stm = T.S_GAssign(mkGlobalVar lhs, singleArg env rhs)
414                        in                        in
415                          case rator                          doNode (!succ, ifStk, stm::stms)
                          of Op.Print _ => if Target.supportsPrinting()  
                               then doit ()  
                               else doNode (env, !succ, ifStk, stms)  
                           | _ => doit()  
                         (* end case *)  
416                        end                        end
417                    | IR.GASSIGN{lhs, rhs, succ, ...} => let                    | IR.NEW{strand, args, succ, ...} => let
418                        val stm = (case useAsInput(env, rhs)                        val stm = T.S_New(strand, List.map (singleArg env) args)
                              of NONE => T.S_GAssign(getGlobalVar lhs, useVar env rhs)  
                               | SOME mkStm => mkStm(getGlobalVar lhs)  
                             (* end case *))  
419                        in                        in
420                          doNode (env, !succ, ifStk, stm::stms)                          doNode (!succ, ifStk, stm::stms)
421                        end                        end
                   | IR.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"  
422                    | IR.SAVE{lhs, rhs, succ, ...} => let                    | IR.SAVE{lhs, rhs, succ, ...} => let
423                        val stm = T.S_Save([getStateVar lhs], useVar env rhs)                        val stm = T.S_Save(getStateVar lhs, singleArg env rhs)
424                        in                        in
425                          doNode (env, !succ, ifStk, stm::stms)                          doNode (!succ, ifStk, stm::stms)
426                        end                        end
427                    | k as IR.EXIT{kind, succ, ...} => (case (!succ, kind)                    | k as IR.EXIT{kind, succ, ...} => (case (!succ, kind)
428                         of (NONE, ExitKind.RETURN) => let                         of (NONE, ExitKind.RETURN) => mkBlock (List.rev(T.S_Exit :: stms))
429                              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  
430                          | (NONE, ExitKind.STABILIZE) => let                          | (NONE, ExitKind.STABILIZE) => let
431                              val stms = T.S_Stabilize :: stms                              val stms = T.S_Stabilize :: stms
432                              in                              in
433                                join (env, ifStk, stms, k)                                join (ifStk, stms, k)
434                              end                              end
435                          | (NONE, ExitKind.DIE) => join (env, ifStk, T.S_Die :: stms, k)                          | (NONE, ExitKind.DIE) => join (ifStk, T.S_Die :: stms, k)
436                          | (NONE, ExitKind.UNREACHABLE) => join (env, ifStk, stms, k)                          | (NONE, ExitKind.UNREACHABLE) => join (ifStk, stms, k)
437                          | (SOME nd, ExitKind.ACTIVE) => doNode (env, nd, ifStk, T.S_Active :: stms)                          | (SOME nd, ExitKind.ACTIVE) => doNode (nd, ifStk, T.S_Active :: stms)
438                          | (SOME nd, ExitKind.STABILIZE) => doNode (env, nd, ifStk, T.S_Stabilize :: stms)                          | (SOME nd, ExitKind.STABILIZE) => doNode (nd, ifStk, T.S_Stabilize :: stms)
439                          | (SOME nd, ExitKind.DIE) => doNode (env, nd, ifStk, T.S_Die :: stms)                          | (SOME nd, ExitKind.DIE) => doNode (nd, ifStk, T.S_Die :: stms)
440                          | (SOME nd, ExitKind.UNREACHABLE) => doNode (env, nd, ifStk, stms)                          | (SOME nd, ExitKind.UNREACHABLE) => doNode (nd, ifStk, stms)
441                          | _ => raise Fail("unexpected continuation edge from "^IR.Node.toString nd)                          | _ => raise Fail("unexpected continuation edge from "^IR.Node.toString nd)
442                        (* end case *))                        (* end case *))
443                  (* end case *))                  (* end case *))
444            in            in
445              doNode (env, CFG.entry cfg, [], [])              ScopeVars.assignScopes (doNode (IR.CFG.entry cfg, [], []))
446            end            end
447    
448      fun trCFG vecLayout (prefix, cfg) = trCFGWithEnv (Env.new vecLayout, prefix, cfg)      fun trCFG info cfg = trCFGWithEnv (Env.new info, cfg)
449    
450      fun trStrand strand = let      fun trStrand info strand = let
451              val trCFG = trCFG info
452            val IR.Strand{name, params, state, stateInit, initM, updateM, stabilizeM} = strand            val IR.Strand{name, params, state, stateInit, initM, updateM, stabilizeM} = strand
453            val params' = List.map newParam params            val params' = List.map Util.newParamVar params
454            val env = ListPair.foldlEq            val env = Env.new info
455                  (fn (x, x', env) => rename(env, x, x')) ?? (params, params')            val () = ListPair.appEq
456                    (fn (x, x') => Env.bindSimple (env, x, Env.TREE(T.E_Var x'))) (params, params')
457            val state' = List.map getStateVar state            val state' = List.map getStateVar state
458            in            in
459              T.Strand{              T.Strand{
# Line 409  Line 461 
461                  params = params',                  params = params',
462                  state = state',                  state = state',
463                  stateInit = trCFGWithEnv (env, stateInit),                  stateInit = trCFGWithEnv (env, stateInit),
464                  initM = Option.map (fn cfg => trCFG ([], cfg)) initM,                  initM = Option.map trCFG initM,
465                  updateM = trCFG ([], updateM),                  updateM = trCFG updateM,
466                  stabilizeM = Option.map (fn cfg => trCFG ([], cfg)) stabilizeM                  stabilizeM = Option.map trCFG stabilizeM
467                }                }
468            end            end
469    
470      fun translate (prog, vecLayout) = let      fun translate (prog, info) = let
471            val LowIR.Program{            val LowIR.Program{
472                    props, consts, inputs, constInit, globals, globalInit, strand, create, update                    props, consts, inputs, constInit, globals, globalInit, strand, create, update
473                  } = prog                  } = prog
474              val trCFG = trCFG info
475            in            in
476              TreeIR.Program{              TreeIR.Program{
477                  props = props,                  props = props,
478                  consts = ??,                  consts = List.map mkGlobalVar consts,
479                  inputs = ??,                  inputs = List.map (Inputs.map mkGlobalVar) inputs,
480                  constInit = ??,                  constInit = trCFG constInit,
481                  globals = ??,                  globals = List.map mkGlobalVar globals,
482                  globalInit = ??,                  globalInit = trCFG globalInit,
483                  strand = ??,                  strand = trStrand info strand,
484                  create = ??,                  create = let
485                  update = ??                    val IR.Create{dim, code} = create
486                      in
487                        T.Create{dim = dim, code = trCFG code}
488                      end,
489                    update = Option.map trCFG update
490                }                }
491            end            end
492    

Legend:
Removed from v.3843  
changed lines
  Added in v.3852

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