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

SCM Repository

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

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

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

revision 3900, Mon May 23 15:20:24 2016 UTC revision 4039, Fri Jun 24 15:35:09 2016 UTC
# Line 15  Line 15 
15    
16      val trBlock : CodeGenEnv.t * TreeIR.block -> CLang.stm      val trBlock : CodeGenEnv.t * TreeIR.block -> CLang.stm
17    
18        val trWithLocals : CodeGenEnv.t * TreeVar.t list * (CodeGenEnv.t -> CLang.stm list) -> CLang.stm
19    
20        val trStms : CodeGenEnv.t * TreeIR.stm list -> CodeGenEnv.t * CLang.stm list
21    
22      val trExp : CodeGenEnv.t * TreeIR.exp -> CLang.exp      val trExp : CodeGenEnv.t * TreeIR.exp -> CLang.exp
23    
24    (* translate an expression to a variable form; return the variable (as an expression)    (* translate an expression to a variable form; return the variable (as an expression)
# Line 22  Line 26 
26     *)     *)
27      val trExpToVar : CodeGenEnv.t * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list      val trExpToVar : CodeGenEnv.t * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list
28    
     val trAssign : CodeGenEnv.t * CLang.exp * TreeIR.exp -> CLang.stm list  
   
29    (* generate code to register an error message (require that a world pointer "wrld" is in scope) *)    (* generate code to register an error message (require that a world pointer "wrld" is in scope) *)
30      val errorMsgAdd : CLang.exp -> CLang.stm      val errorMsgAdd : CodeGenEnv.t * CLang.exp -> CLang.stm
31    
32        val trParam : CodeGenEnv.t * TreeIR.var -> CodeGenEnv.t * CLang.param
33    
34    end = struct    end = struct
35    
# Line 35  Line 39 
39      structure Ty = TreeTypes      structure Ty = TreeTypes
40      structure V = TreeVar      structure V = TreeVar
41      structure Env = CodeGenEnv      structure Env = CodeGenEnv
42        structure RN = CxxNames
43    
44      fun trType (env, ty) = (case ty      val trType = TypeToCxx.trType
45             of Ty.BoolTy => CL.boolTy      val dynseqTy = TypeToCxx.dynseqTy
             | Ty.StringTy => CL.T_Named "std::string"  
             | Ty.IntTy => Env.intTy env  
             | (Ty.VecTy(1, 1)) => Env.realTy env  
             | (Ty.VecTy(d, _)) => CL.T_Named("vec" ^ Int.toString d)  
             | (Ty.TupleTy tys) => raise Fail "FIXME: TupleTy"  
             | (Ty.TensorTy dd) => CL.T_Array(Env.realTy env, SOME(List.foldl Int.* 1 dd))  
             | (Ty.SeqTy(t, NONE)) => CL.T_Template("diderot::dynseq", [trType(env, t)])  
             | (Ty.SeqTy(t, SOME n)) => CL.T_Array(trType(env, t), SOME n)  
             | (Ty.ImageTy info) =>  
                 CL.T_Template(  
                   concat["diderot::image", Int.toString(ImageInfo.dim info), "d"],  
                   [Env.realTy env])  
             | (Ty.StrandTy name) => CL.T_Named("strand_" ^ Atom.toString name)  
           (* end case *))  
