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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 770, Mon Feb 22 00:17:15 2010 UTC revision 1122, Tue Apr 19 23:01:52 2011 UTC
# Line 1  Line 1 
1  (* translate.sml  (* translate.sml
2   *  
3   * COPYRIGHT (c) 2009 John Reppy (http://cs.uchicago.edu/~jhr)   * COPYRIGHT (c) 2009 John Reppy (http://cs.uchicago.edu/~jhr)
4   * All rights reserved.   * All rights reserved.
5   *   *
# Line 8  Line 8 
8    
9  structure Translate : sig  structure Translate : sig
10    
11      val compile : Particles.particle_group -> PSysIR.block list      val compile : Particles.program -> PSysIR.program
12    
13    end = struct    end = struct
14    
# Line 20  Line 20 
20    
21      fun printErr s = TextIO.output(TextIO.stdErr, s ^ "\n")      fun printErr s = TextIO.output(TextIO.stdErr, s ^ "\n")
22    
23    (*
24      datatype particle_state = PS of {      datatype particle_state = PS of {
25          pos : IR.var,           (* vec3 *)          pos : IR.var,           (* vec3 *)
26          vel : IR.var,           (* vec3 *)          vel : IR.var,           (* vec3 *)
27          size : IR.var,          (* float *)          size : IR.var,          (* float *)
28          isDead : IR.var,        (* bool *)        ttl : IR.var,             (* float *)
29          color : IR.var          (* vec3 (NOTE: should be vector4) *)        color : IR.var,   (* vec3 (NOTE: should be vector4) *)
30          user : IR.var list
31        }        }
32    *)
33        type particle_state = IR.var list
34    
35    (* special PSV global variables *)    (* special PSV global variables *)
     val timeStep = PSV.new("g_timeStep", PSV.T_FLOAT)   (* physics timestep *)  
     val numDead = PSV.new("g_numDead", PSV.T_INT)       (* # of dead particles *)  
36      val epsilon = PSV.constf(0.00001)      val epsilon = PSV.constf(0.00001)
37    
38    (* constants *)    (* constants *)
39      val pi = 3.14159265358979      val pi = 3.14159265358979
40    
41    (* dummy placeholder *)      fun retState s = IR.mkRETURN s
     fun dummy (state, k) =  
           IR.mkPRIM(  
             IR.newLocal(  
               "temp",  
               IR.T_BOOL,  
               (IR.COPY, [IR.newConst("c", IR.C_BOOL false)])  
             ),  
             IR.COPY,  
             [IR.newConst("c", IR.C_BOOL false)],  
             k state  
           )  
42    
43    (* translation environment *)    (* translation environment *)
44      datatype env = TE of (IR.block list ref * IR.var PSV.Map.map)      datatype env = TE of (IR.block list ref * IR.var PSV.Map.map)
45        fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))
46    
47      (* Interaction with environment and state variables *)
48      fun psvToIRVar (TE(_, env), x as PSV.V{name, id, ...}) = (case PSV.Map.find(env, x)      fun psvToIRVar (TE(_, env), x as PSV.V{name, id, ...}) = (case PSV.Map.find(env, x)
49             of SOME x' => x'             of SOME x' => x'
50              | NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])              | NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])
51            (* end case *))            (* end case *))
52    
53      fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))          fun findIRVarByName (state, name) = let
54              fun eq (var as IR.V{name=st_name, ...}) = st_name = ("ps_" ^ name)
   (* create a block that implements the given continuation *)  
     fun newBlock (TE(blks, _), k : particle_state -> IR.stmt) = let  
           val pos = IR.newParam ("ps_pos", IR.T_VEC)  
           val vel = IR.newParam ("ps_vel", IR.T_VEC)  
           val size = IR.newParam ("ps_size", IR.T_FLOAT)  
           val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)  
           val color = IR.newParam ("ps_color", IR.T_VEC)  
           val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color}  
           val blk = IR.newBlock ([pos, vel, size, isDead, color], k state)  
55            in            in
56              blks := blk :: !blks;            (case (List.find eq state)
57              blk              of SOME sv => sv
58                 | NONE => raise Fail ("Could not find var mapping.")
59              (* end case *))
60            end            end
61    
62          fun newBlockWithArgs (TE(blks, _), args, k : particle_state -> IR.stmt) = let          fun getIRVarForSV (v as PSV.SV{name, ...}, state) = findIRVarByName(state, name)
63            val pos = IR.newParam ("ps_pos", IR.T_VEC)  
64            val vel = IR.newParam ("ps_vel", IR.T_VEC)     (* create a block that implements the given continuation *)
65            val size = IR.newParam ("ps_size", IR.T_FLOAT)      fun newBlockWithArgs (TE(blks, _), state , args, k : particle_state -> IR.stmt) = let
66            val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)         fun copyVar(v as IR.V{name, varType, ...}) = IR.newParam(name, varType)
67            val color = IR.newParam ("ps_color", IR.T_VEC)         val newState = List.map copyVar state
68            val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color}             val blk = IR.newBlock (newState @ args, k newState)
           val blk = IR.newBlock ([pos, vel, size, isDead, color] @ args, k state)  
69            in            in
70              blks := blk :: !blks;              blks := blk :: !blks;
71              blk              blk
72            end            end
73    
74      fun goto (PS{pos, vel, size, isDead, color}, blk) =          fun newBlock (env, state, k) = newBlockWithArgs(env, state, [], k)
           IR.mkGOTO(blk, [pos, vel, size, isDead, color])  
75    
76          fun gotoWithArgs(PS{pos, vel, size, isDead, color}, args, blk) =      fun gotoWithArgs(state, args, blk) = IR.mkGOTO(blk, state @ args)
77            IR.mkGOTO(blk, [pos, vel, size, isDead, color] @ args)      fun goto (state, blk) = gotoWithArgs(state, [], blk)
78    
79      fun letPRIM (x, ty, p, args, body) = let      fun letPRIM (x, ty, p, args, body) = let
80            val x' = IR.newLocal(x, ty, (p, args))            val x' = IR.newLocal(x, ty, (p, args))
# Line 98  Line 82 
82              IR.mkPRIM(x', p, args, body x')              IR.mkPRIM(x', p, args, body x')
83            end            end
84    
   (* prim bound to state variable (S_LOCAL for now) *)  
     fun letSPRIM(x, ty, p, args, body) = let  
           val x' = IR.new(x, IR.S_LOCAL(p, args), ty)  
           in  
             IR.mkPRIM(x', p, args, body x')  
           end  
   
