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

SCM Repository

[diderot] Annotation of /branches/vis12-cl/src/compiler/cl-target/tree-to-cl.sml
ViewVC logotype

Annotation of /branches/vis12-cl/src/compiler/cl-target/tree-to-cl.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3159 - (view) (download)

1 : jhr 1640 (* tree-to-cl.sml
2 : jhr 1117 *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 : jhr 1640 * Translate TreeIL to the OpenCL version of CLang.
7 : jhr 1117 *)
8 :    
9 :     structure TreeToCL : sig
10 :    
11 :     datatype var = V of (CLang.ty * CLang.var)
12 :    
13 :     type env = var TreeIL.Var.Map.map
14 :    
15 : jhr 1640 val trBlock : env * TreeIL.block -> CLang.stm
16 : jhr 1117
17 : jhr 1370 val trFragment : env * TreeIL.block -> env * CLang.stm list
18 :    
19 : jhr 2405 val trAssign : env * CLang.exp * TreeIL.exp -> CLang.stm list
20 : jhr 1117
21 :     val trExp : env * TreeIL.exp -> CLang.exp
22 :    
23 : jhr 1370 (* vector indexing support. Arguments are: vector, index *)
24 :     val vecIndex : CLang.exp * int -> CLang.exp
25 : jhr 1117
26 :     end = struct
27 :    
28 :     structure CL = CLang
29 : jhr 3095 structure N = OCLNames
30 : jhr 1117 structure IL = TreeIL
31 :     structure Op = IL.Op
32 :     structure Ty = IL.Ty
33 :     structure V = IL.Var
34 :    
35 : jhr 1370 datatype var = datatype CLang.typed_var
36 : jhr 1117
37 :     type env = var TreeIL.Var.Map.map
38 :    
39 :     fun lookup (env, x) = (case V.Map.find (env, x)
40 : jhr 1640 of SOME(V(_, x')) => x'
41 :     | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
42 :     (* end case *))
43 : jhr 1117
44 : jhr 2405 local
45 :     fun global env = CL.mkVar(lookup(env, PseudoVars.global))
46 :     fun selfIn env = CL.mkVar(lookup(env, PseudoVars.selfIn))
47 :     fun selfOut env = CL.mkVar(lookup(env, PseudoVars.selfOut))
48 :     in
49 :     (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
50 : jhr 2804 fun lvalueVar (env, x) = CL.mkVar(lookup(env, x))
51 : jhr 2405
52 :     (* translate a variable that occurs in an r-value context *)
53 : jhr 2804 fun rvalueVar (env, x) = CL.mkVar(lookup(env, x))
54 : jhr 2405
55 : jhr 2804 (* translate a global variable *)
56 : jhr 3116 fun lvalueGlobalVar (env, x) = CL.mkIndirect(global env, IL.GlobalVar.name x)
57 : jhr 2804 val rvalueGlobalVar = lvalueGlobalVar
58 :    
59 : jhr 2405 (* translate a strand state variable that occurs in an l-value context *)
60 : jhr 2804 fun lvalueStateVar (env, x) = CL.mkIndirect(selfOut env, "sv_" ^ IL.StateVar.name x)
61 : jhr 2405
62 :     (* translate a strand state variable that occurs in an r-value context *)
63 : jhr 2804 fun rvalueStateVar (env, x) = CL.mkIndirect(selfIn env, "sv_" ^ IL.StateVar.name x)
64 : jhr 2405 end (* local *)
65 :    
66 : jhr 1117 (* integer literal expression *)
67 : jhr 1370 fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
68 : jhr 1117
69 :     (* generate new variables *)
70 :     local
71 :     val count = ref 0
72 :     fun freshName prefix = let
73 : jhr 1640 val n = !count
74 :     in
75 :     count := n+1;
76 :     concat[prefix, "_", Int.toString n]
77 :     end
78 : jhr 1117 in
79 :     fun tmpVar ty = freshName "tmp"
80 :     fun freshVar prefix = freshName prefix
81 :     end (* local *)
82 :    
83 :     (* translate IL basis functions *)
84 : jhr 1922 fun trApply (f, args) = CL.mkApply(MathFuns.toString f, args)
85 : jhr 1117
86 : jhr 1370 (* vector indexing support. Arguments are: vector, index *)
87 :     local
88 :     val fields = Vector.fromList [
89 :     "s0", "s1", "s2", "s3",
90 :     "s4", "s5", "s6", "s7",
91 :     "s8", "s9", "sa", "sb",
92 :     "sc", "sd", "se", "sf"
93 :     ]
94 :     in
95 :     fun vecIndex (v, ix) = CL.mkSelect(v, Vector.sub(fields, ix))
96 :     end
97 : jhr 1117
98 : jhr 3095 fun unionTy n = CL.T_Named(concat["union", Int.toString n, !CNames.gRealSuffix, "_t"])
99 : jhr 2739
100 : jhr 1671 (* matrix indexing *)
101 :     fun matIndex (m, ix, jx) = CL.mkSelect(CL.mkSubscript(m, ix), concat["s",jx])
102 : jhr 3099
103 : jhr 1640 (* translate a state-variable use *)
104 :     fun trStateVar (IL.SV{name, ...}) = CL.mkIndirect(CL.mkVar "selfIn", name)
105 :    
106 :     fun castArgs ty = List.map (fn e => CL.mkCast(ty, e))
107 :    
108 : jhr 1117 (* Translate a TreeIL operator application to a CLang expression *)
109 :     fun trOp (rator, args) = (case (rator, args)
110 : jhr 1640 of (Op.Add ty, [a, b]) => CL.mkBinOp(a, CL.#+, b)
111 :     | (Op.Sub ty, [a, b]) => CL.mkBinOp(a, CL.#-, b)
112 :     | (Op.Mul ty, [a, b]) => CL.mkBinOp(a, CL.#*, b)
113 :     | (Op.Div ty, [a, b]) => CL.mkBinOp(a, CL.#/, b)
114 :     | (Op.Neg ty, [a]) => CL.mkUnOp(CL.%-, a)
115 :     | (Op.Abs(Ty.IntTy), args) => CL.mkApply("abs", args)
116 : jhr 3095 | (Op.Abs(Ty.TensorTy[]), args) => CL.mkApply(N.fabs, args)
117 :     | (Op.Abs(Ty.TensorTy[_]), args) => CL.mkApply(N.fabs, args)
118 : jhr 1640 | (Op.Abs ty, [a]) => raise Fail(concat["Abs<", Ty.toString ty, ">"])
119 :     | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)
120 :     | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)
121 :     | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)
122 :     | (Op.NEQ ty, [a, b]) => CL.mkBinOp(a, CL.#!=, b)
123 :     | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)
124 :     | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)
125 :     | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)
126 : jhr 3095 | (Op.Max, args) => CL.mkApply(N.max, castArgs (!N.gRealTy) args)
127 :     | (Op.Min, args) => CL.mkApply(N.min, castArgs (!N.gRealTy) args)
128 :     | (Op.Clamp ty, [lo, hi, x]) => CL.mkApply(N.clamp, [x, lo, hi])
129 : jhr 1640 | (Op.Lerp ty, args) => (case ty
130 : jhr 3095 of Ty.TensorTy[] => CL.mkApply(N.lerp, castArgs (!N.gRealTy) args)
131 :     | Ty.TensorTy[n] => CL.mkApply(N.lerp, castArgs (N.vecTy n) args)
132 : jhr 1640 | _ => raise Fail(concat[
133 :     "lerp<", Ty.toString ty, "> not supported"
134 :     ])
135 :     (* end case *))
136 : jhr 3095 | (Op.Dot d, args) => CL.mkApply(N.dot, args)
137 : jhr 1640 | (Op.MulVecMat(m, n), args) =>
138 :     if (1 < m) andalso (m < 4) andalso (m = n)
139 : jhr 3095 then CL.mkApply(N.mulVecMat(m,n), args)
140 : jhr 1640 else raise Fail "unsupported vector-matrix multiply"
141 :     | (Op.MulMatVec(m, n), args) =>
142 :     if (1 < m) andalso (m < 4) andalso (m = n)
143 : jhr 3095 then CL.mkApply(N.mulMatVec(m,n), args)
144 : jhr 1640 else raise Fail "unsupported matrix-vector multiply"
145 :     | (Op.MulMatMat(m, n, p), args) =>
146 :     if (1 < m) andalso (m < 4) andalso (m = n) andalso (n = p)
147 : jhr 3095 then CL.mkApply(N.mulMatMat(m,n,p), args)
148 : jhr 1640 else raise Fail "unsupported matrix-matrix multiply"
149 : jhr 3095 | (Op.Cross, args) => CL.mkApply(N.cross, args)
150 :     | (Op.Norm(Ty.TensorTy[n]), args) => CL.mkApply(N.length, args)
151 :     | (Op.Norm(Ty.TensorTy[m,n]), args) => CL.mkApply(N.normMat(m,n), args)
152 :     | (Op.Normalize d, args) => CL.mkApply(N.normalize, args)
153 : jhr 1640 | (Op.Scale(Ty.TensorTy[n]), [s, v]) => CL.mkBinOp(s, CL.#*, v)
154 :     | (Op.PrincipleEvec ty, _) => raise Fail "PrincipleEvec unimplemented"
155 :     | (Op.Select(Ty.TupleTy tys, i), [a]) => raise Fail "Select unimplemented"
156 :     | (Op.Index(Ty.SeqTy(Ty.IntTy, n), i), [a]) => vecIndex (a, i)
157 :     | (Op.Index(Ty.TensorTy[n], i), [a]) => vecIndex (a, i)
158 :     | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)
159 :     | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, ix]) => let
160 : jhr 2739 val vecExp = CL.mkSelect(CL.mkCast(unionTy n, v), "i")
161 : jhr 1370 in
162 : jhr 1640 CL.mkSubscript(vecExp, ix)
163 :     end
164 : jhr 1671 | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)
165 : jhr 1640 | (Op.Subscript(Ty.TensorTy[n]), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)
166 :     | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
167 : jhr 2739 val vecExp = CL.mkSelect(CL.mkCast(unionTy n, v), "r")
168 : jhr 1640 in
169 :     CL.mkSubscript(vecExp, ix)
170 :     end
171 :     | (Op.Subscript(Ty.TensorTy[_,_]), [m, ix, CL.E_Int(jx, _)]) =>
172 :     vecIndex(CL.mkSubscript(m, ix), Int.fromLarge jx)
173 :     | (Op.Subscript(Ty.TensorTy[_,n]), [m, ix, jx]) => let
174 : jhr 2739 val vecExp = CL.mkSelect(CL.mkCast(unionTy n, CL.mkSubscript(m, ix)), "r")
175 : jhr 1640 in
176 : jhr 1370 CL.mkSubscript(vecExp, jx)
177 :     end
178 : jhr 1640 | (Op.Subscript ty, t::(ixs as _::_)) =>
179 :     raise Fail(concat["Subscript<", Ty.toString ty, "> unsupported"])
180 :     | (Op.Ceiling d, args) => CL.mkApply("ceil", args)
181 :     | (Op.Floor d, args) => CL.mkApply("floor", args)
182 :     | (Op.Round d, args) => CL.mkApply("round", args)
183 :     | (Op.Trunc d, args) => CL.mkApply("trunc", args)
184 : jhr 3095 | (Op.IntToReal, [a]) => CL.mkCast(!N.gRealTy, a)
185 :     | (Op.RealToInt 1, [a]) => CL.mkCast(!N.gIntTy, a)
186 :     | (Op.RealToInt d, args) => CL.mkApply(N.vecftoi d, args)
187 : jhr 2726 | (Op.ImageAddress info, [a]) => let
188 : jhr 3118 val cTy = CL.T_Qual("__global", CL.T_Ptr(CL.T_Num(ImageInfo.sampleTy info)))
189 : jhr 1640 in
190 : jhr 3159 CL.mkCast(cTy, CL.mkSelect(a, "data"))
191 : jhr 1640 end
192 :     | (Op.LoadVoxels(info, 1), [a]) => let
193 : jhr 3095 val realTy as CL.T_Num rTy = !N.gRealTy
194 : jhr 2694 val a = CL.mkUnOp(CL.%*, a)
195 : jhr 1640 in
196 :     if (rTy = ImageInfo.sampleTy info)
197 :     then a
198 : jhr 2694 else CL.mkCast(realTy, a)
199 : jhr 1640 end
200 :     | (Op.LoadVoxels _, [a]) =>
201 :     raise Fail("impossible " ^ Op.toString rator)
202 : jhr 1793 | (Op.PosToImgSpace info, [img, pos]) =>
203 : jhr 3159 CL.mkApply(N.toImageSpace(ImageInfo.dim info), [CL.mkUnOp(CL.%&, img), pos])
204 : jhr 1640 | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
205 : jhr 3095 CL.mkApply(N.toWorldSpace ty, [CL.mkUnOp(CL.%&,v), x])
206 : jhr 1793 | (Op.Inside(info, s), [pos, img]) =>
207 : jhr 3159 CL.mkApply(N.inside(ImageInfo.dim info), [pos, CL.mkUnOp(CL.%&, img), intExp s])
208 : jhr 2012 | (Op.Input _, []) => raise Fail("impossible " ^ Op.toString rator)
209 : jhr 1640 | _ => raise Fail(concat[
210 :     "unknown or incorrect operator ", Op.toString rator
211 :     ])
212 :     (* end case *))
213 : jhr 1117
214 :     fun trExp (env, e) = (case e
215 : jhr 3088 of IL.E_Global x => rvalueGlobalVar (env, x)
216 :     | IL.E_State x => rvalueStateVar (env, x)
217 : jhr 2405 | IL.E_Var x => rvalueVar (env, x)
218 : jhr 3095 | IL.E_Lit(Literal.Int n) => CL.mkIntTy(n, !N.gIntTy)
219 : jhr 1640 | IL.E_Lit(Literal.Bool b) => CL.mkBool b
220 : jhr 3095 | IL.E_Lit(Literal.Float f) => CL.mkFlt(f, !N.gRealTy)
221 : jhr 1640 | IL.E_Lit(Literal.String s) => CL.mkStr s
222 :     | IL.E_Op(rator, args) => trOp (rator, trExps(env, args))
223 :     | IL.E_Apply(f, args) => trApply(f, trExps(env, args))
224 : jhr 3116 | IL.E_Cons(Ty.TensorTy[3], args) => CL.mkApply("VEC3", trExps(env, args))
225 : jhr 3095 | IL.E_Cons(Ty.TensorTy[n], args) => CL.mkVec(N.vecTy n, trExps(env, args))
226 : jhr 1640 | IL.E_Cons(ty, _) => raise Fail(concat["E_Cons(", Ty.toString ty, ", _) in expression"])
227 :     (* end case *))
228 : jhr 1117
229 :     and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
230 : jhr 1640
231 : jhr 1671 (* translate an expression to a variable form; return the variable and the
232 :     * (optional) declaration.
233 :     *)
234 :     fun expToVar (env, ty, name, exp) = (case trExp(env, exp)
235 :     of x as CL.E_Var _ => (x, [])
236 :     | exp => let
237 :     val x = freshVar name
238 :     in
239 : jhr 1764 (CL.mkVar x, [CL.mkDeclInit(ty, x, exp)])
240 : jhr 1671 end
241 :     (* end case *))
242 :    
243 : jhr 2405 fun trAssign (env, lhs, rhs) = (
244 : jhr 1640 (* certain rhs forms, such as those that return a matrix,
245 :     * require a function call instead of an assignment
246 :     *)
247 :     case rhs
248 :     of IL.E_Op(Op.Add(Ty.TensorTy[m,n]), args) =>
249 : jhr 3095 [CL.mkCall(N.addMat(m,n), lhs :: trExps(env, args))]
250 : jhr 1640 | IL.E_Op(Op.Sub(Ty.TensorTy[m,n]), args) =>
251 : jhr 3095 [CL.mkCall(N.subMat(m,n), lhs :: trExps(env, args))]
252 : jhr 1640 | IL.E_Op(Op.Neg(Ty.TensorTy[m,n]), args) =>
253 : jhr 3095 [CL.mkCall(N.scaleMat(m,n), lhs :: intExp ~1 :: trExps(env, args))]
254 : jhr 1640 | IL.E_Op(Op.Scale(Ty.TensorTy[m,n]), args) =>
255 : jhr 3095 [CL.mkCall(N.scaleMat(m,n), lhs :: trExps(env, args))]
256 : jhr 1640 | IL.E_Op(Op.MulMatMat(m,n,p), args) =>
257 : jhr 3095 [CL.mkCall(N.mulMatMat(m,n,p), lhs :: trExps(env, args))]
258 : jhr 1640 | IL.E_Op(Op.Identity n, args) =>
259 : jhr 3095 [CL.mkCall(N.identityMat n, [lhs])]
260 : jhr 1640 | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>
261 : jhr 3095 [CL.mkCall(N.zeroMat(m,n), [lhs])]
262 : jhr 1640 | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy[_,_]), [img,src]) =>
263 : jhr 3095 [CL.mkCall(N.toWorldSpace ty, lhs :: [CL.mkUnOp(CL.%&,trExp(env, img)),trExp(env, src)] )]
264 : jhr 1640 | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>
265 :     if (n > 1)
266 :     then let
267 :     val stride = ImageInfo.stride info
268 :     val rTy = ImageInfo.sampleTy info
269 :     val vp = freshVar "vp"
270 : jhr 3095 val needsCast = (CL.T_Num rTy <> !N.gRealTy)
271 : jhr 1640 fun mkLoad i = let
272 :     val e = CL.mkSubscript(CL.mkVar vp, intExp(i*stride))
273 :     in
274 : jhr 3095 if needsCast then CL.mkCast(!N.gRealTy, e) else e
275 : jhr 1640 end
276 : jhr 3116 val voxs = if (n = 3)
277 :     then CL.mkApply("VEC3", List.tabulate (n, mkLoad))
278 :     else CL.mkVec(N.vecTy n, List.tabulate (n, mkLoad))
279 : jhr 1640 in [
280 : jhr 2405 CL.mkDeclInit(CLTyTranslate.imageDataPtrTy info, vp, trExp(env, a)),
281 : jhr 3116 CL.mkAssign(lhs, voxs)
282 : jhr 1640 ] end
283 :     else [CL.mkAssign(lhs, trExp(env, rhs))]
284 : jhr 1671 | IL.E_Op(Op.EigenVals2x2, [m]) => let
285 : jhr 3095 val (m, stms) = expToVar (env, N.matTy(2,2), "m", m)
286 : jhr 1671 in
287 : jhr 3095 stms @ [CL.mkCall(N.evals2x2, [
288 : jhr 1671 CL.mkUnOp(CL.%&,lhs),
289 :     matIndex (m, CL.mkInt 0, "0"),
290 :     matIndex (m, CL.mkInt 0, "1"),
291 :     matIndex (m, CL.mkInt 1, "1")
292 :     ])]
293 :     end
294 :     | IL.E_Op(Op.EigenVals3x3, [m]) => let
295 : jhr 3095 val (m, stms) = expToVar (env, N.matTy(3,3), "m", m)
296 : jhr 1671 in
297 : jhr 3095 stms @ [CL.mkCall(N.evals3x3, [
298 : jhr 1671 CL.mkUnOp(CL.%&,lhs),
299 :     matIndex (m, CL.mkInt 0, "0"),
300 :     matIndex (m, CL.mkInt 0, "1"),
301 :     matIndex (m, CL.mkInt 0, "2"),
302 :     matIndex (m, CL.mkInt 1, "1"),
303 :     matIndex (m, CL.mkInt 1, "2"),
304 :     matIndex (m, CL.mkInt 2, "2")
305 :     ])]
306 :     end
307 :    
308 : jhr 1640 | IL.E_Cons(Ty.TensorTy[n,m], args) => let
309 :     (* matrices are represented as arrays of union<d><ty>_t vectors *)
310 :     fun doRows (_, []) = []
311 :     | doRows (i, e::es) =
312 :     CL.mkAssign(CL.mkSubscript(lhs, intExp i), e)
313 :     :: doRows (i+1, es)
314 :     in
315 :     doRows (0, trExps(env, args))
316 :     end
317 :     | IL.E_Var x => (case IL.Var.ty x
318 : jhr 3095 of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, rvalueVar(env, x)])]
319 : jhr 2405 | _ => [CL.mkAssign(lhs, rvalueVar(env, x))]
320 : jhr 1640 (* end case *))
321 : jhr 3159 | IL.E_Global x => (case IL.GlobalVar.ty x
322 :     of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, rvalueGlobalVar (env, x)])]
323 :     | Ty.ImageTy info => let
324 :     fun mkLHS fld = CL.mkSelect(lhs, fld)
325 :     fun mkLHS' (fld, i) = CL.mkSubscript(mkLHS fld, CL.mkInt i)
326 :     val rhs = rvalueGlobalVar (env, x)
327 :     fun mkRHS fld = CL.mkSelect(rhs, fld)
328 :     fun mkRHS' (fld, i) = CL.mkSubscript(mkRHS fld, CL.mkInt i)
329 :     val dataStm = CL.mkAssign(mkLHS "data", mkRHS "data")
330 :     in
331 :     case ImageInfo.dim info
332 :     of 1 => [
333 :     CL.mkAssign(mkLHS' ("size", 0), mkRHS' ("size", 0)),
334 :     CL.mkAssign(mkLHS "s", mkRHS "s"),
335 :     CL.mkAssign(mkLHS "t", mkRHS "t"),
336 :     dataStm
337 :     ]
338 :     | 2 => [
339 :     CL.mkAssign(mkLHS' ("size", 0), mkRHS' ("size", 0)),
340 :     CL.mkAssign(mkLHS' ("size", 1), mkRHS' ("size", 1)),
341 :     CL.mkAssign(mkLHS' ("w2i", 0), mkRHS' ("w2i", 0)),
342 :     CL.mkAssign(mkLHS' ("w2i", 1), mkRHS' ("w2i", 1)),
343 :     CL.mkAssign(mkLHS "tVec", mkRHS "tVec"),
344 :     CL.mkAssign(mkLHS' ("w2iT", 0), mkRHS' ("w2iT", 0)),
345 :     CL.mkAssign(mkLHS' ("w2iT", 1), mkRHS' ("w2iT", 1)),
346 :     dataStm
347 :     ]
348 :     | 3 => [
349 :     CL.mkAssign(mkLHS' ("size", 0), mkRHS' ("size", 0)),
350 :     CL.mkAssign(mkLHS' ("size", 1), mkRHS' ("size", 1)),
351 :     CL.mkAssign(mkLHS' ("size", 2), mkRHS' ("size", 2)),
352 :     CL.mkAssign(mkLHS' ("w2i", 0), mkRHS' ("w2i", 0)),
353 :     CL.mkAssign(mkLHS' ("w2i", 1), mkRHS' ("w2i", 1)),
354 :     CL.mkAssign(mkLHS' ("w2i", 2), mkRHS' ("w2i", 2)),
355 :     CL.mkAssign(mkLHS "tVec", mkRHS "tVec"),
356 :     CL.mkAssign(mkLHS' ("w2iT", 0), mkRHS' ("w2iT", 0)),
357 :     CL.mkAssign(mkLHS' ("w2iT", 1), mkRHS' ("w2iT", 1)),
358 :     CL.mkAssign(mkLHS' ("w2iT", 2), mkRHS' ("w2iT", 2)),
359 :     dataStm
360 :     ]
361 :     | _ => raise Fail "image with dimension > 3"
362 :     (* end case *)
363 :     end
364 :     | _ => [CL.mkAssign(lhs, rvalueGlobalVar (env, x))]
365 :     (* end case *))
366 : jhr 1640 | _ => [CL.mkAssign(lhs, trExp(env, rhs))]
367 :     (* end case *))
368 :    
369 : jhr 1671 fun trMultiAssign (env, lhs, IL.E_Op(rator, args)) = (case (lhs, rator, args)
370 :     of ([vals, vecs], Op.EigenVecs2x2, [m]) => let
371 : jhr 3095 val (m, stms) = expToVar (env, N.matTy(2,2), "m", m)
372 : jhr 1671 in
373 : jhr 3095 stms @ [CL.mkCall(N.evecs2x2, [
374 : jhr 1671 CL.mkUnOp(CL.%&,vals), vecs,
375 :     matIndex (m, CL.mkInt 0, "0"),
376 :     matIndex (m, CL.mkInt 0, "1"),
377 :     matIndex (m, CL.mkInt 1, "1")
378 :     ])]
379 :     end
380 :     | ([vals, vecs], Op.EigenVecs3x3, [m]) => let
381 : jhr 3095 val (m, stms) = expToVar (env, N.matTy(3,3), "m", m)
382 : jhr 1671 in
383 : jhr 3095 stms @ [CL.mkCall(N.evecs3x3, [
384 : jhr 1671 CL.mkUnOp(CL.%&,vals), vecs,
385 :     matIndex (m, CL.mkInt 0, "0"),
386 :     matIndex (m, CL.mkInt 0, "1"),
387 :     matIndex (m, CL.mkInt 0, "2"),
388 :     matIndex (m, CL.mkInt 1, "1"),
389 :     matIndex (m, CL.mkInt 1, "2"),
390 :     matIndex (m, CL.mkInt 2, "2")
391 :     ])]
392 :     end
393 :     | _ => raise Fail "bogus multi-assignment"
394 :     (* end case *))
395 :     | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
396 :    
397 : jhr 1370 fun trLocals (env : env, locals) =
398 : jhr 1640 List.foldl
399 : jhr 2405 (fn (x, env) => V.Map.insert(env, x, V(CLTyTranslate.toGPUType(V.ty x), V.name x)))
400 : jhr 1640 env locals
401 : jhr 1370
402 : jhr 1640 fun trStms (env, stms) = let
403 :     fun trStmt (env, stm) = (case stm
404 : jhr 2405 of IL.S_Comment text => [CL.mkComment text]
405 :     | IL.S_Assign([x], exp) => trAssign (env, lvalueVar (env, x), exp)
406 :     | IL.S_Assign(xs, exp) =>
407 :     trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp)
408 : jhr 3088 | IL.S_GAssign(x, exp) => trAssign (env, lvalueGlobalVar (env, x), exp)
409 : jhr 2405 | IL.S_IfThen(cond, thenBlk) =>
410 :     [CL.mkIfThen(trExp(env, cond), trBlk(env, thenBlk))]
411 :     | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
412 :     [CL.mkIfThenElse(trExp(env, cond),
413 :     trBlk(env, thenBlk),
414 :     trBlk(env, elseBlk))]
415 :     | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)
416 :     | IL.S_Save([x], exp) => trAssign (env, lvalueStateVar(env, x), exp)
417 :     | IL.S_Save(xs, exp) =>
418 :     trMultiAssign (env, List.map (fn x => lvalueStateVar(env, x)) xs, exp)
419 :     | IL.S_LoadNrrd _ => raise Fail "impossible S_LoadNrrd in OpenCL"
420 :     | IL.S_Input _ => raise Fail "impossible S_Input in OpenCL"
421 :     | IL.S_InputNrrd _ => raise Fail "impossible S_InputNrrd in OpenCL"
422 : jhr 2758 | IL.S_Exit args => []
423 : jhr 3095 | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]
424 :     | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]
425 :     | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar N.kDie))]
426 : jhr 2405 (* end case *))
427 : jhr 1640 in
428 :     List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] stms
429 :     end
430 : jhr 1117
431 : jhr 1640 and trBlk (env, IL.Block{locals, body}) = let
432 :     val env = trLocals (env, locals)
433 :     val stms = trStms (env, body)
434 :     fun mkDecl (x, stms) = (case V.Map.find (env, x)
435 :     of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
436 :     | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
437 :     (* end case *))
438 :     val stms = List.foldr mkDecl stms locals
439 :     in
440 :     CL.mkBlock stms
441 :     end
442 : jhr 1370
443 :     fun trFragment (env, IL.Block{locals, body}) = let
444 : jhr 1640 val env = trLocals (env, locals)
445 :     val stms = trStms (env, body)
446 :     fun mkDecl (x, stms) = (case V.Map.find (env, x)
447 :     of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
448 :     | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
449 :     (* end case *))
450 :     val stms = List.foldr mkDecl stms locals
451 :     in
452 :     (env, stms)
453 :     end
454 : jhr 1370
455 :     val trBlock = trBlk
456 :    
457 : jhr 1117 end

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