46    
47    (* translate a local variable that occurs in an l-value context *)    (* translate a local variable that occurs in an l-value context *)
48      fun lvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))      fun lvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
# Line 59  Line 50 
50      fun rvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))      fun rvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
51    
52    (* translate a global variable that occurs in an l-value context *)    (* translate a global variable that occurs in an l-value context *)
53      fun lvalueGlobalVar (env, x) = CL.mkIndirect(CL.mkVar(Env.global env), TreeGlobalVar.name x)      fun lvalueGlobalVar (env, x) = CL.mkIndirect(CL.mkVar(Env.global env), TreeGlobalVar.qname x)
54    (* translate a global variable that occurs in an r-value context *)    (* translate a global variable that occurs in an r-value context *)
55      val rvalueGlobalVar = lvalueGlobalVar      val rvalueGlobalVar = lvalueGlobalVar
56    
57    (* translate a strand state variable that occurs in an l-value context *)    (* translate a strand state variable that occurs in an l-value context *)
58      fun lvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfOut env), TreeStateVar.name x)      fun lvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfOut env), TreeStateVar.qname x)
59    (* translate a strand state variable that occurs in an r-value context *)    (* translate a strand state variable that occurs in an r-value context *)
60      fun rvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfIn env), TreeStateVar.name x)      fun rvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfIn env), TreeStateVar.qname x)
61    
62        fun worldVar env = CL.mkVar(Env.world env)
63    
64    (* generate new variables *)    (* generate new variables *)
65      local      val freshVar = CodeGenUtil.freshVar
       val count = ref 0  
       fun freshName prefix = let  
             val n = !count  
             in  
               count := n+1;  
               concat[prefix, "_", Int.toString n]  
             end  
     in  
     fun tmpVar () = freshName "tmp"  
     fun freshVar prefix = freshName prefix  
     end (* local *)  
