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

branches/vis15/src/compiler/c-util/tree-to-cxx.sml revision 3870, Tue May 17 13:53:58 2016 UTC branches/vis15/src/compiler/cxx-util/tree-to-cxx.sml revision 3900, Mon May 23 15:20:24 2016 UTC
# Line 11  Line 11 
11    
12  structure TreeToCxx : sig  structure TreeToCxx : sig
13    
14      type env = CLang.typed_var TreeVar.Map.map      val trType : CodeGenEnv.t * TreeTypes.t -> CLang.ty
15    
16      val empty : env      val trBlock : CodeGenEnv.t * TreeIR.block -> CLang.stm
17    
18      val trType : TreeTypes.t -> CLang.ty      val trExp : CodeGenEnv.t * TreeIR.exp -> CLang.exp
   
     val trBlock : env * TreeIR.block -> CLang.stm  
   
     val trExp : env * TreeIR.exp -> CLang.exp  
19    
20    (* 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)
21     * and the (optional) declaration.     * and the (optional) declaration.
22     *)     *)
23      val expToVar : env * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list      val trExpToVar : CodeGenEnv.t * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list
24    
25        val trAssign : CodeGenEnv.t * CLang.exp * TreeIR.exp -> CLang.stm list
26    
27      val trAssign : env * CLang.exp * TreeIR.exp -> CLang.stm list    (* generate code to register an error message (require that a world pointer "wrld" is in scope) *)
28        val errorMsgAdd : CLang.exp -> CLang.stm
29    
30    end = struct    end = struct
31    
# Line 35  Line 34 
34      structure Op = TreeOps      structure Op = TreeOps
35      structure Ty = TreeTypes      structure Ty = TreeTypes
36      structure V = TreeVar      structure V = TreeVar
37      structure VMap = VMap      structure Env = CodeGenEnv
38    
39      datatype var = datatype CL.typed_var      fun trType (env, ty) = (case ty
40      type env = CLang.typed_var VMap.map             of Ty.BoolTy => CL.boolTy
41                | Ty.StringTy => CL.T_Named "std::string"
42      val empty = VMap.empty              | Ty.IntTy => Env.intTy env
43                | (Ty.VecTy(1, 1)) => Env.realTy env
44      fun lookup (env, x) = (case VMap.find (env, x)              | (Ty.VecTy(d, _)) => CL.T_Named("vec" ^ Int.toString d)
45             of SOME(V(_, x')) => x'              | (Ty.TupleTy tys) => raise Fail "FIXME: TupleTy"
46              | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])              | (Ty.TensorTy dd) => CL.T_Array(Env.realTy env, SOME(List.foldl Int.* 1 dd))
47                | (Ty.SeqTy(t, NONE)) => CL.T_Template("diderot::dynseq", [trType(env, t)])
48                | (Ty.SeqTy(t, SOME n)) => CL.T_Array(trType(env, t), SOME n)
49                | (Ty.ImageTy info) =>
50                    CL.T_Template(
51                      concat["diderot::image", Int.toString(ImageInfo.dim info), "d"],
52                      [Env.realTy env])
53                | (Ty.StrandTy name) => CL.T_Named("strand_" ^ Atom.toString name)
54            (* end case *))            (* end case *))
55    
     local  
       fun global env = CL.mkVar(lookup(env, PseudoVars.global))  
       fun selfIn env = CL.mkVar(lookup(env, PseudoVars.selfIn))  
       fun selfOut env = CL.mkVar(lookup(env, PseudoVars.selfOut))  
     in  
