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 901, Fri May 28 19:15:30 2010 UTC revision 1146, Wed May 4 21:06:27 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.program      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          pos2 : IR.var,          (* vec3 *)        user : IR.var list
         dummy : IR.var  
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  
           )  
   
   
     fun retState s = let  
       val PS{pos, vel, size, isDead, color, pos2, dummy} = s  
      in  
       IR.mkRETURN [pos, vel, size, isDead, color, pos2, dummy]  
      end  
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 dummy = IR.newParam ("ps_dummy", IR.T_FLOAT)  
           val pos2 = IR.newParam ("ps_pos2", IR.T_VEC)  
           val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color, pos2=pos2, dummy=dummy}  
           val blk = IR.newBlock ([pos, vel, size, isDead, color, pos2, dummy], 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 dummy = IR.newParam ("ps_dummy", IR.T_FLOAT)             val blk = IR.newBlock (newState @ args, k newState)
           val pos2 = IR.newParam ("ps_pos2", IR.T_VEC)  
           val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color, pos2=pos2, dummy = dummy}  
           val blk = IR.newBlock ([pos, vel, size, isDead, color, pos2, dummy] @ 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, pos2, dummy}, blk) =          fun newBlock (env, state, k) = newBlockWithArgs(env, state, [], k)
           IR.mkGOTO(blk, [pos, vel, size, isDead, color, pos2, dummy])  
75    
76          fun gotoWithArgs(PS{pos, vel, size, isDead, color, pos2, dummy}, args, blk) =      fun gotoWithArgs(state, args, blk) = IR.mkGOTO(blk, state @ args)
77            IR.mkGOTO(blk, [pos, vel, size, isDead, color, pos2, dummy] @ 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 111  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(ref (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 128  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: " ^ (P.dToStr 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)
151    
152              | P.D_LINE({pt1, pt2}) =>              | P.D_LINE({pt1, pt2}) =>
153    
154                (* Lerp between the points. *)                (* Lerp between the points. *)
155                  letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>                  letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
156                  letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>                  letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>
# Line 180  Line 196 
196    
197    
198              | P.D_TRIANGLE{pt1, pt2, pt3} =>              | P.D_TRIANGLE{pt1, pt2, pt3} =>
199    
200                  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 =>
201                  letPRIM ("pt1ToPt3", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt3), psvToIRVar(env, pt1)], fn pt1ToPt3 =>                  letPRIM ("pt1ToPt3", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt3), psvToIRVar(env, pt1)], fn pt1ToPt3 =>
202                  letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>                  letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>
# Line 200  Line 217 
217                    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 =>
218                    letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>                    letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>
219                    (* Generate a point in the lower disc. *)                    (* Generate a point in the lower disc. *)
220                      genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>                      genVecVar("ptInDisc",
221                          insert(env, normVar, norm),
222                          P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
223                          dist,
224                          fn ptInDisc =>
225                    (* Now add this point to a random scaling of the normVec. *)                    (* Now add this point to a random scaling of the normVec. *)
226                      letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>                      letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>
227                      letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>                      letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>
# Line 208  Line 229 
229                   end                   end
230    
231              | P.D_DISC {pt, normal, irad, orad} =>              | P.D_DISC {pt, normal, irad, orad} =>
232    
233                (* Get a random angle... *)                (* Get a random angle... *)
234                  letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>                  letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>
235                  letPRIM ("t", IR.T_FLOAT, IR.MULT, [randForAng, IR.newConst("fullCir", IR.C_FLOAT (2.0 * pi))], fn randAng =>                  letPRIM ("t", IR.T_FLOAT, IR.MULT, [randForAng, IR.newConst("fullCir", IR.C_FLOAT (2.0 * pi))], fn randAng =>
236    
237                (* Get a random radius *)                (* Get a random radius *)
238                  letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>                  letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>
239                  letPRIM ("e0sq", IR.T_FLOAT, IR.MULT, [newRand, newRand], fn randRadSq =>                  letPRIM ("e0sq", IR.T_FLOAT, IR.MULT, [newRand, newRand], fn randRadSq =>
240                  letPRIM ("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>                  letPRIM ("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
241                  letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>                  letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>
242                  letPRIM ("newRad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), newRadDist], fn newRad =>                  letPRIM ("newRad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), newRadDist], fn newRad =>
243    
244                (* Find a vector in the plane of the disc, and then                (* Find a vector in the plane of the disc, and then
245                 * translate it to the center.               * translate it to the center. *)
                *)  
246                  letPRIM ("ntoc", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn normToCen =>                  letPRIM ("ntoc", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn normToCen =>
247                  letPRIM ("v", IR.T_VEC, IR.CROSS, [psvToIRVar(env, pt), normToCen], fn vecInDisc =>                  letPRIM ("v", IR.T_VEC, IR.CROSS, [psvToIRVar(env, pt), normToCen], fn vecInDisc =>
248                  letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>                  letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>
249                  letPRIM ("p", IR.T_VEC, IR.CROSS, [vecInDiscNorm, psvToIRVar(env, normal)], fn ptInDisc =>                  letPRIM ("p", IR.T_VEC, IR.CROSS, [vecInDiscNorm, psvToIRVar(env, normal)], fn ptInDisc =>
250                  letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>                  letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>
251    
252                (* Figure out x and y values for our new radius and angle *)                (* Figure out x and y values for our new radius and angle *)
253                  letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>                  letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>
254                  letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>                  letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>
# Line 233  Line 257 
257                  letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>                  letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>
258                  letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>                  letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>
259                  letPRIM ("res", IR.T_VEC, IR.ADD_VEC, [resVecOne, resVecTwo], fn result =>                  letPRIM ("res", IR.T_VEC, IR.ADD_VEC, [resVecOne, resVecTwo], fn result =>
260                  letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt))))))))))))))))))))  
261                letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt)
262                )))))))))))))))))))
263    
264              | P.D_CONE{pt1, pt2, irad, orad} => let              | P.D_CONE{pt1, pt2, irad, orad} => let
265                  val normVar = PSV.new("local_ht", PSV.T_VEC3F)                  val normVar = PSV.new("local_ht", PSV.T_VEC3F)
# Line 241  Line 267 
267                    letPRIM("eh",  IR.T_FLOAT, IR.RAND, [], fn ourRand =>                    letPRIM("eh",  IR.T_FLOAT, IR.RAND, [], fn ourRand =>
268                    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 =>
269                    letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>                    letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>
270                      genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>               genVecVar("ptInDisc",
271                  insert(env, normVar, norm),
272                  P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
273                  dist,
274                  fn ptInDisc =>
275                      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 =>
276                      letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>                      letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>
277                      letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>                      letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>
278                      letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>                      letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>
279                      letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))               letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)
280                 ))))))))
281                  end                  end
282    
283              | _ => raise Fail "Cannot generate point in specified domain."                  | P.D_SPHERE{center, irad, orad} =>
           (* end case *))  
           (*  
           | generate (Dplane{pt, n}) = Vec3f.unpack pt  
       | generate (Drectangle{pt, u, v}) = Vec3f.unpack pt  
       | generate (Dsphere{c, orad, irad}) = Vec3f.unpack c  
       | generate (Dblob{c, stddev}) = Vec3f.unpack c  
           *)  
