Home My Page Projects Code Snippets Project Openings 3D graphics for Standard ML
Summary Activity SCM

SCM Repository

[sml3d] Annotation of /trunk/sml3d/src/particles/compiler/translate.sml
ViewVC logotype

Annotation of /trunk/sml3d/src/particles/compiler/translate.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 746 - (view) (download)

1 : pavelk 746 (* translate.sml
2 :     *
3 :     * COPYRIGHT (c) 2009 John Reppy (http://cs.uchicago.edu/~jhr)
4 :     * All rights reserved.
5 :     *
6 :     * Translate a particle system to the IR.
7 :     *)
8 :    
9 :     structure Translate : sig
10 :    
11 :     val compile : Particles.action -> PSysIR.block list
12 :    
13 :     end = struct
14 :    
15 :     open SML3dTypeUtil
16 :    
17 :     structure P = ParticlesImp
18 :     structure PSV = P.PSV
19 :     structure IR = PSysIR
20 :    
21 :     datatype particle_state = PS of {
22 :     pos : IR.var,
23 :     vel : IR.var,
24 :     size : IR.var,
25 :     isDead : IR.var,
26 :     color : IR.var
27 :     }
28 :    
29 :     (* special PSV global variables *)
30 :     val timeStep = PSV.new("g_timeStep", PSV.T_FLOAT) (* physics timestep *)
31 :     val numDead = PSV.new("g_numDead", PSV.T_INT) (* # of dead particles *)
32 :     val epsilon = PSV.constf(0.00001)
33 :    
34 :     (* constants *)
35 :     val pi = 3.14159265358979
36 :    
37 :     (* dummy placeholder *)
38 :     fun dummy (state, k) =
39 :     IR.mkCONST(
40 :     IR.newLocal(
41 :     "temp",
42 :     IR.T_BOOL,
43 :     (IR.COPY, [IR.newConst("c", IR.C_BOOL false)])
44 :     ),
45 :     IR.C_BOOL(false),
46 :     k state
47 :     )
48 :    
49 :     (* translation environment *)
50 :     datatype env = TE of (IR.block list ref * IR.var PSV.Map.map)
51 :    
52 :     fun psvToIRVar (TE(_, env), x as PSV.V{name, ...}) = (case PSV.Map.find(env, x)
53 :     of SOME x' => x'
54 :     | NONE => raise Fail ("unknown variable " ^ name)
55 :     (* end case *))
56 :    
57 :     fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))
58 :    
59 :     (* create a block that implements the given continuation *)
60 :     fun newBlock (TE(blks, _), k : particle_state -> IR.stmt) = let
61 :     val pos = IR.newParam ("ps_pos", IR.T_VEC)
62 :     val vel = IR.newParam ("ps_vel", IR.T_VEC)
63 :     val size = IR.newParam ("ps_size", IR.T_FLOAT)
64 :     val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)
65 :     val color = IR.newParam ("ps_color", IR.T_VEC)
66 :     val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color}
67 :     val blk = IR.newBlock ([pos, vel, size, isDead, color], k state)
68 :     in
69 :     blks := blk :: !blks;
70 :     blk
71 :     end
72 :    
73 :     fun newBlockWithArgs (TE(blks, _), args, k : particle_state -> IR.stmt) = let
74 :     val pos = IR.newParam ("ps_pos", IR.T_VEC)
75 :     val vel = IR.newParam ("ps_vel", IR.T_VEC)
76 :     val size = IR.newParam ("ps_size", IR.T_FLOAT)
77 :     val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)
78 :     val color = IR.newParam ("ps_color", IR.T_VEC)
79 :     val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color}
80 :     val blk = IR.newBlock ([pos, vel, size, isDead, color] @ args, k state)
81 :     in
82 :     blks := blk :: !blks;
83 :     blk
84 :     end
85 :    
86 :     fun goto (PS{pos, vel, size, isDead, color}, blk) =
87 :     IR.mkGOTO(blk, [pos, vel, size, isDead, color])
88 :    
89 :     fun gotoWithArgs(PS{pos, vel, size, isDead, color}, args, blk) =
90 :     IR.mkGOTO(blk, [pos, vel, size, isDead, color] @ args)
91 :    
92 :     fun letPRIM (x, ty, p, args, body) = let
93 :     val x' = IR.newLocal(x, ty, (p, args))
94 :     in
95 :     IR.mkPRIM(x', p, args, body x')
96 :     end
97 :    
98 :     (* prim bound to state variable (S_LOCAL for now) *)
99 :     fun letSPRIM(x, ty, p, args, body) = let
100 :     val x' = IR.new(x, IR.S_LOCAL(p, args), ty)
101 :     in
102 :     IR.mkPRIM(x', p, args, body x')
103 :     end
104 :    
105 :     fun letCONST (x, c, body) = body (IR.newConst(x, c))
106 :    
107 :     (* Not sure if this should be made into a primitive or not, but
108 :     * basically this creates the XOR'd value of var1 and var2 and
109 :     * stores it in result.
110 :     *)
111 :     fun mkXOR (result, var1, var2, stmt : IR.var -> IR.stmt) =
112 :     letPRIM("testOR", IR.T_BOOL, IR.OR, [var1, var2], fn testOR =>
113 :     letPRIM("testAND", IR.T_BOOL, IR.AND, [var1, var2], fn testAND =>
114 :     letPRIM("testNAND", IR.T_BOOL, IR.NOT, [testAND], fn testNAND =>
115 :     letPRIM(result, IR.T_BOOL, IR.AND, [testOR, testNAND], stmt))))
116 :    
117 :     (* Generates a random vector within the given domain and puts it in vecVar *)
118 :     fun genVecVar (vecVar, env, domain, stmt : IR.var -> IR.stmt) = (case domain
119 :     of P.D_POINT(pt) =>
120 :     (* Our options here are pretty limited... *)
121 :     letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)
122 :    
123 :     | P.D_LINE({pt1, pt2}) =>
124 :     (* Lerp between the points. *)
125 :     letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
126 :     letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>
127 :     letPRIM ("pt1s", IR.T_VEC, IR.SCALE, [randVal, psvToIRVar(env, pt1)], fn pt1ScaleVec =>
128 :     letPRIM ("pt2s", IR.T_VEC, IR.SCALE, [randInv, psvToIRVar(env, pt2)], fn pt2ScaleVec =>
129 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))
130 :    
131 :     (* This is a bit more complicated if we're trying to avoid accessing
132 :     * the vector variables themselves. Basically the way we can do it is to
133 :     * decompose the vector connecting min and max into the basis vectors,
134 :     * scale them independently, and then add them back together.
135 :     *
136 :     * !FIXME! Actually do that. Don't have time right now...
137 :     *)
138 :     | P.D_BOX{max, min} => raise Fail "Cannot generate point in D_BOX."
139 :    
140 :     | P.D_TRIANGLE{pt1, pt2, pt3} =>
141 :     letPRIM ("pt1ToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn pt1ToPt2 =>
142 :     letPRIM ("pt1ToPt3", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt3), psvToIRVar(env, pt1)], fn pt1ToPt3 =>
143 :     letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>
144 :     letPRIM ("randTwo", IR.T_FLOAT, IR.RAND, [], fn rand2 =>
145 :     letPRIM ("randTwoInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), rand2], fn rand2Inv =>
146 :     letPRIM ("scaleOne", IR.T_VEC, IR.SCALE, [rand1, pt1ToPt2], fn scale1 =>
147 :     letPRIM ("nextScale1", IR.T_VEC, IR.SCALE, [rand2Inv, scale1], fn nextScale1 =>
148 :     letPRIM ("scaleTwo", IR.T_VEC, IR.SCALE, [rand2, pt1ToPt3], fn scale2 =>
149 :     letPRIM ("tempAdd", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, pt1), nextScale1], fn tempAdd =>
150 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [tempAdd, scale2], stmt))))))))))
151 :    
152 :     | P.D_CYLINDER {pt1, pt2, irad, orad} => let
153 :     val normVar = PSV.new("local_ht", PSV.T_VEC3F)
154 :     in
155 :     letPRIM("rand", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
156 :     letPRIM("n", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
157 :     letPRIM("ht", IR.T_FLOAT, IR.LEN, [normVec], fn height =>
158 :     letPRIM("htInv", IR.T_FLOAT, IR.DIV, [IR.newConst("one", IR.C_FLOAT 1.0), height], fn htInv =>
159 :     letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>
160 :     (* Generate a point in the lower disc. *)
161 :     genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>
162 :     (* Now add this point to a random scaling of the normVec. *)
163 :     letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>
164 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>
165 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
166 :     end
167 :    
168 :     | P.D_DISC {pt, normal, irad, orad} =>
169 :     (* Get a random angle... *)
170 :     letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>
171 :     letPRIM ("t", IR.T_FLOAT, IR.MULT, [randForAng, IR.newConst("fullCir", IR.C_FLOAT (2.0 * pi))], fn randAng =>
172 :     (* Get a random radius *)
173 :     letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>
174 :     letPRIM ("e0sq", IR.T_FLOAT, IR.MULT, [newRand, newRand], fn randRadSq =>
175 :     letPRIM ("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
176 :     letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>
177 :     letPRIM ("newRad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), newRadDist], fn newRad =>
178 :     (* Find a vector in the plane of the disc, and then
179 :     * translate it to the center.
180 :     *)
181 :     letPRIM ("ntoc", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn normToCen =>
182 :     letPRIM ("v", IR.T_VEC, IR.CROSS, [psvToIRVar(env, pt), normToCen], fn vecInDisc =>
183 :     letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>
184 :     letPRIM ("p", IR.T_VEC, IR.CROSS, [vecInDiscNorm, psvToIRVar(env, normal)], fn ptInDisc =>
185 :     letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>
186 :     (* Figure out x and y values for our new radius and angle *)
187 :     letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>
188 :     letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>
189 :     letPRIM ("rv1", IR.T_VEC, IR.SCALE, [amtVecOne, vecInDiscNorm], fn resVecOne =>
190 :     letPRIM ("ry", IR.T_FLOAT, IR.SIN, [randAng], fn radY =>
191 :     letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>
192 :     letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>
193 :     letPRIM ("res", IR.T_VEC, IR.ADD_VEC, [resVecOne, resVecTwo], fn result =>
194 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt))))))))))))))))))))
195 :    
196 :     | P.D_CONE{pt1, pt2, irad, orad} => let
197 :     val normVar = PSV.new("local_ht", PSV.T_VEC3F)
198 :     in
199 :     letPRIM("eh", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
200 :     letPRIM("nv", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
201 :     letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>
202 :     genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>
203 :     letPRIM("gptt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), ptInDisc], fn genPtToTip =>
204 :     letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>
205 :     letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>
206 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>
207 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
208 :     end
209 :    
210 :     | _ => raise Fail "Cannot generate point in specified domain."
211 :     (* end case *))
212 :     (*
213 :     | generate (Dplane{pt, n}) = Vec3f.unpack pt
214 :     | generate (Drectangle{pt, u, v}) = Vec3f.unpack pt
215 :     | generate (Dsphere{c, orad, irad}) = Vec3f.unpack c
216 :     | generate (Dblob{c, stddev}) = Vec3f.unpack c
217 :     *)
218 :    
219 :    
220 :     (* This function takes an IR boolean, its environment, a particle state, domain,
221 :     * and continuation.
222 :     *
223 :     * We set the boolean to whether or not the current particle given by the particle
224 :     * state is within the domain, and then pass the continuation on.
225 :     *)
226 :     fun mkWithinVar (boolVar, env, state, d, stmt : IR.var -> IR.stmt) = let
227 :     val PS{pos, vel, size, isDead, color} = state
228 :     in
229 :     case d
230 :     of P.D_POINT(pt) =>
231 :     letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn subVec =>
232 :     letPRIM("vecLen", IR.T_FLOAT, IR.LEN, [subVec], fn vecLen =>
233 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), vecLen], stmt)))
234 :    
235 :     (* Take the vectors going from our position to pt1, and pt2. Then
236 :     * after we normalize them, if their dot product is equal to -1, then
237 :     * they are pointing in opposite directions meaning that the position
238 :     * is inbetween pt1 and pt2 as desired.
239 :     *)
240 :     | P.D_LINE{pt1, pt2} =>
241 :     letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn posToPt1 =>
242 :     letPRIM("posToPt1Norm", IR.T_VEC, IR.NORM, [posToPt1], fn posToPt1Norm =>
243 :     letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), pos], fn posToPt2 =>
244 :     letPRIM("posToPt2Norm", IR.T_VEC, IR.NORM, [posToPt2], fn posToPt2Norm =>
245 :     letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt2, posToPt1], fn dotProd =>
246 :     letPRIM("testMe", IR.T_FLOAT, IR.SUB, [dotProd, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn testVal =>
247 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), testVal], stmt)))))))
248 :    
249 :     (* Just see whether or not the dot product between the normal
250 :     * and the vector from a point on the plane to our position is
251 :     * greater than zero. Essentially, we're "within" a plane if we're
252 :     * behind it (with respect to the normal)
253 :     *)
254 :     | P.D_PLANE{pt, normal} =>
255 :     letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn posToPt =>
256 :     letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
257 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [dotProd, IR.newConst("zero", IR.C_FLOAT 0.0)], stmt)))
258 :    
259 :     (* Similar to checking to see whether or not we're within a plane,
260 :     * here all we have to do is see how far we are from the center
261 :     * of the disc (pt), and then see whther or not we're perpendicular to
262 :     * the normal, and that our distance is greater than irad but less than
263 :     * orad.
264 :     *)
265 :     | P.D_DISC{pt, normal, orad, irad} =>
266 :     letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn posToPt =>
267 :     letPRIM("posToPtLen", IR.T_FLOAT, IR.LEN, [posToPt], fn posToPtLen =>
268 :     letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
269 :     letPRIM("inDisc", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.01), dotProd], fn inDisc =>
270 :     letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOrad =>
271 :     letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIrad =>
272 :     letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
273 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))
274 :    
275 :     (* Simply see whether or not the distance from the center is within the
276 :     * specified bounds.
277 :     *)
278 :     | P.D_SPHERE{center, orad, irad} =>
279 :     letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn posToC =>
280 :     letPRIM("posToPtLen", IR.T_VEC, IR.LEN, [posToC], fn posToCLen =>
281 :     letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToCLen], fn inOrad =>
282 :     letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToCLen, psvToIRVar(env, irad)], fn inIrad =>
283 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))
284 :     (*
285 :     | P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}
286 :     | P.D_PLANE {pt: vec3f var, normal: vec3f var}
287 :     | P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}
288 :     | P.D_BOX {min: vec3f var, max: vec3f var}
289 :     | P.D_SPHERE {center: vec3f var, irad: vec3f var, orad: vec3f var}
290 :     | P.D_CYLINDER {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}
291 :     | P.D_CONE {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}
292 :     | P.D_BLOB {center: vec3f var, stddev: float var}
293 :     | P.D_DISC {pt: vec3f var, normal: vec3f var, irad: float var, orad: float var}
294 :     *)
295 :     | _ => raise Fail "Cannot determine within-ness for specified domain."
296 :     (* end case *)
297 :     end (*end let *)
298 :    
299 :    
300 :     (* generate code to produce a random particle state from a domain *)
301 :     fun newParticle (posDomain, velDomain, colDomain, env, k : particle_state -> IR.stmt) =
302 :     (* genVecVar (vecVar, env, domain, stmt) *)
303 :     genVecVar("ps_pos", env, posDomain, fn newPos =>
304 :     genVecVar("ps_vel", env, velDomain, fn newVel =>
305 :     genVecVar("ps_col", env, colDomain, fn newCol =>
306 :     letSPRIM ("ps_size", IR.T_FLOAT, IR.RAND, [], fn newSize =>
307 :     letSPRIM ("ps_isDead", IR.T_BOOL, IR.COPY, [IR.newConst("fbool", IR.C_BOOL false)], fn newIsDead =>
308 :     k(PS{pos = newPos, vel = newVel, size = newSize, isDead = newIsDead, color = newCol}))))))
309 :    
310 :     (* Find the normal at the given position of the particle for the specified
311 :     * domain. Note, that the particle doesn't necessarily need to be on the
312 :     * domain, but if it's not then the behavior is undefined.
313 :     *)
314 :     fun normAtPoint(retNorm, d, env, state, k : IR.var -> particle_state -> IR.stmt) = let
315 :     val newNorm = IR.newParam("n", IR.T_VEC)
316 :     val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))
317 :     in
318 :     (case d
319 :     of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
320 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
321 :     | P.D_DISC{pt, normal, irad, orad} =>
322 :     mkWithinVar("inP", env, state, d, fn inPlane =>
323 :     IR.mkIF(inPlane,
324 :     (* then *)
325 :     letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
326 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk)),
327 :     (* else *)
328 :     letPRIM(retNorm,
329 :     IR.T_VEC,
330 :     IR.SCALE,
331 :     [IR.newConst("negOne", IR.C_FLOAT ~1.0), psvToIRVar(env, normal)],
332 :     fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
333 :     )
334 :     )
335 :    
336 :     | P.D_SPHERE{center, irad, orad} => let
337 :     val PS{pos, vel, size, isDead, color} = state
338 :     in
339 :     letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, center)], fn subVec =>
340 :     letPRIM(retNorm, IR.T_VEC, IR.NORM, [subVec], fn newNormVar => k newNormVar state
341 :     ))
342 :     end
343 :    
344 :     | _ => raise Fail("Cannot find normal to point of specified domain.")
345 :     (* end case *))
346 :     end
347 :    
348 :     fun trAct (action, env, state, k : particle_state -> IR.stmt) = let
349 :     val PS{pos, vel, size, isDead, color} = state
350 :     in
351 :     case action
352 :     of P.BOUNCE{friction, resilience, cutoff, d} => let
353 :     val blk = newBlock (env, k)
354 :     val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)
355 :     in
356 :     letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn velScale =>
357 :     letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
358 :     mkWithinVar("wnp", env, state, d, fn withinNextPos =>
359 :     IR.mkIF(withinNextPos,
360 :     (*then*)
361 :     normAtPoint("n", d, env, state, fn normAtD => fn state' => let
362 :     val PS{pos=nextPos, vel=nextVel, size=nextSize, isDead=nextIsDead, color=nextColor} = state'
363 :     in
364 :     letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>
365 :     letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>
366 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>
367 :     letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>
368 :    
369 :     letPRIM("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>
370 :     letPRIM("cosq", IR.T_FLOAT, IR.MULT, [psvToIRVar(env, cutoff), psvToIRVar(env, cutoff)], fn cutoffSq =>
371 :     letPRIM("inco", IR.T_BOOL, IR.GT, [tangLenSq, cutoffSq], fn inCutoff =>
372 :    
373 :     letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>
374 :    
375 :     IR.mkIF(inCutoff,
376 :     (*then*)
377 :     letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>
378 :     letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>
379 :     letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>
380 :     letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
381 :     goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor}, blk)
382 :     )))),
383 :     (*else*)
384 :     letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>
385 :     letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
386 :     goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor}, blk)
387 :     ))
388 :     )))))))))
389 :     end
390 :     ),
391 :     (*else*)
392 :     goto(state, blk)))))
393 :     end
394 :    
395 :     | P.SOURCE({maxNum, posDomain, velDomain, colDomain}) => let
396 :     val blk = newBlock (env, k)
397 :     in
398 :     IR.mkIF(isDead,
399 :     (* then *)
400 :     letPRIM("t1", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, maxNum)], fn t1 =>
401 :     letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, numDead)], fn t2 =>
402 :     letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
403 :     letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
404 :     letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
405 :     IR.mkIF(t3,
406 :     (* then *)
407 :     newParticle (posDomain, velDomain, colDomain, env,
408 :     fn state' => goto (state', blk)),
409 :     (* else *)
410 :     IR.DISCARD)))))),
411 :     (* else *)
412 :     goto (state, blk))
413 :     end
414 :    
415 :     | P.GRAVITY(dir) =>
416 :     letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), psvToIRVar(env, dir)], fn theScale =>
417 :     letPRIM("nextVel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>
418 :     k(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color})))
419 :    
420 :     | P.MOVE =>
421 :     letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn theScale =>
422 :     letPRIM("nextPos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
423 :     k(PS{pos = newPos, vel = vel, size = size, isDead = isDead, color = color})))
424 :    
425 :     | P.SINK({d, kill_inside}) => let
426 :     val deadState = PS{
427 :     pos = pos, vel = vel, size = size,
428 :     isDead = IR.newConst("reallyDead", IR.C_BOOL true),
429 :     color = color
430 :     }
431 :     val blk = newBlock (env, k)
432 :     in
433 :     mkWithinVar("isWithin", env, state, d, fn withinVal =>
434 :     mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),
435 :     fn shouldNotKill =>
436 :     IR.mkIF(shouldNotKill,
437 :     (*then*) goto(state, blk),
438 :     (*else*) goto(deadState, blk))
439 :     ))
440 :     end
441 :    
442 :     | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let
443 :     val blk = newBlock (env, k)
444 :     in
445 :     letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, endp2), psvToIRVar(env, endp1)], fn subVec =>
446 :     letPRIM("vecToEndP", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, endp1)], fn vecToEndP =>
447 :     letPRIM("basis", IR.T_VEC, IR.NORM, [subVec], fn basis =>
448 :     letPRIM("parDot", IR.T_FLOAT, IR.DOT, [basis, vecToEndP], fn parDot =>
449 :     letPRIM("parVec", IR.T_VEC, IR.SCALE, [parDot, basis], fn parVec =>
450 :     letPRIM("closestP", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, endp1), parVec], fn closestP =>
451 :     letPRIM("vecToP", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn vecToP =>
452 :     letPRIM("distToP", IR.T_FLOAT, IR.LEN, [vecToP], fn distToP =>
453 :     letPRIM("effRad", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, maxRad), distToP], fn effRad =>
454 :     letPRIM("radInDist", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), effRad], fn radInDist =>
455 :     IR.mkIF(radInDist,
456 :     (*then*)
457 :     goto(state, blk),
458 :     (*else*)
459 :     letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>
460 :     letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
461 :     letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
462 :     letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, timeStep)], fn totMag =>
463 :     letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>
464 :     letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>
465 :     letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
466 :     goto(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color}, blk)
467 :     )))))))
468 :     )))))))))))
469 :     end
470 :     | _ => raise Fail("Action not implemented...")
471 :     (* end case *)
472 :     end
473 :    
474 :     fun compile (P.PSAE{action, vars}) = let
475 :     val blks = ref[]
476 :     val env = let
477 :     (* add special globals to free vars *)
478 :     val vars = PSV.Set.addList(vars, [numDead, timeStep, epsilon])
479 :     fun ins (x as PSV.V{name, ty, binding, ...}, map) = let
480 :     val x' = (case (ty, !binding)
481 :     of (PSV.T_BOOL, PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
482 :     | (PSV.T_BOOL, PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))
483 :     | (PSV.T_INT, PSV.UNDEF) => IR.newGlobal(x, IR.T_INT)
484 :     | (PSV.T_INT, PSV.INT intVal) => IR.newConst(name, IR.C_INT(intVal))
485 :     | (PSV.T_FLOAT, PSV.UNDEF) => IR.newGlobal(x, IR.T_FLOAT)
486 :     | (PSV.T_FLOAT, PSV.FLOAT floatVal) => IR.newConst(name, IR.C_FLOAT(floatVal))
487 :     | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
488 :     | (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))
489 :     | _ => raise Fail("Error in setup, type mismatch between IR and PSV vars.")
490 :     (* end case *))
491 :     in
492 :     PSV.Map.insert (map, x, x')
493 :     end
494 :     in
495 :     TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)
496 :     end
497 :     fun trActs [] state = let
498 :     val PS{pos, vel, size, isDead, color} = state
499 :     in
500 :     IR.mkRETURN[ pos, vel, size, isDead, color ]
501 :     end (* trActs *)
502 :     | trActs (psa :: psal) state = trAct(psa, env, state, trActs psal)
503 :     val entryBlock = newBlock (env, fn state => trActs action state)
504 :     in
505 :     IR.output(TextIO.stdErr, !blks);
506 :     if Checker.checkIR(!blks) then
507 :     !blks(* note that the entryBlock will be the first block *)
508 :     else
509 :     []
510 :     end (* compile *)
511 :    
512 :     end (* Translate *)

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