85    (* Not sure if this should be made into a primitive or not, but    (* Not sure if this should be made into a primitive or not, but
86     * basically this creates the XOR'd value of var1 and var2 and     * basically this creates the XOR'd value of var1 and var2 and
87     * stores it in result.     * stores it in result.
# Line 115  Line 92 
92            letPRIM("testNAND", IR.T_BOOL, IR.NOT, [testAND], fn testNAND =>            letPRIM("testNAND", IR.T_BOOL, IR.NOT, [testAND], fn testNAND =>
93            letPRIM(result, IR.T_BOOL, IR.AND, [testOR, testNAND], stmt))))            letPRIM(result, IR.T_BOOL, IR.AND, [testOR, testNAND], stmt))))
94    
95        fun genFloatVar (fltVar, env, domain : Float.float P.domain, dist, stmt : IR.var -> IR.stmt) = let
96          fun genRandVal(var, stmt : IR.var -> IR.stmt) = (case dist
97            of P.DIST_UNIFORM =>
98              letPRIM(var, IR.T_FLOAT, IR.RAND, [], stmt)
99    
100             (* The PDF here is f(x) = 2x when 0 < x <= 1, so the CDF is going
101              * to be the integral of f from 0 -> y => y^2. Hence, whenever we
102              * generate a random number, in order to get the random value according
103              * to this probability distribution, we just square it.
104              *)
105             | P.DIST_INC_LIN =>
106              letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
107              letPRIM(var, IR.T_FLOAT, IR.MULT, [randVal, randVal], stmt))
108    
109             (* The PDF here is f(x) = -2x + 2 when 0 <= x < 1, so the CDF is going
110              * to be the integral of f from 0 -> y => -(y^2) + 2y. Hence, whenever we
111              * generate a random number, in order to get the random value according
112              * to this probability distribution, we just square it.
113              *)
114             | P.DIST_DEC_LIN =>
115              letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
116              letPRIM("randSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randSq =>
117              letPRIM("termOne", IR.T_FLOAT, IR.MULT, [randSq, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn termOne =>
118              letPRIM("termTwo", IR.T_FLOAT, IR.MULT, [randVal, IR.newConst("negOne", IR.C_FLOAT 2.0)], fn termTwo =>
119              letPRIM(var, IR.T_FLOAT, IR.ADD, [termOne, termTwo], stmt)
120              ))))
121    
122             | _ => raise Fail "Unable to create random float for specified distribution."
123           (* end case *))
124         in
125         (case domain
126          of P.D_POINT(pt) =>
127             (* Our options here are pretty limited... *)
128             letPRIM (fltVar, IR.T_FLOAT, IR.COPY, [psvToIRVar(env, pt)], stmt)
129    
130           | P.D_BOX{max, min} =>
131             genRandVal("randf", fn rand =>
132             letPRIM("boxDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, max), psvToIRVar(env, max)], fn diff =>
133             letPRIM("scale", IR.T_FLOAT, IR.MULT, [diff, rand], fn scale =>
134             letPRIM( fltVar, IR.T_FLOAT, IR.ADD, [psvToIRVar(env, max), scale], stmt )
135             )))
136           | _ => raise Fail "Cannot generate float in specified domain."
137         (* end case *))
138        end
139    
140    (* Generates a random vector within the given domain and puts it in vecVar *)    (* Generates a random vector within the given domain and puts it in vecVar *)
141      fun genVecVar (vecVar, env, domain, stmt : IR.var -> IR.stmt) = (case domain      fun genVecVar (
142          vecVar,
143          env,
144          domain : Vec3f.vec3 P.domain,
145          dist : Vec3f.vec3 P.distribution,
146          stmt : IR.var -> IR.stmt
147        ) = (case domain
148             of P.D_POINT(pt) =>             of P.D_POINT(pt) =>
149               (* Our options here are pretty limited... *)               (* Our options here are pretty limited... *)
150                  letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)                  letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)
# Line 129  Line 157 
157                  letPRIM ("pt2s", IR.T_VEC, IR.SCALE, [randInv, psvToIRVar(env, pt2)], fn pt2ScaleVec =>                  letPRIM ("pt2s", IR.T_VEC, IR.SCALE, [randInv, psvToIRVar(env, pt2)], fn pt2ScaleVec =>
158                  letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))                  letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))
159    
160            (* This is a bit more complicated if we're trying to avoid accessing              | P.D_BOX{max, min} =>
161             * the vector variables themselves. Basically the way we can do it is to                  (* Extract the componentwise vector variables *)
162             * decompose the vector connecting min and max into the basis vectors,                  letPRIM("minX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, min)], fn minX =>
163             * scale them independently, and then add them back together.                  letPRIM("maxX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, max)], fn maxX =>
164             *                  letPRIM("minY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, min)], fn minY =>
165             * !FIXME! Actually do that. Don't have time right now...                  letPRIM("maxY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, max)], fn maxY =>
166                    letPRIM("minZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, min)], fn minZ =>
167                    letPRIM("maxZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, max)], fn maxZ =>
168    
169                    (* Find the distance in each component *)
170                    letPRIM("distX", IR.T_FLOAT, IR.SUB, [maxX, minX], fn distX =>
171                    letPRIM("distY", IR.T_FLOAT, IR.SUB, [maxY, minY], fn distY =>
172                    letPRIM("distZ", IR.T_FLOAT, IR.SUB, [maxZ, minZ], fn distZ =>
173    
174                    (* Get three random numbers for each of the components *)
175                    letPRIM("randX", IR.T_FLOAT, IR.RAND, [], fn randX =>
176                    letPRIM("randY", IR.T_FLOAT, IR.RAND, [], fn randY =>
177                    letPRIM("randZ", IR.T_FLOAT, IR.RAND, [], fn randZ =>
178    
179                    (* Scale the distances by these random numbers *)
180                    letPRIM("scaledX", IR.T_FLOAT, IR.MULT, [randX, distX], fn scaledX =>
181                    letPRIM("scaledY", IR.T_FLOAT, IR.MULT, [randY, distY], fn scaledY =>
182                    letPRIM("scaledZ", IR.T_FLOAT, IR.MULT, [randZ, distZ], fn scaledZ =>
183    
184                    (* Add them to the minimum vec in order to create a new vec inside
185                     * of the box.
186             *)             *)
187              | P.D_BOX{max, min} => raise Fail "Cannot generate point in D_BOX."                  letPRIM("newX", IR.T_FLOAT, IR.ADD, [minX, scaledX], fn newX =>
188                    letPRIM("newY", IR.T_FLOAT, IR.ADD, [minY, scaledY], fn newY =>
189                    letPRIM("newZ", IR.T_FLOAT, IR.ADD, [minZ, scaledZ], fn newZ =>
190    
191                    (* Gen the vector *)
192                    letPRIM(vecVar, IR.T_VEC, IR.GEN_VEC, [newX, newY, newZ], stmt
193    
194                    )))))))))))))))))))
195    
196    
197              | P.D_TRIANGLE{pt1, pt2, pt3} =>              | P.D_TRIANGLE{pt1, pt2, pt3} =>
198                  letPRIM ("pt1ToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn pt1ToPt2 =>                  letPRIM ("pt1ToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn pt1ToPt2 =>
# Line 159  Line 215 
215                    letPRIM("htInv", IR.T_FLOAT, IR.DIV, [IR.newConst("one", IR.C_FLOAT 1.0), height], fn htInv =>                    letPRIM("htInv", IR.T_FLOAT, IR.DIV, [IR.newConst("one", IR.C_FLOAT 1.0), height], fn htInv =>
216                    letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>                    letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>
217                    (* Generate a point in the lower disc. *)                    (* Generate a point in the lower disc. *)
218                      genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>                      genVecVar("ptInDisc",
219                          insert(env, normVar, norm),
220                          P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
221                          dist,
222                          fn ptInDisc =>
223                    (* Now add this point to a random scaling of the normVec. *)                    (* Now add this point to a random scaling of the normVec. *)
224                      letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>                      letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>
225                      letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>                      letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>
# Line 200  Line 260 
260                    letPRIM("eh",  IR.T_FLOAT, IR.RAND, [], fn ourRand =>                    letPRIM("eh",  IR.T_FLOAT, IR.RAND, [], fn ourRand =>
261                    letPRIM("nv", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>                    letPRIM("nv", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
262                    letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>                    letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>
263                      genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>                      genVecVar("ptInDisc",
264                          insert(env, normVar, norm),
265                          P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
266                          dist,
267                          fn ptInDisc =>
268                      letPRIM("gptt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), ptInDisc], fn genPtToTip =>                      letPRIM("gptt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), ptInDisc], fn genPtToTip =>
269                      letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>                      letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>
270                      letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>                      letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>
# Line 208  Line 272 
272                      letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))                      letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
273                  end                  end
274    
275                    | P.D_SPHERE{center, irad, orad} =>
276    
277              (* generate two random angles... *)
278              letPRIM("r1", IR.T_FLOAT, IR.RAND, [], fn randForAngOne =>
279              letPRIM("t1", IR.T_FLOAT, IR.MULT, [randForAngOne, IR.newConst("fullCit", IR.C_FLOAT (2.0 * pi))], fn randAngOne =>
280              letPRIM("r2", IR.T_FLOAT, IR.RAND, [], fn randForAngTwo =>
281              letPRIM("t2", IR.T_FLOAT, IR.MULT, [randForAngTwo, IR.newConst("fullCit", IR.C_FLOAT (2.0 * pi))], fn randAngTwo =>
282    
283              (* Generate vector in the sphere ... *)
284              (* If my math is correct this should be
285               * <(cos t1)(cos t2), (sin t1)(cos t2), sin t2>
286               * This is different from wikipedia's article on spherical coordinates
287               * because of a phase shift, but for the generation of random numbers,
288               * it's irrelevant.
289               *)
290              letPRIM("cost1", IR.T_FLOAT, IR.COS, [randAngOne], fn cost1 =>
291              letPRIM("cost2", IR.T_FLOAT, IR.COS, [randAngTwo], fn cost2 =>
292              letPRIM("sint1", IR.T_FLOAT, IR.SIN, [randAngOne], fn sint1 =>
293              letPRIM("sint2", IR.T_FLOAT, IR.SIN, [randAngTwo], fn sint2 =>
294    
295              letPRIM("xVal", IR.T_FLOAT, IR.MULT, [cost1, cost2], fn xVal =>
296              letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sint1, cost2], fn yVal =>
297              (* zval is just sint2 *)
298    
299              letPRIM("xVec", IR.T_VEC, IR.SCALE, [xVal, IR.newConst("xDir", IR.C_VEC {x=1.0, y=0.0, z=0.0})], fn xVec =>
300              letPRIM("yVec", IR.T_VEC, IR.SCALE, [yVal, IR.newConst("yDir", IR.C_VEC {x=0.0, y=1.0, z=0.0})], fn yVec =>
301              letPRIM("zVec", IR.T_VEC, IR.SCALE, [sint2, IR.newConst("zDir", IR.C_VEC {x=0.0, y=0.0, z=1.0})], fn zVec =>
302    
303              letPRIM("addedVecs", IR.T_VEC, IR.ADD_VEC, [xVec, yVec], fn addedVecs =>
304              letPRIM("notNormVec", IR.T_VEC, IR.ADD_VEC, [addedVecs, zVec], fn nnVec =>
305              letPRIM("vec", IR.T_VEC, IR.NORM, [nnVec], fn vec =>
306    
307              (* Generate a random radius... *)
308                      letPRIM("ratio", IR.T_FLOAT, IR.DIV, [psvToIRVar(env, irad), psvToIRVar(env, orad)], fn ratio =>
309                      letPRIM("invRatio", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), ratio], fn invRatio =>
310                      letPRIM("randVar", IR.T_FLOAT, IR.RAND, [], fn rand =>
311                      letPRIM("randScale", IR.T_FLOAT, IR.MULT, [rand, invRatio], fn randScale =>
312                      letPRIM("randVal", IR.T_FLOAT, IR.ADD, [randScale, ratio], fn randVal =>
313                      letPRIM("randValSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randValSq =>
314                      letPRIM("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
315                      letPRIM("randRadVal", IR.T_FLOAT, IR.MULT, [radDiff, randValSq], fn randRadVal =>
316                      letPRIM("rad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), randRadVal], fn rad =>
317    
318                      (* Normalize the vector and scale it by the radius. *)
319                      letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [rad, vec], fn sVec =>
320                      letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [sVec, psvToIRVar(env, center)], stmt)
321                      ))))))))))
322                      ))))))))))))
323                      ))))
324    
325              | _ => raise Fail "Cannot generate point in specified domain."              | _ => raise Fail "Cannot generate point in specified domain."
326            (* end case *))            (* end case *))
327            (*            (*
# Line 217  Line 331 
331        | generate (Dblob{c, stddev}) = Vec3f.unpack c        | generate (Dblob{c, stddev}) = Vec3f.unpack c
332            *)            *)
333    
   
