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 5296 - (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 : jhr 5081 * COPYRIGHT (c) 2017 The University of Chicago
6 : jhr 3768 * 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 4380 val trLit : CodeGenEnv.t * Literal.t -> CLang.exp
23 :    
24 : jhr 3873 val trExp : CodeGenEnv.t * TreeIR.exp -> CLang.exp
25 : jhr 3768
26 : jhr 4500 (* returns an expression to access a state variable via the strands array. The third
27 : jhr 4590 * argument is the ID of the strand.
28 : jhr 4500 *)
29 : jhr 4590 val rvalueStateVarId : CodeGenEnv.t * TreeIR.state_var * CLang.exp -> CLang.exp
30 : jhr 4500
31 : jhr 4386 (* translate application of a TreeIR function to a C++ expression *)
32 :     val trApply : CodeGenEnv.t * TreeIR.func * TreeIR.exp list -> CLang.exp
33 :    
34 : jhr 3866 (* translate an expression to a variable form; return the variable (as an expression)
35 : jhr 3768 * and the (optional) declaration.
36 :     *)
37 : jhr 3876 val trExpToVar : CodeGenEnv.t * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list
38 : jhr 3768
39 : jhr 3900 (* generate code to register an error message (require that a world pointer "wrld" is in scope) *)
40 : jhr 3927 val errorMsgAdd : CodeGenEnv.t * CLang.exp -> CLang.stm
41 : jhr 3900
42 : jhr 3927 val trParam : CodeGenEnv.t * TreeIR.var -> CodeGenEnv.t * CLang.param
43 : jhr 3917
44 : jhr 5184 (* `loadNrrd (obj, arg, proxy)`
45 : jhr 4071 * returns code to load data from a nrrd. The `obj` specifies either an image or dynamic
46 :     * sequence object, and the `arg` specifies either a nrrd or nrrd file.
47 :     * The generated code checks the status of the load attempt and will return "true"
48 :     * (i.e., error) if the load fails.
49 :     *)
50 : jhr 5184 val loadNrrd : CLang.exp * CLang.exp * TreeIR.proxy -> CLang.stm
51 : jhr 4071
52 : jhr 3768 end = struct
53 :    
54 :     structure CL = CLang
55 :     structure IR = TreeIR
56 :     structure Op = TreeOps
57 :     structure Ty = TreeTypes
58 : jhr 3866 structure V = TreeVar
59 : jhr 4547 structure TSV = TreeStateVar
60 : jhr 3873 structure Env = CodeGenEnv
61 : jhr 3918 structure RN = CxxNames
62 : jhr 3768
63 : jhr 3988 val trType = TypeToCxx.trType
64 :     val dynseqTy = TypeToCxx.dynseqTy
65 : jhr 3768
66 : jhr 4500 fun worldVar env = CL.mkVar(Env.world env)
67 :    
68 : jhr 3866 (* translate a local variable that occurs in an l-value context *)
69 : jhr 3873 fun lvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
70 : jhr 3866 (* translate a variable that occurs in an r-value context *)
71 : jhr 3873 fun rvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
72 : jhr 3768
73 : jhr 3866 (* translate a global variable that occurs in an l-value context *)
74 : jhr 3924 fun lvalueGlobalVar (env, x) = CL.mkIndirect(CL.mkVar(Env.global env), TreeGlobalVar.qname x)
75 : jhr 3866 (* translate a global variable that occurs in an r-value context *)
76 :     val rvalueGlobalVar = lvalueGlobalVar
77 :    
78 : jhr 4500 local
79 :     fun isSharedVar (env, x) = TargetSpec.dualState(Env.target env)
80 : jhr 4591 andalso TSV.isShared x andalso TSV.isVarying x
81 : jhr 4500 fun strands env = CL.mkIndirect(worldVar env, "_strands")
82 :     in
83 : jhr 3866 (* translate a strand state variable that occurs in an l-value context *)
84 : jhr 4500 fun lvalueStateVar (env, x) = let
85 : jhr 4591 val sp = if isSharedVar (env, x)
86 :     then Env.selfOut env
87 :     else Env.selfLocal env
88 :     in
89 :     CL.mkIndirect(CL.mkVar sp, TSV.qname x)
90 :     end
91 : jhr 3866 (* translate a strand state variable that occurs in an r-value context *)
92 : jhr 4500 fun rvalueStateVar (env, x) = let
93 : jhr 4591 val sp = if isSharedVar (env, x)
94 :     then Env.selfIn env
95 :     else Env.selfLocal env
96 :     in
97 :     CL.mkIndirect(CL.mkVar sp, TSV.qname x)
98 :     end
99 : jhr 4590 (* returns an expression to access the (input) state variable for the strand
100 :     * with the given ID.
101 : jhr 4500 *)
102 : jhr 4590 fun rvalueStateVarId (env, x, id) = let
103 : jhr 4591 val m = if isSharedVar (env, x)
104 :     then "id_to_in_state"
105 :     else "id_to_local_state"
106 :     in
107 :     CL.mkIndirect(CL.mkDispatch(strands env, m, [id]), TSV.qname x)
108 :     end
109 : jhr 4500 end (* local *)
110 : jhr 3866
111 :     (* generate new variables *)
112 : jhr 3926 val freshVar = CodeGenUtil.freshVar
113 : jhr 3866
114 :     (* integer literal expression *)
115 : jhr 3982 fun mkInt (i : int) = CL.mkInt(IntInf.fromInt i)
116 : jhr 3866
117 : jhr 3893 val zero = CL.mkInt 0
118 :    
119 : jhr 3866 fun addrOf e = CL.mkUnOp(CL.%&, e)
120 :    
121 :     (* make an application of a function from the "std" namespace *)
122 :     fun mkStdApply (f, args) = CL.mkApply("std::" ^ f, args)
123 :    
124 :     (* make an application of a function from the "diderot" namespace *)
125 :     fun mkDiderotApply (f, args) = CL.mkApply("diderot::" ^ f, args)
126 : jhr 3872 fun mkDiderotCall (f, args) = CL.mkCall("diderot::" ^ f, args)
127 : jhr 4065 fun mkDynseqApply (env, ty, f, args) =
128 : jhr 4317 CL.mkQApply([CL.SC_Type(dynseqTy(env, ty))], f, args)
129 : jhr 3866
130 : jhr 5184 fun loadNrrd (obj, arg, NONE) =
131 : jhr 4317 CL.mkIfThen(CL.mkDispatch(obj, "load", [CL.mkVar "wrld", arg]),
132 :     CL.mkReturn(SOME(CL.mkVar "true")))
133 : jhr 5184 | loadNrrd (obj, arg, SOME info) = let
134 :     val vSz = List.foldl Int.* 1 (ImageInfo.voxelShape info)
135 :     val args = List.foldr
136 :     (fn (d, args) => mkInt d :: args)
137 :     [mkInt vSz] (ImageInfo.sizes info)
138 :     in
139 : jhr 5215 CL.mkBlock[
140 :     CL.mkDeclInit(CL.T_Named "diderot::nrrd_proxy", "proxy",
141 :     mkDiderotApply ("nrrd_proxy", args)),
142 :     CL.mkIfThen(
143 :     CL.mkDispatch(obj, "load", [
144 :     CL.mkVar "wrld", arg, CL.mkAddrOf(CL.mkVar "proxy")
145 :     ]),
146 :     CL.mkReturn(SOME(CL.mkVar "true")))
147 :     ]
148 : jhr 5184 end
149 : jhr 4071
150 : jhr 3810 (* Translate a TreeIR operator application to a CLang expression *)
151 : jhr 4412 fun trOp (env, rator, cxxArgs) = (case (rator, cxxArgs)
152 : jhr 4317 of (Op.IAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)
153 :     | (Op.ISub, [a, b]) => CL.mkBinOp(a, CL.#-, b)
154 :     | (Op.IMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
155 :     | (Op.IDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)
156 :     | (Op.IMod, [a, b]) => CL.mkBinOp(a, CL.#%, b)
157 :     | (Op.INeg, [a]) => CL.mkUnOp(CL.%-, a)
158 :     | (Op.RAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)
159 :     | (Op.RSub, [a, b]) => CL.mkBinOp(a, CL.#-, b)
160 :     | (Op.RMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
161 :     | (Op.RDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)
162 :     | (Op.RNeg, [a]) => CL.mkUnOp(CL.%-, a)
163 :     | (Op.RClamp, [a, b, c]) => CL.mkApply("clamp", [a, b, c])
164 :     | (Op.RLerp, [a, b, c]) => CL.mkApply("lerp", [a, b, c])
165 :     | (Op.RCeiling, [a]) => mkStdApply("ceil", [a])
166 :     | (Op.RFloor, [a]) => mkStdApply("floor", [a])
167 :     | (Op.RRound, [a]) => mkStdApply("round", [a])
168 :     | (Op.RTrunc, [a]) => mkStdApply("trunc", [a])
169 :     | (Op.RealToInt, [a]) => mkStdApply("lround", [a])
170 : jhr 3768 | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)
171 :     | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)
172 :     | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)
173 :     | (Op.NEQ ty, [a, b]) => CL.mkBinOp(a, CL.#!=, b)
174 :     | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)
175 :     | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)
176 : jhr 4434 | (Op.BAnd, [a, b]) => CL.mkBinOp(a, CL.#&&, b)
177 :     | (Op.BOr, [a, b]) => CL.mkBinOp(a, CL.#||, b)
178 :     | (Op.BNot, [a]) => CL.mkUnOp(CL.%!, a)
179 : jhr 4317 | (Op.Abs ty, args) => mkStdApply("abs", args)
180 :     | (Op.Max ty, args) => mkStdApply("max", args)
181 :     | (Op.Min ty, args) => mkStdApply("min", args)
182 :     | (Op.VAdd d, [a, b]) => CL.mkBinOp(a, CL.#+, b)
183 :     | (Op.VSub d, [a, b]) => CL.mkBinOp(a, CL.#-, b)
184 :     | (Op.VScale(w, _), [a, b]) => CL.mkApply(RN.vscale w, [a, b])
185 :     | (Op.VMul d, [a, b]) => CL.mkBinOp(a, CL.#*, b)
186 :     | (Op.VNeg d, [a]) => CL.mkUnOp(CL.%-, a)
187 :     | (Op.VSum(w, _), [a]) => CL.mkApply(RN.vsum w, [a])
188 :     | (Op.VDot(w, _), [a, b]) => CL.mkApply(RN.vdot w, [a, b])
189 :     | (Op.VIndex(w, p, i), [a]) => CL.mkSubscript(a, mkInt i)
190 :     | (Op.VCeiling(w, _), [a]) => CL.mkApply(RN.vceiling w, [a])
191 :     | (Op.VFloor(w, _), [a]) => CL.mkApply(RN.vfloor w, [a])
192 :     | (Op.VRound(w, _), [a]) => CL.mkApply(RN.vround w, [a])
193 :     | (Op.VTrunc(w, _), [a]) => CL.mkApply(RN.vtrunc w, [a])
194 : jhr 5139 | (Op.VToInt{wid, ...}, args) => CL.mkApply (RN.vtoi wid, args)
195 : jhr 4317 | (Op.TensorIndex(ty, idxs), [a]) => let
196 :     val dd = (case ty
197 :     of Ty.TensorTy(_::dd) => dd
198 :     | Ty.TensorRefTy(_::dd) => dd
199 :     | _ => raise Fail "bogus type for TensorIndex"
200 :     (* end case *))
201 :     (* dimensions/indices are slowest to fastest *)
202 :     fun index ([], [i], acc) = acc + i
203 :     | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
204 :     in
205 :     CL.mkSubscript(a, mkInt(index (dd, idxs, 0)))
206 :     end
207 :     | (Op.ProjectLast(ty, idxs), [a]) => let
208 :     val dd = (case ty
209 :     of Ty.TensorTy(_::dd) => dd
210 :     | Ty.TensorRefTy(_::dd) => dd
211 :     | _ => raise Fail "bogus type for ProjectLast"
212 :     (* end case *))
213 :     (* dimensions/indices are slowest to fastest *)
214 :     fun index ([], [], acc) = acc
215 :     | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
216 :     in
217 :     CL.mkDispatch(a, "last", [mkInt(index (dd, idxs, 0))])
218 :     end
219 :     (* NOTE: since C++ will do the coercion automatically, we don't really need
220 :     * to generate the constructor application for TensorRef!
221 :     *)
222 :     | (Op.TensorRef shp, [a]) => CL.mkCons(RN.tensorRefTy shp, [a])
223 : jhr 4364 | (Op.Select(Ty.TupleTy tys, i), [a]) =>
224 : jhr 4373 CL.mkSelect(a, "tpl_" ^ Int.toString i)
225 : jhr 4567 (* QUESTION: if this is a sequence of tensors, will there be an extra copy? *)
226 : jhr 4317 | (Op.Subscript ty, [a, b]) => CL.mkSubscript(a, b)
227 : jhr 4533 | (Op.MkDynamic(ty, n), [a]) =>
228 : jhr 4591 CL.mkCons(dynseqTy(env, ty), [mkInt n, CL.mkDispatch(a, "data", [])])
229 : jhr 3982 (* FIXME: eventually we should do some kind of liveness analysis to enable in situ operations *)
230 : jhr 4434 | (Op.Prepend(seqTy, itemTy), [a, b]) => (case itemTy
231 :     of Ty.TensorRefTy _ => (* copy tensor data *)
232 :     CL.mkDispatch (b, "prepend", [CL.mkDispatch(a, "base", [])])
233 :     | _ => mkDynseqApply (env, seqTy, "prepend", [a, b])
234 :     (* end case *))
235 : jhr 4412 | (Op.Append(seqTy, itemTy), [a, b]) => (case itemTy
236 : jhr 4434 of Ty.TensorRefTy _ => (* copy tensor data *)
237 :     CL.mkDispatch (a, "append", [CL.mkDispatch(b, "base", [])])
238 :     | _ => mkDynseqApply (env, seqTy, "append", [a, b])
239 :     (* end case *))
240 : jhr 4317 | (Op.Concat ty, [a, b]) => mkDynseqApply (env, ty, "concat", [a, b])
241 :     | (Op.Range, [a, b]) => CL.mkCons(dynseqTy(env, Ty.IntTy), [a, b])
242 :     | (Op.Length ty, [a]) => CL.mkDispatch(a, "length", [])
243 : jhr 4547 | (Op.SphereQuery(dim, Ty.StrandIdTy s), args) => let
244 : jhr 4591 (* The sphere_query needs the self pointer to filter out the invoking strand.
245 :     * In the dual-state case, we don't have a pointer of the right type, but
246 :     * we can cast the local-state pointer, since it also points to the beginning
247 :     * of the strand.
248 :     *)
249 :     val self = if TargetSpec.dualState(Env.target env)
250 :     then CL.mkReinterpretCast(
251 :     CL.T_Ptr(RN.strandTy(Atom.toString s)),
252 :     CL.mkVar(Env.selfLocal env))
253 :     else CL.mkVar(Env.selfIn env)
254 :     in
255 :     CL.mkApply("sphere_query", CL.mkVar(Env.world env) :: self :: args)
256 :     end
257 : jhr 4317 | (Op.Sqrt, [a]) => mkStdApply("sqrt", [a])
258 :     | (Op.Cos, [a]) => mkStdApply("cos", [a])
259 :     | (Op.ArcCos, [a]) => mkStdApply("acos", [a])
260 :     | (Op.Sin, [a]) => mkStdApply("sin", [a])
261 :     | (Op.ArcSin, [a]) => mkStdApply("asin", [a])
262 :     | (Op.Tan, [a]) => mkStdApply("tan", [a])
263 :     | (Op.ArcTan, [a]) => mkStdApply("atan", [a])
264 :     | (Op.Exp, [a]) => mkStdApply("exp", [a])
265 : jhr 5296 | (Op.Sign, [a]) => mkDiderotApply("sign", [a])
266 : jhr 4317 | (Op.IntToReal, [a]) => CL.mkStaticCast(Env.realTy env, a)
267 : jhr 4394 | (Op.NumStrands StrandSets.ACTIVE, []) =>
268 : jhr 4519 CL.mkDispatch(RN.strandArray env, "num_active", [])
269 : jhr 4394 | (Op.NumStrands StrandSets.ALL, []) =>
270 : jhr 4519 CL.mkDispatch(RN.strandArray env, "num_alive", [])
271 : jhr 4394 | (Op.NumStrands StrandSets.STABLE, []) =>
272 : jhr 4519 CL.mkDispatch(RN.strandArray env, "num_stable", [])
273 : jhr 4317 | (Op.Transform info, [img]) => CL.mkApply("world2image", [img])
274 :     | (Op.Translate info, [img]) => CL.mkApply("translate", [img])
275 :     | (Op.BaseAddress info, [img]) => CL.mkDispatch(img, "base_addr", [])
276 :     | (Op.ControlIndex(info, ctl, d), [img, idx]) =>
277 :     CL.mkDispatch(img, IndexCtl.toString ctl, [mkInt d, idx])
278 :     | (Op.LoadVoxel info, [addr, offp]) => let
279 :     val voxel = CL.mkSubscript(addr, offp)
280 :     in
281 : jhr 4432 if RawTypes.same(ImageInfo.sampleTy info, Env.rawRealTy env)
282 : jhr 4434 then voxel
283 :     else CL.mkStaticCast(Env.realTy env, voxel)
284 : jhr 4317 end
285 :     | (Op.Inside(layout, _, s), args) =>
286 :     CL.mkApply (RN.inside(#wid layout, s), args)
287 :     | (Op.IndexInside(info, s), [pos, img]) => CL.mkDispatch(img, "inside", [pos, mkInt s])
288 :     | (Op.ImageDim(info, i), [img]) => CL.mkDispatch(img, "size", [mkInt i])
289 :     | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, args)
290 :     | _ => raise Fail(concat[
291 :     "unknown or incorrect operator ", Op.toString rator
292 :     ])
293 :     (* end case *))
294 : jhr 3768
295 : jhr 4380 fun trLit (env, lit) = (case lit
296 :     of Literal.Int n => CL.mkIntTy(n, Env.intTy env)
297 :     | Literal.Bool b => CL.mkBool b
298 :     | Literal.Real f => CL.mkFlt(f, Env.realTy env)
299 :     | Literal.String s => CL.mkStr s
300 : jhr 4434 (* end case *))
301 : jhr 4380
302 : jhr 3866 fun trExp (env, e) = (case e
303 :     of IR.E_Global x => rvalueGlobalVar (env, x)
304 : jhr 3872 | IR.E_State(NONE, x) => rvalueStateVar (env, x)
305 : jhr 4590 | IR.E_State(SOME e, x) => rvalueStateVarId (env, x, trExp(env, e))
306 : jhr 3866 | IR.E_Var x => rvalueVar (env, x)
307 : jhr 4380 | IR.E_Lit lit => trLit (env, lit)
308 : jhr 3886 | IR.E_Op(rator, args) => trOp (env, rator, trExps(env, args))
309 : jhr 4386 | IR.E_Apply(f, args) => trApply (env, f, args)
310 : jhr 4317 | IR.E_Vec(w, pw, args) => CL.mkApply(RN.vcons w, trExps (env, args))
311 : jhr 3893 | IR.E_Cons(args, Ty.TensorTy shape) => raise Fail "unexpected E_Cons"
312 :     | IR.E_Seq(args, ty) => raise Fail "unexpected E_Seq"
313 : jhr 4317 | IR.E_Pack(layout, args) => raise Fail "unexpected E_Pack"
314 : jhr 3894 (* FIXME: check if e is aligned and use "vload_aligned" in that case *)
315 : jhr 4317 | IR.E_VLoad(layout, e, i) =>
316 :     CL.mkApply(RN.vload(Ty.nthWidth(layout, i)),
317 :     [CL.mkDispatch(trExp(env, e), "addr", [mkInt(Ty.offsetOf(layout, i))])])
318 :     | _ => raise Fail "trExp"
319 : jhr 3866 (* end case *))
320 :    
321 :     and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
322 :    
323 : jhr 4386 and trApply (env, f, args) = let
324 : jhr 4434 val args = trExps (env, args)
325 :     val args = if TreeFunc.hasGlobals f
326 :     then CL.mkVar(Env.global env) :: args
327 :     else args
328 :     val args = if TreeFunc.needsWorld f
329 :     then CL.mkVar(Env.world env) :: args
330 :     else args
331 :     in
332 :     CL.mkApply(TreeFunc.qname f, args)
333 :     end
334 : jhr 4386
335 : jhr 3873 (* QUESTION: not sure that we need this function? *)
336 : jhr 3872 fun trExpToVar (env, ty, name, exp) = (case trExp (env, exp)
337 : jhr 4317 of e as CL.E_Var _ => (e, [])
338 :     | e => let
339 :     val x = freshVar name
340 :     in
341 :     (CL.mkVar x, [CL.mkDeclInit(ty, x, e)])
342 :     end
343 :     (* end case *))
344 : jhr 3872
345 : jhr 3955 (* FIXME: trAssign and trDecl do the same analysis of the rhs; we should factor that out *)
346 : jhr 3977 (* translate the assignment `lhs = rhs` and add the code to the stms list. Note that the
347 :     * stms list is reverse order!
348 :     *)
349 : jhr 4067 fun trAssign env = let
350 : jhr 4317 fun tr (lhs, rhs, stms) = (case rhs
351 : jhr 4539 of IR.E_Op(Op.TensorCopy shp, [a]) => CL.mkAssign(lhs, trExp (env, a)) :: stms
352 : jhr 4317 | IR.E_Op(Op.EigenVals2x2, [a]) =>
353 :     CL.mkCall("eigenvals", [trExp (env, a), lhs]) :: stms
354 :     | IR.E_Op(Op.EigenVals3x3, [a]) =>
355 :     CL.mkCall("eigenvals", [trExp (env, a), lhs]) :: stms
356 :     | IR.E_Pack({wid, ...}, args) =>
357 :     CL.mkCall (RN.vpack wid, lhs :: List.map (fn e => trExp(env, e)) args) :: stms
358 :     | IR.E_Cons(args, _) => let
359 :     fun trArg (i, arg, stms) = tr (CL.mkSubscript(lhs, mkInt i), arg, stms)
360 :     in
361 :     List.foldli trArg stms args
362 :     end
363 : jhr 5108 | IR.E_Seq(args, Ty.SeqTy(_, NONE)) => (* dynamic sequence *)
364 :     CL.mkAssign (lhs, CL.mkArray(trExps (env, args))) :: stms
365 :     | IR.E_Seq(args, _) => let (* fixed-size sequence *)
366 : jhr 4317 fun trArg (i, arg, stms) = tr (CL.mkSubscript(lhs, mkInt i), arg, stms)
367 :     in
368 :     List.foldli trArg stms args
369 :     end
370 :     | _ => CL.mkAssign(lhs, trExp (env, rhs)) :: stms
371 :     (* end case *))
372 :     in
373 :     tr
374 :     end
375 : jhr 3872
376 : jhr 4004 fun trDecl (env, ty, lhs, rhs, stms) = let
377 : jhr 4317 fun trArgs args = CL.mkDecl(
378 :     ty, lhs, SOME(CL.I_Exps(List.map (fn arg => CL.I_Exp(trExp (env, arg))) args)))
379 :     in
380 :     case rhs
381 : jhr 4539 of IR.E_Op(Op.TensorCopy shp, [a]) => CL.mkDeclInit(ty, lhs, trExp(env, a)) :: stms
382 : jhr 4317 | IR.E_Op(Op.EigenVals2x2, [a]) =>
383 :     CL.mkCall("eigenvals", [trExp (env, a), CL.mkVar lhs]) ::
384 :     CL.mkDecl(ty, lhs, NONE) :: stms
385 :     | IR.E_Op(Op.EigenVals3x3, [a]) =>
386 :     CL.mkCall("eigenvals", [trExp (env, a), CL.mkVar lhs]) ::
387 :     CL.mkDecl(ty, lhs, NONE) :: stms
388 :     | IR.E_Pack({wid, ...}, args) =>
389 :     CL.mkCall (RN.vpack wid, CL.mkVar lhs :: List.map (fn e => trExp(env, e)) args) ::
390 :     CL.mkDecl(ty, lhs, NONE) :: stms
391 :     | IR.E_Cons(args, _) => let
392 :     val init = List.map (fn arg => CL.I_Exp(trExp(env, arg))) args
393 :     in
394 :     CL.mkDecl(ty, lhs, SOME(CL.I_Exps init)) :: stms
395 :     end
396 : jhr 5113 | IR.E_Seq(args, Ty.SeqTy(_, NONE)) => (* dynamic sequence *)
397 :     CL.mkDecl(ty, lhs, SOME(CL.I_Exps(map CL.I_Exp (trExps (env, args))))) :: stms
398 : jhr 4317 | IR.E_Seq(args, _) => let
399 :     val dcl = CL.mkDecl(ty, lhs, NONE)
400 :     val trAssign = trAssign env
401 :     fun trArg (i, arg, stms) =
402 :     trAssign (CL.mkSubscript(CL.mkVar lhs, mkInt i), arg, stms)
403 :     in
404 :     List.foldli trArg (dcl :: stms) args
405 :     end
406 :     | _ => CL.mkDeclInit(ty, lhs, trExp (env, rhs)) :: stms
407 :     (* end case *)
408 :     end
409 : jhr 3872
410 : jhr 3870 fun trMultiAssign (env, lhs, IR.E_Op(rator, args)) = (case (lhs, rator, args)
411 : jhr 3876 of ([vals, vecs], Op.EigenVecs2x2, [exp]) =>
412 : jhr 4317 CL.mkCall("eigenvecs", [trExp (env, exp), vals, vecs])
413 : jhr 3876 | ([vals, vecs], Op.EigenVecs3x3, [exp]) =>
414 : jhr 4317 CL.mkCall("eigenvecs", [trExp (env, exp), vals, vecs])
415 : jhr 3870 | _ => raise Fail "bogus multi-assignment"
416 :     (* end case *))
417 :     | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
418 : jhr 3866
419 : jhr 4911 fun trPrintStm (env, tys, args) = let
420 : jhr 4317 fun mkExp (lhs, [], []) = CL.mkBinOp(lhs, CL.#<<, CL.mkVar "std::flush")
421 :     | mkExp (lhs, ty::tys, e::es) = let
422 :     (* if necessary, wrap the argument so that the correct "<<" instance is used *)
423 :     val e = (case ty
424 :     of Ty.TensorTy shape => CL.mkApply(RN.tensorRefStruct shape, [e])
425 :     | _ => e
426 :     (* end case *))
427 :     in
428 :     mkExp (CL.mkBinOp(lhs, CL.#<<, e), tys, es)
429 :     end
430 :     | mkExp _ = raise Fail "trPrintStm: arity mismatch"
431 : jhr 5017 val wrld = worldVar env
432 :     val outS = CL.mkIndirectDispatch(wrld, "print", [])
433 :     val stm = CL.mkExpStm (mkExp (outS, tys, args))
434 : jhr 4317 in
435 : jhr 5017 if TargetSpec.isParallel(Env.target env)
436 :     then let
437 :     val lock = CL.mkAddrOf(CL.mkIndirect(CL.mkIndirect(wrld, "_sched"), "_prLock"))
438 :     in [
439 :     (* NOTE: statements will be reversed! *)
440 :     CL.mkCall("pthread_mutex_unlock", [lock]),
441 :     stm,
442 :     CL.mkCall("pthread_mutex_lock", [lock])
443 :     ] end
444 :     else [stm]
445 : jhr 4317 end
446 : jhr 3918
447 : jhr 3872 fun trStms (env, stms : TreeIR.stm list) = let
448 : jhr 3870 fun trStm (stm, (env, stms : CL.stm list)) = (case stm
449 :     of IR.S_Comment text => (env, CL.mkComment text :: stms)
450 : jhr 3872 | IR.S_Assign(true, x, exp) => let
451 : jhr 4317 val ty = trType (env, V.ty x)
452 :     val x' = V.name x
453 :     val env = Env.insert (env, x, x')
454 :     in
455 :     (env, trDecl (env, ty, x', exp, stms))
456 :     end
457 : jhr 3977 | IR.S_Assign(false, x, exp) =>
458 : jhr 4317 (env, trAssign env (lvalueVar (env, x), exp, stms))
459 :     | IR.S_MAssign(xs, exp) =>
460 : jhr 3886 (env, trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp) :: stms)
461 : jhr 3866 | IR.S_GAssign(x, exp) =>
462 : jhr 4317 (env, trAssign env (lvalueGlobalVar (env, x), exp, stms))
463 : jhr 3866 | IR.S_IfThen(cond, thenBlk) =>
464 : jhr 3870 (env, CL.mkIfThen(trExp(env, cond), trBlock(env, thenBlk)) :: stms)
465 : jhr 3866 | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let
466 : jhr 4317 val stm = CL.mkIfThenElse(trExp(env, cond),
467 :     trBlock(env, thenBlk),
468 :     trBlock(env, elseBlk))
469 :     in
470 :     (env, stm :: stms)
471 :     end
472 :     | IR.S_For(x, lo, hi, blk) => let
473 :     val x' = V.name x
474 :     val env' = Env.insert (env, x, x')
475 :     val (hi', hiInit) = if CodeGenUtil.isSimple hi
476 :     then (trExp(env, hi), [])
477 :     else let
478 :     val hi' = freshVar "hi"
479 :     in
480 :     (CL.mkVar hi', [CL.mkDeclInit(CL.int32, hi', trExp(env, hi))])
481 :     end
482 :     val loop = CL.mkFor(
483 :     CL.int32, [( x', trExp(env, lo))],
484 :     CL.mkBinOp(CL.mkVar x', CL.#<=, hi'),
485 :     [CL.mkUnOp(CL.%++, CL.mkVar x')],
486 :     trBlock (env', blk))
487 :     in
488 :     (env, hiInit @ loop :: stms)
489 :     end
490 : jhr 4344 | IR.S_Foreach(x, e, blk) => let
491 : jhr 4373 val seq = trExp(env, e)
492 : jhr 4344 val x' = V.name x
493 :     val env' = Env.insert (env, x, x')
494 : jhr 4373 val blk' = trBlock (env', blk)
495 :     val loop = (case TreeTypeOf.exp e
496 :     of Ty.SeqTy(_, SOME n) => let
497 :     val ix = freshVar "ix"
498 :     val defx = CL.mkDeclInit(CL.T_Named "auto", x',
499 :     CL.mkSubscript(seq, CL.mkVar ix))
500 :     in
501 :     CL.mkFor(
502 :     CL.int32, [(ix, CL.mkInt 0)],
503 :     CL.mkBinOp(CL.mkVar ix, CL.#<, mkInt n),
504 :     [CL.mkUnOp(CL.%++, CL.mkVar ix)],
505 :     CL.prependStm(defx, blk'))
506 :     end
507 :     | Ty.SeqTy(_, NONE) => let
508 :     val ix = freshVar "it"
509 :     val defx = CL.mkDeclInit(CL.T_Named "auto", x',
510 :     CL.mkUnOp(CL.%*, CL.mkVar ix))
511 :     in
512 :     CL.mkFor(
513 :     CL.T_Named "auto", [(ix, CL.mkDispatch(seq, "cbegin", []))],
514 :     CL.mkBinOp(CL.mkVar ix, CL.#!=, CL.mkDispatch(seq, "cend", [])),
515 :     [CL.mkUnOp(CL.%++, CL.mkVar ix)],
516 :     CL.prependStm(defx, blk'))
517 :     end
518 :     | _ => raise Fail "impossible"
519 :     (* end case *))
520 : jhr 4344 in
521 :     (env, loop :: stms)
522 :     end
523 : jhr 4476 | IR.S_MapReduce(mrs, src) => Env.mapReduceCB (env, mrs, src, stms)
524 : jhr 3927 | IR.S_New(strand, args) => let
525 : jhr 4935 val args = worldVar env :: List.map (fn e => trExp(env, e)) args
526 :     val args = if TargetSpec.isParallel(Env.target env)
527 :     then CL.mkVar RN.workerVar :: args
528 : jhr 5017 else args
529 : jhr 4935 val stm = CL.mkCall(Atom.toString strand ^ "_new", args)
530 : jhr 4317 in
531 :     (env, stm :: stms)
532 :     end
533 : jhr 3977 | IR.S_Save(x, exp) =>
534 : jhr 4317 (env, trAssign env (lvalueStateVar(env, x), exp, stms))
535 : jhr 5184 | IR.S_LoadNrrd(lhs, ty, nrrd, proxy) => let
536 :     val stm = loadNrrd (lvalueVar (env, lhs), CL.mkStr nrrd, proxy)
537 : jhr 4317 in
538 :     (env, stm :: stms)
539 :     end
540 : jhr 3870 | IR.S_Input(_, _, _, NONE) => (env, stms)
541 :     | IR.S_Input(gv, name, _, SOME dflt) =>
542 :     (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)
543 : jhr 3866 | IR.S_InputNrrd _ => (env, stms)
544 : jhr 4482 | IR.S_StabilizeAll => let
545 :     val stm = CL.mkExpStm(CL.mkIndirectDispatch(worldVar env, "stabilize_all", []))
546 :     in
547 :     (env, stm::stms)
548 :     end
549 : jhr 4628 | IR.S_KillAll => let
550 :     val stm = CL.mkExpStm(CL.mkIndirectDispatch(worldVar env, "kill_all", []))
551 :     in
552 :     (env, stm::stms)
553 :     end
554 : jhr 4317 | IR.S_Print(tys, args) => let
555 :     val args = List.map (fn e => trExp(env, e)) args
556 :     in
557 : jhr 4911 (env, trPrintStm(env, tys, args) @ stms)
558 : jhr 4317 end
559 : jhr 5286 | IR.S_Return NONE => (env, CL.mkReturn NONE :: stms)
560 :     | IR.S_Return(SOME e) => (env, CL.mkReturn(SOME(trExp(env, e))) :: stms)
561 : jhr 3876 | IR.S_Active => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kActive")) :: stms)
562 :     | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kStabilize")) :: stms)
563 :     | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kDie")) :: stms)
564 : jhr 3866 (* end case *))
565 : jhr 4317 val (env, stms) = List.foldl trStm (env, []) stms
566 : jhr 3866 in
567 : jhr 4317 (env, List.rev stms)
568 : jhr 3866 end
569 :    
570 :     and trBlock (env, IR.Block{locals, body}) = let
571 : jhr 4317 fun trLocal (x, (env, dcls)) = let
572 :     val x' = V.name x
573 :     val dcl = CL.mkDecl(trType(env, V.ty x), x', NONE)
574 :     in
575 :     (Env.insert(env, x, x'), dcl :: dcls)
576 :     end
577 :     val (env, dcls) = List.foldl trLocal (env, []) (!locals)
578 :     val (_, stms) = trStms (env, body)
579 : jhr 3866 in
580 : jhr 3927 CL.mkBlock (dcls @ stms)
581 : jhr 3866 end
582 :    
583 : jhr 3924 and trWithLocals (env, locals, trBody) = let
584 : jhr 4317 fun trLocal (x, (env, dcls)) = let
585 :     val x' = V.name x
586 :     val dcl = CL.mkDecl(trType(env, V.ty x), x', NONE)
587 :     in
588 :     (Env.insert(env, x, x'), dcl :: dcls)
589 :     end
590 :     val (env, dcls) = List.foldl trLocal (env, []) locals
591 : jhr 3924 in
592 :     CL.mkBlock (dcls @ trBody env)
593 :     end
594 :    
595 : jhr 3927 fun errorMsgAdd (env, msg) =
596 :     CL.mkCall("biffMsgAdd", [CL.mkIndirect(worldVar env, "_errors"), msg])
597 : jhr 3900
598 : jhr 3927 fun trParam (env, x)= let
599 : jhr 4317 val x' = V.name x
600 :     in
601 :     (Env.insert (env, x, x'), CL.PARAM([], trType(env, V.ty x), x'))
602 :     end
603 : jhr 3917
604 : jhr 3768 end

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