284    
285                      (* Source: http://mathworld.wolfram.com/SpherePointPicking.html *)
286    
287              (* generate two random values... one will be called u and will
288               * represent cos(theta), and the other will be called v and will
289               * represent a random value in [0, 2 * pi] *)
290              letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn rv =>
291              letPRIM("dblRandVal", IR.T_FLOAT, IR.MULT, [rv, IR.newConst("Two", IR.C_FLOAT 2.0)], fn drv =>
292              letPRIM("rand", IR.T_FLOAT, IR.SUB, [drv, IR.newConst("One", IR.C_FLOAT 1.0)], fn u =>
293    
294              letPRIM("rv2", IR.T_FLOAT, IR.RAND, [], fn rv2 =>
295              letPRIM("rand2", IR.T_FLOAT, IR.MULT, [rv2, IR.newConst("TwoPi", IR.C_FLOAT (2.0 * Float.M_PI))], fn theta =>
296    
297              letPRIM("cosTheta", IR.T_FLOAT, IR.COS, [theta], fn cosT =>
298              letPRIM("sinTheta", IR.T_FLOAT, IR.SIN, [theta], fn sinT =>
299    
300              letPRIM("usq", IR.T_FLOAT, IR.MULT, [u, u], fn usq =>
301              letPRIM("usqInv", IR.T_FLOAT, IR.SUB, [IR.newConst("One", IR.C_FLOAT 1.0), usq], fn usqInv =>
302              letPRIM("sinPhi", IR.T_FLOAT, IR.SQRT, [usqInv], fn sinP =>
303    
304              letPRIM("xVal", IR.T_FLOAT, IR.MULT, [sinP, cosT], fn xVal =>
305              letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sinP, sinT], fn yVal =>
306              (* zval is just u *)
307    
308              letPRIM("vec", IR.T_VEC, IR.GEN_VEC, [xVal, yVal, u], fn vec =>
309    
310              (* Generate a random radius... *)
311                      letPRIM("ratio", IR.T_FLOAT, IR.DIV, [psvToIRVar(env, irad), psvToIRVar(env, orad)], fn ratio =>
312                      letPRIM("invRatio", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), ratio], fn invRatio =>
313                      letPRIM("randVar", IR.T_FLOAT, IR.RAND, [], fn rand =>
314                      letPRIM("randScale", IR.T_FLOAT, IR.MULT, [rand, invRatio], fn randScale =>
315                      letPRIM("randVal", IR.T_FLOAT, IR.ADD, [randScale, ratio], fn randVal =>
316                      letPRIM("randValSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randValSq =>
317                      letPRIM("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
318                      letPRIM("randRadVal", IR.T_FLOAT, IR.MULT, [radDiff, randValSq], fn randRadVal =>
319                      letPRIM("rad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), randRadVal], fn rad =>
320    
321                      (* Normalize the vector and scale it by the radius. *)
322                      letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [rad, vec], fn sVec =>
323                      letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [sVec, psvToIRVar(env, center)], stmt)
324                      ))))))))))
325                      )))))))))))))
326    
327                | _ => raise Fail ("Cannot generate point in specified domain: "  ^ (P.dToStr domain))
328              (* end case *))
329    
330    (* This function takes an IR boolean, its environment, a particle state, domain,    (* This function takes an IR boolean, its environment, a particle state, domain,
331     * and continuation.     * and continuation.
# Line 265  Line 333 
333     * 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
334     * state is within the domain, and then pass the continuation on.     * state is within the domain, and then pass the continuation on.
335     *)     *)
336      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
337            val pos = var            val pos = var
338            in            in
339              case d              case d
# Line 294  Line 362 
362               * behind it (with respect to the normal)               * behind it (with respect to the normal)
363               *)               *)
364                | P.D_PLANE{pt, normal} =>                | P.D_PLANE{pt, normal} =>
365                    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 =>
366                    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 =>
367                    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)))
368    
# Line 305  Line 373 
373               * orad.               * orad.
374               *)               *)
375                | P.D_DISC{pt, normal, orad, irad} =>                | P.D_DISC{pt, normal, orad, irad} =>
376                    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 =>  
377                    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 =>
378                    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 =>
379                    letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOrad =>  
380                    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 =>
381                letPRIM("perpPosToP", IR.T_VEC, IR.SUB_VEC, [posToPt, posToPtParallelToNormal], fn posToPtPerpToNormal =>
382                letPRIM("inDiscLen", IR.T_FLOAT, IR.LEN, [posToPtPerpToNormal], fn posToPtLen =>
383    
384                letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOradGt =>
385                letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), posToPtLen], fn inOradEq =>
386                letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
387    
388                letPRIM("inIradGt", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIradGt =>
389                letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [posToPtLen, psvToIRVar(env, irad)], fn inIradEq =>
390                letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
391    
392                    letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>                    letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
393                    letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))  
394                letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))))))))
395    
396              (* 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
397               * specified bounds.               * specified bounds.
# Line 323  Line 402 
402                    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 =>
403                    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 =>
404                    letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))                    letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))
405    
406                      | P.D_CYLINDER {pt1, pt2, irad, orad} =>
407    
408                      (* !FIXME! Right now, we see whether or not the point is within the two planes defined
409                       * by the endpoints of the cylinder, and then testing to see whether or not the smallest
410                       * distance to the line segment falls within the radii. It might be faster to find the
411                       * closest point to the line defined by the endpoints and then see whether or not the point
412                       * is within the segment.
413                       *)
414    
415                      (* Is it in one plane *)
416                      letPRIM("plane1Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn plane1Norm =>
417                      letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt1)], fn posToPt1 =>
418                      letPRIM("dot1", IR.T_FLOAT, IR.DOT, [posToPt1, plane1Norm], fn dot1Prod =>
419                      letPRIM("inPlane1", IR.T_BOOL, IR.GT, [dot1Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane1=>
420    
421                      (* Is it in another plane *)
422                      letPRIM("plane2Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), psvToIRVar(env, pt2)], fn plane2Norm =>
423                      letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt2)], fn posToPt2 =>
424                      letPRIM("dot2", IR.T_FLOAT, IR.DOT, [posToPt2, plane2Norm], fn dot2Prod =>
425                      letPRIM("inPlane2", IR.T_BOOL, IR.GT, [dot2Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane2=>
426    
427                      (* Is it in both planes? *)
428                      letPRIM("inPlanes", IR.T_BOOL, IR.AND, [inPlane1, inPlane2], fn inPlanes =>
429    
430                      (* Find distance from segment *)
431                      letPRIM("a", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn a =>
432                      letPRIM("b", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn b =>
433                      letPRIM("alen", IR.T_FLOAT, IR.LEN, [a], fn alen =>
434                      letPRIM("axb", IR.T_VEC, IR.CROSS, [a, b], fn axb =>
435                      letPRIM("axblen", IR.T_FLOAT, IR.LEN, [axb], fn axblen =>
436                      letPRIM("dist", IR.T_FLOAT, IR.DIV, [axblen, alen], fn dist =>
437    
438                      (* Is distance in both radii? *)
439                      letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), dist], fn inOradGt =>
440                      letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), dist], fn inOradEq =>
441                      letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
442    
443                      letPRIM("inIradGt", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, irad)], fn inIradGt =>
444                      letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [dist, psvToIRVar(env, irad)], fn inIradEq =>
445                      letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
446    
447                      letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
448    
449                      (* It's in the cylinder (tube) if it's within both radii and in both planes... *)
450                      letPRIM(boolVar, IR.T_BOOL, IR.AND, [inPlanes, inBothRad], stmt)
451                      ))))))))))))))))))))))
452  (*  (*
453                | P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}                | P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}
454                | P.D_PLANE {pt: vec3f var, normal: vec3f var}                | P.D_PLANE {pt: vec3f var, normal: vec3f var}
455                | P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}                | P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}
456                | P.D_BOX {min: vec3f var, max: vec3f var}                | P.D_BOX {min: vec3f var, max: vec3f var}
457                | 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}  
458                | 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}
459                | P.D_BLOB {center: vec3f var, stddev: float var}                | P.D_BLOB {center: vec3f var, stddev: float var}
460                | 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}
461  *)  *)
462                | _ => raise Fail "Cannot determine within-ness for specified domain."                | _ => raise Fail ("Cannot determine within-ness for specified vec3 domain: " ^ (P.dToStr d))
463              (* end case *)              (* end case *)
464            end (*end let *)            end (*end let *)
465    
466            fun mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) = (case d
467              of P.D_POINT(pt) => letPRIM(boolVar, IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, pt), var], stmt)
468               | P.D_BOX {min, max} =>
469                 letPRIM("bigMin", IR.T_BOOL, IR.GT, [var, psvToIRVar(env, min)], fn bigMin =>
470                 letPRIM("smallMax", IR.T_BOOL, IR.GT, [psvToIRVar(env, max), var], fn smallMax =>
471                 letPRIM(boolVar, IR.T_BOOL, IR.AND, [bigMin, smallMax], stmt)))
472               | _ => raise Fail ("Cannot determine within-ness for specified float domain: " ^ (P.dToStr d))
473             (* end case *))
474    
475    (* generate code to produce a random particle state from a domain *)          fun mkIntBool(env, p1var, p2var, d : Vec3f.vec3 P.domain, state, k : IR.var -> particle_state -> IR.stmt) = let
476      fun newParticle (posDomain, velDomain, colDomain, env, k : particle_state -> IR.stmt) =            val _ = ()
477              (* genVecVar (vecVar, env, domain, stmt) *)           in
478              genVecVar("ps_pos", env, posDomain, fn newPos =>            (case d
479              genVecVar("ps_vel", env, velDomain, fn newVel =>              of P.D_POINT(pt) =>
480              genVecVar("ps_col", env, colDomain, fn newCol =>  
481              letSPRIM ("ps_size", IR.T_FLOAT, IR.RAND, [], fn newSize =>               (* Get vectors *)
482              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 =>
483                k(PS{pos = newPos,               letPRIM("p2ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p2var], fn p2ToPt =>
484                     vel = newVel,               letPRIM("p1ToP2", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn p1ToP2 =>
485                     size = newSize,  
486                     isDead = newIsDead,               (* Get distances *)
487                     color = newCol,               letPRIM("p1ToPtLen", IR.T_FLOAT, IR.LEN, [p1ToPt], fn p1ToPtLen =>
488                     pos2 = IR.newConst("p2", IR.C_VEC {x=0.0, y=0.0, z=0.0}),               letPRIM("p2ToPtLen", IR.T_FLOAT, IR.LEN, [p2ToPt], fn p2ToPtLen =>
489                     dummy = IR.newConst("dmy", IR.C_FLOAT 0.01)})               letPRIM("p1ToP2Len", IR.T_FLOAT, IR.LEN, [p1ToP2], fn p1ToP2Len =>
490              )))))  
491                 (* Add & subtract ... *)
492                 letPRIM("distSum", IR.T_FLOAT, IR.ADD, [p1ToPtLen, p2ToPtLen], fn distSum =>
493                 letPRIM("distDiff", IR.T_FLOAT, IR.SUB, [distSum, p1ToP2Len], fn distDiff =>
494                 letPRIM("distDiffAbs", IR.T_FLOAT, IR.ABS, [distDiff], fn distDiffAbs =>
495    
496                 (* Do the boolean stuff... *)
497                 letPRIM("intersect", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), distDiffAbs], fn intVar => k intVar state)
498    
499                 )))
500                 )))
501                 )))
502    
503                | P.D_PLANE {pt, normal} =>
504                  letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
505                  letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
506                  letPRIM("p2d", IR.T_FLOAT, IR.DOT, [p2var, psvToIRVar(env, normal)], fn p2d =>
507                  letPRIM("p1dist", IR.T_FLOAT, IR.SUB, [d, p1d], fn p1dist =>
508                  letPRIM("p2dist", IR.T_FLOAT, IR.SUB, [d, p2d], fn p2dist =>
509                  letPRIM("distProd", IR.T_FLOAT, IR.MULT, [p1dist, p2dist], fn distProd =>
510                  letPRIM("intersect", IR.T_BOOL, IR.GT, [IR.newConst("zero", IR.C_FLOAT 0.0), distProd], fn intVar => k intVar state)
511                  ))))))
512    
513                | P.D_DISC {pt, normal, orad, irad} => let
514                  val boolVar = IR.newParam("intersect", IR.T_BOOL)
515                  val newBlk = newBlockWithArgs(env, state, [boolVar], k boolVar)
516                 in
517                  letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
518                  letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
519    
520                  (* Early out... does it intersect the plane?
521                   *
522                   * !SPEED! Due to the perceived slowness of branching on
523                   * GPUs, this might not actually be faster on all runtime environments *)
524    
525                  letPRIM("p2d", IR.T_FLOAT, IR.DOT, [p2var, psvToIRVar(env, normal)], fn p2d =>
526                  letPRIM("p1dist", IR.T_FLOAT, IR.SUB, [d, p1d], fn p1dist =>
527                  letPRIM("p2dist", IR.T_FLOAT, IR.SUB, [d, p2d], fn p2dist =>
528                  letPRIM("distProd", IR.T_FLOAT, IR.MULT, [p1dist, p2dist], fn distProd =>
529                  letPRIM("earlyOut", IR.T_BOOL, IR.GT, [distProd, IR.newConst("zero", IR.C_FLOAT 0.0)], fn earlyOut =>
530                  IR.mkIF(earlyOut,
531                    (* then *)
532                    letPRIM("intersect", IR.T_BOOL, IR.NOT, [earlyOut], fn var => gotoWithArgs(state, [var], newBlk)),
533                    (* else *)
534                    letPRIM("v", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn v =>
535                    letPRIM("vDotn", IR.T_FLOAT, IR.DOT, [v, psvToIRVar(env, normal)], fn vdn =>
536                    letPRIM("t", IR.T_FLOAT, IR.DIV, [p1dist, vdn], fn t =>
537    
538                    (* !TODO! Add some sort of assert mechanism to make sure that t is
539                     * in the interval [0, 1]... *)
540                    letPRIM("vscale", IR.T_VEC, IR.SCALE, [t, v], fn vscale =>
541                    letPRIM("ppt", IR.T_VEC, IR.ADD_VEC, [p1var, vscale], fn ppt =>
542                    letPRIM("lenVec", IR.T_VEC, IR.SUB_VEC, [ppt, psvToIRVar(env, pt)], fn cv =>
543                    letPRIM("len", IR.T_FLOAT, IR.LEN, [cv], fn len =>
544    
545                    (* Check to see whether or not it's within the radius... *)
546                    letPRIM("gtirad", IR.T_BOOL, IR.GT, [len, psvToIRVar(env, irad)], fn gtirad =>
547                    letPRIM("ltorad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), len], fn ltorad =>
548                    letPRIM("intersect", IR.T_BOOL, IR.AND, [gtirad, ltorad], fn var => gotoWithArgs(state, [var], newBlk))
549                   ))))))))))
550                 )))))))
551                end (* P.D_DISC *)
552    
553                | _ => raise Fail ("Cannot calculate intersection bool for specified domain: " ^ (P.dToStr d))
554              (* end case *))
555    
556             end (* mkIntBool *)
557    
558            (* We assume that the segment already intersects with the domain. *)
559            fun mkIntPt(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let
560              val _ = ()
561             in
562              (case d
563                of P.D_POINT(pt) => k (psvToIRVar (env, pt))
564    
565                 | P.D_PLANE {pt, normal} =>
566                   letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
567                   letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
568                   letPRIM("num", IR.T_FLOAT, IR.SUB, [d, p1d], fn num =>
569                   letPRIM("v", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn v =>
570                   letPRIM("den", IR.T_FLOAT, IR.DOT, [v, psvToIRVar(env, normal)], fn den =>
571                   letPRIM("t", IR.T_FLOAT, IR.DIV, [num, den], fn t =>
572                   letPRIM("vsc", IR.T_VEC, IR.SCALE, [t, v], fn vs =>
573                   letPRIM("intPt", IR.T_VEC, IR.ADD_VEC, [p1var, vs], k)
574                   )))))))
575    
576                 (* Since we already know they intersect, the intersection point must be
577                  * just the point that's on the plane... *)
578                 | P.D_DISC {pt, normal, orad, irad} => mkIntPt(env, p1var, p2var, P.D_PLANE{pt = pt, normal = normal}, k)
579                 | _ => raise Fail ("Cannot calculate intersection point for specified domain: "  ^ (P.dToStr d))
580              (* end case *))
581             end (* mkIntPt *)
582    
583      (* 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
584       * 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
585       * domain, but if it's not then the behavior is undefined.       * domain, but if it's not then the behavior is undefined. *)
586       *)      fun normAtPoint(retNorm, d, env, pos, state, k : IR.var -> particle_state -> IR.stmt) = let
     fun normAtPoint(retNorm, d, env, state, k : IR.var -> particle_state -> IR.stmt) = let  