334    (* This function takes an IR boolean, its environment, a particle state, domain,    (* This function takes an IR boolean, its environment, a particle state, domain,
335     * and continuation.     * and continuation.
336     *     *
337     * We set the boolean to whether or not the current particle given by the particle     * We set the boolean to whether or not the current particle given by the particle
338     * state is within the domain, and then pass the continuation on.     * state is within the domain, and then pass the continuation on.
339     *)     *)
340      fun mkWithinVar (boolVar, env, var, d, stmt : IR.var -> IR.stmt) = let      fun mkVecWithinVar (boolVar, env, var, d : Vec3f.vec3 P.domain, stmt : IR.var -> IR.stmt) = let
341            val pos = var            val pos = var
342            in            in
343              case d              case d
# Line 253  Line 366 
366               * behind it (with respect to the normal)               * behind it (with respect to the normal)
367               *)               *)
368                | P.D_PLANE{pt, normal} =>                | P.D_PLANE{pt, normal} =>
369                    letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn posToPt =>                    letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
370                    letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>                    letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
371                    letPRIM(boolVar, IR.T_BOOL, IR.GT, [dotProd, IR.newConst("zero", IR.C_FLOAT 0.0)], stmt)))                    letPRIM(boolVar, IR.T_BOOL, IR.GT, [dotProd, IR.newConst("zero", IR.C_FLOAT 0.0)], stmt)))
372    
# Line 264  Line 377 
377               * orad.               * orad.
378               *)               *)
379                | P.D_DISC{pt, normal, orad, irad} =>                | P.D_DISC{pt, normal, orad, irad} =>
380                    letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn posToPt =>                    letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
                   letPRIM("posToPtLen", IR.T_FLOAT, IR.LEN, [posToPt], fn posToPtLen =>  
381                    letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>                    letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
382                    letPRIM("inDisc", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.01), dotProd], fn inDisc =>                    letPRIM("inDisc", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.01), dotProd], fn inDisc =>
383                    letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOrad =>  
384                    letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIrad =>                    letPRIM("parPosToP", IR.T_VEC, IR.SCALE, [dotProd, psvToIRVar(env, normal)], fn posToPtParallelToNormal =>
385                      letPRIM("perpPosToP", IR.T_VEC, IR.SUB_VEC, [posToPt, posToPtParallelToNormal], fn posToPtPerpToNormal =>
386                      letPRIM("inDiscLen", IR.T_FLOAT, IR.LEN, [posToPtPerpToNormal], fn posToPtLen =>
387    
388                      letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOradGt =>
389                      letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), posToPtLen], fn inOradEq =>
390                      letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
391    
392                      letPRIM("inIradGt", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIradGt =>
393                      letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [posToPtLen, psvToIRVar(env, irad)], fn inIradEq =>
394                      letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
395    
396                    letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>                    letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
397                    letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))  
398                      letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))))))))
399    
400              (* Simply see whether or not the distance from the center is within the              (* Simply see whether or not the distance from the center is within the
401               * specified bounds.               * specified bounds.
# Line 282  Line 406 
406                    letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToCLen], fn inOrad =>                    letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToCLen], fn inOrad =>
407                    letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToCLen, psvToIRVar(env, irad)], fn inIrad =>                    letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToCLen, psvToIRVar(env, irad)], fn inIrad =>
408                    letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))                    letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))
409    
410                      | P.D_CYLINDER {pt1, pt2, irad, orad} =>
411    
412                      (* !FIXME! Right now, we see whether or not the point is within the two planes defined
413                       * by the endpoints of the cylinder, and then testing to see whether or not the smallest
414                       * distance to the line segment falls within the radii. It might be faster to find the
415                       * closest point to the line defined by the endpoints and then see whether or not the point
416                       * is within the segment.
417                       *)
418    
419                      (* Is it in one plane *)
420                      letPRIM("plane1Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn plane1Norm =>
421                      letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt1)], fn posToPt1 =>
422                      letPRIM("dot1", IR.T_FLOAT, IR.DOT, [posToPt1, plane1Norm], fn dot1Prod =>
423                      letPRIM("inPlane1", IR.T_BOOL, IR.GT, [dot1Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane1=>
424    
425                      (* Is it in another plane *)
426                      letPRIM("plane2Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), psvToIRVar(env, pt2)], fn plane2Norm =>
427                      letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt2)], fn posToPt2 =>
428                      letPRIM("dot2", IR.T_FLOAT, IR.DOT, [posToPt2, plane2Norm], fn dot2Prod =>
429                      letPRIM("inPlane2", IR.T_BOOL, IR.GT, [dot2Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane2=>
430    
431                      (* Is it in both planes? *)
432                      letPRIM("inPlanes", IR.T_BOOL, IR.AND, [inPlane1, inPlane2], fn inPlanes =>
433    
434                      (* Find distance from segment *)
435                      letPRIM("a", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn a =>
436                      letPRIM("b", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn b =>
437                      letPRIM("alen", IR.T_FLOAT, IR.LEN, [a], fn alen =>
438                      letPRIM("axb", IR.T_VEC, IR.CROSS, [a, b], fn axb =>
439                      letPRIM("axblen", IR.T_FLOAT, IR.LEN, [axb], fn axblen =>
440                      letPRIM("dist", IR.T_FLOAT, IR.DIV, [axblen, alen], fn dist =>
441    
442                      (* Is distance in both radii? *)
443                      letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), dist], fn inOradGt =>
444                      letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), dist], fn inOradEq =>
445                      letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
446    
447                      letPRIM("inIradGt", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, irad)], fn inIradGt =>
448                      letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [dist, psvToIRVar(env, irad)], fn inIradEq =>
449                      letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
450    
451                      letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
452    
453                      (* It's in the cylinder (tube) if it's within both radii and in both planes... *)
454                      letPRIM(boolVar, IR.T_BOOL, IR.AND, [inPlanes, inBothRad], stmt)
455                      ))))))))))))))))))))))
456  (*  (*
457                | P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}                | P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}
458                | P.D_PLANE {pt: vec3f var, normal: vec3f var}                | P.D_PLANE {pt: vec3f var, normal: vec3f var}
459                | P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}                | P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}
460                | P.D_BOX {min: vec3f var, max: vec3f var}                | P.D_BOX {min: vec3f var, max: vec3f var}
461                | P.D_SPHERE {center: vec3f var, irad: vec3f var, orad: vec3f var}                | P.D_SPHERE {center: vec3f var, irad: vec3f var, orad: vec3f var}
               | P.D_CYLINDER {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}  