66    
67    (* integer literal expression *)    (* integer literal expression *)
68      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)      fun mkInt (i : int) = CL.mkInt(IntInf.fromInt i)
69    
70      val zero = CL.mkInt 0      val zero = CL.mkInt 0
71    
# Line 95  Line 77 
77    (* make an application of a function from the "diderot" namespace *)    (* make an application of a function from the "diderot" namespace *)
78      fun mkDiderotApply (f, args) = CL.mkApply("diderot::" ^ f, args)      fun mkDiderotApply (f, args) = CL.mkApply("diderot::" ^ f, args)
79      fun mkDiderotCall (f, args) = CL.mkCall("diderot::" ^ f, args)      fun mkDiderotCall (f, args) = CL.mkCall("diderot::" ^ f, args)
80        fun mkDynseqApply (env, ty, f, args) = CL.mkTemplateApply(f, [dynseqTy(env, ty)], args)
81    
82    (* Translate a TreeIR operator application to a CLang expression *)    (* Translate a TreeIR operator application to a CLang expression *)
83      fun trOp (env, rator, args) = (case (rator, args)      fun trOp (env, rator, args) = (case (rator, args)
# Line 131  Line 114 
114              | (Op.VScale d, [a, b]) => CL.mkApply("vscale", [a, b])              | (Op.VScale d, [a, b]) => CL.mkApply("vscale", [a, b])
115              | (Op.VMul d, [a, b]) => CL.mkBinOp(a, CL.#*, b)              | (Op.VMul d, [a, b]) => CL.mkBinOp(a, CL.#*, b)
116              | (Op.VNeg d, [a]) => CL.mkUnOp(CL.%-, a)              | (Op.VNeg d, [a]) => CL.mkUnOp(CL.%-, a)
117              | (Op.VSum d, [a]) => CL.mkApply("vsum", [a])              | (Op.VSum(w, _), [a]) => CL.mkApply(RN.vsum w, [a])
118              | (Op.VIndex(w, p, i), [a]) => CL.mkSubscript(a, intExp i)              | (Op.VIndex(w, p, i), [a]) => CL.mkSubscript(a, mkInt i)
119              | (Op.VClamp d, [a, b, c]) => CL.mkApply("vclamp", [a, b, c])              | (Op.VClamp(w, _), [a, b, c]) => CL.mkApply("vclamp", [a, b, c])
120              | (Op.VMapClamp d, [a, b, c]) => CL.mkApply("vclamp", [a, b, c])              | (Op.VMapClamp(w, _), [a, b, c]) => CL.mkApply("vclamp", [a, b, c])
121              | (Op.VLerp d, [a, b, c]) => CL.mkApply("vlerp", [a, b, c])              | (Op.VLerp(w, _), [a, b, c]) => CL.mkApply("vlerp", [a, b, c])
122              | (Op.VCeiling d, [a]) => CL.mkApply("vceiling", [a])              | (Op.VCeiling d, [a]) => CL.mkApply("vceiling", [a])
123              | (Op.VFloor d, [a]) => CL.mkApply("vfloor", [a])              | (Op.VFloor d, [a]) => CL.mkApply("vfloor", [a])
124              | (Op.VRound d, [a]) => CL.mkApply("vround", [a])              | (Op.VRound d, [a]) => CL.mkApply("vround", [a])
125              | (Op.VTrunc d, [a]) => CL.mkApply("vtrunc", [a])              | (Op.VTrunc d, [a]) => CL.mkApply("vtrunc", [a])
126              | (Op.VToInt d, [a]) => CL.mkApply("vtoi", [a])              | (Op.TensorIndex(ty, idxs), [a]) => let
127              | (Op.TensorIndex(Ty.TensorTy(_::dd), idxs), [a]) => let                  val dd = (case ty
128                           of Ty.TensorTy(_::dd) => dd
129                            | Ty.TensorRefTy(_::dd) => dd
130                            | _ => raise Fail "bogus type for TensorIndex"
131                          (* end case *))
132                (* dimensions/indices are slowest to fastest *)                (* dimensions/indices are slowest to fastest *)
133                  fun index ([], [i], acc) = acc + i                  fun index ([], [i], acc) = acc + i
134                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
135                  in                  in
136                    CL.mkSubscript(a, intExp(index (dd, idxs, 0)))                    CL.mkSubscript(a, mkInt(index (dd, idxs, 0)))
137                  end                  end
138              | (Op.ProjectLast(Ty.TensorTy(_::dd), idxs), [a]) => let              | (Op.ProjectLast(ty, idxs), [a]) => let
139                    val dd = (case ty
140                           of Ty.TensorTy(_::dd) => raise Fail "FIXME: no ProjectLast for tensor type"
141                            | Ty.TensorRefTy(_::dd) => dd
142                            | _ => raise Fail "bogus type for ProjectLast"
143                          (* end case *))
144                (* dimensions/indices are slowest to fastest *)                (* dimensions/indices are slowest to fastest *)
145                  fun index ([], [], acc) = acc                  fun index ([], [], acc) = acc
146                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
147                  in                  in
148                    CL.mkAddrOf(CL.mkSubscript(a, intExp(index (dd, idxs, 0))))                    CL.mkDispatch(a, "last", [mkInt(index (dd, idxs, 0))])
149                  end                  end
150                  (* NOTE: since C++ will do the coercion automatically, we don't really need
151                   * to generate the constructor application for TensorRef!
152                   *)
153                | (Op.TensorRef shp, [a]) => CL.mkCons(RN.tensorRefTy shp, [a])
154              | (Op.EigenVals2x2, [a]) => raise Fail "FIXME: EigenVals2x2"              | (Op.EigenVals2x2, [a]) => raise Fail "FIXME: EigenVals2x2"
155              | (Op.EigenVals3x3, [a]) => raise Fail "FIXME: EigenVals3x3"              | (Op.EigenVals3x3, [a]) => raise Fail "FIXME: EigenVals3x3"
156              | (Op.Select(ty, i), [a]) => raise Fail "FIXME: Select"              | (Op.Select(ty, i), [a]) => raise Fail "FIXME: Select"
157              | (Op.Subscript ty, [a, b]) => CL.mkSubscript(a, b)              | (Op.Subscript ty, [a, b]) => CL.mkSubscript(a, b)
158              | (Op.MkDynamic(ty, i), [a]) => raise Fail "FIXME: MkDynamic"              | (Op.MkDynamic(ty, n), [a]) => CL.mkCons(dynseqTy(env, ty), [mkInt n, a])
159              | (Op.Append ty, [a, b]) => raise Fail "FIXME: Append"  (* FIXME: eventually we should do some kind of liveness analysis to enable in situ operations *)
160              | (Op.Prepend ty, [a, b]) => raise Fail "FIXME: Prepend"              | (Op.Append ty, [a, b]) => mkDynseqApply (env, ty, "append", [a, b])
161              | (Op.Concat ty, [a, b]) => raise Fail "FIXME: Concat"              | (Op.Prepend ty, [a, b]) => mkDynseqApply (env, ty, "prepend", [a, b])
162              | (Op.Range, [a, b]) => raise Fail "FIXME: Range"              | (Op.Concat ty, [a, b]) => mkDynseqApply (env, ty, "concat", [a, b])
163              | (Op.Length ty, [a]) => raise Fail "FIXME: Length"              | (Op.Range, [a, b]) => CL.mkCons(dynseqTy(env, Ty.IntTy), [a, b])
164                | (Op.Length ty, [a]) => CL.mkDispatch(a, "length", [])
165              | (Op.SphereQuery(ty1, ty2), []) => raise Fail "FIXME: SphereQuery"              | (Op.SphereQuery(ty1, ty2), []) => raise Fail "FIXME: SphereQuery"
166              | (Op.Sqrt, [a]) => mkStdApply("sqrt", [a])              | (Op.Sqrt, [a]) => mkStdApply("sqrt", [a])
167              | (Op.Cos, [a]) => mkStdApply("cos", [a])              | (Op.Cos, [a]) => mkStdApply("cos", [a])
# Line 185  Line 182 
182              | R_Mean of ty              | R_Mean of ty
183              | R_Variance of ty              | R_Variance of ty
184  *)  *)
185              | (Op.Transform info, [img]) => CL.mkDispatch(img, "world2image", [])              | (Op.Transform info, [img]) => CL.mkApply("world2image", [img])
186              | (Op.Translate info, [img]) => CL.mkDispatch(img, "translate", [])              | (Op.Translate info, [img]) => CL.mkApply("translate", [img])
187              | (Op.BaseAddress info, [img]) => CL.mkDispatch(img, "base_addr", [])              | (Op.BaseAddress info, [img]) => CL.mkDispatch(img, "base_addr", [])
188              | (Op.ControlIndex(info, ctl, d), [img, idx]) =>              | (Op.ControlIndex(info, ctl, d), [img, idx]) =>
189                  CL.mkDispatch(img, IndexCtl.toString ctl, [intExp d, idx])                  CL.mkDispatch(img, IndexCtl.toString ctl, [mkInt d, idx])
190              | (Op.Inside(info, s), [pos, img]) => CL.mkDispatch(img, "inside", [pos, intExp s])              | (Op.LoadVoxel info, [addr, offp]) => let
191              | (Op.ImageDim(info, i), [img]) => CL.mkDispatch(img, "size", [intExp i])                  val voxel = CL.mkSubscript(addr, offp)
192                    in
193                      case ImageInfo.sampleTy info
194                       of NONE => voxel (* no proxy, so we are using the default real type *)
195                        | SOME rty => if RawTypes.same(rty, Env.rawRealTy env)
196                            then voxel
197                            else CL.mkStaticCast(Env.realTy env, voxel)
198                      (* end case *)
199                    end
200                | (Op.Inside(info, s), [pos, img]) => CL.mkDispatch(img, "inside", [pos, mkInt s])
201                | (Op.ImageDim(info, i), [img]) => CL.mkDispatch(img, "size", [mkInt i])
202              | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, args)              | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, args)
203              | _ => raise Fail(concat[              | _ => raise Fail(concat[
204                     "unknown or incorrect operator ", Op.toString rator                     "unknown or incorrect operator ", Op.toString rator
# Line 208  Line 215 
215              | IR.E_Lit(Literal.Real f) => CL.mkFlt(f, Env.realTy env)              | IR.E_Lit(Literal.Real f) => CL.mkFlt(f, Env.realTy env)
216              | IR.E_Lit(Literal.String s) => CL.mkStr s              | IR.E_Lit(Literal.String s) => CL.mkStr s
217              | IR.E_Op(rator, args) => trOp (env, rator, trExps(env, args))              | IR.E_Op(rator, args) => trOp (env, rator, trExps(env, args))
218              | IR.E_Vec(w, pw, args) => let              | IR.E_Vec(w, pw, args) => CL.mkApply(RN.vcons w, trExps (env, args))
                 val args = trExps (env, args)  
                 val args = if (w < pw) then args @ List.tabulate(pw-w, fn _ => zero) else args  
                 in  
                   CL.mkVec(CL.T_Named("vec" ^ Int.toString pw), args)  
                 end  
219              | IR.E_Cons(args, Ty.TensorTy shape) => raise Fail "unexpected E_Cons"              | IR.E_Cons(args, Ty.TensorTy shape) => raise Fail "unexpected E_Cons"
220              | IR.E_Seq(args, ty) => raise Fail "unexpected E_Seq"              | IR.E_Seq(args, ty) => raise Fail "unexpected E_Seq"
221              | IR.E_Pack(layout, args) => raise Fail "unexpected E_Pack"              | IR.E_Pack(layout, args) => raise Fail "unexpected E_Pack"
222  (* FIXME: check if e is aligned and use "vload_aligned" in that case *)  (* FIXME: check if e is aligned and use "vload_aligned" in that case *)
223              | IR.E_VLoad(layout, e, i) =>              | IR.E_VLoad(layout, e, i) =>
224                  CL.mkTemplateApply("vload",                  CL.mkApply(RN.vload(Ty.nthWidth(layout, i)),
225                    [trType(env, Ty.nthVec(layout, i))],                    [CL.mkDispatch(trExp(env, e), "addr", [mkInt(Ty.offsetOf(layout, i))])])
                   [CL.mkBinOp(trExp(env, e), CL.#+, intExp(Ty.offsetOf(layout, i)))])  
226              | _ => raise Fail "trExp"              | _ => raise Fail "trExp"
227            (* end case *))            (* end case *))
228    
# Line 237  Line 238 
238                  end                  end
239            (* end case *))            (* end case *))
240    
241      fun trAssign (env, lhs, rhs) = let  (* FIXME: trAssign and trDecl do the same analysis of the rhs; we should factor that out *)
242            fun trArg (i, arg) = CL.mkAssign(CL.mkSubscript(lhs, intExp i), trExp (env, arg))    (* translate the assignment `lhs = rhs` and add the code to the stms list.  Note that the
243       * stms list is reverse order!
244       *)
245        fun trAssign (env, lhs, rhs, stms) = let
246              fun trArg (i, arg, stms) =
247                    CL.mkAssign(CL.mkSubscript(lhs, mkInt i), trExp (env, arg)) :: stms
248            in            in
249              case rhs              case rhs
250               of IR.E_Pack(_, args) => [CL.mkCall ("vpack", List.map (fn e => trExp(env, e)) args)]               of IR.E_Op(Op.VToInt _, [a]) =>
251                | IR.E_Cons(args, _) => List.mapi trArg args                    CL.mkCall ("vtoi", [lhs, trExp(env, a)]) :: stms
252                | IR.E_Seq(args, _) => List.mapi trArg args  (*
253                | _ => [CL.mkAssign(lhs, trExp (env, rhs))]                | IR.E_Op(Op.TensorCopy shp, [a]) =>
254                      CL.mkCall (RN.tensorCopy shp, [lhs, trExp(env, a)]) :: stms
255    *)
256                  | IR.E_Op(Op.TensorCopy shp, [a]) => CL.mkAssign(lhs, trExp (env, a)) :: stms
257                  | IR.E_Pack({wid, ...}, args) =>
258                      CL.mkCall (RN.vpack wid, lhs :: List.map (fn e => trExp(env, e)) args) :: stms
259                  | IR.E_Cons(args, _) => List.foldli trArg stms args
260                  | IR.E_Seq(args, _) => List.foldli trArg stms args
261                  | _ => CL.mkAssign(lhs, trExp (env, rhs)) :: stms
262              (* end case *)              (* end case *)
263            end            end
264    
265      fun trDecl (env, ty, lhs, rhs) = let      fun trDecl (env, ty, lhs, rhs, stms) = let
266            fun trArgs args = CL.mkDecl(            fun trArgs args = CL.mkDecl(
267                  ty, lhs, SOME(CL.I_Exps(List.map (fn arg => CL.I_Exp(trExp (env, arg))) args)))                  ty, lhs, SOME(CL.I_Exps(List.map (fn arg => CL.I_Exp(trExp (env, arg))) args)))
268            in            in
269              case rhs              case rhs
270               of IR.E_Cons(args, _) => trArgs args               of IR.E_Op(Op.VToInt _, [a]) => (* NOTE: reverse order! *)
271                | IR.E_Seq(args, _) => trArgs args                    CL.mkCall ("vtoi", [CL.mkVar lhs, trExp(env, a)]) ::
272                | _ => CL.mkDeclInit(ty, lhs, trExp (env, rhs))                    CL.mkDecl(ty, lhs, NONE) :: stms
273    (*
274                  | IR.E_Op(Op.TensorCopy shp, [a]) => [ (* NOTE: reverse order! *)
275                        CL.mkCall (RN.tensorCopy shp, [CL.mkVar lhs, trExp(env, a)]),
276                        CL.mkDecl(ty, lhs, NONE)
277                      ]
278    *)
279                  | IR.E_Op(Op.TensorCopy shp, [a]) => CL.mkDeclInit(ty, lhs, trExp(env, a)) :: stms
280                  | IR.E_Pack({wid, ...}, args) =>
281                      CL.mkCall (RN.vpack wid, CL.mkVar lhs :: List.map (fn e => trExp(env, e)) args) ::
282                      CL.mkDecl(ty, lhs, NONE) :: stms
283                  | IR.E_Cons(args, _) => trArgs args :: stms
284                  | IR.E_Seq(args, _) => trArgs args :: stms
285                  | _ => CL.mkDeclInit(ty, lhs, trExp (env, rhs)) :: stms
286              (* end case *)              (* end case *)
287            end            end
288    
# Line 268  Line 295 
295            (* end case *))            (* end case *))
296        | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"        | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
297    
298        fun trPrintStm (outS, tys, args) = let
299              fun mkExp (lhs, [], []) = CL.mkBinOp(lhs, CL.#<<, CL.mkVar "std::flush")
300                | mkExp (lhs, ty::tys, e::es) = let
301                  (* if necessary, wrap the argument so that the correct "<<" instance is used *)
302                    val e = (case ty
303                           of Ty.TensorTy shape => CL.mkApply(RN.tensorRefStruct shape, [e])
304                            | _ => e
305                          (* end case *))
306                    in
307                      mkExp (CL.mkBinOp(lhs, CL.#<<, e), tys, es)
308                    end
309                | mkExp _ = raise Fail "trPrintStm: arity mismatch"
310              in
311                CL.mkExpStm (mkExp (outS, tys, args))
312              end
313    
314      fun trStms (env, stms : TreeIR.stm list) = let      fun trStms (env, stms : TreeIR.stm list) = let
315            fun trStm (stm, (env, stms : CL.stm list)) = (case stm            fun trStm (stm, (env, stms : CL.stm list)) = (case stm
316                   of IR.S_Comment text => (env, CL.mkComment text :: stms)                   of IR.S_Comment text => (env, CL.mkComment text :: stms)
# Line 276  Line 319 
319                        val x' = V.name x                        val x' = V.name x
320                        val env = Env.insert (env, x, x')                        val env = Env.insert (env, x, x')
321                        in                        in
322                          (env, trDecl (env, ty, x', exp) :: stms)                          (env, trDecl (env, ty, x', exp, stms))
                       end  
                   | IR.S_Assign(false, x, exp) => let  
                       val stms' = trAssign (env, lvalueVar (env, x), exp)  
                       in  
                         (env, stms' @ stms)  
323                        end                        end
324                      | IR.S_Assign(false, x, exp) =>
325                          (env, trAssign (env, lvalueVar (env, x), exp, stms))
326                    | IR.S_MAssign(xs, exp) =>                    | IR.S_MAssign(xs, exp) =>
327                        (env, trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp) :: stms)                        (env, trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp) :: stms)
328                    | IR.S_GAssign(x, exp) =>                    | IR.S_GAssign(x, exp) =>
329                        (env, trAssign (env, lvalueGlobalVar (env, x), exp) @ stms)                        (env, trAssign (env, lvalueGlobalVar (env, x), exp, stms))
330                    | IR.S_IfThen(cond, thenBlk) =>                    | IR.S_IfThen(cond, thenBlk) =>
331                        (env, CL.mkIfThen(trExp(env, cond), trBlock(env, thenBlk)) :: stms)                        (env, CL.mkIfThen(trExp(env, cond), trBlock(env, thenBlk)) :: stms)
332                    | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let                    | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let
# Line 296  Line 336 
336                        in                        in
337                          (env, stm :: stms)                          (env, stm :: stms)
338                        end                        end
339                    | IR.S_Foreach(x, IR.E_Op(Op.Range, [lo, hi]), blk) => let                    | IR.S_For(x, lo, hi, blk) => let
340                        val x' = V.name x                        val x' = V.name x
341                        val env' = Env.insert (env, x, x')                        val env' = Env.insert (env, x, x')
342                        val (hi', hiInit) = if CodeGenUtil.isSimple hi                        val (hi', hiInit) = if CodeGenUtil.isSimple hi
# Line 307  Line 347 
347                                  (CL.mkVar hi', [CL.mkDeclInit(CL.int32, hi', trExp(env, hi))])                                  (CL.mkVar hi', [CL.mkDeclInit(CL.int32, hi', trExp(env, hi))])
348                                end                                end
349                        val loop = CL.mkFor(                        val loop = CL.mkFor(
350                              [(CL.int32, x', trExp(env, lo))],                              CL.int32, [( x', trExp(env, lo))],
351                              CL.mkBinOp(CL.mkVar x', CL.#<=, hi'),                              CL.mkBinOp(CL.mkVar x', CL.#<=, hi'),
352                              [CL.mkUnOp(CL.%++, CL.mkVar x')],                              [CL.mkUnOp(CL.%++, CL.mkVar x')],
353                              trBlock (env', blk))                              trBlock (env', blk))
# Line 315  Line 355 
355                          (env, hiInit @ loop :: stms)                          (env, hiInit @ loop :: stms)
356                        end                        end
357                    | IR.S_Foreach(x, e, blk) => raise Fail "Foreach"                    | IR.S_Foreach(x, e, blk) => raise Fail "Foreach"
358                    | IR.S_New(strand, args) => raise Fail "New"                    | IR.S_New(strand, args) => let
359                    | IR.S_Save(x, exp) => (env, trAssign (env, lvalueStateVar(env, x), exp))                        val args = List.map (fn e => trExp(env, e)) args
360                          val stm = CL.mkCall(
361                                Atom.toString strand ^ "_new",
362                                worldVar env :: args)
363                          in
364                            (env, stm :: stms)
365                          end
366                      | IR.S_Save(x, exp) =>
367                        (env, trAssign (env, lvalueStateVar(env, x), exp, stms))
368                    | IR.S_LoadNrrd(lhs, ty, nrrd) => let                    | IR.S_LoadNrrd(lhs, ty, nrrd) => let
369                        val stm = (case ty                        val stm = (case ty
370                               of APITypes.SeqTy(ty, NONE) =>                               of APITypes.SeqTy(ty, NONE) =>
371                                    GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd)                                    GenLoadNrrd.loadSeqFromFile (
372                                        env, lvalueVar (env, lhs), ty, CL.mkStr nrrd)
373                                | APITypes.ImageTy _ =>                                | APITypes.ImageTy _ =>
374                                    GenLoadNrrd.loadImage (lvalueVar (env, lhs), CL.mkStr nrrd)                                    GenLoadNrrd.loadImage (lvalueVar (env, lhs), CL.mkStr nrrd)
375                                | _ => raise Fail(concat[                                | _ => raise Fail(concat[
# Line 334  Line 383 
383                    | IR.S_Input(gv, name, _, SOME dflt) =>                    | IR.S_Input(gv, name, _, SOME dflt) =>
384                        (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)                        (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)
385                    | IR.S_InputNrrd _ => (env, stms)                    | IR.S_InputNrrd _ => (env, stms)
386                    | IR.S_Exit => (env, stms)                    | IR.S_Exit => (env, List.revAppend(Env.handleExit env, stms))
387                    | IR.S_Print(tys, args) => let                    | IR.S_Print(tys, args) => let
388                        val args = List.map (fn e => trExp(env, e)) args                        val args = List.map (fn e => trExp(env, e)) args
389                        val stm = GenPrint.genPrintStm (                        val stm = trPrintStm (
390                              CL.mkIndirect(CL.mkVar "wrld", "_output"),                              CL.mkIndirectDispatch(worldVar env, "output", []),
391                              tys, args)                              tys, args)
392                        in                        in
393                          (env, stm::stms)                          (env, stm::stms)
# Line 347  Line 396 
396                    | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kStabilize")) :: stms)                    | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kStabilize")) :: stms)
397                    | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kDie")) :: stms)                    | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kDie")) :: stms)
398                  (* end case *))                  (* end case *))
399              val (env, stms) = List.foldl trStm (env, []) stms
400            in            in
401              List.rev (#2 (List.foldl trStm (env, []) stms))              (env, List.rev stms)
402            end            end
403    
404      and trBlock (env, IR.Block{locals, body}) = let      and trBlock (env, IR.Block{locals, body}) = let
# Line 359  Line 409 
409                    (Env.insert(env, x, x'), dcl :: dcls)                    (Env.insert(env, x, x'), dcl :: dcls)
410                  end                  end
411            val (env, dcls) = List.foldl trLocal (env, []) (!locals)            val (env, dcls) = List.foldl trLocal (env, []) (!locals)
412              val (_, stms) = trStms (env, body)
413              in
414                CL.mkBlock (dcls @ stms)
415              end
416    
417        and trWithLocals (env, locals, trBody) = let
418              fun trLocal (x, (env, dcls)) = let
419                    val x' = V.name x
420                    val dcl = CL.mkDecl(trType(env, V.ty x), x', NONE)
421            in            in
422              CL.mkBlock (dcls @ trStms (env, body))                    (Env.insert(env, x, x'), dcl :: dcls)
423            end            end
424              val (env, dcls) = List.foldl trLocal (env, []) locals
425              in
426                CL.mkBlock (dcls @ trBody env)
427              end
428    
429        fun errorMsgAdd (env, msg) =
430              CL.mkCall("biffMsgAdd", [CL.mkIndirect(worldVar env, "_errors"), msg])
431    
432      fun errorMsgAdd msg =      fun trParam (env, x)= let
433            CL.mkCall("biffMsgAdd", [CL.mkIndirect(CL.mkVar "wrld", "_errors"), msg])            val x' = V.name x
434              in
435                (Env.insert (env, x, x'), CL.PARAM([], trType(env, V.ty x), x'))
436              end
437    
438    end    end

Legend:
Removed from v.3900  
changed lines
  Added in v.4039

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