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

Legend:
Removed from v.3869  
changed lines
  Added in v.3924

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