462                | P.D_CONE {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}                | P.D_CONE {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}
463                | P.D_BLOB {center: vec3f var, stddev: float var}                | P.D_BLOB {center: vec3f var, stddev: float var}
464                | P.D_DISC {pt: vec3f var, normal: vec3f var, irad: float var, orad: float var}                | P.D_DISC {pt: vec3f var, normal: vec3f var, irad: float var, orad: float var}
465  *)  *)
466                | _ => raise Fail "Cannot determine within-ness for specified domain."                | _ => raise Fail "Cannot determine within-ness for specified vec3 domain."
467              (* end case *)              (* end case *)
468            end (*end let *)            end (*end let *)
469    
470            fun mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) = (case d
471              of P.D_POINT(pt) => letPRIM(boolVar, IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, pt), var], stmt)
472               | P.D_BOX {min, max} =>
473                 letPRIM("bigMin", IR.T_BOOL, IR.GT, [var, psvToIRVar(env, min)], fn bigMin =>
474                 letPRIM("smallMax", IR.T_BOOL, IR.GT, [psvToIRVar(env, max), var], fn smallMax =>
475                 letPRIM(boolVar, IR.T_BOOL, IR.AND, [bigMin, smallMax], stmt)))
476               | _ => raise Fail "Cannot determine within-ness for specified float domain."
477             (* end case *))
478    
479    (* generate code to produce a random particle state from a domain *)          fun mkIntBool(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let
480      fun newParticle (posDomain, velDomain, colDomain, env, k : particle_state -> IR.stmt) =            val _ = ()
481              (* genVecVar (vecVar, env, domain, stmt) *)           in
482              genVecVar("ps_pos", env, posDomain, fn newPos =>            (case d
483              genVecVar("ps_vel", env, velDomain, fn newVel =>              of P.D_POINT(pt) =>
484              genVecVar("ps_col", env, colDomain, fn newCol =>  
485              letSPRIM ("ps_size", IR.T_FLOAT, IR.RAND, [], fn newSize =>               (* Get vectors *)
486              letSPRIM ("ps_isDead", IR.T_BOOL, IR.COPY, [IR.newConst("fbool", IR.C_BOOL false)], fn newIsDead =>               letPRIM("p1ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p1var], fn p1ToPt =>
487                k(PS{pos = newPos, vel = newVel, size = newSize, isDead = newIsDead, color = newCol}))))))               letPRIM("p2ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p2var], fn p2ToPt =>
488                 letPRIM("p1ToP2", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn p1ToP2 =>
489    
490                 (* Get distances *)
491                 letPRIM("p1ToPtLen", IR.T_FLOAT, IR.LEN, [p1ToPt], fn p1ToPtLen =>
492                 letPRIM("p2ToPtLen", IR.T_FLOAT, IR.LEN, [p2ToPt], fn p2ToPtLen =>
493                 letPRIM("p1ToP2Len", IR.T_FLOAT, IR.LEN, [p1ToP2], fn p1ToP2Len =>
494    
495                 (* Add & subtract ... *)
496                 letPRIM("distSum", IR.T_FLOAT, IR.ADD, [p1ToPtLen, p2ToPtLen], fn distSum =>
497                 letPRIM("distDiff", IR.T_FLOAT, IR.SUB, [distSum, p1ToP2Len], fn distDiff =>
498                 letPRIM("distDiffAbs", IR.T_FLOAT, IR.ABS, [distDiff], fn distDiffAbs =>
499    
500                 (* Do the boolean stuff... *)
501                 letPRIM("intersect", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), distDiffAbs], k)
502    
503                 )))
504                 )))
505                 )))
506    
507                | _ => raise Fail ("Cannot calculate intersection for specified domain")
508              (* end case *))
509    
510             end (* mkIntBool *)
511    
512            fun mkIntPt(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let
513              val _ = ()
514             in
515              (case d
516                of P.D_POINT(pt) => k (psvToIRVar (env, pt))
517                 | _ => raise Fail ("Cannot calculate intersection for specified domain")
518              (* end case *))
519             end (* mkIntPt *)
520    
521      (* Find the normal at the given position of the particle for the specified      (* Find the normal at the given position of the particle for the specified
522       * domain. Note, that the particle doesn't necessarily need to be on the       * domain. Note, that the particle doesn't necessarily need to be on the
523       * domain, but if it's not then the behavior is undefined.       * domain, but if it's not then the behavior is undefined.
524       *)       *)
525      fun normAtPoint(retNorm, d, env, state, k : IR.var -> particle_state -> IR.stmt) = let      fun normAtPoint(retNorm, d, env, pos, state, k : IR.var -> particle_state -> IR.stmt) = let
526        val newNorm = IR.newParam("n", IR.T_VEC)        val newNorm = IR.newParam("n", IR.T_VEC)
527        val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))        val nextBlk = newBlockWithArgs(env, state, [newNorm], k(newNorm))
       val PS{pos, ...} = state  