587        val newNorm = IR.newParam("n", IR.T_VEC)        val newNorm = IR.newParam("n", IR.T_VEC)
588        val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))        val nextBlk = newBlockWithArgs(env, state, [newNorm], k(newNorm))
       val PS{pos, ...} = state  
589       in       in
590        (case d        (case d
591            of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],            of P.D_PLANE{pt, normal} =>
592                fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))               letPRIM("inVec", IR.T_VEC, IR.SUB, [psvToIRVar(env, pt), pos], fn inVec =>
593                 letPRIM("dotNorm", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, normal), inVec], fn dotNorm =>
594                 letPRIM("eqZero", IR.T_BOOL, IR.EQUALS, [dotNorm, IR.newConst("One", IR.C_FLOAT 0.0)], fn eqZero =>
595                 IR.mkIF(eqZero,
596                     (*thenStmt*)
597                     gotoWithArgs(state, [psvToIRVar(env, normal)], nextBlk),
598                 (*elseStmt*)
599                 letPRIM("dnRecip", IR.T_FLOAT, IR.DIV, [IR.newConst("One", IR.C_FLOAT 1.0), dotNorm], fn dnRecip =>
600                 letPRIM("absR", IR.T_FLOAT, IR.ABS, [dnRecip], fn absR =>
601                 letPRIM("sign", IR.T_FLOAT, IR.MULT, [absR, dotNorm], fn sign =>
602                 letPRIM(retNorm, IR.T_VEC, IR.SCALE, [sign, psvToIRVar(env, normal)],
603                 fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk)))))
604             ))))
605    
606             | P.D_DISC{pt, normal, irad, orad} =>             | P.D_DISC{pt, normal, irad, orad} =>
607                mkWithinVar("inP", env, pos, d, fn inPlane =>                normAtPoint(retNorm, P.D_PLANE{pt=pt, normal=normal}, env, pos, state, k)
                   IR.mkIF(inPlane,  
                     (* then *)  
                     letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],  
                       fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk)),  
                     (* else *)  
                     letPRIM(retNorm,  
                       IR.T_VEC,  
                           IR.SCALE,  
                           [IR.newConst("negOne", IR.C_FLOAT ~1.0), psvToIRVar(env, normal)],  
                           fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))  
                    )  
                  )  
