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 1160 - (view) (download)

1 : pavelk 746 (* translate.sml
2 : pavelk 1108
3 : pavelk 746 * 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 : jhr 1050 val compile : Particles.program -> PSysIR.program
12 : pavelk 746
13 :     end = struct
14 :    
15 :     open SML3dTypeUtil
16 :    
17 :     structure P = ParticlesImp
18 :     structure PSV = P.PSV
19 :     structure IR = PSysIR
20 : pavelk 770
21 :     fun printErr s = TextIO.output(TextIO.stdErr, s ^ "\n")
22 : pavelk 746
23 :     (* special PSV global variables *)
24 :     val epsilon = PSV.constf(0.00001)
25 :    
26 :     (* constants *)
27 :     val pi = 3.14159265358979
28 : pavelk 870
29 : pavelk 746 (* translation environment *)
30 : pavelk 1147 datatype ir_env = TE of (IR.block list ref * IR.var PSV.Map.map * IR.var PSV.SVMap.map)
31 :     fun insertVar (TE(blks, v_env, sv_env), x, x') = TE(blks, PSV.Map.insert (v_env, x, x'), sv_env)
32 : pavelk 1150 fun insertSVar (TE(blks, v_env, sv_env), x, x') = (case (PSV.SVMap.find (sv_env, x))
33 :     of NONE => raise Fail("Changing mapping to state var that doesn't exist.")
34 :     | SOME var => (
35 :     IR.setRenderVar(x', IR.isRenderVar var);
36 :     TE(blks, v_env, PSV.SVMap.insert (sv_env, x, x'))
37 :     )
38 :     (* end case *))
39 : pavelk 746
40 : pavelk 1147 fun retState (TE(_, _, sv_env)) = IR.mkRETURN (PSV.SVMap.listItems sv_env)
41 :    
42 :     (* Interaction with environment and psys variables *)
43 :     fun psvToIRVar (TE(_, env, _), x as PSV.V{name, id, ...}) = (case PSV.Map.find(env, x)
44 : pavelk 746 of SOME x' => x'
45 : pavelk 770 | NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])
46 : pavelk 1108 (* end case *))
47 : pavelk 746
48 : pavelk 1147 fun pssvToIRVar (TE(_, _, env), x as PSV.SV{name, id, ...}) = (case PSV.SVMap.find(env, x)
49 :     of SOME x' => x'
50 :     | NONE => raise Fail (String.concat["unknown state variable ", name, " with ID ", Int.toString id])
51 :     (* end case *))
52 :    
53 : pavelk 1109 (* create a block that implements the given continuation *)
54 : pavelk 1147 fun newBlockWithArgs (env as TE(blks, _, sv_env), args, k : ir_env -> IR.stmt) = let
55 : pavelk 1109 fun copyVar(v as IR.V{name, varType, ...}) = IR.newParam(name, varType)
56 : pavelk 1147 val newState = List.map copyVar (PSV.SVMap.listItems sv_env)
57 :     fun inssv((oldv, newv), TE(theBlks, v_env, svenv)) = let
58 :     val theKey =
59 :     List.find
60 :     (fn v => IR.varEq(PSV.SVMap.lookup(svenv, v), oldv))
61 : pavelk 1150 (PSV.SVMap.listKeys svenv)
62 :     val sv = (case theKey
63 :     of SOME x => x
64 : pavelk 1147 | NONE => raise Fail("Trying to create new mapping for variable that doesn't already exist.")
65 :     (* end case *))
66 : pavelk 1150 in
67 :     IR.setRenderVar(newv, IR.isRenderVar oldv);
68 :     TE(theBlks, v_env, PSV.SVMap.insert(svenv, sv, newv))
69 : pavelk 1147 end
70 :    
71 :     val blk = IR.newBlock (
72 :     newState @ args,
73 :     k (List.foldl inssv env
74 :     (ListPair.zipEq
75 :     (PSV.SVMap.listItems sv_env, newState)
76 :     )
77 :     )
78 :     )
79 : pavelk 746 in
80 : pavelk 1107 blks := blk :: !blks;
81 :     blk
82 : pavelk 746 end
83 :    
84 : pavelk 1147 fun newBlock (env, k) = newBlockWithArgs(env, [], k)
85 : pavelk 746
86 :     fun letPRIM (x, ty, p, args, body) = let
87 :     val x' = IR.newLocal(x, ty, (p, args))
88 :     in
89 :     IR.mkPRIM(x', p, args, body x')
90 :     end
91 :    
92 : pavelk 1150 fun gotoWithArgs(TE(_, _, env), args, blk) = let
93 :    
94 :     fun copyVar(v as IR.V{name, varType, ...}) = IR.newLocal(name^"_copy", varType, (IR.RAND, []))
95 :    
96 :     fun copyRenderVar (oldv, newv) = IR.setRenderVar (newv, IR.isRenderVar oldv)
97 :    
98 :     val vars = ((PSV.SVMap.listItems env) @ args)
99 :     val varCopies = List.map copyVar vars
100 :    
101 :     fun mkCopy(newv, oldv, k) = IR.mkPRIM(newv, IR.COPY, [oldv], k)
102 :     in
103 :     List.app copyRenderVar (ListPair.zipEq (vars, varCopies));
104 :     ListPair.foldr mkCopy (IR.mkGOTO(blk, varCopies)) (varCopies, vars)
105 :     end
106 :    
107 :     fun goto (env, blk) = gotoWithArgs(env, [], blk)
108 :    
109 :    
110 : pavelk 746 (* Not sure if this should be made into a primitive or not, but
111 :     * basically this creates the XOR'd value of var1 and var2 and
112 : pavelk 1147 * stores it in result. *)
113 : pavelk 746 fun mkXOR (result, var1, var2, stmt : IR.var -> IR.stmt) =
114 :     letPRIM("testOR", IR.T_BOOL, IR.OR, [var1, var2], fn testOR =>
115 :     letPRIM("testAND", IR.T_BOOL, IR.AND, [var1, var2], fn testAND =>
116 :     letPRIM("testNAND", IR.T_BOOL, IR.NOT, [testAND], fn testNAND =>
117 :     letPRIM(result, IR.T_BOOL, IR.AND, [testOR, testNAND], stmt))))
118 :    
119 : pavelk 1017 fun genFloatVar (fltVar, env, domain : Float.float P.domain, dist, stmt : IR.var -> IR.stmt) = let
120 :     fun genRandVal(var, stmt : IR.var -> IR.stmt) = (case dist
121 :     of P.DIST_UNIFORM =>
122 :     letPRIM(var, IR.T_FLOAT, IR.RAND, [], stmt)
123 :    
124 :     (* The PDF here is f(x) = 2x when 0 < x <= 1, so the CDF is going
125 :     * to be the integral of f from 0 -> y => y^2. Hence, whenever we
126 :     * generate a random number, in order to get the random value according
127 : pavelk 1147 * to this probability distribution, we just square it. *)
128 : pavelk 1017 | P.DIST_INC_LIN =>
129 :     letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
130 :     letPRIM(var, IR.T_FLOAT, IR.MULT, [randVal, randVal], stmt))
131 :    
132 :     (* The PDF here is f(x) = -2x + 2 when 0 <= x < 1, so the CDF is going
133 :     * to be the integral of f from 0 -> y => -(y^2) + 2y. Hence, whenever we
134 :     * generate a random number, in order to get the random value according
135 :     * to this probability distribution, we just square it.
136 :     *)
137 :     | P.DIST_DEC_LIN =>
138 :     letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
139 :     letPRIM("randSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randSq =>
140 :     letPRIM("termOne", IR.T_FLOAT, IR.MULT, [randSq, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn termOne =>
141 :     letPRIM("termTwo", IR.T_FLOAT, IR.MULT, [randVal, IR.newConst("negOne", IR.C_FLOAT 2.0)], fn termTwo =>
142 :     letPRIM(var, IR.T_FLOAT, IR.ADD, [termOne, termTwo], stmt)
143 :     ))))
144 :    
145 : pavelk 1132 | _ => raise Fail "Unable to create random float for specified distribution"
146 : pavelk 1017 (* end case *))
147 :     in
148 :     (case domain
149 :     of P.D_POINT(pt) =>
150 :     (* Our options here are pretty limited... *)
151 :     letPRIM (fltVar, IR.T_FLOAT, IR.COPY, [psvToIRVar(env, pt)], stmt)
152 :    
153 :     | P.D_BOX{max, min} =>
154 :     genRandVal("randf", fn rand =>
155 :     letPRIM("boxDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, max), psvToIRVar(env, max)], fn diff =>
156 :     letPRIM("scale", IR.T_FLOAT, IR.MULT, [diff, rand], fn scale =>
157 :     letPRIM( fltVar, IR.T_FLOAT, IR.ADD, [psvToIRVar(env, max), scale], stmt )
158 :     )))
159 : pavelk 1132 | _ => raise Fail ("Cannot generate float in specified domain: " ^ (P.dToStr domain))
160 : pavelk 1017 (* end case *))
161 :     end
162 :    
163 : pavelk 746 (* Generates a random vector within the given domain and puts it in vecVar *)
164 : pavelk 1108 fun genVecVar (
165 :     vecVar,
166 :     env,
167 :     domain : Vec3f.vec3 P.domain,
168 :     dist : Vec3f.vec3 P.distribution,
169 :     stmt : IR.var -> IR.stmt
170 :     ) = (case domain
171 : pavelk 746 of P.D_POINT(pt) =>
172 :     (* Our options here are pretty limited... *)
173 :     letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)
174 :    
175 :     | P.D_LINE({pt1, pt2}) =>
176 : pavelk 1131
177 :     (* Lerp between the points. *)
178 :     letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
179 :     letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>
180 :     letPRIM ("pt1s", IR.T_VEC, IR.SCALE, [randVal, psvToIRVar(env, pt1)], fn pt1ScaleVec =>
181 :     letPRIM ("pt2s", IR.T_VEC, IR.SCALE, [randInv, psvToIRVar(env, pt2)], fn pt2ScaleVec =>
182 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))
183 : pavelk 746
184 : pavelk 873 | P.D_BOX{max, min} =>
185 :     (* Extract the componentwise vector variables *)
186 :     letPRIM("minX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, min)], fn minX =>
187 :     letPRIM("maxX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, max)], fn maxX =>
188 :     letPRIM("minY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, min)], fn minY =>
189 :     letPRIM("maxY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, max)], fn maxY =>
190 :     letPRIM("minZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, min)], fn minZ =>
191 :     letPRIM("maxZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, max)], fn maxZ =>
192 :    
193 :     (* Find the distance in each component *)
194 :     letPRIM("distX", IR.T_FLOAT, IR.SUB, [maxX, minX], fn distX =>
195 :     letPRIM("distY", IR.T_FLOAT, IR.SUB, [maxY, minY], fn distY =>
196 :     letPRIM("distZ", IR.T_FLOAT, IR.SUB, [maxZ, minZ], fn distZ =>
197 :    
198 :     (* Get three random numbers for each of the components *)
199 :     letPRIM("randX", IR.T_FLOAT, IR.RAND, [], fn randX =>
200 :     letPRIM("randY", IR.T_FLOAT, IR.RAND, [], fn randY =>
201 :     letPRIM("randZ", IR.T_FLOAT, IR.RAND, [], fn randZ =>
202 :    
203 :     (* Scale the distances by these random numbers *)
204 :     letPRIM("scaledX", IR.T_FLOAT, IR.MULT, [randX, distX], fn scaledX =>
205 :     letPRIM("scaledY", IR.T_FLOAT, IR.MULT, [randY, distY], fn scaledY =>
206 :     letPRIM("scaledZ", IR.T_FLOAT, IR.MULT, [randZ, distZ], fn scaledZ =>
207 :    
208 :     (* Add them to the minimum vec in order to create a new vec inside
209 :     * of the box.
210 :     *)
211 :     letPRIM("newX", IR.T_FLOAT, IR.ADD, [minX, scaledX], fn newX =>
212 :     letPRIM("newY", IR.T_FLOAT, IR.ADD, [minY, scaledY], fn newY =>
213 :     letPRIM("newZ", IR.T_FLOAT, IR.ADD, [minZ, scaledZ], fn newZ =>
214 :    
215 :     (* Gen the vector *)
216 :     letPRIM(vecVar, IR.T_VEC, IR.GEN_VEC, [newX, newY, newZ], stmt
217 :    
218 :     )))))))))))))))))))
219 :    
220 : pavelk 746
221 : pavelk 1131 | P.D_TRIANGLE{pt1, pt2, pt3} =>
222 :    
223 :     letPRIM ("pt1ToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn pt1ToPt2 =>
224 :     letPRIM ("pt1ToPt3", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt3), psvToIRVar(env, pt1)], fn pt1ToPt3 =>
225 :     letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>
226 :     letPRIM ("randTwo", IR.T_FLOAT, IR.RAND, [], fn rand2 =>
227 :     letPRIM ("randTwoInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), rand2], fn rand2Inv =>
228 :     letPRIM ("scaleOne", IR.T_VEC, IR.SCALE, [rand1, pt1ToPt2], fn scale1 =>
229 :     letPRIM ("nextScale1", IR.T_VEC, IR.SCALE, [rand2Inv, scale1], fn nextScale1 =>
230 :     letPRIM ("scaleTwo", IR.T_VEC, IR.SCALE, [rand2, pt1ToPt3], fn scale2 =>
231 :     letPRIM ("tempAdd", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, pt1), nextScale1], fn tempAdd =>
232 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [tempAdd, scale2], stmt))))))))))
233 : pavelk 1160
234 :     | P.D_PLANE _ => raise Fail ("Cannot generate point in plane because domain is unbounded.")
235 :    
236 :     | P.D_RECT{pt, htvec, wdvec} =>
237 :    
238 :     letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>
239 :     letPRIM ("randTwo", IR.T_FLOAT, IR.RAND, [], fn rand2 =>
240 :     letPRIM ("htScale", IR.T_VEC, IR.SCALE, [rand1, psvToIRVar(env, htvec)], fn htScale =>
241 :     letPRIM ("wdScale", IR.T_VEC, IR.SCALE, [rand2, psvToIRVar(env, wdvec)], fn wdScale =>
242 :     letPRIM ("overTheRiver", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, pt), htScale], fn stepOne =>
243 :     letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [stepOne, wdScale], stmt)
244 :     )))))
245 : pavelk 746
246 :     | P.D_CYLINDER {pt1, pt2, irad, orad} => let
247 :     val normVar = PSV.new("local_ht", PSV.T_VEC3F)
248 :     in
249 :     letPRIM("rand", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
250 :     letPRIM("n", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
251 :     letPRIM("ht", IR.T_FLOAT, IR.LEN, [normVec], fn height =>
252 :     letPRIM("htInv", IR.T_FLOAT, IR.DIV, [IR.newConst("one", IR.C_FLOAT 1.0), height], fn htInv =>
253 :     letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>
254 :     (* Generate a point in the lower disc. *)
255 : pavelk 1109 genVecVar("ptInDisc",
256 : pavelk 1147 insertVar(env, normVar, norm),
257 : pavelk 1109 P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
258 :     dist,
259 :     fn ptInDisc =>
260 : pavelk 746 (* Now add this point to a random scaling of the normVec. *)
261 :     letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>
262 :     letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>
263 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
264 :     end
265 : pavelk 1131
266 : pavelk 1160 | P.D_DISC {pt, normal, irad, orad} => let
267 :     val up = IR.newConst("up", IR.C_VEC (Vec3f.pack (0.0, 1.0, 0.0)))
268 :     in
269 : pavelk 1131
270 :     (* Get a random angle... *)
271 :     letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>
272 :     letPRIM ("t", IR.T_FLOAT, IR.MULT, [randForAng, IR.newConst("fullCir", IR.C_FLOAT (2.0 * pi))], fn randAng =>
273 :    
274 :     (* Get a random radius *)
275 :     letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>
276 : pavelk 1148 letPRIM ("e0sq", IR.T_FLOAT, IR.SQRT, [newRand], fn randRadSq =>
277 : pavelk 1131 letPRIM ("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
278 :     letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>
279 :     letPRIM ("newRad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), newRadDist], fn newRad =>
280 :    
281 : pavelk 1160 (* Build vector in unit disc *)
282 :     letPRIM("sinRandAng", IR.T_FLOAT, IR.SIN, [randAng], fn randSin =>
283 :     letPRIM("cosRandAng", IR.T_FLOAT, IR.COS, [randAng], fn randCos =>
284 :     letPRIM("unitV", IR.T_VEC, IR.GEN_VEC, [randCos, IR.newConst("zero", IR.C_FLOAT 0.0), randSin], fn unitV =>
285 :     letPRIM("genV", IR.T_VEC, IR.SCALE, [newRad, unitV], fn genV =>
286 : pavelk 1131
287 : pavelk 1160 (* Figure out angle and axis of rotation for disc. *)
288 :     letPRIM("rotVec", IR.T_VEC, IR.CROSS, [psvToIRVar(env, normal), up], fn rotVec =>
289 :     letPRIM("dotN", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, normal), up], fn cosRotAng =>
290 :     letPRIM("rotAng", IR.T_FLOAT, IR.ACOS, [cosRotAng], fn rotAng =>
291 : pavelk 1131
292 : pavelk 1160 (* Rotate our unit vector that we generated so that it lies in the same plane as the
293 :     * disc using the following formula:
294 :     *
295 :     * Given a vector v to rotate about an axis r by angle a, the resulting vector is
296 :     * (v - dot(v, r) * r) cos(a) + cross(v, r) * sin(a) + dot(v, r) * r
297 :     *)
298 :     letPRIM ("vDotR", IR.T_FLOAT, IR.DOT, [genV, rotVec], fn vDotR =>
299 :     letPRIM ("vPara", IR.T_VEC, IR.SCALE, [vDotR, rotVec], fn vPara =>
300 :     letPRIM ("vPerp", IR.T_VEC, IR.SUB_VEC, [genV, vPara], fn vPerp =>
301 :     letPRIM ("vCrossR", IR.T_VEC, IR.CROSS, [genV, rotVec], fn vCrossR =>
302 :     (* cosA is cosRotAng *)
303 :     letPRIM ("sinA", IR.T_FLOAT, IR.SIN, [rotAng], fn sinRotAng =>
304 :     letPRIM ("scaleCross", IR.T_VEC, IR.SCALE, [sinRotAng, vCrossR], fn scaleCross =>
305 :     letPRIM ("scalePerp", IR.T_VEC, IR.SCALE, [cosRotAng, vPerp], fn scalePerp =>
306 :     letPRIM ("scaleAdd", IR.T_VEC, IR.ADD_VEC, [scalePerp, scaleCross], fn scaleAdd =>
307 :     letPRIM ("result", IR.T_VEC, IR.ADD_VEC, [scaleAdd, vPara], fn result =>
308 :    
309 : pavelk 1131 letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt)
310 : pavelk 1160 )))))))))))))))))))))))
311 :     end
312 :    
313 :     (* In order to generate a normal distribution in a cone you need to choose a hight whose
314 :     * density is proportional to the area of the corresponding disc cross-section. The way
315 :     * I did this is by choosing a uniformly random area (basically the sqrt of a random
316 :     * variable) and then generating a uniformly distributed point in the corresponding
317 :     * cross section. I'm not 100% sure that this is the right way to do it, but it's definitely
318 :     * better than what I was doing before (check the SVN logs) *)
319 : pavelk 1131 | P.D_CONE{pt1, pt2, irad, orad} => let
320 :     val normVar = PSV.new("local_ht", PSV.T_VEC3F)
321 : pavelk 1160 val ptVar = PSV.new("local_pt", PSV.T_VEC3F)
322 :     val newORad = PSV.new("local_orad", PSV.T_FLOAT)
323 :     val newIRad = PSV.new("local_irad", PSV.T_FLOAT)
324 : pavelk 1131 in
325 :     letPRIM("eh", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
326 : pavelk 1160 letPRIM("randVal", IR.T_FLOAT, IR.SQRT, [ourRand], fn randVal =>
327 :     letPRIM("randORad", IR.T_FLOAT, IR.MULT, [randVal, psvToIRVar(env, orad)], fn randORad =>
328 :     letPRIM("randIRad", IR.T_FLOAT, IR.MULT, [randVal, psvToIRVar(env, irad)], fn randIRad =>
329 : pavelk 1131 letPRIM("nv", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
330 :     letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>
331 : pavelk 1160 letPRIM("vecToRandPt", IR.T_VEC, IR.SCALE, [randVal, normVec], fn vecToRandPt =>
332 :     letPRIM("discCenter", IR.T_VEC, IR.ADD, [psvToIRVar(env, pt1), vecToRandPt], fn discCenter =>
333 :     genVecVar(vecVar,
334 :     insertVar(insertVar(insertVar(insertVar(env,
335 :     ptVar, discCenter),
336 :     normVar, norm),
337 :     newORad, randORad),
338 :     newIRad, randIRad),
339 :     P.D_DISC{pt = ptVar, normal = normVar, irad = newIRad, orad = newORad},
340 :     dist, stmt)
341 : pavelk 1131 ))))))))
342 :     end
343 : pavelk 1074
344 :     | P.D_SPHERE{center, irad, orad} =>
345 :    
346 : pavelk 1131 (* Source: http://mathworld.wolfram.com/SpherePointPicking.html *)
347 :    
348 :     (* generate two random values... one will be called u and will
349 :     * represent cos(theta), and the other will be called v and will
350 :     * represent a random value in [0, 2 * pi] *)
351 :     letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn rv =>
352 :     letPRIM("dblRandVal", IR.T_FLOAT, IR.MULT, [rv, IR.newConst("Two", IR.C_FLOAT 2.0)], fn drv =>
353 :     letPRIM("rand", IR.T_FLOAT, IR.SUB, [drv, IR.newConst("One", IR.C_FLOAT 1.0)], fn u =>
354 :    
355 :     letPRIM("rv2", IR.T_FLOAT, IR.RAND, [], fn rv2 =>
356 :     letPRIM("rand2", IR.T_FLOAT, IR.MULT, [rv2, IR.newConst("TwoPi", IR.C_FLOAT (2.0 * Float.M_PI))], fn theta =>
357 : pavelk 1074
358 : pavelk 1131 letPRIM("cosTheta", IR.T_FLOAT, IR.COS, [theta], fn cosT =>
359 :     letPRIM("sinTheta", IR.T_FLOAT, IR.SIN, [theta], fn sinT =>
360 :    
361 :     letPRIM("usq", IR.T_FLOAT, IR.MULT, [u, u], fn usq =>
362 :     letPRIM("usqInv", IR.T_FLOAT, IR.SUB, [IR.newConst("One", IR.C_FLOAT 1.0), usq], fn usqInv =>
363 :     letPRIM("sinPhi", IR.T_FLOAT, IR.SQRT, [usqInv], fn sinP =>
364 :    
365 :     letPRIM("xVal", IR.T_FLOAT, IR.MULT, [sinP, cosT], fn xVal =>
366 :     letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sinP, sinT], fn yVal =>
367 :     (* zval is just u *)
368 : pavelk 1074
369 : pavelk 1131 letPRIM("vec", IR.T_VEC, IR.GEN_VEC, [xVal, yVal, u], fn vec =>
370 : pavelk 1074
371 :     (* Generate a random radius... *)
372 :     letPRIM("ratio", IR.T_FLOAT, IR.DIV, [psvToIRVar(env, irad), psvToIRVar(env, orad)], fn ratio =>
373 :     letPRIM("invRatio", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), ratio], fn invRatio =>
374 :     letPRIM("randVar", IR.T_FLOAT, IR.RAND, [], fn rand =>
375 :     letPRIM("randScale", IR.T_FLOAT, IR.MULT, [rand, invRatio], fn randScale =>
376 :     letPRIM("randVal", IR.T_FLOAT, IR.ADD, [randScale, ratio], fn randVal =>
377 : pavelk 1151 letPRIM("randValSq", IR.T_FLOAT, IR.SQRT, [randVal], fn randValSq =>
378 : pavelk 1074 letPRIM("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
379 :     letPRIM("randRadVal", IR.T_FLOAT, IR.MULT, [radDiff, randValSq], fn randRadVal =>
380 :     letPRIM("rad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), randRadVal], fn rad =>
381 :    
382 :     (* Normalize the vector and scale it by the radius. *)
383 :     letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [rad, vec], fn sVec =>
384 :     letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [sVec, psvToIRVar(env, center)], stmt)
385 :     ))))))))))
386 : pavelk 1131 )))))))))))))
387 : pavelk 746
388 :     (* end case *))
389 :    
390 :     (* This function takes an IR boolean, its environment, a particle state, domain,
391 :     * and continuation.
392 :     *
393 :     * We set the boolean to whether or not the current particle given by the particle
394 :     * state is within the domain, and then pass the continuation on.
395 :     *)
396 : pavelk 1120 fun mkVecWithinVar (boolVar, env, var, d : Vec3f.vec3 P.domain, stmt : IR.var -> IR.stmt) = let
397 : pavelk 1147 val pos = var
398 : pavelk 746 in
399 :     case d
400 :     of P.D_POINT(pt) =>
401 :     letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn subVec =>
402 : pavelk 1160 letPRIM("vecLen", IR.T_FLOAT, IR.LEN_SQ, [subVec], fn vecLen =>
403 : pavelk 746 letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), vecLen], stmt)))
404 :    
405 :     (* Take the vectors going from our position to pt1, and pt2. Then
406 :     * after we normalize them, if their dot product is equal to -1, then
407 :     * they are pointing in opposite directions meaning that the position
408 :     * is inbetween pt1 and pt2 as desired.
409 :     *)
410 :     | P.D_LINE{pt1, pt2} =>
411 :     letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn posToPt1 =>
412 :     letPRIM("posToPt1Norm", IR.T_VEC, IR.NORM, [posToPt1], fn posToPt1Norm =>
413 :     letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), pos], fn posToPt2 =>
414 :     letPRIM("posToPt2Norm", IR.T_VEC, IR.NORM, [posToPt2], fn posToPt2Norm =>
415 :     letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt2, posToPt1], fn dotProd =>
416 :     letPRIM("testMe", IR.T_FLOAT, IR.SUB, [dotProd, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn testVal =>
417 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), testVal], stmt)))))))
418 :    
419 :     (* Just see whether or not the dot product between the normal
420 :     * and the vector from a point on the plane to our position is
421 :     * greater than zero. Essentially, we're "within" a plane if we're
422 :     * behind it (with respect to the normal)
423 :     *)
424 :     | P.D_PLANE{pt, normal} =>
425 : pavelk 905 letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
426 : pavelk 746 letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
427 :     letPRIM(boolVar, IR.T_BOOL, IR.GT, [dotProd, IR.newConst("zero", IR.C_FLOAT 0.0)], stmt)))
428 :    
429 :     (* Similar to checking to see whether or not we're within a plane,
430 :     * here all we have to do is see how far we are from the center
431 :     * of the disc (pt), and then see whther or not we're perpendicular to
432 :     * the normal, and that our distance is greater than irad but less than
433 :     * orad.
434 :     *)
435 :     | P.D_DISC{pt, normal, orad, irad} =>
436 : pavelk 1133 letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
437 :     letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
438 :     letPRIM("inDisc", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.01), dotProd], fn inDisc =>
439 :    
440 :     letPRIM("parPosToP", IR.T_VEC, IR.SCALE, [dotProd, psvToIRVar(env, normal)], fn posToPtParallelToNormal =>
441 :     letPRIM("perpPosToP", IR.T_VEC, IR.SUB_VEC, [posToPt, posToPtParallelToNormal], fn posToPtPerpToNormal =>
442 :     letPRIM("inDiscLen", IR.T_FLOAT, IR.LEN, [posToPtPerpToNormal], fn posToPtLen =>
443 :    
444 :     letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOradGt =>
445 :     letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), posToPtLen], fn inOradEq =>
446 :     letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
447 :    
448 :     letPRIM("inIradGt", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIradGt =>
449 :     letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [posToPtLen, psvToIRVar(env, irad)], fn inIradEq =>
450 :     letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
451 :    
452 :     letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
453 :    
454 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))))))))
455 : pavelk 987
456 : pavelk 746 (* Simply see whether or not the distance from the center is within the
457 :     * specified bounds.
458 :     *)
459 :     | P.D_SPHERE{center, orad, irad} =>
460 :     letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn posToC =>
461 :     letPRIM("posToPtLen", IR.T_VEC, IR.LEN, [posToC], fn posToCLen =>
462 :     letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToCLen], fn inOrad =>
463 :     letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToCLen, psvToIRVar(env, irad)], fn inIrad =>
464 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))
465 : pavelk 1060
466 :     | P.D_CYLINDER {pt1, pt2, irad, orad} =>
467 :    
468 :     (* !FIXME! Right now, we see whether or not the point is within the two planes defined
469 :     * by the endpoints of the cylinder, and then testing to see whether or not the smallest
470 :     * distance to the line segment falls within the radii. It might be faster to find the
471 :     * closest point to the line defined by the endpoints and then see whether or not the point
472 :     * is within the segment.
473 :     *)
474 :    
475 :     (* Is it in one plane *)
476 :     letPRIM("plane1Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn plane1Norm =>
477 :     letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt1)], fn posToPt1 =>
478 :     letPRIM("dot1", IR.T_FLOAT, IR.DOT, [posToPt1, plane1Norm], fn dot1Prod =>
479 :     letPRIM("inPlane1", IR.T_BOOL, IR.GT, [dot1Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane1=>
480 :    
481 :     (* Is it in another plane *)
482 :     letPRIM("plane2Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), psvToIRVar(env, pt2)], fn plane2Norm =>
483 :     letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt2)], fn posToPt2 =>
484 :     letPRIM("dot2", IR.T_FLOAT, IR.DOT, [posToPt2, plane2Norm], fn dot2Prod =>
485 :     letPRIM("inPlane2", IR.T_BOOL, IR.GT, [dot2Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane2=>
486 :    
487 :     (* Is it in both planes? *)
488 :     letPRIM("inPlanes", IR.T_BOOL, IR.AND, [inPlane1, inPlane2], fn inPlanes =>
489 :    
490 :     (* Find distance from segment *)
491 :     letPRIM("a", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn a =>
492 :     letPRIM("b", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn b =>
493 :     letPRIM("alen", IR.T_FLOAT, IR.LEN, [a], fn alen =>
494 :     letPRIM("axb", IR.T_VEC, IR.CROSS, [a, b], fn axb =>
495 :     letPRIM("axblen", IR.T_FLOAT, IR.LEN, [axb], fn axblen =>
496 :     letPRIM("dist", IR.T_FLOAT, IR.DIV, [axblen, alen], fn dist =>
497 :    
498 :     (* Is distance in both radii? *)
499 :     letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), dist], fn inOradGt =>
500 :     letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), dist], fn inOradEq =>
501 :     letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
502 :    
503 :     letPRIM("inIradGt", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, irad)], fn inIradGt =>
504 :     letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [dist, psvToIRVar(env, irad)], fn inIradEq =>
505 :     letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
506 :    
507 :     letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
508 :    
509 :     (* It's in the cylinder (tube) if it's within both radii and in both planes... *)
510 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [inPlanes, inBothRad], stmt)
511 :     ))))))))))))))))))))))
512 : pavelk 1159
513 : pavelk 1132 | _ => raise Fail ("Cannot determine within-ness for specified vec3 domain: " ^ (P.dToStr d))
514 : pavelk 746 (* end case *)
515 :     end (*end let *)
516 : pavelk 1120
517 :     fun mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) = (case d
518 :     of P.D_POINT(pt) => letPRIM(boolVar, IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, pt), var], stmt)
519 :     | P.D_BOX {min, max} =>
520 :     letPRIM("bigMin", IR.T_BOOL, IR.GT, [var, psvToIRVar(env, min)], fn bigMin =>
521 :     letPRIM("smallMax", IR.T_BOOL, IR.GT, [psvToIRVar(env, max), var], fn smallMax =>
522 :     letPRIM(boolVar, IR.T_BOOL, IR.AND, [bigMin, smallMax], stmt)))
523 : pavelk 1132 | _ => raise Fail ("Cannot determine within-ness for specified float domain: " ^ (P.dToStr d))
524 : pavelk 1120 (* end case *))
525 : pavelk 746
526 : pavelk 1147 fun mkIntBool(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> ir_env -> IR.stmt) = let
527 : pavelk 1108 val _ = ()
528 :     in
529 :     (case d
530 :     of P.D_POINT(pt) =>
531 :    
532 :     (* Get vectors *)
533 :     letPRIM("p1ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p1var], fn p1ToPt =>
534 :     letPRIM("p2ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p2var], fn p2ToPt =>
535 :     letPRIM("p1ToP2", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn p1ToP2 =>
536 :    
537 :     (* Get distances *)
538 :     letPRIM("p1ToPtLen", IR.T_FLOAT, IR.LEN, [p1ToPt], fn p1ToPtLen =>
539 :     letPRIM("p2ToPtLen", IR.T_FLOAT, IR.LEN, [p2ToPt], fn p2ToPtLen =>
540 :     letPRIM("p1ToP2Len", IR.T_FLOAT, IR.LEN, [p1ToP2], fn p1ToP2Len =>
541 :    
542 :     (* Add & subtract ... *)
543 :     letPRIM("distSum", IR.T_FLOAT, IR.ADD, [p1ToPtLen, p2ToPtLen], fn distSum =>
544 :     letPRIM("distDiff", IR.T_FLOAT, IR.SUB, [distSum, p1ToP2Len], fn distDiff =>
545 :     letPRIM("distDiffAbs", IR.T_FLOAT, IR.ABS, [distDiff], fn distDiffAbs =>
546 :    
547 :     (* Do the boolean stuff... *)
548 : pavelk 1147 letPRIM("intersect", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), distDiffAbs], fn intVar => k intVar env)
549 : pavelk 1108
550 :     )))
551 :     )))
552 :     )))
553 : pavelk 1132
554 :     | P.D_PLANE {pt, normal} =>
555 :     letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
556 :     letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
557 :     letPRIM("p2d", IR.T_FLOAT, IR.DOT, [p2var, psvToIRVar(env, normal)], fn p2d =>
558 :     letPRIM("p1dist", IR.T_FLOAT, IR.SUB, [d, p1d], fn p1dist =>
559 :     letPRIM("p2dist", IR.T_FLOAT, IR.SUB, [d, p2d], fn p2dist =>
560 :     letPRIM("distProd", IR.T_FLOAT, IR.MULT, [p1dist, p2dist], fn distProd =>
561 : pavelk 1147 letPRIM("intersect", IR.T_BOOL, IR.GT, [IR.newConst("zero", IR.C_FLOAT 0.0), distProd], fn intVar => k intVar env)
562 : pavelk 1132 ))))))
563 : pavelk 1108
564 : pavelk 1132 | P.D_DISC {pt, normal, orad, irad} => let
565 : pavelk 1134 val boolVar = IR.newParam("intersect", IR.T_BOOL)
566 : pavelk 1147 val newBlk = newBlockWithArgs(env, [boolVar], k boolVar)
567 : pavelk 1132 in
568 :     letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
569 :     letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
570 :    
571 :     (* Early out... does it intersect the plane?
572 :     *
573 :     * !SPEED! Due to the perceived slowness of branching on
574 :     * GPUs, this might not actually be faster on all runtime environments *)
575 :    
576 :     letPRIM("p2d", IR.T_FLOAT, IR.DOT, [p2var, psvToIRVar(env, normal)], fn p2d =>
577 :     letPRIM("p1dist", IR.T_FLOAT, IR.SUB, [d, p1d], fn p1dist =>
578 :     letPRIM("p2dist", IR.T_FLOAT, IR.SUB, [d, p2d], fn p2dist =>
579 :     letPRIM("distProd", IR.T_FLOAT, IR.MULT, [p1dist, p2dist], fn distProd =>
580 :     letPRIM("earlyOut", IR.T_BOOL, IR.GT, [distProd, IR.newConst("zero", IR.C_FLOAT 0.0)], fn earlyOut =>
581 :     IR.mkIF(earlyOut,
582 :     (* then *)
583 : pavelk 1147 letPRIM("intersect", IR.T_BOOL, IR.NOT, [earlyOut], fn var => gotoWithArgs(env, [var], newBlk)),
584 : pavelk 1132 (* else *)
585 :     letPRIM("v", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn v =>
586 :     letPRIM("vDotn", IR.T_FLOAT, IR.DOT, [v, psvToIRVar(env, normal)], fn vdn =>
587 :     letPRIM("t", IR.T_FLOAT, IR.DIV, [p1dist, vdn], fn t =>
588 :    
589 :     (* !TODO! Add some sort of assert mechanism to make sure that t is
590 :     * in the interval [0, 1]... *)
591 :     letPRIM("vscale", IR.T_VEC, IR.SCALE, [t, v], fn vscale =>
592 :     letPRIM("ppt", IR.T_VEC, IR.ADD_VEC, [p1var, vscale], fn ppt =>
593 :     letPRIM("lenVec", IR.T_VEC, IR.SUB_VEC, [ppt, psvToIRVar(env, pt)], fn cv =>
594 :     letPRIM("len", IR.T_FLOAT, IR.LEN, [cv], fn len =>
595 :    
596 :     (* Check to see whether or not it's within the radius... *)
597 :     letPRIM("gtirad", IR.T_BOOL, IR.GT, [len, psvToIRVar(env, irad)], fn gtirad =>
598 :     letPRIM("ltorad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), len], fn ltorad =>
599 : pavelk 1147 letPRIM("intersect", IR.T_BOOL, IR.AND, [gtirad, ltorad], fn var => gotoWithArgs(env, [var], newBlk))
600 : pavelk 1132 ))))))))))
601 :     )))))))
602 :     end (* P.D_DISC *)
603 :    
604 :     | _ => raise Fail ("Cannot calculate intersection bool for specified domain: " ^ (P.dToStr d))
605 : pavelk 1108 (* end case *))
606 :    
607 :     end (* mkIntBool *)
608 :    
609 : pavelk 1132 (* We assume that the segment already intersects with the domain. *)
610 : pavelk 1109 fun mkIntPt(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let
611 : pavelk 1108 val _ = ()
612 :     in
613 :     (case d
614 : pavelk 1109 of P.D_POINT(pt) => k (psvToIRVar (env, pt))
615 : pavelk 1132
616 :     | P.D_PLANE {pt, normal} =>
617 :     letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
618 :     letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
619 :     letPRIM("num", IR.T_FLOAT, IR.SUB, [d, p1d], fn num =>
620 :     letPRIM("v", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn v =>
621 :     letPRIM("den", IR.T_FLOAT, IR.DOT, [v, psvToIRVar(env, normal)], fn den =>
622 :     letPRIM("t", IR.T_FLOAT, IR.DIV, [num, den], fn t =>
623 :     letPRIM("vsc", IR.T_VEC, IR.SCALE, [t, v], fn vs =>
624 :     letPRIM("intPt", IR.T_VEC, IR.ADD_VEC, [p1var, vs], k)
625 :     )))))))
626 :    
627 :     (* Since we already know they intersect, the intersection point must be
628 :     * just the point that's on the plane... *)
629 :     | P.D_DISC {pt, normal, orad, irad} => mkIntPt(env, p1var, p2var, P.D_PLANE{pt = pt, normal = normal}, k)
630 :     | _ => raise Fail ("Cannot calculate intersection point for specified domain: " ^ (P.dToStr d))
631 : pavelk 1108 (* end case *))
632 :     end (* mkIntPt *)
633 :    
634 : pavelk 746 (* Find the normal at the given position of the particle for the specified
635 :     * domain. Note, that the particle doesn't necessarily need to be on the
636 : pavelk 1132 * domain, but if it's not then the behavior is undefined. *)
637 : pavelk 1147 fun normAtPoint(retNorm, d, env, pos, k : IR.var -> ir_env -> IR.stmt) = let
638 : pavelk 746 val newNorm = IR.newParam("n", IR.T_VEC)
639 : pavelk 1147 val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))
640 : pavelk 746 in
641 :     (case d
642 : pavelk 1160 of P.D_POINT(pt) =>
643 :     letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn subVec =>
644 :     letPRIM(retNorm, IR.T_VEC, IR.NORM, [subVec], fn newNormVar => k newNormVar env
645 :     ))
646 :    
647 :     | P.D_PLANE{pt, normal} =>
648 : pavelk 1147 letPRIM("inVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn inVec =>
649 : pavelk 1146 letPRIM("dotNorm", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, normal), inVec], fn dotNorm =>
650 : pavelk 1151 letPRIM("absDot", IR.T_FLOAT, IR.ABS, [dotNorm], fn absDot =>
651 :     letPRIM("avoidZero", IR.T_FLOAT, IR.MAX, [psvToIRVar(env, epsilon), absDot], fn dot =>
652 :     letPRIM("dnRecip", IR.T_FLOAT, IR.DIV, [IR.newConst("One", IR.C_FLOAT 1.0), dot], fn dnRecip =>
653 :     letPRIM("sign", IR.T_FLOAT, IR.MULT, [dnRecip, dotNorm], fn sign =>
654 : pavelk 1158 (* sign here can still be zero... *)
655 :     letPRIM("signOffset", IR.T_FLOAT, IR.ADD, [sign, IR.newConst("half", IR.C_FLOAT 0.5)], fn signOffset =>
656 :     letPRIM("soRecip", IR.T_FLOAT, IR.DIV, [IR.newConst("One", IR.C_FLOAT 1.0), signOffset], fn soRecip =>
657 :     letPRIM("absSign", IR.T_FLOAT, IR.ABS, [soRecip], fn absSign =>
658 :     letPRIM("signFinal", IR.T_FLOAT, IR.MULT, [absSign, signOffset], fn signFinal =>
659 :    
660 :     letPRIM("notNorm", IR.T_VEC, IR.SCALE, [signFinal, psvToIRVar(env, normal)], fn notNorm =>
661 : pavelk 1155 letPRIM(retNorm, IR.T_VEC, IR.NORM, [notNorm],
662 : pavelk 1151 fn newNormVar => gotoWithArgs(env, [newNormVar], nextBlk)))))
663 : pavelk 1158 ))))))))
664 : pavelk 1146
665 : pavelk 746 | P.D_DISC{pt, normal, irad, orad} =>
666 : pavelk 1147 normAtPoint(retNorm, P.D_PLANE{pt=pt, normal=normal}, env, pos, k)
667 : pavelk 746
668 : pavelk 1109 | P.D_SPHERE{center, irad, orad} =>
669 : pavelk 746 letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, center)], fn subVec =>
670 : pavelk 1160 letPRIM("svLen", IR.T_FLOAT, IR.LEN, [subVec], fn svLen =>
671 :     letPRIM("inIrad", IR.T_BOOL, IR.GT, [svLen, psvToIRVar(env, irad)], fn inIrad =>
672 :     IR.mkIF(inIrad,
673 :     (* then *)
674 :     letPRIM("norm", IR.T_VEC, IR.NORM, [subVec], fn normVar =>
675 :     letPRIM(retNorm, IR.T_VEC, IR.NEG_VEC, [normVar], fn newNormVar =>
676 :     gotoWithArgs(env, [newNormVar], nextBlk)
677 :     )),
678 :     (* else *)
679 :     letPRIM(retNorm, IR.T_VEC, IR.NORM, [subVec], fn newNormVar =>
680 :     gotoWithArgs(env, [newNormVar], nextBlk)
681 :     )))))
682 : pavelk 746
683 : pavelk 1132 | _ => raise Fail("Cannot find normal to point of specified domain." ^ (P.dToStr d))
684 : pavelk 746 (* end case *))
685 :     end
686 : pavelk 769
687 : pavelk 1147 fun trExpr(expr, env, k : IR.var -> ir_env -> IR.stmt) = (case expr
688 :     of P.CONSTF f => k (IR.newConst ("c", IR.C_FLOAT f)) env
689 : pavelk 1108
690 : pavelk 1147 | P.CONST3F v => k (IR.newConst ("c", IR.C_VEC v)) env
691 : pavelk 1108
692 : pavelk 1147 | P.VAR v => k (psvToIRVar (env, v)) env
693 : pavelk 1108
694 : pavelk 1147 | P.STATE_VAR sv => k (pssvToIRVar (env, sv)) env
695 : pavelk 1108
696 : pavelk 1147 | P.GENERATE3F (dom, dist) => genVecVar("genVec", env, dom, dist, fn var => k var env)
697 : pavelk 1108
698 : pavelk 1147 | P.GENERATEF (dom, dist) => genFloatVar("genFlt", env, dom, dist, fn var => k var env)
699 : pavelk 1108
700 : pavelk 1109 | P.ADD(e1, e2) =>
701 : pavelk 1147 trExpr(e1, env, fn e1var => fn env' =>
702 :     trExpr(e2, env', fn e2var => fn env'' =>
703 : pavelk 1108 let
704 : pavelk 1109 val IR.V{varType=vt1, ...} = e1var
705 :     val IR.V{varType=vt2, ...} = e2var
706 : pavelk 1108 in
707 :     (case (vt1, vt2)
708 : pavelk 1147 of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("addVar", IR.T_FLOAT, IR.ADD, [e1var, e2var], fn var => k var env'')
709 :     | (IR.T_VEC, IR.T_VEC) => letPRIM("addVar", IR.T_VEC, IR.ADD_VEC, [e1var, e2var], fn var => k var env'')
710 : pavelk 1108 | _ => raise Fail ("Type mismatch to ADD expression")
711 :     (* end case *))
712 :     end))
713 :    
714 : pavelk 1109 | P.SCALE (e1, e2) =>
715 : pavelk 1147 trExpr(e1, env, fn e1var => fn env' =>
716 :     trExpr(e2, env', fn e2var => fn env'' =>
717 : pavelk 1108 let
718 : pavelk 1109 val IR.V{varType=vt1, ...} = e1var
719 :     val IR.V{varType=vt2, ...} = e2var
720 : pavelk 1108 in
721 :     (case (vt1, vt2)
722 : pavelk 1147 of (IR.T_FLOAT, IR.T_VEC) => letPRIM("scaleVar", IR.T_VEC, IR.SCALE, [e1var, e2var], fn var => k var env'')
723 :     | (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("scaleVar", IR.T_FLOAT, IR.MULT, [e1var, e2var], fn var => k var env'')
724 : pavelk 1130 | _ => raise Fail (String.concat["Type mismatch to SCALE expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
725 : pavelk 1108 (* end case *))
726 :     end))
727 :    
728 : pavelk 1109 | P.DIV (e1, e2) =>
729 : pavelk 1147 trExpr(e1, env, fn e1var => fn env' =>
730 :     trExpr(e2, env', fn e2var => fn env'' =>
731 : pavelk 1108 let
732 : pavelk 1109 val IR.V{varType=vt1, ...} = e1var
733 :     val IR.V{varType=vt2, ...} = e2var
734 : pavelk 1108 in
735 :     (case (vt1, vt2)
736 : pavelk 1147 of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("divVar", IR.T_FLOAT, IR.DIV, [e1var, e2var], fn var => k var env'')
737 : pavelk 1133 | _ => raise Fail (String.concat["Type mismatch to DIV expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
738 : pavelk 1108 (* end case *))
739 :     end))
740 : pavelk 866
741 : pavelk 1109 | P.NEG e =>
742 : pavelk 1147 trExpr(e, env, fn evar => fn env' =>
743 : pavelk 1108 let
744 : pavelk 1109 val IR.V{varType, ...} = evar
745 : pavelk 1108 in
746 :     (case varType
747 : pavelk 1147 of IR.T_FLOAT => letPRIM("negVar", IR.T_FLOAT, IR.MULT, [evar, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn var => k var env')
748 :     | IR.T_VEC => letPRIM("negVar", IR.T_VEC, IR.NEG_VEC, [evar], fn var => k var env')
749 : pavelk 1108 | _ => raise Fail ("Type mismatch to NEG expression")
750 :     (* end case *))
751 :     end)
752 :    
753 : pavelk 1109 | P.DOT (e1, e2) =>
754 : pavelk 1147 trExpr(e1, env, fn e1var => fn env' =>
755 :     trExpr(e2, env', fn e2var => fn env'' =>
756 : pavelk 1108 let
757 : pavelk 1109 val IR.V{varType=vt1, ...} = e1var
758 :     val IR.V{varType=vt2, ...} = e2var
759 : pavelk 1108 in
760 :     (case (vt1, vt2)
761 : pavelk 1147 of (IR.T_VEC, IR.T_VEC) => letPRIM("dotVar", IR.T_FLOAT, IR.DOT, [e1var, e2var], fn var => k var env'')
762 : pavelk 1108 | _ => raise Fail ("Type mismatch to DOT expression")
763 :     (* end case *))
764 :     end))
765 :    
766 : pavelk 1109 | P.CROSS (e1, e2) =>
767 : pavelk 1147 trExpr(e1, env, fn e1var => fn env' =>
768 :     trExpr(e2, env', fn e2var => fn env'' =>
769 : pavelk 1108 let
770 : pavelk 1109 val IR.V{varType=vt1, ...} = e1var
771 :     val IR.V{varType=vt2, ...} = e2var
772 : pavelk 1108 in
773 :     (case (vt1, vt2)
774 : pavelk 1147 of (IR.T_VEC, IR.T_VEC) => letPRIM("crossVar", IR.T_VEC, IR.CROSS, [e1var, e2var], fn var => k var env'')
775 : pavelk 1108 | _ => raise Fail ("Type mismatch to CROSS expression")
776 :     (* end case *))
777 :     end))
778 :    
779 : pavelk 1109 | P.NORMALIZE e =>
780 : pavelk 1147 trExpr(e, env, fn evar => fn env' =>
781 : pavelk 1108 let
782 : pavelk 1109 val IR.V{varType, ...} = evar
783 : pavelk 1108 in
784 :     (case varType
785 : pavelk 1147 of IR.T_VEC => letPRIM("normVar", IR.T_VEC, IR.NORM, [evar], fn var => k var env')
786 : pavelk 1108 | _ => raise Fail ("Type mismatch to NORMALIZE expression")
787 :     (* end case *))
788 :     end)
789 :    
790 : pavelk 1109 | P.LENGTH e =>
791 : pavelk 1147 trExpr(e, env, fn evar => fn env' =>
792 : pavelk 1108 let
793 : pavelk 1109 val IR.V{varType, ...} = evar
794 : pavelk 1108 in
795 :     (case varType
796 : pavelk 1147 of IR.T_VEC => letPRIM("lenVar", IR.T_FLOAT, IR.LEN, [evar], fn var => k var env')
797 : pavelk 1108 | _ => raise Fail ("Type mismatch to LENGTH expression")
798 :     (* end case *))
799 :     end)
800 :    
801 :     (* !SPEED! We're assuming that there is an intersection here... *)
802 : pavelk 1109 | P.INTERSECT {p1, p2, d} =>
803 : pavelk 1147 trExpr(p1, env, fn p1var => fn env' =>
804 :     trExpr(p2, env', fn p2var => fn env'' =>
805 : pavelk 1108 let
806 : pavelk 1109 val IR.V{varType=vt1, ...} = p1var
807 :     val IR.V{varType=vt2, ...} = p2var
808 : pavelk 1108 in
809 :     (case (vt1, vt2)
810 : pavelk 1147 of (IR.T_VEC, IR.T_VEC) => mkIntPt(env, p1var, p2var, d, fn var => k var env'')
811 : pavelk 1108 | _ => raise Fail("Type mismatch to INTERSECT expression")
812 :     (* end case *))
813 :     end))
814 :    
815 : pavelk 1109 | P.NORMALTO (e, d) =>
816 : pavelk 1147 trExpr(e, env, fn evar => fn env' =>
817 : pavelk 1108 let
818 : pavelk 1109 val IR.V{varType, ...} = evar
819 : pavelk 1108 fun cont s = k s
820 :     in
821 :     (case varType
822 : pavelk 1147 of IR.T_VEC => normAtPoint("normVar", d, env', evar, k)
823 : pavelk 1108 | _ => raise Fail("Type mismatch to NORMALTO expression")
824 :     (* end case *))
825 :     end)
826 :    
827 :     (* end case expr *))
828 : pavelk 1109
829 : pavelk 1147 (* generate code to produce a random particle state from a domain *)
830 :     fun newParticle (sv_gens, env, k : ir_env -> IR.stmt) = let
831 : pavelk 1109
832 :     fun createVar(P.GEN{var, ...}) = let
833 :     val P.PSV.SV{name, ty, ...} = var
834 :     in
835 :     IR.newLocal("ps_" ^ name, IR.psvTyToIRTy ty, (IR.RAND, []))
836 :     end
837 :    
838 :     val newState = List.map createVar sv_gens
839 :    
840 :     fun genVar((sv_gen, var), cont) = let
841 : pavelk 1147 val P.GEN{exp, var=svar} = sv_gen
842 : pavelk 1109 val IR.V{varType, ...} = var
843 :     in
844 : pavelk 1147 fn env' => trExpr(exp, env', fn newVal => fn env'' => cont (insertSVar(env'', svar, newVal)))
845 : pavelk 1109 end (* genVar *)
846 :    
847 :     in
848 : pavelk 1147 (List.foldr (fn (x, y) => genVar(x, y)) k (ListPair.zipEq (sv_gens, newState))) env
849 : pavelk 1109 end (* new particle *)
850 : pavelk 1108
851 : pavelk 1147 fun trEmitter(emit, env, k) = let
852 : pavelk 1108 val P.EMIT{freq, sv_gens} = emit
853 : pavelk 1147 val ttl = pssvToIRVar(env, P.sv_ttl)
854 : pavelk 1108 in
855 :     letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>
856 : pavelk 770 IR.mkIF(isDead,
857 :     (* then *)
858 : pavelk 1147 trExpr(freq, env, fn t1 => fn env' =>
859 :     letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env', PSV.numDead)], fn t2 =>
860 : pavelk 770 letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
861 :     letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
862 :     letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
863 :     IR.mkIF(t3,
864 :     (* then *)
865 : pavelk 1147 newParticle (sv_gens, env', fn env'' => k env''),
866 : pavelk 770 (* else *)
867 :     IR.DISCARD)))))),
868 :     (* else *)
869 : pavelk 1147 k env))
870 : pavelk 770 end
871 : pavelk 1120
872 :     (* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)
873 :     (* mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) *)
874 : pavelk 1147 fun trPred(cond, env, thenk : ir_env -> IR.stmt, elsek : ir_env -> IR.stmt) = let
875 :     fun grabVar(cond, env, k : IR.var -> ir_env -> IR.stmt) = (case cond
876 : pavelk 1120 of P.WITHINF(d, expr) =>
877 : pavelk 1147 trExpr(expr, env, fn checkMe => fn env' =>
878 :     mkFloatWithinVar("wv", env', checkMe, d, fn var => k var env'))
879 : pavelk 1120
880 :     | P.WITHIN3F(d, expr) =>
881 : pavelk 1147 trExpr(expr, env, fn checkMe => fn env' =>
882 :     mkVecWithinVar("wv", env', checkMe, d, fn var => k var env'))
883 : pavelk 1120
884 :     | P.DO_INTERSECT {p1, p2, d} =>
885 : pavelk 1147 trExpr(p1, env, fn p1var => fn env' =>
886 :     trExpr(p2, env', fn p2var => fn env'' =>
887 :     mkIntBool(env'', p1var, p2var, d, k)))
888 : pavelk 1120
889 :     | P.GTHAN (e1, e2) =>
890 : pavelk 1147 trExpr(e1, env, fn e1var => fn env' =>
891 :     trExpr(e2, env, fn e2var => fn env'' =>
892 :     letPRIM("gtVar", IR.T_BOOL, IR.GT, [e1var, e2var], fn var => k var env'')))
893 : pavelk 1129
894 : pavelk 1120 | P.AND(c1, c2) =>
895 : pavelk 1147 grabVar(c1, env, fn c1Var => fn env' =>
896 :     grabVar(c2, env', fn c2Var => fn env'' =>
897 :     letPRIM("andVar", IR.T_BOOL, IR.AND, [c1Var, c2Var], fn var => k var env'')))
898 : pavelk 1120
899 :     | P.OR(c1, c2) =>
900 : pavelk 1147 grabVar(c1, env, fn c1Var => fn env' =>
901 :     grabVar(c2, env, fn c2Var => fn env'' =>
902 :     letPRIM("andVar", IR.T_BOOL, IR.OR, [c1Var, c2Var], fn var => k var env'')))
903 : pavelk 1120
904 :     | P.XOR(c1, c2) =>
905 : pavelk 1147 grabVar(c1, env, fn c1Var => fn env' =>
906 :     grabVar(c2, env', fn c2Var => fn env'' =>
907 :     mkXOR ("xorVar", c1Var, c2Var, fn var => k var env'')))
908 : pavelk 1120
909 :     | P.NOT(c) =>
910 : pavelk 1147 grabVar(c, env, fn cvar => fn env' =>
911 :     letPRIM("notVar", IR.T_BOOL, IR.NOT, [cvar], fn var => k var env'))
912 : pavelk 1120
913 :     (* end case *))
914 :     in
915 : pavelk 1147 grabVar(cond, env, fn result => fn env' =>
916 :     IR.mkIF(result, thenk(env'), elsek(env')))
917 : pavelk 1120 end
918 :    
919 : pavelk 868 fun compile (P.PG{
920 : pavelk 1107 emit as P.EMIT{freq, sv_gens}, act, render,
921 :     vars, state_vars, render_vars
922 : pavelk 868 }) = let
923 : pavelk 1107 val blks = ref[]
924 : pavelk 1122
925 : pavelk 1134 fun printVar (PSV.V{name, id, ...}) =
926 :     printErr (String.concat[name, ": ", Int.toString id])
927 : pavelk 1150
928 : pavelk 1147 val v_env = let
929 : pavelk 746 (* add special globals to free vars *)
930 : pavelk 1107 val pgm_vars = PSV.Set.union(PSV.Set.singleton epsilon, vars)
931 :     fun insv (x as PSV.V{name, ty, binding, id, ...}, map) = let
932 : pavelk 1147 val x' = (case (ty, !binding)
933 :     of (PSV.T_BOOL, PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
934 :     | (PSV.T_BOOL, PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))
935 :     | (PSV.T_INT, PSV.UNDEF) => IR.newGlobal(x, IR.T_INT)
936 :     | (PSV.T_INT, PSV.INT intVal) => IR.newConst(name, IR.C_INT(intVal))
937 :     | (PSV.T_FLOAT, PSV.UNDEF) => IR.newGlobal(x, IR.T_FLOAT)
938 :     | (PSV.T_FLOAT, PSV.FLOAT floatVal) => IR.newConst(name, IR.C_FLOAT(floatVal))
939 :     | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
940 :     | (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))
941 :     | _ => raise Fail("Error in setup, type mismatch between PSV vars and their binding.")
942 :     (* end case *))
943 :     in
944 :     PSV.Map.insert (map, x, x')
945 :     end (* ins *)
946 :    
947 :     in
948 :     PSV.Set.foldl insv PSV.Map.empty pgm_vars
949 :     end (* env *)
950 : pavelk 1107
951 : pavelk 1147 fun evalActs theAct env f = (case theAct
952 : pavelk 867 of P.SEQ(acts) => (case acts
953 : pavelk 1147 of [] => f env
954 :     | oneAct :: rest => evalActs oneAct env (fn env' => (evalActs (P.SEQ(rest)) env' f))
955 : pavelk 1120 (* end case *))
956 :    
957 : pavelk 1137 | P.PRED(cond, thenAct, elseAct) => let
958 : pavelk 1147 val joinBlk = newBlock (env, fn env' => f env')
959 :     fun joinActs env = goto(env, joinBlk)
960 : pavelk 1137 in
961 : pavelk 1147 trPred(cond, env,
962 :     fn env' => evalActs thenAct env' joinActs,
963 :     fn env' => evalActs elseAct env' joinActs
964 : pavelk 1137 )
965 :     end
966 : pavelk 1120
967 :     | P.DIE => IR.DISCARD
968 :    
969 :     | P.ASSIGN(sv, expr) => let
970 : pavelk 1150 val PSV.SV{name, ty, ...} = sv
971 : pavelk 1120 in
972 : pavelk 1147 trExpr(expr, env, fn newVar => fn env' =>
973 : pavelk 1150 letPRIM("ps_" ^ name, IR.psvTyToIRTy ty, IR.COPY, [newVar],
974 : pavelk 1147 fn thisVar => f (insertSVar(env', sv, thisVar))))
975 : pavelk 1120 end
976 : pavelk 1137
977 : pavelk 1120 (* end case *))
978 : pavelk 1147
979 :     val sv_env = let
980 :     (* add special globals to free vars *)
981 :     fun insv (x as PSV.SV{name, ty, ...}, map) = let
982 :     val x' = IR.newParam("ps_" ^ name, IR.psvTyToIRTy ty)
983 :     in
984 : pavelk 1150 IR.setRenderVar(x', PSV.SVMap.inDomain(render_vars, x));
985 : pavelk 1147 PSV.SVMap.insert (map, x, x')
986 :     end (* ins *)
987 :    
988 :     in
989 :     PSV.SVSet.foldl insv PSV.SVMap.empty state_vars
990 :     end (* env *)
991 : pavelk 1150
992 : pavelk 1147 val env = TE(blks, v_env, sv_env)
993 :    
994 : pavelk 868 (* The entry block is the first block of the program, or in other words, the emitter. *)
995 : pavelk 1147 val emitterBlock = newBlock (env, fn env => trEmitter(emit, env, retState))
996 :     val physicsBlock = newBlock (env, fn env => evalActs act env retState)
997 : pavelk 868
998 : pavelk 972 (* The entry block is the emitter, and the rest of the blocks define the physics processing. *)
999 :    
1000 :     fun isGlobal(IR.V{scope, ...}) = (case scope
1001 :     of IR.S_GLOBAL(v) => true
1002 :     | _ => false
1003 :     (* end case *))
1004 :    
1005 : pavelk 866 val outPgm = PSysIR.PGM {
1006 : pavelk 1147 globals = PSV.Map.filter isGlobal v_env,
1007 :     emitter = emitterBlock,
1008 :     physics = physicsBlock,
1009 : pavelk 866 render = render
1010 :     }
1011 : pavelk 868
1012 : pavelk 1143 val optimized = if (Checker.checkIR(outPgm)) then (printErr "\nPre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
1013 : pavelk 746 in
1014 : pavelk 1107 (* Note: it only succeeds if we can optimize, too *)
1015 :     if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();
1016 :    
1017 :     optimized
1018 : pavelk 746 end (* compile *)
1019 :    
1020 :     end (* Translate *)

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