528       in       in
529        (case d        (case d
530            of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],            of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
531                fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))                fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
532             | P.D_DISC{pt, normal, irad, orad} =>             | P.D_DISC{pt, normal, irad, orad} =>
533                mkWithinVar("inP", env, pos, d, fn inPlane =>                mkVecWithinVar("inP", env, pos, d, fn inPlane =>
534                    IR.mkIF(inPlane,                    IR.mkIF(inPlane,
535                      (* then *)                      (* then *)
536                      letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],                      letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
# Line 335  Line 544 
544                     )                     )
545                   )                   )
546    
547             | P.D_SPHERE{center, irad, orad} => let             | P.D_SPHERE{center, irad, orad} =>
               val PS{pos, vel, size, isDead, color} = state  
               in  
548                      letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, center)], fn subVec =>                      letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, center)], fn subVec =>
549                  letPRIM(retNorm, IR.T_VEC, IR.NORM, [subVec], fn newNormVar => k newNormVar state                  letPRIM(retNorm, IR.T_VEC, IR.NORM, [subVec], fn newNormVar => k newNormVar state
550                      ))                      ))
               end  
551    
552             | _ => raise Fail("Cannot find normal to point of specified domain.")             | _ => raise Fail("Cannot find normal to point of specified domain.")
553           (* end case *))           (* end case *))
554          end          end
555    
556            fun trExpr(expr, env, state, k : IR.var -> IR.stmt) = (case expr
557              of P.CONSTF f => k (IR.newConst ("c", IR.C_FLOAT f))
558    
559           | P.CONST3F v => k (IR.newConst ("c", IR.C_VEC v))
560    
561           | P.VAR v => k (psvToIRVar (env, v))
562    
563           | P.STATE_VAR sv => k (getIRVarForSV (sv, state))
564    
565           | P.GENERATE3F (dom, dist) => genVecVar("genVec", env, dom, dist, k)
566    
567           | P.GENERATEF (dom, dist) => genFloatVar("genFlt", env, dom, dist, k)
568    
569           | P.ADD(e1, e2) =>
570             trExpr(e1, env, state, fn e1var =>
571             trExpr(e2, env, state, fn e2var =>
572             let
573              val IR.V{varType=vt1, ...} = e1var
574              val IR.V{varType=vt2, ...} = e2var
575             in
576              (case (vt1, vt2)
577                of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("addVar", IR.T_FLOAT, IR.ADD, [e1var, e2var], k)
578                 | (IR.T_VEC, IR.T_VEC) => letPRIM("addVar", IR.T_VEC, IR.ADD_VEC, [e1var, e2var], k)
579                 | _ => raise Fail ("Type mismatch to ADD expression")
580              (* end case *))
581             end))
582    
583           | P.SCALE (e1, e2) =>
584             trExpr(e1, env, state, fn e1var =>
585             trExpr(e2, env, state, fn e2var =>
586             let
587              val IR.V{varType=vt1, ...} = e1var
588              val IR.V{varType=vt2, ...} = e2var
589             in
590              (case (vt1, vt2)
591                of (IR.T_FLOAT, IR.T_VEC) => letPRIM("scaleVar", IR.T_VEC, IR.SCALE, [e1var, e2var], k)
592                 | (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("addVar", IR.T_FLOAT, IR.MULT, [e1var, e2var], k)
593                 | _ => raise Fail ("Type mismatch to SCALE expression")
594              (* end case *))
595             end))
596    
597           | P.DIV (e1, e2) =>
598             trExpr(e1, env, state, fn e1var =>
599             trExpr(e2, env, state, fn e2var =>
600             let
601              val IR.V{varType=vt1, ...} = e1var
602              val IR.V{varType=vt2, ...} = e2var
603             in
604              (case (vt1, vt2)
605                of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("divVar", IR.T_FLOAT, IR.DIV, [e1var, e2var], k)
606                 | _ => raise Fail ("Type mismatch to DIV expression")
607              (* end case *))
608             end))
609    
610           | P.NEG e =>
611             trExpr(e, env, state, fn evar =>
612             let
613              val IR.V{varType, ...} = evar
614             in
615              (case varType
616                of IR.T_FLOAT => letPRIM("negVar", IR.T_FLOAT, IR.MULT, [evar, IR.newConst("negOne", IR.C_FLOAT ~1.0)], k)
617                 | IR.T_VEC => letPRIM("negVar", IR.T_VEC, IR.NEG_VEC, [evar], k)
618                 | _ => raise Fail ("Type mismatch to NEG expression")
619              (* end case *))
620             end)
621    
622           | P.DOT (e1, e2) =>
623             trExpr(e1, env, state, fn e1var =>
624             trExpr(e2, env, state, fn e2var =>
625             let
626              val IR.V{varType=vt1, ...} = e1var
627              val IR.V{varType=vt2, ...} = e2var
628             in
629              (case (vt1, vt2)
630                of (IR.T_VEC, IR.T_VEC) => letPRIM("dotVar", IR.T_FLOAT, IR.DOT, [e1var, e2var], k)
631                 | _ => raise Fail ("Type mismatch to DOT expression")
632              (* end case *))
633             end))
634    
635           | P.CROSS (e1, e2) =>
636             trExpr(e1, env, state, fn e1var =>
637             trExpr(e2, env, state, fn e2var =>
638             let
639              val IR.V{varType=vt1, ...} = e1var
640              val IR.V{varType=vt2, ...} = e2var
641             in
642              (case (vt1, vt2)
643                of (IR.T_VEC, IR.T_VEC) => letPRIM("crossVar", IR.T_VEC, IR.CROSS, [e1var, e2var], k)
644                 | _ => raise Fail ("Type mismatch to CROSS expression")
645              (* end case *))
646             end))
647    
648           | P.NORMALIZE e =>
649             trExpr(e, env, state, fn evar =>
650             let
651              val IR.V{varType, ...} = evar
652             in
653              (case varType
654                of IR.T_VEC => letPRIM("normVar", IR.T_VEC, IR.NORM, [evar], k)
655                 | _ => raise Fail ("Type mismatch to NORMALIZE expression")
656              (* end case *))
657             end)
658    
659           | P.LENGTH e =>
660             trExpr(e, env, state, fn evar =>
661             let
662              val IR.V{varType, ...} = evar
663             in
664              (case varType
665                of IR.T_VEC => letPRIM("lenVar", IR.T_VEC, IR.LEN, [evar], k)
666                 | _ => raise Fail ("Type mismatch to LENGTH expression")
667              (* end case *))
668             end)
669    
670           (* !SPEED! We're assuming that there is an intersection here... *)
671           | P.INTERSECT {p1, p2, d} =>
672             trExpr(p1, env, state, fn p1var =>
673             trExpr(p2, env, state, fn p2var =>
674             let
675              val IR.V{varType=vt1, ...} = p1var
676              val IR.V{varType=vt2, ...} = p2var
677             in
678              (case (vt1, vt2)
679                of (IR.T_VEC, IR.T_VEC) => mkIntPt(env, p1var, p2var, d, k)
680                 | _ => raise Fail("Type mismatch to INTERSECT expression")
681              (* end case *))
682             end))
683    
684           | P.NORMALTO (e, d) =>
685             trExpr(e, env, state, fn evar =>
686             let
687              val IR.V{varType, ...} = evar
688              fun cont s = k s
689             in
690              (case varType
691                of IR.T_VEC => normAtPoint("normVar", d, env, evar, state, fn var => fn state' => k var)
692                 | _ => raise Fail("Type mismatch to NORMALTO expression")
693              (* end case *))
694             end)
695    
696              (* end case expr *))
697    
698              (* generate code to produce a random particle state from a domain *)
699        fun newParticle (sv_gens, env, state, k : particle_state -> IR.stmt) = let
700    
701          fun createVar(P.GEN{var, ...}) = let
702            val P.PSV.SV{name, ty, ...} = var
703           in
704            IR.newLocal("ps_" ^ name, IR.psvTyToIRTy ty, (IR.RAND, []))
705           end
706    
707          val newState = List.map createVar sv_gens
708    
709          fun genVar((sv_gen, var), cont) = let
710            val P.GEN{exp, ...} = sv_gen
711            val IR.V{varType, ...} = var
712           in
713            (* This is kind of a hack, but it'll get optimized out. *)
714            trExpr(exp, env, state, fn newVal => IR.mkPRIM(var, IR.COPY, [newVal], cont))
715           end (* genVar *)
716    
717         in
718          List.foldr (fn (x, y) => genVar(x, y)) (k newState) (ListPair.zipEq (sv_gens, newState))
719         end (* new particle *)
720    
721          fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let          fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let
722            val PS{pos, vel, size, isDead, color} = state        val P.EMIT{freq, sv_gens} = emit
723            val P.EMIT{maxNum, posDomain, velDomain, colDomain, ...} = emit        val blk = newBlock (env, state, k)
724            val blk = newBlock (env, k)        val ttl = findIRVarByName(state, "ttl")
725           in           in
726          letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>
727        IR.mkIF(isDead,        IR.mkIF(isDead,
728         (* then *)         (* then *)
729         letPRIM("t1", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, maxNum)], fn t1 =>         trExpr(freq, env, state, fn t1 =>
730         letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, numDead)], fn t2 =>         letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, PSV.numDead)], fn t2 =>
731         letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>         letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
732         letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>         letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
733         letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>         letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
734         IR.mkIF(t3,         IR.mkIF(t3,
735          (* then *)          (* then *)
736          newParticle (posDomain, velDomain, colDomain, env,          newParticle (sv_gens, env, state, fn state' => retState state'),
          fn state' => goto (state', blk)),  
737          (* else *)          (* else *)
738          IR.DISCARD)))))),          IR.DISCARD)))))),
739         (* else *)         (* else *)
740         goto (state, blk))         retState state))
741       end       end
742    
743    (*
744    //
745          fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let          fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
           val PS{pos, vel, size, isDead, color} = state  
746            val P.PR{ifstmt, ...} = pred            val P.PR{ifstmt, ...} = pred
           val thenBlk = newBlock(env, thenk)  
           val elseBlk = newBlock(env, elsek)  
747           in           in
748            case ifstmt            case ifstmt
749             of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>             of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>
750              IR.mkIF(withinVar, goto(state, thenBlk), goto(state, elseBlk)))                 IR.mkIF(withinVar, thenk(state), elsek(state)))
751              | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>              | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>
752              IR.mkIF(withinVar, goto(state, thenBlk), goto(state, elseBlk)))                 IR.mkIF(withinVar, thenk(state), elsek(state)))
753           end           end
754    //
755    //    fun trAct (action, env, state, k : particle_state -> IR.stmt) = let/
756    //        val PS{pos, vel, size, ttl, color, user} = state
757    //        in
758    //          case action
759    //           of P.BOUNCE{friction, resilience, cutoff, d} => let
760    //                val blk = newBlock (env, user, k)
761    //                val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)
762    //                in
763    //                  letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn velScale =>
764    //                  letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
765    //                  mkWithinVar("wcp", env, pos, d, fn withinCurPos =>
766    //                  mkWithinVar("wnp", env, nextPos, d, fn withinNextPos =>
767    //                  letPRIM("nwcp", IR.T_BOOL, IR.NOT, [withinCurPos], fn notWithinCurPos =>
768    //                  letPRIM("sb", IR.T_BOOL, IR.AND, [notWithinCurPos, withinNextPos], fn shouldBounce =>
769    //                  IR.mkIF(shouldBounce,
770    //                    (*then*)
771    //                      normAtPoint("n", d, env, state, fn normAtD => fn state' => let
772    //               val PS{pos=nextPos, vel=nextVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser} = state'
773    //                        in
774    //                         letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>
775    //                         letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>
776    //                         letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>
777    //                         letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>
778    //
779    //                         letPRIM("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>
780    //                         letPRIM("cosq", IR.T_FLOAT, IR.MULT, [psvToIRVar(env, cutoff), psvToIRVar(env, cutoff)], fn cutoffSq =>
781    //                         letPRIM("inco", IR.T_BOOL, IR.GT, [tangLenSq, cutoffSq], fn inCutoff =>
782    //
783    //                         letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>
784    //
785    //                         IR.mkIF(inCutoff,
786    //                           (*then*)
787    //                           letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>
788    //                           letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>
789    //                           letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>
790    //                           letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
791    //                            goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)
792    //                          )))),
793    //                           (*else*)
794    //                           letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>
795    //                           letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
796    //                            goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)
797    //                           ))
798    //                       )))))))))
799    //                       end
800    //                    ),
801    //                    (*else*)
802    //                    goto(state, blk))))))))
803    //                end
804    //
805    //            | P.ACCEL dir =>
806    //                  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), psvToIRVar(env, dir)], fn theScale =>
807    //                  letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>
808    //                    k(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user = user})))
809    //
810    //            | P.MOVE =>
811    //              letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn theScale =>
812    //                  letPRIM("ps_pos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
813    //                    k(PS{pos = newPos, vel = vel, size = size, ttl = ttl, color = color, user = user})))
814    //
815    //            | P.ORBITPOINT {center, mag, maxRad} => let
816    //                val blk = newBlock (env, user, k)
817    //               in
818    //                letPRIM("toCenter", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn toCenter =>
819    //                letPRIM("dist", IR.T_FLOAT, IR.LEN, [toCenter], fn dist =>
820    //                letPRIM("radInDist", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, maxRad)], fn radInDist =>
821    //                IR.mkIF(radInDist,
822    //                  (* then *)
823    //                  goto(state, blk),
824    //                  (* else *)
825    //                letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [dist, psvToIRVar(env, maxRad)], fn magRatio =>
826    //                letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
827    //                letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
828    //                letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>
829    //                letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, toCenter], fn acc =>
830    //                letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
831    //                goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)
832    //                ))))))))))
833    //               end
834    //
835    //
836    //            | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let
837    //                val blk = newBlock (env, user, k)
838    //              in
839    //              letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, endp2), psvToIRVar(env, endp1)], fn subVec =>
840    //              letPRIM("vecToEndP", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, endp1)], fn vecToEndP =>
841    //              letPRIM("basis", IR.T_VEC, IR.NORM, [subVec], fn basis =>
842    //              letPRIM("parDot", IR.T_FLOAT, IR.DOT, [basis, vecToEndP], fn parDot =>
843    //              letPRIM("parVec", IR.T_VEC, IR.SCALE, [parDot, basis], fn parVec =>
844    //              letPRIM("closestP", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, endp1), parVec], fn closestP =>
845    //              letPRIM("vecToP", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn vecToP =>
846    //              letPRIM("distToP", IR.T_FLOAT, IR.LEN, [vecToP], fn distToP =>
847    //              letPRIM("effRad", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, maxRad), distToP], fn effRad =>
848    //              letPRIM("radInDist", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), effRad], fn radInDist =>
849    //              IR.mkIF(radInDist,
850    //                (*then*)
851    //                goto(state, blk),
852    //                (*else*)
853    //                letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>
854    //                letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
855    //                letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
856    //                letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>
857    //                letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>
858    //                letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>
859    //                letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
860    //                goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)
861    //                )))))))
862    //              )))))))))))
863    //              end
864    //
865    //            (* just kill it. *)
866    //            (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, ttl = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)
867    //            | P.DIE => IR.DISCARD
868    //            | _ => raise Fail("Action not implemented...")
869    //          (* end case *)
870    //        end
871    *)
872    
873      fun trAct (action, env, state, k : particle_state -> IR.stmt) = let      (* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)
874            val PS{pos, vel, size, isDead, color} = state      (* mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) *)
875            in      fun trPred(cond, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
876              case action        fun grabVar(cond, env, state, k : IR.var -> IR.stmt) = (case cond
877               of P.BOUNCE{friction, resilience, cutoff, d} => let          of P.WITHINF(d, expr) =>
878                    val blk = newBlock (env, k)              trExpr(expr, env, state, fn checkMe =>
879                    val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)              mkFloatWithinVar("wv", env, checkMe, d, k))
880                    in  
881                      letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn velScale =>           | P.WITHIN3F(d, expr) =>
882                      letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>              trExpr(expr, env, state, fn checkMe =>
883                      mkWithinVar("wnp", env, pos, d, fn withinNextPos =>              mkVecWithinVar("wv", env, checkMe, d, k))
884                      IR.mkIF(withinNextPos,  
885                        (*then*)           | P.DO_INTERSECT {p1, p2, d} =>
886                          normAtPoint("n", d, env, state, fn normAtD => fn state' => let             trExpr(p1, env, state, fn p1var =>
887                 val PS{pos=nextPos, vel=nextVel, size=nextSize, isDead=nextIsDead, color=nextColor} = state'             trExpr(p2, env, state, fn p2var =>
888                            in             mkIntBool(env, p1var, p2var, d, k)))
889                             letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>  
890                             letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>           | P.GTHAN (e1, e2) =>
891                             letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>             trExpr(e1, env, state, fn e1var =>
892                             letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>             trExpr(e2, env, state, fn e2var =>
893               letPRIM("gtVar", IR.T_BOOL, IR.GT, [e1var, e2var], k)))
894                             letPRIM("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>  
895                             letPRIM("cosq", IR.T_FLOAT, IR.MULT, [psvToIRVar(env, cutoff), psvToIRVar(env, cutoff)], fn cutoffSq =>           | P.BOOLVAR (b) => k (psvToIRVar(env, b))
896                             letPRIM("inco", IR.T_BOOL, IR.GT, [tangLenSq, cutoffSq], fn inCutoff =>  
897             | P.AND(c1, c2) =>
898                             letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>             grabVar(c1, env, state, fn c1Var =>
899               grabVar(c2, env, state, fn c2Var =>
900               letPRIM("andVar", IR.T_BOOL, IR.AND, [c1Var, c2Var], k)))
901    
902             | P.OR(c1, c2) =>
903               grabVar(c1, env, state, fn c1Var =>
904               grabVar(c2, env, state, fn c2Var =>
905               letPRIM("andVar", IR.T_BOOL, IR.OR, [c1Var, c2Var], k)))
906    
907             | P.XOR(c1, c2) =>
908               grabVar(c1, env, state, fn c1Var =>
909               grabVar(c2, env, state, fn c2Var =>
910               mkXOR ("xorVar", c1Var, c2Var, k)))
911    
912             | P.NOT(c) =>
913               grabVar(c, env, state, fn cvar =>
914               letPRIM("notVar", IR.T_BOOL, IR.NOT, [cvar], k))
915    
916                             IR.mkIF(inCutoff,          (* end case *))
917                               (*then*)       in
918                               letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>        grabVar(cond, env, state, fn result =>
919                               letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>        IR.mkIF(result, thenk(state), elsek(state)))
                              letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>  
                              letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>  
                               goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor}, blk)  
                             )))),  
                              (*else*)  
                              letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>  
                              letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>  
                               goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor}, blk)  
                              ))  
                          )))))))))  
                          end  
                       ),  
                       (*else*)  
                       goto(state, blk)))))  