56    (* translate a local variable that occurs in an l-value context *)    (* translate a local variable that occurs in an l-value context *)
57      fun lvalueVar (env, x) = CL.mkVar(lookup(env, x))      fun lvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
58    (* translate a variable that occurs in an r-value context *)    (* translate a variable that occurs in an r-value context *)
59      fun rvalueVar (env, x) = CL.mkVar(lookup(env, x))      fun rvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
60    
61    (* translate a global variable that occurs in an l-value context *)    (* translate a global variable that occurs in an l-value context *)
62      fun lvalueGlobalVar (env, x) = CL.mkIndirect(global env, TreeGlobalVar.name x)      fun lvalueGlobalVar (env, x) = CL.mkIndirect(CL.mkVar(Env.global env), TreeGlobalVar.name x)
63    (* translate a global variable that occurs in an r-value context *)    (* translate a global variable that occurs in an r-value context *)
64      val rvalueGlobalVar = lvalueGlobalVar      val rvalueGlobalVar = lvalueGlobalVar
65    
66    (* translate a strand state variable that occurs in an l-value context *)    (* translate a strand state variable that occurs in an l-value context *)
67      fun lvalueStateVar (env, x) = CL.mkIndirect(selfOut env, TreeStateVar.name x)      fun lvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfOut env), TreeStateVar.name x)
68    (* translate a strand state variable that occurs in an r-value context *)    (* translate a strand state variable that occurs in an r-value context *)
69      fun rvalueStateVar (env, x) = CL.mkIndirect(selfIn env, TreeStateVar.name x)      fun rvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfIn env), TreeStateVar.name x)
     end (* local *)  
