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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3958 - (view) (download)

1 : jhr 3866 (* tree-to-cxx.sml
2 : jhr 3768 *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2016 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 : jhr 3866 * Translate TreeIR to the C++ version of CLang.
9 : jhr 3768 *)
10 :    
11 :    
12 : jhr 3866 structure TreeToCxx : sig
13 : jhr 3768
14 : jhr 3886 val trType : CodeGenEnv.t * TreeTypes.t -> CLang.ty
15 : jhr 3768
16 : jhr 3873 val trBlock : CodeGenEnv.t * TreeIR.block -> CLang.stm
17 : jhr 3768
18 : jhr 3924 val trWithLocals : CodeGenEnv.t * TreeVar.t list * (CodeGenEnv.t -> CLang.stm list) -> CLang.stm
19 :    
20 : jhr 3927 val trStms : CodeGenEnv.t * TreeIR.stm list -> CodeGenEnv.t * CLang.stm list
21 : jhr 3924
22 : jhr 3873 val trExp : CodeGenEnv.t * TreeIR.exp -> CLang.exp
23 : jhr 3768
24 : jhr 3866 (* translate an expression to a variable form; return the variable (as an expression)
25 : jhr 3768 * and the (optional) declaration.
26 :     *)
27 : jhr 3876 val trExpToVar : CodeGenEnv.t * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list
28 : jhr 3768
29 : jhr 3873 val trAssign : CodeGenEnv.t * CLang.exp * TreeIR.exp -> CLang.stm list
30 : jhr 3768
31 : jhr 3900 (* generate code to register an error message (require that a world pointer "wrld" is in scope) *)
32 : jhr 3927 val errorMsgAdd : CodeGenEnv.t * CLang.exp -> CLang.stm
33 : jhr 3900
34 : jhr 3927 val trParam : CodeGenEnv.t * TreeIR.var -> CodeGenEnv.t * CLang.param
35 : jhr 3917
36 : jhr 3768 end = struct
37 :    
38 :     structure CL = CLang
39 :     structure IR = TreeIR
40 :     structure Op = TreeOps
41 :     structure Ty = TreeTypes
42 : jhr 3866 structure V = TreeVar
43 : jhr 3873 structure Env = CodeGenEnv
44 : jhr 3918 structure RN = CxxNames
45 : jhr 3768
46 : jhr 3886 fun trType (env, ty) = (case ty
47 :     of Ty.BoolTy => CL.boolTy
48 :     | 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 : jhr 3955 | (Ty.TensorTy dd) => CL.T_Array(Env.realTy env, SOME(List.foldl Int.* 1 dd))
53 :     | (Ty.TensorRefTy _) => CL.constPtrTy(Env.realTy env)
54 : jhr 3894 | (Ty.TupleTy tys) => raise Fail "FIXME: TupleTy"
55 : jhr 3886 | (Ty.SeqTy(t, NONE)) => CL.T_Template("diderot::dynseq", [trType(env, t)])
56 :     | (Ty.SeqTy(t, SOME n)) => CL.T_Array(trType(env, t), SOME n)
57 :     | (Ty.ImageTy info) =>
58 :     CL.T_Template(
59 :     concat["diderot::image", Int.toString(ImageInfo.dim info), "d"],
60 :     [Env.realTy env])
61 :     | (Ty.StrandTy name) => CL.T_Named("strand_" ^ Atom.toString name)
62 :     (* end case *))
63 : jhr 3768
64 : jhr 3866 (* translate a local variable that occurs in an l-value context *)
65 : jhr 3873 fun lvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
66 : jhr 3866 (* translate a variable that occurs in an r-value context *)
67 : jhr 3873 fun rvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
68 : jhr 3768
69 : jhr 3866 (* translate a global variable that occurs in an l-value context *)
70 : jhr 3924 fun lvalueGlobalVar (env, x) = CL.mkIndirect(CL.mkVar(Env.global env), TreeGlobalVar.qname x)
71 : jhr 3866 (* translate a global variable that occurs in an r-value context *)
72 :     val rvalueGlobalVar = lvalueGlobalVar
73 :    
74 :     (* translate a strand state variable that occurs in an l-value context *)
75 : jhr 3924 fun lvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfOut env), TreeStateVar.qname x)
76 : jhr 3866 (* translate a strand state variable that occurs in an r-value context *)
77 : jhr 3924 fun rvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfIn env), TreeStateVar.qname x)
78 : jhr 3866
79 : jhr 3927 fun worldVar env = CL.mkVar(Env.world env)
80 :    
81 : jhr 3866 (* generate new variables *)
82 : jhr 3926 val freshVar = CodeGenUtil.freshVar
83 : jhr 3866
84 :     (* integer literal expression *)
85 :     fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
86 :    
87 : jhr 3893 val zero = CL.mkInt 0
88 :    
89 : jhr 3866 fun addrOf e = CL.mkUnOp(CL.%&, e)
90 :    
91 :     (* make an application of a function from the "std" namespace *)
92 :     fun mkStdApply (f, args) = CL.mkApply("std::" ^ f, args)
93 :    
94 :     (* make an application of a function from the "diderot" namespace *)
95 :     fun mkDiderotApply (f, args) = CL.mkApply("diderot::" ^ f, args)
96 : jhr 3872 fun mkDiderotCall (f, args) = CL.mkCall("diderot::" ^ f, args)
97 : jhr 3866
98 : jhr 3810 (* Translate a TreeIR operator application to a CLang expression *)
99 : jhr 3886 fun trOp (env, rator, args) = (case (rator, args)
100 : jhr 3870 of (Op.IAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)
101 : jhr 3768 | (Op.ISub, [a, b]) => CL.mkBinOp(a, CL.#-, b)
102 :     | (Op.IMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
103 :     | (Op.IDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)
104 :     | (Op.IMod, [a, b]) => CL.mkBinOp(a, CL.#%, b)
105 :     | (Op.INeg, [a]) => CL.mkUnOp(CL.%-, a)
106 :     | (Op.RAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)
107 :     | (Op.RSub, [a, b]) => CL.mkBinOp(a, CL.#-, b)
108 :     | (Op.RMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
109 :     | (Op.RDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)
110 :     | (Op.RNeg, [a]) => CL.mkUnOp(CL.%-, a)
111 : jhr 3870 | (Op.RClamp, [a, b, c]) => CL.mkApply("clamp", [a, b, c])
112 :     | (Op.RLerp, [a, b, c]) => CL.mkApply("lerp", [a, b, c])
113 : jhr 3886 | (Op.RCeiling, [a]) => mkStdApply("ceil", [a])
114 :     | (Op.RFloor, [a]) => mkStdApply("floor", [a])
115 :     | (Op.RRound, [a]) => mkStdApply("round", [a])
116 :     | (Op.RTrunc, [a]) => mkStdApply("trunc", [a])
117 :     | (Op.RealToInt, [a]) => mkStdApply("lround", [a])
118 : jhr 3768 | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)
119 :     | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)
120 :     | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)
121 :     | (Op.NEQ ty, [a, b]) => CL.mkBinOp(a, CL.#!=, b)
122 :     | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)
123 :     | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)
124 :     | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)
125 : jhr 3866 | (Op.Abs ty, args) => mkStdApply("abs", args)
126 :     | (Op.Max ty, args) => mkStdApply("min", args)
127 :     | (Op.Min ty, args) => mkStdApply("max", args)
128 :     | (Op.VAdd d, [a, b]) => CL.mkBinOp(a, CL.#+, b)
129 :     | (Op.VSub d, [a, b]) => CL.mkBinOp(a, CL.#-, b)
130 : jhr 3870 | (Op.VScale d, [a, b]) => CL.mkApply("vscale", [a, b])
131 : jhr 3866 | (Op.VMul d, [a, b]) => CL.mkBinOp(a, CL.#*, b)
132 :     | (Op.VNeg d, [a]) => CL.mkUnOp(CL.%-, a)
133 : jhr 3922 | (Op.VSum(w, _), [a]) => CL.mkApply(RN.vsum w, [a])
134 : jhr 3886 | (Op.VIndex(w, p, i), [a]) => CL.mkSubscript(a, intExp i)
135 : jhr 3922 | (Op.VClamp(w, _), [a, b, c]) => CL.mkApply("vclamp", [a, b, c])
136 :     | (Op.VMapClamp(w, _), [a, b, c]) => CL.mkApply("vclamp", [a, b, c])
137 :     | (Op.VLerp(w, _), [a, b, c]) => CL.mkApply("vlerp", [a, b, c])
138 : jhr 3886 | (Op.VCeiling d, [a]) => CL.mkApply("vceiling", [a])
139 :     | (Op.VFloor d, [a]) => CL.mkApply("vfloor", [a])
140 :     | (Op.VRound d, [a]) => CL.mkApply("vround", [a])
141 :     | (Op.VTrunc d, [a]) => CL.mkApply("vtrunc", [a])
142 : jhr 3958 | (Op.TensorIndex(Ty.TensorRefTy(_::dd), idxs), [a]) => let
143 : jhr 3886 (* dimensions/indices are slowest to fastest *)
144 :     fun index ([], [i], acc) = acc + i
145 :     | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
146 :     in
147 :     CL.mkSubscript(a, intExp(index (dd, idxs, 0)))
148 :     end
149 : jhr 3958 | (Op.ProjectLast(Ty.TensorRefTy(_::dd), idxs), [a]) => let
150 : jhr 3886 (* dimensions/indices are slowest to fastest *)
151 :     fun index ([], [], acc) = acc
152 :     | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
153 :     in
154 :     CL.mkAddrOf(CL.mkSubscript(a, intExp(index (dd, idxs, 0))))
155 :     end
156 :     | (Op.EigenVals2x2, [a]) => raise Fail "FIXME: EigenVals2x2"
157 :     | (Op.EigenVals3x3, [a]) => raise Fail "FIXME: EigenVals3x3"
158 :     | (Op.Select(ty, i), [a]) => raise Fail "FIXME: Select"
159 :     | (Op.Subscript ty, [a, b]) => CL.mkSubscript(a, b)
160 :     | (Op.MkDynamic(ty, i), [a]) => raise Fail "FIXME: MkDynamic"
161 :     | (Op.Append ty, [a, b]) => raise Fail "FIXME: Append"
162 :     | (Op.Prepend ty, [a, b]) => raise Fail "FIXME: Prepend"
163 :     | (Op.Concat ty, [a, b]) => raise Fail "FIXME: Concat"
164 :     | (Op.Range, [a, b]) => raise Fail "FIXME: Range"
165 :     | (Op.Length ty, [a]) => raise Fail "FIXME: Length"
166 :     | (Op.SphereQuery(ty1, ty2), []) => raise Fail "FIXME: SphereQuery"
167 : jhr 3870 | (Op.Sqrt, [a]) => mkStdApply("sqrt", [a])
168 :     | (Op.Cos, [a]) => mkStdApply("cos", [a])
169 :     | (Op.ArcCos, [a]) => mkStdApply("acos", [a])
170 :     | (Op.Sin, [a]) => mkStdApply("sin", [a])
171 :     | (Op.ArcSin, [a]) => mkStdApply("asin", [a])
172 :     | (Op.Tan, [a]) => mkStdApply("tan", [a])
173 :     | (Op.ArcTan, [a]) => mkStdApply("atan", [a])
174 :     | (Op.Exp, [a]) => mkStdApply("exp", [a])
175 : jhr 3886 | (Op.IntToReal, [a]) => CL.mkStaticCast(Env.realTy env, a)
176 : jhr 3768 (*
177 :     | R_All of ty
178 :     | R_Exists of ty
179 :     | R_Max of ty
180 :     | R_Min of ty
181 :     | R_Sum of ty
182 :     | R_Product of ty
183 :     | R_Mean of ty
184 :     | R_Variance of ty
185 :     *)
186 : jhr 3886 | (Op.Transform info, [img]) => CL.mkDispatch(img, "world2image", [])
187 :     | (Op.Translate info, [img]) => CL.mkDispatch(img, "translate", [])
188 :     | (Op.BaseAddress info, [img]) => CL.mkDispatch(img, "base_addr", [])
189 :     | (Op.ControlIndex(info, ctl, d), [img, idx]) =>
190 :     CL.mkDispatch(img, IndexCtl.toString ctl, [intExp d, idx])
191 : jhr 3927 | (Op.LoadVoxel info, [addr, offp]) => let
192 :     val voxel = CL.mkSubscript(addr, offp)
193 :     in
194 :     if RawTypes.same(ImageInfo.sampleTy info, Env.rawRealTy env)
195 :     then voxel
196 :     else CL.mkStaticCast(Env.realTy env, voxel)
197 :     end
198 : jhr 3886 | (Op.Inside(info, s), [pos, img]) => CL.mkDispatch(img, "inside", [pos, intExp s])
199 :     | (Op.ImageDim(info, i), [img]) => CL.mkDispatch(img, "size", [intExp i])
200 : jhr 3870 | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, args)
201 : jhr 3866 | _ => raise Fail(concat[
202 :     "unknown or incorrect operator ", Op.toString rator
203 :     ])
204 : jhr 3768 (* end case *))
205 :    
206 : jhr 3866 fun trExp (env, e) = (case e
207 :     of IR.E_Global x => rvalueGlobalVar (env, x)
208 : jhr 3872 | IR.E_State(NONE, x) => rvalueStateVar (env, x)
209 :     | IR.E_State(SOME e, x) => CL.mkIndirect(trExp(env, e), TreeStateVar.name x)
210 : jhr 3866 | IR.E_Var x => rvalueVar (env, x)
211 : jhr 3876 | IR.E_Lit(Literal.Int n) => CL.mkIntTy(n, Env.intTy env)
212 : jhr 3866 | IR.E_Lit(Literal.Bool b) => CL.mkBool b
213 : jhr 3876 | IR.E_Lit(Literal.Real f) => CL.mkFlt(f, Env.realTy env)
214 : jhr 3866 | IR.E_Lit(Literal.String s) => CL.mkStr s
215 : jhr 3886 | IR.E_Op(rator, args) => trOp (env, rator, trExps(env, args))
216 : jhr 3919 | IR.E_Vec(w, pw, args) => CL.mkApply(RN.vcons w, trExps (env, args))
217 : jhr 3893 | IR.E_Cons(args, Ty.TensorTy shape) => raise Fail "unexpected E_Cons"
218 :     | IR.E_Seq(args, ty) => raise Fail "unexpected E_Seq"
219 : jhr 3894 | 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 : jhr 3919 CL.mkApply(RN.vload(Ty.nthWidth(layout, i)),
223 : jhr 3894 [CL.mkBinOp(trExp(env, e), CL.#+, intExp(Ty.offsetOf(layout, i)))])
224 :     | _ => raise Fail "trExp"
225 : jhr 3866 (* end case *))
226 :    
227 :     and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
228 :    
229 : jhr 3873 (* QUESTION: not sure that we need this function? *)
230 : jhr 3872 fun trExpToVar (env, ty, name, exp) = (case trExp (env, exp)
231 :     of e as CL.E_Var _ => (e, [])
232 :     | e => let
233 : jhr 3893 val x = freshVar name
234 : jhr 3872 in
235 : jhr 3876 (CL.mkVar x, [CL.mkDeclInit(ty, x, e)])
236 : jhr 3872 end
237 : jhr 3873 (* end case *))
238 : jhr 3872
239 : jhr 3955 (* FIXME: trAssign and trDecl do the same analysis of the rhs; we should factor that out *)
240 : jhr 3893 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 : jhr 3950 of IR.E_Op(Op.VToInt _, [a]) => [CL.mkCall ("vtoi", [lhs, trExp(env, a)])]
245 : jhr 3955 | IR.E_Op(Op.TensorCopy shp, [a]) =>
246 :     [CL.mkCall (RN.tensorCopy shp, [lhs, trExp(env, a)])]
247 :     | IR.E_Pack({wid, ...}, args) =>
248 :     [CL.mkCall (RN.vpack wid, lhs :: List.map (fn e => trExp(env, e)) args)]
249 : jhr 3894 | IR.E_Cons(args, _) => List.mapi trArg args
250 : jhr 3893 | IR.E_Seq(args, _) => List.mapi trArg args
251 :     | _ => [CL.mkAssign(lhs, trExp (env, rhs))]
252 :     (* end case *)
253 :     end
254 : jhr 3872
255 : jhr 3893 fun trDecl (env, ty, lhs, rhs) = let
256 :     fun trArgs args = CL.mkDecl(
257 :     ty, lhs, SOME(CL.I_Exps(List.map (fn arg => CL.I_Exp(trExp (env, arg))) args)))
258 :     in
259 :     case rhs
260 : jhr 3950 of IR.E_Op(Op.VToInt _, [a]) => [ (* NOTE: reverse order! *)
261 :     CL.mkCall ("vtoi", [CL.mkVar lhs, trExp(env, a)]),
262 :     CL.mkDecl(ty, lhs, NONE)
263 :     ]
264 : jhr 3955 | IR.E_Op(Op.TensorCopy shp, [a]) => [ (* NOTE: reverse order! *)
265 :     CL.mkCall (RN.tensorCopy shp, [CL.mkVar lhs, trExp(env, a)]),
266 :     CL.mkDecl(ty, lhs, NONE)
267 :     ]
268 : jhr 3950 | IR.E_Cons(args, _) => [trArgs args]
269 :     | IR.E_Seq(args, _) => [trArgs args]
270 :     | _ => [CL.mkDeclInit(ty, lhs, trExp (env, rhs))]
271 : jhr 3893 (* end case *)
272 :     end
273 : jhr 3872
274 : jhr 3870 fun trMultiAssign (env, lhs, IR.E_Op(rator, args)) = (case (lhs, rator, args)
275 : jhr 3876 of ([vals, vecs], Op.EigenVecs2x2, [exp]) =>
276 : jhr 3872 mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])
277 : jhr 3876 | ([vals, vecs], Op.EigenVecs3x3, [exp]) =>
278 : jhr 3872 mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])
279 : jhr 3870 | _ => raise Fail "bogus multi-assignment"
280 :     (* end case *))
281 :     | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
282 : jhr 3866
283 : jhr 3918 fun trPrintStm (outS, tys, args) = let
284 :     fun mkExp (lhs, [], []) = CL.mkBinOp(lhs, CL.#<<, CL.mkVar "std::end")
285 :     | mkExp (lhs, ty::tys, e::es) = let
286 :     (* if necessary, wrap the argument so that the correct "<<" instance is used *)
287 :     val e = (case ty
288 :     of Ty.TensorTy shape => CL.mkApply(RN.tensorStruct shape, [e])
289 :     | _ => e
290 :     (* end case *))
291 :     in
292 :     mkExp (CL.mkBinOp(lhs, CL.#<<, e), tys, es)
293 :     end
294 :     | mkExp _ = raise Fail "trPrintStm: arity mismatch"
295 :     in
296 :     CL.mkExpStm (mkExp (outS, tys, args))
297 :     end
298 :    
299 : jhr 3872 fun trStms (env, stms : TreeIR.stm list) = let
300 : jhr 3870 fun trStm (stm, (env, stms : CL.stm list)) = (case stm
301 :     of IR.S_Comment text => (env, CL.mkComment text :: stms)
302 : jhr 3872 | IR.S_Assign(true, x, exp) => let
303 : jhr 3893 val ty = trType (env, V.ty x)
304 : jhr 3894 val x' = V.name x
305 : jhr 3893 val env = Env.insert (env, x, x')
306 : jhr 3872 in
307 : jhr 3950 (env, trDecl (env, ty, x', exp) @ stms)
308 : jhr 3872 end
309 :     | IR.S_Assign(false, x, exp) => let
310 : jhr 3893 val stms' = trAssign (env, lvalueVar (env, x), exp)
311 : jhr 3866 in
312 : jhr 3893 (env, stms' @ stms)
313 : jhr 3866 end
314 :     | IR.S_MAssign(xs, exp) =>
315 : jhr 3886 (env, trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp) :: stms)
316 : jhr 3866 | IR.S_GAssign(x, exp) =>
317 : jhr 3893 (env, trAssign (env, lvalueGlobalVar (env, x), exp) @ stms)
318 : jhr 3866 | IR.S_IfThen(cond, thenBlk) =>
319 : jhr 3870 (env, CL.mkIfThen(trExp(env, cond), trBlock(env, thenBlk)) :: stms)
320 : jhr 3866 | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let
321 :     val stm = CL.mkIfThenElse(trExp(env, cond),
322 : jhr 3870 trBlock(env, thenBlk),
323 :     trBlock(env, elseBlk))
324 : jhr 3866 in
325 :     (env, stm :: stms)
326 :     end
327 : jhr 3924 | IR.S_For(x, lo, hi, blk) => let
328 : jhr 3876 val x' = V.name x
329 :     val env' = Env.insert (env, x, x')
330 : jhr 3894 val (hi', hiInit) = if CodeGenUtil.isSimple hi
331 :     then (trExp(env, hi), [])
332 :     else let
333 :     val hi' = freshVar "hi"
334 :     in
335 :     (CL.mkVar hi', [CL.mkDeclInit(CL.int32, hi', trExp(env, hi))])
336 :     end
337 : jhr 3876 val loop = CL.mkFor(
338 : jhr 3894 [(CL.int32, x', trExp(env, lo))],
339 : jhr 3876 CL.mkBinOp(CL.mkVar x', CL.#<=, hi'),
340 : jhr 3886 [CL.mkUnOp(CL.%++, CL.mkVar x')],
341 : jhr 3876 trBlock (env', blk))
342 :     in
343 : jhr 3894 (env, hiInit @ loop :: stms)
344 : jhr 3876 end
345 : jhr 3894 | IR.S_Foreach(x, e, blk) => raise Fail "Foreach"
346 : jhr 3927 | IR.S_New(strand, args) => let
347 :     val args = List.map (fn e => trExp(env, e)) args
348 :     val stm = CL.mkCall(
349 :     Atom.toString strand ^ "_new",
350 :     worldVar env :: args)
351 :     in
352 :     (env, stm :: stms)
353 :     end
354 : jhr 3922 | IR.S_Save(x, exp) => (env, trAssign (env, lvalueStateVar(env, x), exp) @ stms)
355 : jhr 3894 | IR.S_LoadNrrd(lhs, ty, nrrd) => let
356 :     val stm = (case ty
357 :     of APITypes.SeqTy(ty, NONE) =>
358 : jhr 3886 GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd)
359 : jhr 3900 | APITypes.ImageTy _ =>
360 :     GenLoadNrrd.loadImage (lvalueVar (env, lhs), CL.mkStr nrrd)
361 : jhr 3894 | _ => raise Fail(concat[
362 :     "bogus type ", APITypes.toString ty, " for LoadNrrd"
363 :     ])
364 : jhr 3886 (* end case *))
365 :     in
366 :     (env, stm :: stms)
367 :     end
368 : jhr 3870 | IR.S_Input(_, _, _, NONE) => (env, stms)
369 :     | IR.S_Input(gv, name, _, SOME dflt) =>
370 :     (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)
371 : jhr 3866 | IR.S_InputNrrd _ => (env, stms)
372 : jhr 3870 | IR.S_Exit => (env, stms)
373 :     | IR.S_Print(tys, args) => let
374 :     val args = List.map (fn e => trExp(env, e)) args
375 : jhr 3918 val stm = trPrintStm (
376 : jhr 3927 CL.mkIndirect(worldVar env, "_output"),
377 : jhr 3870 tys, args)
378 :     in
379 :     (env, stm::stms)
380 :     end
381 : jhr 3876 | IR.S_Active => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kActive")) :: stms)
382 :     | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kStabilize")) :: stms)
383 :     | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kDie")) :: stms)
384 : jhr 3866 (* end case *))
385 : jhr 3927 val (env, stms) = List.foldl trStm (env, []) stms
386 : jhr 3866 in
387 : jhr 3927 (env, List.rev stms)
388 : jhr 3866 end
389 :    
390 :     and trBlock (env, IR.Block{locals, body}) = let
391 : jhr 3873 fun trLocal (x, (env, dcls)) = let
392 :     val x' = V.name x
393 : jhr 3886 val dcl = CL.mkDecl(trType(env, V.ty x), x', NONE)
394 : jhr 3873 in
395 : jhr 3886 (Env.insert(env, x, x'), dcl :: dcls)
396 : jhr 3873 end
397 :     val (env, dcls) = List.foldl trLocal (env, []) (!locals)
398 : jhr 3927 val (_, stms) = trStms (env, body)
399 : jhr 3866 in
400 : jhr 3927 CL.mkBlock (dcls @ stms)
401 : jhr 3866 end
402 :    
403 : jhr 3924 and trWithLocals (env, locals, trBody) = let
404 :     fun trLocal (x, (env, dcls)) = let
405 :     val x' = V.name x
406 :     val dcl = CL.mkDecl(trType(env, V.ty x), x', NONE)
407 :     in
408 :     (Env.insert(env, x, x'), dcl :: dcls)
409 :     end
410 :     val (env, dcls) = List.foldl trLocal (env, []) locals
411 :     in
412 :     CL.mkBlock (dcls @ trBody env)
413 :     end
414 :    
415 : jhr 3927 fun errorMsgAdd (env, msg) =
416 :     CL.mkCall("biffMsgAdd", [CL.mkIndirect(worldVar env, "_errors"), msg])
417 : jhr 3900
418 : jhr 3927 fun trParam (env, x)= let
419 : jhr 3917 val x' = V.name x
420 :     in
421 : jhr 3927 (Env.insert (env, x, x'), CL.PARAM([], trType(env, V.ty x), x'))
422 : jhr 3917 end
423 :    
424 : jhr 3768 end

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