920                    end                    end
921    
922                | P.GRAVITY(dir) =>      fun compile (P.PG{
923                      letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), psvToIRVar(env, dir)], fn theScale =>         emit as P.EMIT{freq, sv_gens}, act, render,
924                      letPRIM("nextVel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>         vars, state_vars, render_vars
925                        k(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color})))      }) = let
926          val blks = ref[]
               | P.MOVE =>  
                 letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn theScale =>  
                     letPRIM("nextPos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>  
                       k(PS{pos = newPos, vel = vel, size = size, isDead = isDead, color = color})))  
               (*  
               | P.SINK({d, kill_inside}) =>  
                     mkWithinVar("isWithin", env, state, d, fn withinVal =>  
                     mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),  
                       fn shouldNotKill =>  
                     letPRIM("shouldKill", IR.T_BOOL, IR.NOT, [shouldNotKill], fn shouldKill =>  
                     letPRIM("isReallyDead", IR.T_BOOL, IR.OR, [shouldKill, isDead], fn isReallyDead =>  
                     k(PS{pos = pos, vel = vel, size = size, isDead = isReallyDead, color = color})  
                         ))))  
               *)  
927    
928                | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let        val demand = IR.getDemand(render)
929                    val blk = newBlock (env, k)        fun getIRNameForSV (v as PSV.SV{name, ...}) =
930           (case (PSV.SVMap.find (render_vars, v))
931             of SOME na => let
932               fun inDemand n = List.exists (fn x => #1 x = "ps_" ^ n) demand
933                  in                  in
934                  letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, endp2), psvToIRVar(env, endp1)], fn subVec =>             (* Sanity check *)
935                  letPRIM("vecToEndP", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, endp1)], fn vecToEndP =>             if not (inDemand na) then
936                  letPRIM("basis", IR.T_VEC, IR.NORM, [subVec], fn basis =>               raise Fail (String.concat["Variable with name ", name," marked for rendering but not in demand."])
937                  letPRIM("parDot", IR.T_FLOAT, IR.DOT, [basis, vecToEndP], fn parDot =>             else
938                  letPRIM("parVec", IR.T_VEC, IR.SCALE, [parDot, basis], fn parVec =>               "ps_" ^ na
                 letPRIM("closestP", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, endp1), parVec], fn closestP =>  
                 letPRIM("vecToP", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn vecToP =>  
                 letPRIM("distToP", IR.T_FLOAT, IR.LEN, [vecToP], fn distToP =>  
                 letPRIM("effRad", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, maxRad), distToP], fn effRad =>  
                 letPRIM("radInDist", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), effRad], fn radInDist =>  
                 IR.mkIF(radInDist,  
                   (*then*)  
                   goto(state, blk),  
                   (*else*)  
                   letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>  
                   letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>  
                   letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>  
                   letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, timeStep)], fn totMag =>  
                   letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>  
                   letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>  
                   letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>  
                   goto(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color}, blk)  
                   )))))))  
                 )))))))))))  
                 end  
   
               (* just kill it. *)  
               | P.DIE => k(PS{pos = pos, vel = vel, size = size, isDead = IR.newConst("falseVar", IR.C_BOOL true), color = color})  
               | _ => raise Fail("Action not implemented...")  
             (* end case *)  