608    
609             | P.D_SPHERE{center, irad, orad} => let             | P.D_SPHERE{center, irad, orad} =>
               val PS{pos, ...} = state  
               in  
610                      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 =>
611                  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
612                      ))                      ))
613    
614               | _ => raise Fail("Cannot find normal to point of specified domain." ^ (P.dToStr d))
615             (* end case *))
616                end                end
617    
618             | _ => raise Fail("Cannot find normal to point of specified domain.")          fun trExpr(expr, env, state, k : IR.var -> particle_state -> IR.stmt) = (case expr
619              of P.CONSTF f => k (IR.newConst ("c", IR.C_FLOAT f)) state
620    
621           | P.CONST3F v => k (IR.newConst ("c", IR.C_VEC v)) state
622    
623           | P.VAR v => k (psvToIRVar (env, v)) state
624    
625           | P.STATE_VAR sv => k (getIRVarForSV (sv, state)) state
626    
627           | P.GENERATE3F (dom, dist) => genVecVar("genVec", env, dom, dist, fn var => k var state)
628    
629           | P.GENERATEF (dom, dist) => genFloatVar("genFlt", env, dom, dist, fn var => k var state)
630    
631           | P.ADD(e1, e2) =>
632             trExpr(e1, env, state, fn e1var => fn state' =>
633             trExpr(e2, env, state', fn e2var => fn state'' =>
634             let
635              val IR.V{varType=vt1, ...} = e1var
636              val IR.V{varType=vt2, ...} = e2var
637             in
638              (case (vt1, vt2)
639                of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("addVar", IR.T_FLOAT, IR.ADD, [e1var, e2var], fn var => k var state'')
640                 | (IR.T_VEC, IR.T_VEC) => letPRIM("addVar", IR.T_VEC, IR.ADD_VEC, [e1var, e2var], fn var => k var state'')
641                 | _ => raise Fail ("Type mismatch to ADD expression")
642              (* end case *))
643             end))
644    
645           | P.SCALE (e1, e2) =>
646             trExpr(e1, env, state, fn e1var => fn state' =>
647             trExpr(e2, env, state', fn e2var => fn state'' =>
648             let
649              val IR.V{varType=vt1, ...} = e1var
650              val IR.V{varType=vt2, ...} = e2var
651             in
652              (case (vt1, vt2)
653                of (IR.T_FLOAT, IR.T_VEC) => letPRIM("scaleVar", IR.T_VEC, IR.SCALE, [e1var, e2var], fn var => k var state'')
654                 | (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("scaleVar", IR.T_FLOAT, IR.MULT, [e1var, e2var], fn var => k var state'')
655                 | _ => raise Fail (String.concat["Type mismatch to SCALE expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
656              (* end case *))
657             end))
658    
659           | P.DIV (e1, e2) =>
660             trExpr(e1, env, state, fn e1var => fn state' =>
661             trExpr(e2, env, state', fn e2var => fn state'' =>
662             let
663              val IR.V{varType=vt1, ...} = e1var
664              val IR.V{varType=vt2, ...} = e2var
665             in
666              (case (vt1, vt2)
667                of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("divVar", IR.T_FLOAT, IR.DIV, [e1var, e2var], fn var => k var state'')
668                 | _ => raise Fail (String.concat["Type mismatch to DIV expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
669              (* end case *))
670             end))
671    
672           | P.NEG e =>
673             trExpr(e, env, state, fn evar => fn state' =>
674             let
675              val IR.V{varType, ...} = evar
676             in
677              (case varType
678                of IR.T_FLOAT => letPRIM("negVar", IR.T_FLOAT, IR.MULT, [evar, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn var => k var state')
679                 | IR.T_VEC => letPRIM("negVar", IR.T_VEC, IR.NEG_VEC, [evar], fn var => k var state')
680                 | _ => raise Fail ("Type mismatch to NEG expression")
681              (* end case *))
682             end)
683    
684           | P.DOT (e1, e2) =>
685             trExpr(e1, env, state, fn e1var => fn state' =>
686             trExpr(e2, env, state', fn e2var => fn state'' =>
687             let
688              val IR.V{varType=vt1, ...} = e1var
689              val IR.V{varType=vt2, ...} = e2var
690             in
691              (case (vt1, vt2)
692                of (IR.T_VEC, IR.T_VEC) => letPRIM("dotVar", IR.T_FLOAT, IR.DOT, [e1var, e2var], fn var => k var state'')
693                 | _ => raise Fail ("Type mismatch to DOT expression")
694              (* end case *))
695             end))
696    
697           | P.CROSS (e1, e2) =>
698             trExpr(e1, env, state, fn e1var => fn state' =>
699             trExpr(e2, env, state', fn e2var => fn state'' =>
700             let
701              val IR.V{varType=vt1, ...} = e1var
702              val IR.V{varType=vt2, ...} = e2var
703             in
704              (case (vt1, vt2)
705                of (IR.T_VEC, IR.T_VEC) => letPRIM("crossVar", IR.T_VEC, IR.CROSS, [e1var, e2var], fn var => k var state'')
706                 | _ => raise Fail ("Type mismatch to CROSS expression")
707              (* end case *))
708             end))
709    
710           | P.NORMALIZE e =>
711             trExpr(e, env, state, fn evar => fn state' =>
712             let
713              val IR.V{varType, ...} = evar
714             in
715              (case varType
716                of IR.T_VEC => letPRIM("normVar", IR.T_VEC, IR.NORM, [evar], fn var => k var state')
717                 | _ => raise Fail ("Type mismatch to NORMALIZE expression")
718              (* end case *))
719             end)
720    
721           | P.LENGTH e =>
722             trExpr(e, env, state, fn evar => fn state' =>
723             let
724              val IR.V{varType, ...} = evar
725             in
726              (case varType
727                of IR.T_VEC => letPRIM("lenVar", IR.T_FLOAT, IR.LEN, [evar], fn var => k var state')
728                 | _ => raise Fail ("Type mismatch to LENGTH expression")
729              (* end case *))
730             end)
731    
732           (* !SPEED! We're assuming that there is an intersection here... *)
733           | P.INTERSECT {p1, p2, d} =>
734             trExpr(p1, env, state, fn p1var => fn state' =>
735             trExpr(p2, env, state', fn p2var => fn state'' =>
736             let
737              val IR.V{varType=vt1, ...} = p1var
738              val IR.V{varType=vt2, ...} = p2var
739             in
740              (case (vt1, vt2)
741                of (IR.T_VEC, IR.T_VEC) => mkIntPt(env, p1var, p2var, d, fn var => k var state'')
742                 | _ => raise Fail("Type mismatch to INTERSECT expression")
743              (* end case *))
744             end))
745    
746           | P.NORMALTO (e, d) =>
747             trExpr(e, env, state, fn evar => fn state' =>
748             let
749              val IR.V{varType, ...} = evar
750              fun cont s = k s
751             in
752              (case varType
753                of IR.T_VEC => normAtPoint("normVar", d, env, evar, state', k)
754                 | _ => raise Fail("Type mismatch to NORMALTO expression")
755              (* end case *))
756             end)
757    
758           | P.LOOKUP (varName) => let
759             fun findVar (IR.V{name, ...}) = name = varName
760            in
761             (case (List.find findVar state)
762               of SOME v => k v state
763                | NONE => raise Fail("Compiler Error: Undefined variable: " ^ varName)
764           (* end case *))           (* end case *))
765          end          end
766    
767          fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let            (* end case expr *))
768    
769              (* generate code to produce a random particle state from a domain *)
770        fun newParticle (sv_gens, env, state, k : particle_state -> IR.stmt) = let
771    
772          fun createVar(P.GEN{var, ...}) = let
773            val P.PSV.SV{name, ty, ...} = var
774           in
775            IR.newLocal("ps_" ^ name, IR.psvTyToIRTy ty, (IR.RAND, []))
776           end
777    
778          val newState = List.map createVar sv_gens
779    
780          fun genVar((sv_gen, var), cont) = let
781            val P.GEN{exp, ...} = sv_gen
782            val IR.V{varType, ...} = var
783           in
784            (* This is kind of a hack, but it'll get optimized out.
785             * Also, I think it's OK to leave the state' unused since we're
786             * creating variables here and its assumed that they're independent. *)
787            trExpr(exp, env, state, fn newVal => fn state' => IR.mkPRIM(var, IR.COPY, [newVal], cont))
788           end (* genVar *)
789    
790         in
791          List.foldr (fn (x, y) => genVar(x, y)) (k newState) (ListPair.zipEq (sv_gens, newState))
792         end (* new particle *)
793    
794            val PS{isDead, ...} = state      fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let
795            val P.EMIT{maxNum, posDomain, velDomain, colDomain, ...} = emit        val P.EMIT{freq, sv_gens} = emit
796            val blk = newBlock (env, k)        val blk = newBlock (env, state, k)
797          val ttl = findIRVarByName(state, "ttl")
798           in           in
799          letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>
800        IR.mkIF(isDead,        IR.mkIF(isDead,
801         (* then *)         (* then *)
802         letPRIM("t1", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, maxNum)], fn t1 =>         trExpr(freq, env, state, fn t1 => fn state' =>
803         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 =>
804         letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>         letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
805         letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>         letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
806         letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>         letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
807         IR.mkIF(t3,         IR.mkIF(t3,
808          (* then *)          (* then *)
809          newParticle (posDomain, velDomain, colDomain, env,          newParticle (sv_gens, env, state', fn state'' => retState state''),
          fn state' => retState state'),  
810          (* else *)          (* else *)
811          IR.DISCARD)))))),          IR.DISCARD)))))),
812         (* else *)         (* else *)
813         retState state)         retState state))
814       end       end
815    
816          fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let      (* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)
817            val PS{pos, vel, ...} = state      (* mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) *)
818            val P.PR{ifstmt, ...} = pred      fun trPred(cond, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
819           in        fun grabVar(cond, env, state, k : IR.var -> particle_state -> IR.stmt) = (case cond
820            case ifstmt          of P.WITHINF(d, expr) =>
821             of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>              trExpr(expr, env, state, fn checkMe => fn state' =>
822              IR.mkIF(withinVar, thenk(state), elsek(state)))              mkFloatWithinVar("wv", env, checkMe, d, fn var => k var state'))
823              | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>  
824              IR.mkIF(withinVar, thenk(state), elsek(state)))           | P.WITHIN3F(d, expr) =>
825           end              trExpr(expr, env, state, fn checkMe => fn state' =>
826                mkVecWithinVar("wv", env, checkMe, d, fn var => k var state'))
827    
828             | P.DO_INTERSECT {p1, p2, d} =>
829               trExpr(p1, env, state, fn p1var => fn state' =>
830               trExpr(p2, env, state', fn p2var => fn state'' =>
831               mkIntBool(env, p1var, p2var, d, state'', k)))
832    
833             | P.GTHAN (e1, e2) =>
834               trExpr(e1, env, state, fn e1var => fn state' =>
835               trExpr(e2, env, state', fn e2var => fn state'' =>
836               letPRIM("gtVar", IR.T_BOOL, IR.GT, [e1var, e2var], fn var => k var state'')))
837    
838             | P.AND(c1, c2) =>
839               grabVar(c1, env, state, fn c1Var => fn state' =>
840               grabVar(c2, env, state', fn c2Var => fn state'' =>
841               letPRIM("andVar", IR.T_BOOL, IR.AND, [c1Var, c2Var], fn var => k var state'')))
842    
843             | P.OR(c1, c2) =>
844               grabVar(c1, env, state, fn c1Var => fn state' =>
845               grabVar(c2, env, state', fn c2Var => fn state'' =>
846               letPRIM("andVar", IR.T_BOOL, IR.OR, [c1Var, c2Var], fn var => k var state'')))
847    
848             | P.XOR(c1, c2) =>
849               grabVar(c1, env, state, fn c1Var => fn state' =>
850               grabVar(c2, env, state', fn c2Var => fn state'' =>
851               mkXOR ("xorVar", c1Var, c2Var, fn var => k var state'')))
852    
853             | P.NOT(c) =>
854               grabVar(c, env, state, fn cvar => fn state' =>
855               letPRIM("notVar", IR.T_BOOL, IR.NOT, [cvar], fn var => k var state'))
856    
857      fun trAct (action, env, state, k : particle_state -> IR.stmt) = let          (* end case *))
           val PS{pos, vel, size, isDead, color, pos2, dummy} = state  
           in  
             case action  
              of P.BOUNCE{friction, resilience, cutoff, d} => let  
                   val blk = newBlock (env, k)  
                   val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)  
                   in  
                     letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn velScale =>  
                     letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>  
                     mkWithinVar("wnp", env, pos, d, fn withinNextPos =>  
                     IR.mkIF(withinNextPos,  
                       (*then*)  
                         normAtPoint("n", d, env, state, fn normAtD => fn state' => let  
                val PS{pos=nextPos, vel=nextVel, size=nextSize, isDead=nextIsDead, color=nextColor, pos2=nextPos2, dummy=nextDummy} = state'  
858                            in                            in
859                             letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>        grabVar(cond, env, state, fn result => fn state' =>
860                             letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>        IR.mkIF(result, thenk(state'), elsek(state')))
                            letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>  
                            letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>  
   
                            letPRIM("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>  
                            letPRIM("cosq", IR.T_FLOAT, IR.MULT, [psvToIRVar(env, cutoff), psvToIRVar(env, cutoff)], fn cutoffSq =>  
                            letPRIM("inco", IR.T_BOOL, IR.GT, [tangLenSq, cutoffSq], fn inCutoff =>  
   
                            letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>  
   
                            IR.mkIF(inCutoff,  
                              (*then*)  
                              letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>  
                              letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>  
                              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, pos2=nextPos2, dummy=nextDummy}, 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, pos2=nextPos2, dummy=nextDummy}, blk)  
                              ))  
                          )))))))))  
                          end  
                       ),  
                       (*else*)  
                       goto(state, blk)))))  