70    
71    (* generate new variables *)    (* generate new variables *)
72      local      local
# Line 85  Line 85 
85    (* integer literal expression *)    (* integer literal expression *)
86      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
87    
88        val zero = CL.mkInt 0
89    
90      fun addrOf e = CL.mkUnOp(CL.%&, e)      fun addrOf e = CL.mkUnOp(CL.%&, e)
91    
92    (* make an application of a function from the "std" namespace *)    (* make an application of a function from the "std" namespace *)
# Line 92  Line 94 
94    
95    (* make an application of a function from the "diderot" namespace *)    (* make an application of a function from the "diderot" namespace *)
96      fun mkDiderotApply (f, args) = CL.mkApply("diderot::" ^ f, args)      fun mkDiderotApply (f, args) = CL.mkApply("diderot::" ^ f, args)
97        fun mkDiderotCall (f, args) = CL.mkCall("diderot::" ^ f, args)
98    
99    (* Translate a TreeIR operator application to a CLang expression *)    (* Translate a TreeIR operator application to a CLang expression *)
100      fun trOp (rator, args) = (case (rator, args)      fun trOp (env, rator, args) = (case (rator, args)
101             of (Op.IAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)             of (Op.IAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)
102              | (Op.ISub, [a, b]) => CL.mkBinOp(a, CL.#-, b)              | (Op.ISub, [a, b]) => CL.mkBinOp(a, CL.#-, b)
103              | (Op.IMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)              | (Op.IMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
# Line 108  Line 111 
111              | (Op.RNeg, [a]) => CL.mkUnOp(CL.%-, a)              | (Op.RNeg, [a]) => CL.mkUnOp(CL.%-, a)
112              | (Op.RClamp, [a, b, c]) => CL.mkApply("clamp", [a, b, c])              | (Op.RClamp, [a, b, c]) => CL.mkApply("clamp", [a, b, c])
113              | (Op.RLerp, [a, b, c]) => CL.mkApply("lerp", [a, b, c])              | (Op.RLerp, [a, b, c]) => CL.mkApply("lerp", [a, b, c])
114                | (Op.RCeiling, [a]) => mkStdApply("ceil", [a])
115                | (Op.RFloor, [a]) => mkStdApply("floor", [a])
116                | (Op.RRound, [a]) => mkStdApply("round", [a])
117                | (Op.RTrunc, [a]) => mkStdApply("trunc", [a])
118                | (Op.RealToInt, [a]) => mkStdApply("lround", [a])
119              | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)              | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)
120              | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)              | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)
121              | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)              | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)
# Line 123  Line 131 
131              | (Op.VScale d, [a, b]) => CL.mkApply("vscale", [a, b])              | (Op.VScale d, [a, b]) => CL.mkApply("vscale", [a, b])
132              | (Op.VMul d, [a, b]) => CL.mkBinOp(a, CL.#*, b)              | (Op.VMul d, [a, b]) => CL.mkBinOp(a, CL.#*, b)
133              | (Op.VNeg d, [a]) => CL.mkUnOp(CL.%-, a)              | (Op.VNeg d, [a]) => CL.mkUnOp(CL.%-, a)
134              | (Op.VSum d, [a]) => CL.mkApply("vsum", [a, b])              | (Op.VSum d, [a]) => CL.mkApply("vsum", [a])
135              | (Op.VIndex(d, i), [a]) => CL.mkSubscript(a, intExp i)              | (Op.VIndex(w, p, i), [a]) => CL.mkSubscript(a, intExp i)
136              | (Op.VClamp d, [a, b, c]) => CL.mkApply("clamp", [a, b, c])              | (Op.VClamp d, [a, b, c]) => CL.mkApply("vclamp", [a, b, c])
137              | (Op.VMapClamp d, [a, b, c]) => CL.mkApply("clamp", [a, b, c])              | (Op.VMapClamp d, [a, b, c]) => CL.mkApply("vclamp", [a, b, c])
138              | (Op.VLerp d, [a, b, c]) => CL.mkApply("lerp", [a, b, c])              | (Op.VLerp d, [a, b, c]) => CL.mkApply("vlerp", [a, b, c])
139              | (Op.TensorIndex(ty, idxs), [a]) => ??              | (Op.VCeiling d, [a]) => CL.mkApply("vceiling", [a])
140              | (Op.ProjectLast(ty, idxs), [a]) => ??              | (Op.VFloor d, [a]) => CL.mkApply("vfloor", [a])
141              | (Op.EigenVals2x2, [a]) => ??              | (Op.VRound d, [a]) => CL.mkApply("vround", [a])
142              | (Op.EigenVals3x3, [a]) => ??              | (Op.VTrunc d, [a]) => CL.mkApply("vtrunc", [a])
143              | (Op.Zero ty, []) => ??              | (Op.VToInt d, [a]) => CL.mkApply("vtoi", [a])
144              | (Op.Select(ty, i), [a]) => ??              | (Op.TensorIndex(Ty.TensorTy(_::dd), idxs), [a]) => let
145              | (Op.Subscript ty, [a, b]) => ??                (* dimensions/indices are slowest to fastest *)
146              | (Op.MkDynamic(ty, i), [a]) => ??                  fun index ([], [i], acc) = acc + i
147              | (Op.Append ty, [a, b]) => ??                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
148              | (Op.Prepend ty, [a, b]) => ??                  in
149              | (Op.Concat ty, [a, b]) => ??                    CL.mkSubscript(a, intExp(index (dd, idxs, 0)))
150              | (Op.Range, [a, b]) => ??                  end
151              | (Op.Length ty, [a]) => ??              | (Op.ProjectLast(Ty.TensorTy(_::dd), idxs), [a]) => let
152              | (Op.SphereQuery(ty1, ty2), []) => ??                (* dimensions/indices are slowest to fastest *)
153                    fun index ([], [], acc) = acc
154                      | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
155                    in
156                      CL.mkAddrOf(CL.mkSubscript(a, intExp(index (dd, idxs, 0))))
157                    end
158                | (Op.EigenVals2x2, [a]) => raise Fail "FIXME: EigenVals2x2"
159                | (Op.EigenVals3x3, [a]) => raise Fail "FIXME: EigenVals3x3"
160                | (Op.Select(ty, i), [a]) => raise Fail "FIXME: Select"
161                | (Op.Subscript ty, [a, b]) => CL.mkSubscript(a, b)
162                | (Op.MkDynamic(ty, i), [a]) => raise Fail "FIXME: MkDynamic"
163                | (Op.Append ty, [a, b]) => raise Fail "FIXME: Append"
164                | (Op.Prepend ty, [a, b]) => raise Fail "FIXME: Prepend"
165                | (Op.Concat ty, [a, b]) => raise Fail "FIXME: Concat"
166                | (Op.Range, [a, b]) => raise Fail "FIXME: Range"
167                | (Op.Length ty, [a]) => raise Fail "FIXME: Length"
168                | (Op.SphereQuery(ty1, ty2), []) => raise Fail "FIXME: SphereQuery"
169              | (Op.Sqrt, [a]) => mkStdApply("sqrt", [a])              | (Op.Sqrt, [a]) => mkStdApply("sqrt", [a])
170              | (Op.Cos, [a]) => mkStdApply("cos", [a])              | (Op.Cos, [a]) => mkStdApply("cos", [a])
171              | (Op.ArcCos, [a]) => mkStdApply("acos", [a])              | (Op.ArcCos, [a]) => mkStdApply("acos", [a])
# Line 150  Line 174 
174              | (Op.Tan, [a]) => mkStdApply("tan", [a])              | (Op.Tan, [a]) => mkStdApply("tan", [a])
175              | (Op.ArcTan, [a]) => mkStdApply("atan", [a])              | (Op.ArcTan, [a]) => mkStdApply("atan", [a])
176              | (Op.Exp, [a]) => mkStdApply("exp", [a])              | (Op.Exp, [a]) => mkStdApply("exp", [a])
177              | (Op.Ceiling 1, [a]) => mkStdApply("ceil", [a])              | (Op.IntToReal, [a]) => CL.mkStaticCast(Env.realTy env, a)
             | (Op.Ceiling d, [a]) => ??  
             | (Op.Floor 1, [a]) => mkStdApply("floor", [a])  
             | (Op.Floor d, [a]) => ??  
             | (Op.Round 1, [a]) => mkStdApply("round", [a])  
             | (Op.Round d, [a]) => ??  
             | (Op.Trunc 1, [a]) => mkStdApply("trun", [a])  
             | (Op.Trunc d, [a]) => ??  
             | (Op.IntToReal, [a]) => ??  
             | (Op.RealToInt 1, [a]) => ??  
             | (Op.RealToInt d, [a]) => ??  
178  (*  (*
179              | R_All of ty              | R_All of ty
180              | R_Exists of ty              | R_Exists of ty
# Line 171  Line 185 
185              | R_Mean of ty              | R_Mean of ty
186              | R_Variance of ty              | R_Variance of ty
187  *)  *)
188              | (Op.Transform info, [img]) => ??              | (Op.Transform info, [img]) => CL.mkDispatch(img, "world2image", [])
189              | (Op.Translate info, [img]) => ??              | (Op.Translate info, [img]) => CL.mkDispatch(img, "translate", [])
190              | (Op.BaseAddress info, [img]) => ??              | (Op.BaseAddress info, [img]) => CL.mkDispatch(img, "base_addr", [])
191              | (Op.ControlIndex(info, ctl, i), [a]) => ??              | (Op.ControlIndex(info, ctl, d), [img, idx]) =>
192              | (Op.Inside(info, i), [pos, img]) => ??                  CL.mkDispatch(img, IndexCtl.toString ctl, [intExp d, idx])
193              | (Op.ImageDim(info, i), [img]) => ??              | (Op.Inside(info, s), [pos, img]) => CL.mkDispatch(img, "inside", [pos, intExp s])
194              | (Op.LoadSeq(ty, file), []) => ??              | (Op.ImageDim(info, i), [img]) => CL.mkDispatch(img, "size", [intExp i])
             | (Op.LoadImage(ty, file), []) => ??  
195              | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, args)              | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, args)
196              | _ => raise Fail(concat[              | _ => raise Fail(concat[
197                     "unknown or incorrect operator ", Op.toString rator                     "unknown or incorrect operator ", Op.toString rator
# Line 187  Line 200 
200    
201      fun trExp (env, e) = (case e      fun trExp (env, e) = (case e
202             of IR.E_Global x => rvalueGlobalVar (env, x)             of IR.E_Global x => rvalueGlobalVar (env, x)
203              | IR.E_State x => rvalueStateVar (env, x)              | IR.E_State(NONE, x) => rvalueStateVar (env, x)
204                | IR.E_State(SOME e, x) => CL.mkIndirect(trExp(env, e), TreeStateVar.name x)
205              | IR.E_Var x => rvalueVar (env, x)              | IR.E_Var x => rvalueVar (env, x)
206              | IR.E_Lit(Literal.Int n) => CL.mkIntTy(n, !CTyN.gIntTy)              | IR.E_Lit(Literal.Int n) => CL.mkIntTy(n, Env.intTy env)
207              | IR.E_Lit(Literal.Bool b) => CL.mkBool b              | IR.E_Lit(Literal.Bool b) => CL.mkBool b
208              | IR.E_Lit(Literal.Real f) => CL.mkFlt(f, !CTyN.gRealTy)              | IR.E_Lit(Literal.Real f) => CL.mkFlt(f, Env.realTy env)
209              | IR.E_Lit(Literal.String s) => CL.mkStr s              | IR.E_Lit(Literal.String s) => CL.mkStr s
210              | IR.E_Op(rator, args) => trOp (rator, trExps(env, args))              | IR.E_Op(rator, args) => trOp (env, rator, trExps(env, args))
211              | IR.E_Vec(d, args) => ??              | IR.E_Vec(w, pw, args) => let
212              | IR.E_Cons(args, Ty.TensorTy shape) => ??                  val args = trExps (env, args)
213              | IR.E_Seq(args, ty) => ??                  val args = if (w < pw) then args @ List.tabulate(pw-w, fn _ => zero) else args
214              | IR.E_Pack(layout, args) => ??                  in
215              | IR.E_VLoad(layout, e, i) => ??                    CL.mkVec(CL.T_Named("vec" ^ Int.toString pw), args)
216                    end
217                | IR.E_Cons(args, Ty.TensorTy shape) => raise Fail "unexpected E_Cons"
218                | IR.E_Seq(args, ty) => raise Fail "unexpected E_Seq"
219                | IR.E_Pack(layout, args) => raise Fail "unexpected E_Pack"
220    (* FIXME: check if e is aligned and use "vload_aligned" in that case *)
221                | IR.E_VLoad(layout, e, i) =>
222                    CL.mkTemplateApply("vload",
223                      [trType(env, Ty.nthVec(layout, i))],
224                      [CL.mkBinOp(trExp(env, e), CL.#+, intExp(Ty.offsetOf(layout, i)))])
225                | _ => raise Fail "trExp"
226            (* end case *))            (* end case *))
227    
228      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
229    
230      fun trMultiAssign (env, lhs, IR.E_Op(rator, args)) = (case (lhs, rator, args)  (* QUESTION: not sure that we need this function? *)
231             of ([vals, vecs], Op.EigenVecs2x2, [m]) => let      fun trExpToVar (env, ty, name, exp) = (case trExp (env, exp)
232                  val (m, stms) = expToVar (env, CTyN.matTy(2,2), "m", m)             of e as CL.E_Var _ => (e, [])
233                | e => let
234                    val x = freshVar name
235                  in                  in
236                    stms @ [CL.mkCall(MathN.evecs2x2, [                    (CL.mkVar x, [CL.mkDeclInit(ty, x, e)])
                       vals, vecs,  
                       matIndex (m, CL.mkInt 0, CL.mkInt 0),  
                       matIndex (m, CL.mkInt 0, CL.mkInt 1),  
                       matIndex (m, CL.mkInt 1, CL.mkInt 1)  
                     ])]  
                 end  
             | ([vals, vecs], Op.EigenVecs3x3, [m]) => let  
                 val (m, stms) = expToVar (env, CTyN.matTy(3,3), "m", m)  
                 in  
                   stms @ [CL.mkCall(MathN.evecs3x3, [  
                       vals, vecs,  
                       matIndex (m, CL.mkInt 0, CL.mkInt 0),  
                       matIndex (m, CL.mkInt 0, CL.mkInt 1),  
                       matIndex (m, CL.mkInt 0, CL.mkInt 2),  
                       matIndex (m, CL.mkInt 1, CL.mkInt 1),  
                       matIndex (m, CL.mkInt 1, CL.mkInt 2),  
                       matIndex (m, CL.mkInt 2, CL.mkInt 2)  
                     ])]  
237                  end                  end
238              (* end case *))
239    
240        fun trAssign (env, lhs, rhs) = let
241              fun trArg (i, arg) = CL.mkAssign(CL.mkSubscript(lhs, intExp i), trExp (env, arg))
242              in
243                case rhs
244                 of IR.E_Pack(_, args) => [CL.mkCall ("vpack", List.map (fn e => trExp(env, e)) args)]
245                  | IR.E_Cons(args, _) => List.mapi trArg args
246                  | IR.E_Seq(args, _) => List.mapi trArg args
247                  | _ => [CL.mkAssign(lhs, trExp (env, rhs))]
248                (* end case *)
249              end
250    
251        fun trDecl (env, ty, lhs, rhs) = let
252              fun trArgs args = CL.mkDecl(
253                    ty, lhs, SOME(CL.I_Exps(List.map (fn arg => CL.I_Exp(trExp (env, arg))) args)))
254              in
255                case rhs
256                 of IR.E_Cons(args, _) => trArgs args
257                  | IR.E_Seq(args, _) => trArgs args
258                  | _ => CL.mkDeclInit(ty, lhs, trExp (env, rhs))
259                (* end case *)
260              end
261    
262        fun trMultiAssign (env, lhs, IR.E_Op(rator, args)) = (case (lhs, rator, args)
263               of ([vals, vecs], Op.EigenVecs2x2, [exp]) =>
264                    mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])
265                | ([vals, vecs], Op.EigenVecs3x3, [exp]) =>
266                    mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])
267              | _ => raise Fail "bogus multi-assignment"              | _ => raise Fail "bogus multi-assignment"
268            (* end case *))            (* end case *))
269        | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"        | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
270    
271      fun trLocals (env : env, locals) =      fun trStms (env, stms : TreeIR.stm list) = let
           List.foldl  
             (fn (x, env) => VMap.insert(env, x, V(trType(V.ty x), V.name x)))  
               env locals  
   
     fun trStms (env, stms : CL.stm list) = let  
272            fun trStm (stm, (env, stms : CL.stm list)) = (case stm            fun trStm (stm, (env, stms : CL.stm list)) = (case stm
273                   of IR.S_Comment text => (env, CL.mkComment text :: stms)                   of IR.S_Comment text => (env, CL.mkComment text :: stms)
274                    | IR.S_Assign(isDecl, x, exp) => let                    | IR.S_Assign(true, x, exp) => let
275                        val (env, stm) = trAssign (env, lvalueVar (env, x), exp)                        val ty = trType (env, V.ty x)
276                          val x' = V.name x
277                          val env = Env.insert (env, x, x')
278                        in                        in
279                          (env, stm::stms)                          (env, trDecl (env, ty, x', exp) :: stms)
280                          end
281                      | IR.S_Assign(false, x, exp) => let
282                          val stms' = trAssign (env, lvalueVar (env, x), exp)
283                          in
284                            (env, stms' @ stms)
285                        end                        end
286                    | IR.S_MAssign(xs, exp) =>                    | IR.S_MAssign(xs, exp) =>
287                        (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)
288                    | IR.S_GAssign(x, exp) =>                    | IR.S_GAssign(x, exp) =>
289                        (env, trAssign (env, lvalueGlobalVar (env, x), exp) :: stms)                        (env, trAssign (env, lvalueGlobalVar (env, x), exp) @ stms)
290                    | IR.S_IfThen(cond, thenBlk) =>                    | IR.S_IfThen(cond, thenBlk) =>
291                        (env, CL.mkIfThen(trExp(env, cond), trBlock(env, thenBlk)) :: stms)                        (env, CL.mkIfThen(trExp(env, cond), trBlock(env, thenBlk)) :: stms)
292                    | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let                    | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let
# Line 257  Line 296 
296                        in                        in
297                          (env, stm :: stms)                          (env, stm :: stms)
298                        end                        end
299                    | IR.S_Foreach(x, IR.E_Op(Op.Range, [lo, hi]), blk) => ??                    | IR.S_Foreach(x, IR.E_Op(Op.Range, [lo, hi]), blk) => let
300                    | IR.S_Foreach(x, e, blk) => ??                        val x' = V.name x
301                    | IR.S_New(strand, args) => ??                        val env' = Env.insert (env, x, x')
302                    | IR.S_Save(x, exp) => trAssign (env, lvalueStateVar(env, x), exp)                        val (hi', hiInit) = if CodeGenUtil.isSimple hi
303                    | IR.S_LoadNrrd(lhs, Ty.SeqTy(ty, NONE), nrrd) =>                              then (trExp(env, hi), [])
304                        (env, GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd) :: stms)                              else let
305                    | IR.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) =>                                val hi' = freshVar "hi"
306                        (env, GenLoadNrrd.loadImage (lvalueVar (env, lhs), info, CL.mkStr nrrd) :: stms)                                in
307                                    (CL.mkVar hi', [CL.mkDeclInit(CL.int32, hi', trExp(env, hi))])
308                                  end
309                          val loop = CL.mkFor(
310                                [(CL.int32, x', trExp(env, lo))],
311                                CL.mkBinOp(CL.mkVar x', CL.#<=, hi'),
312                                [CL.mkUnOp(CL.%++, CL.mkVar x')],
313                                trBlock (env', blk))
314                          in
315                            (env, hiInit @ loop :: stms)
316                          end
317                      | IR.S_Foreach(x, e, blk) => raise Fail "Foreach"
318                      | IR.S_New(strand, args) => raise Fail "New"
319                      | IR.S_Save(x, exp) => (env, trAssign (env, lvalueStateVar(env, x), exp))
320                      | IR.S_LoadNrrd(lhs, ty, nrrd) => let
321                          val stm = (case ty
322                                 of APITypes.SeqTy(ty, NONE) =>
323                                      GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd)
324                                  | APITypes.ImageTy _ =>
325                                      GenLoadNrrd.loadImage (lvalueVar (env, lhs), CL.mkStr nrrd)
326                                  | _ => raise Fail(concat[
327                                        "bogus type ", APITypes.toString ty, " for LoadNrrd"
328                                      ])
329                                (* end case *))
330                          in
331                            (env, stm :: stms)
332                          end
333                    | IR.S_Input(_, _, _, NONE) => (env, stms)                    | IR.S_Input(_, _, _, NONE) => (env, stms)
334                    | IR.S_Input(gv, name, _, SOME dflt) =>                    | IR.S_Input(gv, name, _, SOME dflt) =>
335                        (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)                        (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)
# Line 278  Line 343 
343                        in                        in
344                          (env, stm::stms)                          (env, stm::stms)
345                        end                        end
346                    | IR.S_Active => (env, CL.mkReturn(SOME(CL.mkVar RN.kActive)) :: stms)                    | IR.S_Active => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kActive")) :: stms)
347                    | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar RN.kStabilize)) :: stms)                    | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kStabilize")) :: stms)
348                    | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar RN.kDie)) :: stms)                    | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kDie")) :: stms)
349                  (* end case *))                  (* end case *))
350            in            in
351              List.rev (#2 (List.foldl trStm (env, []) stms))              List.rev (#2 (List.foldl trStm (env, []) stms))
352            end            end
353    
354      and trBlock (env, IR.Block{locals, body}) = let      and trBlock (env, IR.Block{locals, body}) = let
355            val env = trLocals (env, locals)            fun trLocal (x, (env, dcls)) = let
356            val stms = trStms (env, body)                  val x' = V.name x
357            fun mkDecl (x, stms) = (case VMap.find (env, x)                  val dcl = CL.mkDecl(trType(env, V.ty x), x', NONE)
                  of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms  
                   | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])  
                 (* end case *))  
           val stms = List.foldr mkDecl stms locals  
358            in            in
359              CL.mkBlock stms                    (Env.insert(env, x, x'), dcl :: dcls)
360            end            end
361              val (env, dcls) = List.foldl trLocal (env, []) (!locals)
362              in
363                CL.mkBlock (dcls @ trStms (env, body))
364              end
365    
366        fun errorMsgAdd msg =
367              CL.mkCall("biffMsgAdd", [CL.mkIndirect(CL.mkVar "wrld", "_errors"), msg])
368    
369    end    end

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

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