939            end            end
940              | NONE => "ps_" ^ name
941           (* end case *))
942    
943      fun compile (P.PG{emit as P.EMIT{maxNum, vars=emitVars, ...}, act as P.PSAE{action=root_act, vars=actionVars}, ...}) = let        fun convertToIR (v as PSV.SV{ty, ...}) = IR.newParam(getIRNameForSV v, IR.psvTyToIRTy ty)
           val blks = ref[]  
944            val env = let            val env = let
945                (* add special globals to free vars *)                (* add special globals to free vars *)
946                  val vars = PSV.Set.union(emitVars, PSV.Set.addList(actionVars, [maxNum, numDead, timeStep, epsilon]))          val pgm_vars = PSV.Set.union(PSV.Set.singleton epsilon, vars)
947                  fun ins (x as PSV.V{name, ty, binding, id, ...}, map) = let          fun insv (x as PSV.V{name, ty, binding, id, ...}, map) = let
948                        val x' = (case (ty, !binding)                        val x' = (case (ty, !binding)
949                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
950                                | (PSV.T_BOOL,  PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))                                | (PSV.T_BOOL,  PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))
# Line 499  Line 954 
954                                | (PSV.T_FLOAT, PSV.FLOAT floatVal) => IR.newConst(name, IR.C_FLOAT(floatVal))                                | (PSV.T_FLOAT, PSV.FLOAT floatVal) => IR.newConst(name, IR.C_FLOAT(floatVal))
955                                | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)                                | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
956                                | (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))                                | (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))
957                                | _ => raise Fail("Error in setup, type mismatch between IR and PSV vars.")                   | _ => raise Fail("Error in setup, type mismatch between PSV vars and their binding.")
958                              (* end case *))                              (* end case *))
959                        in                        in
                     (* printErr (String.concat["Inserting ", name, " with ID ", Int.toString id, " to IR Var list: ", IR.varToString x']); *)  
960                          PSV.Map.insert (map, x, x')                          PSV.Map.insert (map, x, x')
961                        end                     end (* ins *)
962                    in
963                      TE( blks, PSV.Set.foldl insv PSV.Map.empty pgm_vars )
964                    end (* env *)
965    
966          fun evalActs theAct state f = (case theAct
967                  of P.SEQ(acts) => (case acts
968                    of [] => f state
969                     | oneAct :: rest => evalActs oneAct state (fn state' => (evalActs (P.SEQ(rest)) state' f))
970                    (* end case *))
971    
972                   | P.PRED(cond, thenAct, elseAct) =>
973                     trPred(cond, env, state,
974                       fn state' => evalActs thenAct state' f,
975                       fn state' => evalActs elseAct state' f
976                     )
977    
978                   | P.DIE => IR.DISCARD
979    
980                   | P.ASSIGN(sv, expr) => let
981                     val PSV.SV{ty, ...} = sv
982                     fun replaceStateVar (var, []) = [var]
983                       | replaceStateVar (var, nv :: svars) = let
984                         val IR.V{name=nvname, ...} = nv
985                         val IR.V{name=varname, ...} = var
986                  in                  in
987                    TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)                       if nvname = varname then
988                           var :: svars
989                         else
990                           nv :: replaceStateVar(var, svars)
991                  end                  end
           fun trActs [] state = let  
                 val PS{pos, vel, size, isDead, color} = state  
992                  in                  in
993                    IR.mkRETURN[ pos, vel, size, isDead, color ]                   trExpr(expr, env, state, fn newVar =>
994                  end (* trActs *)                   letPRIM(getIRNameForSV sv, IR.psvTyToIRTy ty, IR.COPY, [newVar],
995              | trActs (psa :: psal) state = (case psa                     fn thisVar => f (replaceStateVar(thisVar, state))))
996                of P.SEQ(acts) => (case acts                  end
997                   of [] => raise Fail "Should never reach here."  
                   | [act] => trAct(act, env, state, trActs psal)  
                   | act :: rest => trAct(act, env, state, trActs (P.SEQ(rest) :: psal))  
998                  (* end case *))                  (* end case *))
999                 | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) =>  
1000                    trPred(pred, env, state, trActs (t @ psal), trActs (e @ psal))            (* The entry block is the first block of the program, or in other words, the emitter. *)
1001              val entryBlock = newBlock (
1002                env,
1003                List.map convertToIR (PSV.SVSet.listItems state_vars),
1004                fn pstate => trEmitter(
1005                  emit,
1006                  env,
1007                  pstate,
1008                  fn state => evalActs act state retState
1009                )
1010              )
1011    
1012          (* The entry block is the emitter, and the rest of the blocks define the physics processing. *)
1013    
1014          fun isGlobal(IR.V{scope, ...}) = (case scope
1015            of IR.S_GLOBAL(v) => true
1016             | _ => false
1017                (* end case *))                (* end case *))
1018    
1019            val entryBlock = newBlock (env, fn pstate => trEmitter(emit, env, pstate, fn state => trActs root_act state))        fun extractVarMap(TE(blks, map)) = map
1020    
1021          fun convertDemand (name, x) = ("ps_" ^ name, x)
1022    
1023              val outPgm = PSysIR.PGM {
1024                globals = PSV.Map.filter isGlobal (extractVarMap env),
1025                persistents = List.map convertDemand demand,
1026                uveOptimized = false,
1027            emitter = entryBlock,
1028                physics = List.nth(!blks, 1),
1029                render = render
1030              }
1031    
1032              val optimized = if (Checker.checkIR(outPgm)) then (printErr "Pre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
1033    
1034            in            in
1035              IR.output(TextIO.stdErr, !blks);              (* IR.outputPgm(TextIO.stdErr, outPgm); *)
1036              if Checker.checkIR(!blks) then  
1037                (* note that the entryBlock will be the first block *)              (* Note: it only succeeds if we can optimize, too *)
1038                (IR.output(TextIO.stdErr, Optimize.optimizeIR(!blks));          if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();
1039                !blks)  
1040              else          optimized
               []  
1041            end (* compile *)            end (* compile *)
1042    
1043      end (* Translate *)      end (* Translate *)

Legend:
Removed from v.770  
changed lines
  Added in v.1122

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