861                    end                    end
862    
863                | P.GRAVITY(dir) =>      fun compile (P.PG{
864                      letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), psvToIRVar(env, dir)], fn theScale =>         emit as P.EMIT{freq, sv_gens}, act, render,
865                      letPRIM("nextVel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>         vars, state_vars, render_vars
866                        k(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color, pos2=pos2, dummy=dummy})))      }) = let
867          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, pos2=pos2, dummy=dummy})))  
               (*  
               | 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})  
                         ))))  
               *)  
868    
869                | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let        fun printVar (PSV.V{name, id, ...}) =
870                    val blk = newBlock (env, k)          printErr (String.concat[name, ": ", Int.toString id])
                 in  
                 letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, endp2), psvToIRVar(env, endp1)], fn subVec =>  
                 letPRIM("vecToEndP", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, endp1)], fn vecToEndP =>  
                 letPRIM("basis", IR.T_VEC, IR.NORM, [subVec], fn basis =>  
                 letPRIM("parDot", IR.T_FLOAT, IR.DOT, [basis, vecToEndP], fn parDot =>  
                 letPRIM("parVec", IR.T_VEC, IR.SCALE, [parDot, basis], fn parVec =>  
                 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, pos2=pos2, dummy=dummy}, blk)  
                   )))))))  
                 )))))))))))  
                 end  
871    
872                (* just kill it. *)        val demand = IR.getDemand(render)
873                (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, isDead = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)        fun getIRNameForSV (v as PSV.SV{name, ...}) =
874                | P.DIE => IR.DISCARD         (case (PSV.SVMap.find (render_vars, v))
875                | _ => raise Fail("Action not implemented...")           of SOME na => let
876              (* end case *)             fun inDemand n = List.exists (fn x => #1 x = "ps_" ^ n) demand
877              in
878               (* Sanity check *)
879               if not (inDemand na) then
880                 raise Fail (String.concat["Variable with name ", name," marked for rendering but not in demand."])
881               else
882                 "ps_" ^ na
883            end            end
884              | NONE => "ps_" ^ name
885           (* end case *))
886    
887      fun compile (P.PG{        fun convertToIR (v as PSV.SV{ty, ...}) = IR.newParam(getIRNameForSV v, IR.psvTyToIRTy ty)
        emit as P.EMIT{maxNum, vars=emitVars, ...},  
        act as P.PSAE{action=root_act, vars=actionVars},  
        render  
     }) = let  
           val blks = ref[]  
888            val env = let            val env = let
889                (* add special globals to free vars *)                (* add special globals to free vars *)
890                  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)
891                  fun ins (x as PSV.V{name, ty, binding, id, ...}, map) = let          fun insv (x as PSV.V{name, ty, binding, id, ...}, map) = let
892                        val x' = (case (ty, !binding)                        val x' = (case (ty, !binding)
893                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
894                                | (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 551  Line 898 
898                                | (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))
899                                | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)                                | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
900                                | (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))
901                                | _ => 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.")
902                              (* end case *))                              (* end case *))
903                        in                        in
904                          PSV.Map.insert (map, x, x')                          PSV.Map.insert (map, x, x')
905                       end (* ins *)
906                    in
907                     TE( blks, PSV.Set.foldl insv PSV.Map.empty pgm_vars )
908                    end (* env *)
909    
910          fun evalActs theAct state f = (case theAct
911                  of P.SEQ(acts) => (case acts
912                    of [] => f state
913                     | oneAct :: rest => evalActs oneAct state (fn state' => (evalActs (P.SEQ(rest)) state' f))
914                    (* end case *))
915    
916                   | P.PRED(cond, thenAct, elseAct) => let
917                       val joinBlk = newBlock (env, state, fn state' => f state')
918                       fun joinActs state = IR.mkGOTO(joinBlk, state)
919                      in
920                       trPred(cond, env, state,
921                         fn state' => evalActs thenAct state' joinActs,
922                         fn state' => evalActs elseAct state' joinActs
923                       )
924                        end                        end
925    
926                   | P.DIE => IR.DISCARD
927    
928                   | P.ASSIGN(sv, expr) => let
929                     val PSV.SV{ty, ...} = sv
930                     fun replaceStateVar (var, []) = [var]
931                       | replaceStateVar (var, nv :: svars) = let
932                         val IR.V{name=nvname, ...} = nv
933                         val IR.V{name=varname, ...} = var
934                  in                  in
935                    TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)                       if nvname = varname then
936                           var :: svars
937                         else
938                           nv :: replaceStateVar(var, svars)
939                        end
940                    in
941                     trExpr(expr, env, state, fn newVar => fn state' =>
942                     letPRIM(getIRNameForSV sv, IR.psvTyToIRTy ty, IR.COPY, [newVar],
943                       fn thisVar => f (replaceStateVar(thisVar, state'))))
944                  end                  end
945    
946                   | P.LET(P.V(varName), exp, act) =>
947                     trExpr(exp, env, state, fn newVar => fn state' => let
948    
949            fun evalActs f [] state = f [] state                     val joinBlk = newBlock(env, state', f)
950              | evalActs f (psa :: psal) state = (case psa  
951                of P.SEQ(acts) => (case acts                     fun inOriginalState (IR.V{name=vn, ...}) = let
952                   of [] => raise Fail "Should never reach here."                       fun nameCompare (IR.V{name=vn1, ...}) = vn = vn1
                   | [act] => trAct(act, env, state, evalActs f psal)  
                   | act :: rest => trAct(act, env, state, evalActs f (P.SEQ(rest) :: psal))  
                 (* end case *))  
                | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) => let  
                    val cblk = newBlock(env, evalActs f psal)  
                    fun trPredActs [] state' = goto(state', cblk)  
                      | trPredActs _ _ = raise Fail "Should never reach here."  
953                    in                    in
954                     trPred(pred, env, state, evalActs trPredActs t, evalActs trPredActs e)                       List.exists nameCompare state'
955                    end                    end
               (* end case *))  
956    
957            (* At the highest level, we want to return when we reach the end of the action list *)                     fun gotoJoinBlk state'' = goto(List.filter inOriginalState state'', joinBlk)
958            fun trActs [] state = let  
959                  val PS{pos, vel, size, isDead, color, pos2, dummy} = state                     val IR.V{varType, ...} = newVar
960                       val newParam = IR.newParam(varName, varType)
961                       val newState = newParam :: state'
962    
963                       val blk = newBlock(env, newState, fn state'' => evalActs act state'' gotoJoinBlk)
964                  in                  in
965                    IR.mkRETURN[ pos, vel, size, isDead, color, pos2, dummy ]                     goto(newVar :: state', blk)
966                  end (* trActs *)                    end
967              | trActs _ _ = raise Fail "Should never reach here"                   )
968    
969                  (* end case *))
970    
971            (* The entry block is the first block of the program, or in other words, the emitter. *)            (* The entry block is the first block of the program, or in other words, the emitter. *)
972            val entryBlock = newBlock (            val entryBlock = newBlock (
973              env,              env,
974                List.map convertToIR (PSV.SVSet.listItems state_vars),
975              fn pstate => trEmitter(              fn pstate => trEmitter(
976                emit,                emit,
977                env,                env,
978                pstate,                pstate,
979                fn state => evalActs trActs root_act state                fn state => evalActs act state retState
980              )              )
981            )            )
982    
983            (* The entry block is the emitter, and the rest of the blocks define the physics processing. *)            (* The entry block is the emitter, and the rest of the blocks define the physics processing. *)
984    
985          fun isGlobal(IR.V{scope, ...}) = (case scope
986            of IR.S_GLOBAL(v) => true
987             | _ => false
988            (* end case *))
989    
990          fun extractVarMap(TE(blks, map)) = map
991    
992            val outPgm = PSysIR.PGM {            val outPgm = PSysIR.PGM {
993                globals = PSV.Map.filter isGlobal (extractVarMap env),
994                persistents = demand,
995                uveOptimized = false,
996              emitter = entryBlock,              emitter = entryBlock,
997              physics = List.drop(!blks, 1),              physics = List.nth(!blks, 1),
998              render = render              render = render
999            }            }
1000    
1001            val optimized = if (Checker.checkIR(outPgm)) then Optimize.optimizeIR(outPgm) else outPgm            val _ = IR.outputPgm(TextIO.stdErr, outPgm)
1002              val optimized = if (Checker.checkIR(outPgm)) then (printErr "\nPre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
1003            in            in
1004              IR.outputPgm(TextIO.stdErr, outPgm);              (* Note: it only succeeds if we can optimize, too *)
1005              if Checker.checkIR(optimized) then          if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();
1006               printErr "Compilation succeeded." (* Note: it only succeeds if we can optimize, too *)  
             else  
              ();  
             IR.outputPgm(TextIO.stdErr, optimized);  
1007              optimized              optimized
1008            end (* compile *)            end (* compile *)
1009    

Legend:
Removed from v.901  
changed lines
  Added in v.1146

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