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 873, Wed May 5 20:18:00 2010 UTC revision 1120, Wed Apr 13 05:25:17 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          dummy : IR.var        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  
           )  
   
   
     fun retState s = let  
       val PS{pos, vel, size, isDead, color, dummy} = s  
      in  
       IR.mkRETURN [pos, vel, size, isDead, color, 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 state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color, dummy=dummy}  
           val blk = IR.newBlock ([pos, vel, size, isDead, color, 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 state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color, dummy = dummy}  
           val blk = IR.newBlock ([pos, vel, size, isDead, color, 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, dummy}, blk) =          fun newBlock (env, state, k) = newBlockWithArgs(env, state, [], k)
           IR.mkGOTO(blk, [pos, vel, size, isDead, color, dummy])  
75    
76          fun gotoWithArgs(PS{pos, vel, size, isDead, color, dummy}, args, blk) =      fun gotoWithArgs(state, args, blk) = IR.mkGOTO(blk, state @ args)
77            IR.mkGOTO(blk, [pos, vel, size, isDead, color, 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 108  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 125  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 197  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 238  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 246  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 255  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 291  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 302  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 320  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,               letPRIM("p2ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p2var], fn p2ToPt =>
488                     vel = newVel,               letPRIM("p1ToP2", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn p1ToP2 =>
489                     size = newSize,  
490                     isDead = newIsDead,               (* Get distances *)
491                     color = newCol,               letPRIM("p1ToPtLen", IR.T_FLOAT, IR.LEN, [p1ToPt], fn p1ToPtLen =>
492                     dummy = IR.newConst("dmy", IR.C_FLOAT 0.01)})               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 379  Line 544 
544                     )                     )
545                   )                   )
546    
547             | P.D_SPHERE{center, irad, orad} => let             | P.D_SPHERE{center, irad, orad} =>
               val PS{pos, ...} = 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 trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let          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            val PS{isDead, ...} = state         | P.GENERATE3F (dom, dist) => genVecVar("genVec", env, dom, dist, k)
566            val P.EMIT{maxNum, posDomain, velDomain, colDomain, ...} = emit  
567            val blk = newBlock (env, k)         | 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           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
722          val P.EMIT{freq, sv_gens} = emit
723          val blk = newBlock (env, state, k)
724          val ttl = findIRVarByName(state, "ttl")
725         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' => retState state'),  
737          (* else *)          (* else *)
738          IR.DISCARD)))))),          IR.DISCARD)))))),
739         (* else *)         (* else *)
740         retState state)         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, ...} = state  
746            val P.PR{ifstmt, ...} = pred            val P.PR{ifstmt, ...} = pred
747           in           in
748            case ifstmt            case ifstmt
# Line 424  Line 751 
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, thenk(state), elsek(state)))              IR.mkIF(withinVar, thenk(state), elsek(state)))
753           end           end
754    //
755      fun trAct (action, env, state, k : particle_state -> IR.stmt) = let  //    fun trAct (action, env, state, k : particle_state -> IR.stmt) = let/
756            val PS{pos, vel, size, isDead, color, dummy} = state  //        val PS{pos, vel, size, ttl, color, user} = state
757            in  //        in
758              case action  //          case action
759               of P.BOUNCE{friction, resilience, cutoff, d} => let  //           of P.BOUNCE{friction, resilience, cutoff, d} => let
760                    val blk = newBlock (env, k)  //                val blk = newBlock (env, user, k)
761                    val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)  //                val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)
762                    in  //                in
763                      letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn velScale =>  //                  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 =>  //                  letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
765                      mkWithinVar("wnp", env, pos, d, fn withinNextPos =>  //                  mkWithinVar("wcp", env, pos, d, fn withinCurPos =>
766                      IR.mkIF(withinNextPos,  //                  mkWithinVar("wnp", env, nextPos, d, fn withinNextPos =>
767                        (*then*)  //                  letPRIM("nwcp", IR.T_BOOL, IR.NOT, [withinCurPos], fn notWithinCurPos =>
768                          normAtPoint("n", d, env, state, fn normAtD => fn state' => let  //                  letPRIM("sb", IR.T_BOOL, IR.AND, [notWithinCurPos, withinNextPos], fn shouldBounce =>
769                 val PS{pos=nextPos, vel=nextVel, size=nextSize, isDead=nextIsDead, color=nextColor, dummy=nextDummy} = state'  //                  IR.mkIF(shouldBounce,
770                            in  //                    (*then*)
771                             letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>  //                      normAtPoint("n", d, env, state, fn normAtD => fn state' => let
772                             letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>  //               val PS{pos=nextPos, vel=nextVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser} = state'
773                             letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>  //                        in
774                             letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>  //                         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("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>  //                         letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>
777                             letPRIM("cosq", IR.T_FLOAT, IR.MULT, [psvToIRVar(env, cutoff), psvToIRVar(env, cutoff)], fn cutoffSq =>  //                         letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>
778                             letPRIM("inco", IR.T_BOOL, IR.GT, [tangLenSq, cutoffSq], fn inCutoff =>  //
779    //                         letPRIM("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>
780                             letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>  //                         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                             IR.mkIF(inCutoff,  //
783                               (*then*)  //                         letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>
784                               letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>  //
785                               letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>  //                         IR.mkIF(inCutoff,
786                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>  //                           (*then*)
787                               letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>  //                           letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>
788                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor, dummy=nextDummy}, blk)  //                           letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>
789                              )))),  //                           letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>
790                               (*else*)  //                           letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
791                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>  //                            goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)
792                               letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>  //                          )))),
793                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor, dummy=nextDummy}, blk)  //                           (*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                           end  //                            goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)
797                        ),  //                           ))
798                        (*else*)  //                       )))))))))
799                        goto(state, blk)))))  //                       end
800                    end  //                    ),
801    //                    (*else*)
802                | P.GRAVITY(dir) =>  //                    goto(state, blk))))))))
803                      letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), psvToIRVar(env, dir)], fn theScale =>  //                end
804                      letPRIM("nextVel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>  //
805                        k(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color, dummy=dummy})))  //            | P.ACCEL dir =>
806    //                  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), psvToIRVar(env, dir)], fn theScale =>
807                | P.MOVE =>  //                  letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>
808                  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn theScale =>  //                    k(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user = user})))
809                      letPRIM("nextPos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>  //
810                        k(PS{pos = newPos, vel = vel, size = size, isDead = isDead, color = color, dummy=dummy})))  //            | P.MOVE =>
811                (*  //              letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn theScale =>
812                | P.SINK({d, kill_inside}) =>  //                  letPRIM("ps_pos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
813                      mkWithinVar("isWithin", env, state, d, fn withinVal =>  //                    k(PS{pos = newPos, vel = vel, size = size, ttl = ttl, color = color, user = user})))
814                      mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),  //
815                        fn shouldNotKill =>  //            | P.ORBITPOINT {center, mag, maxRad} => let
816                      letPRIM("shouldKill", IR.T_BOOL, IR.NOT, [shouldNotKill], fn shouldKill =>  //                val blk = newBlock (env, user, k)
817                      letPRIM("isReallyDead", IR.T_BOOL, IR.OR, [shouldKill, isDead], fn isReallyDead =>  //               in
818                      k(PS{pos = pos, vel = vel, size = size, isDead = isReallyDead, color = color})  //                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                | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let      (* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)
874                    val blk = newBlock (env, k)      (* 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                  letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, endp2), psvToIRVar(env, endp1)], fn subVec =>        fun grabVar(cond, env, state, k : IR.var -> IR.stmt) = (case cond
877                  letPRIM("vecToEndP", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, endp1)], fn vecToEndP =>          of P.WITHINF(d, expr) =>
878                  letPRIM("basis", IR.T_VEC, IR.NORM, [subVec], fn basis =>              trExpr(expr, env, state, fn checkMe =>
879                  letPRIM("parDot", IR.T_FLOAT, IR.DOT, [basis, vecToEndP], fn parDot =>              mkFloatWithinVar("wv", env, checkMe, d, k))
880                  letPRIM("parVec", IR.T_VEC, IR.SCALE, [parDot, basis], fn parVec =>  
881                  letPRIM("closestP", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, endp1), parVec], fn closestP =>           | P.WITHIN3F(d, expr) =>
882                  letPRIM("vecToP", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn vecToP =>              trExpr(expr, env, state, fn checkMe =>
883                  letPRIM("distToP", IR.T_FLOAT, IR.LEN, [vecToP], fn distToP =>              mkVecWithinVar("wv", env, checkMe, d, k))
884                  letPRIM("effRad", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, maxRad), distToP], fn effRad =>  
885                  letPRIM("radInDist", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), effRad], fn radInDist =>           | P.DO_INTERSECT {p1, p2, d} =>
886                  IR.mkIF(radInDist,             trExpr(p1, env, state, fn p1var =>
887                    (*then*)             trExpr(p2, env, state, fn p2var =>
888                    goto(state, blk),             mkIntBool(env, p1var, p2var, d, k)))
889                    (*else*)  
890                    letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>           | P.GTHAN (e1, e2) =>
891                    letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>             trExpr(e1, env, state, fn e1var =>
892                    letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>             trExpr(e2, env, state, fn e2var =>
893                    letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, timeStep)], fn totMag =>             letPRIM("gtVar", IR.T_BOOL, IR.GT, [e1var, e2var], k)))
894                    letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>  
895                    letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>           | P.BOOLVAR (b) => k (psvToIRVar(env, b))
896                    letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>  
897                    goto(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color, dummy=dummy}, blk)           | P.AND(c1, c2) =>
898                    )))))))             grabVar(c1, env, state, fn c1Var =>
899                  )))))))))))             grabVar(c2, env, state, fn c2Var =>
900                  end             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                (* just kill it. *)          (* end case *))
917                (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, isDead = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)       in
918                | P.DIE => IR.DISCARD        grabVar(cond, env, state, fn result =>
919                | _ => raise Fail("Action not implemented...")        IR.mkIF(result, thenk(state), elsek(state)))
             (* end case *)  
920            end            end
921    
922      fun compile (P.PG{      fun compile (P.PG{
923         emit as P.EMIT{maxNum, vars=emitVars, ...},         emit as P.EMIT{freq, sv_gens}, act, render,
924         act as P.PSAE{action=root_act, vars=actionVars},         vars, state_vars, render_vars
        render  
925      }) = let      }) = let
926            val blks = ref[]            val blks = ref[]
927          fun convertToIR (PSV.SV{name, ty, id, ...}) = IR.newParam("ps_" ^ name, IR.psvTyToIRTy ty)
928            val env = let            val env = let
929                (* add special globals to free vars *)                (* add special globals to free vars *)
930                  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)
931                  fun ins (x as PSV.V{name, ty, binding, id, ...}, map) = let          fun insv (x as PSV.V{name, ty, binding, id, ...}, map) = let
932                        val x' = (case (ty, !binding)                        val x' = (case (ty, !binding)
933                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
934                                | (PSV.T_BOOL,  PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))                                | (PSV.T_BOOL,  PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))
# Line 547  Line 938 
938                                | (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))
939                                | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)                                | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
940                                | (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))                                | (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))
941                                | _ => 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.")
942                              (* end case *))                              (* end case *))
943                        in                        in
944                          PSV.Map.insert (map, x, x')                          PSV.Map.insert (map, x, x')
945                       end (* ins *)
946                    in
947                      TE( blks, PSV.Set.foldl insv PSV.Map.empty pgm_vars )
948                    end (* env *)
949    
950          fun evalActs theAct state f = (case theAct
951                  of P.SEQ(acts) => (case acts
952                    of [] => f state
953                     | oneAct :: rest => evalActs oneAct state (fn state' => (evalActs (P.SEQ(rest)) state' f))
954                    (* end case *))
955    
956                   | P.PRED(cond, thenAct, elseAct) =>
957                     trPred(cond, env, state,
958                       fn state' => evalActs thenAct state' f,
959                       fn state' => evalActs elseAct state' f
960                     )
961    
962                   | P.DIE => IR.DISCARD
963    
964                   | P.ASSIGN(sv, expr) => let
965                     val PSV.SV{name, ty, ...} = sv
966                     fun replaceStateVar (var, []) = [var]
967                       | replaceStateVar (var, nv :: svars) = let
968                         val IR.V{name=nvname, ...} = nv
969                         val IR.V{name=varname, ...} = var
970                        in
971                         if nvname = varname then
972                           var :: svars
973                         else
974                           nv :: replaceStateVar(var, svars)
975                        end                        end
976                  in                  in
977                    TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)                   trExpr(expr, env, state, fn newVar =>
978                     letPRIM("ps_" ^ name, IR.psvTyToIRTy ty, IR.COPY, [newVar],
979                       fn thisVar => f (replaceStateVar(thisVar, state))))
980                  end                  end
981    
982                  (* end case *))
983            fun evalActs f [] state = f [] state  (*
984              | evalActs f (psa :: psal) state = (case psa                (case acts
               of P.SEQ(acts) => (case acts  
985                   of [] => raise Fail "Should never reach here."                   of [] => raise Fail "Should never reach here."
986                    | [act] => trAct(act, env, state, evalActs f psal)                    | [act] => trAct(act, env, state, evalActs f psal)
987                    | act :: rest => trAct(act, env, state, evalActs f (P.SEQ(rest) :: psal))                    | act :: rest => trAct(act, env, state, evalActs f (P.SEQ(rest) :: psal))
988                  (* end case *))                  (* end case *))
989                 | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) => let                 | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) => let
990                     val cblk = newBlock(env, evalActs f psal)                  val cblk = newBlock(env, userVarsFromState(state), evalActs f psal)
991                     fun trPredActs [] state' = goto(state', cblk)                     fun trPredActs [] state' = goto(state', cblk)
992                       | trPredActs _ _ = raise Fail "Should never reach here."                       | trPredActs _ _ = raise Fail "Should never reach here."
993                    in                    in
994                     trPred(pred, env, state, evalActs trPredActs t, evalActs trPredActs e)                     trPred(pred, env, state, evalActs trPredActs t, evalActs trPredActs e)
995                    end                    end
996                (* end case *))                (* end case *))
997    *)
           (* At the highest level, we want to return when we reach the end of the action list *)  
           fun trActs [] state = let  
                 val PS{pos, vel, size, isDead, color, dummy} = state  
                 in  
                   IR.mkRETURN[ pos, vel, size, isDead, color, dummy ]  
                 end (* trActs *)  
             | trActs _ _ = raise Fail "Should never reach here"  
998    
999            (* 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. *)
1000            val entryBlock = newBlock (            val entryBlock = newBlock (
1001              env,              env,
1002                List.map convertToIR (PSV.SVSet.listItems state_vars),
1003              fn pstate => trEmitter(              fn pstate => trEmitter(
1004                emit,                emit,
1005                env,                env,
1006                pstate,                pstate,
1007                fn state => evalActs trActs root_act state                fn state => evalActs act state retState
1008              )              )
1009            )            )
1010    
1011            (* 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. *)
1012    
1013          fun isGlobal(IR.V{scope, ...}) = (case scope
1014            of IR.S_GLOBAL(v) => true
1015             | _ => false
1016            (* end case *))
1017    
1018          fun extractVarMap(TE(blks, map)) = map
1019    
1020            val outPgm = PSysIR.PGM {            val outPgm = PSysIR.PGM {
1021                globals = PSV.Map.filter isGlobal (extractVarMap env),
1022                persistents = [],
1023                uveOptimized = false,
1024              emitter = entryBlock,              emitter = entryBlock,
1025              physics = List.drop(!blks, 1),              physics = List.nth(!blks, 1),
1026              render = render              render = render
1027            }            }
1028    
1029            val optimized = if (Checker.checkIR(outPgm)) then Optimize.optimizeIR(outPgm) else outPgm            val optimized = if (Checker.checkIR(outPgm)) then (printErr "Pre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
1030    
1031            in            in
1032              IR.outputPgm(TextIO.stdErr, outPgm);              (* IR.outputPgm(TextIO.stdErr, outPgm); *)
1033              if Checker.checkIR(optimized) then  
1034               printErr "Compilation succeeded." (* Note: it only succeeds if we can optimize, too *)              (* Note: it only succeeds if we can optimize, too *)
1035              else          if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();
1036               ();  
             IR.outputPgm(TextIO.stdErr, optimized);  
1037              optimized              optimized
1038            end (* compile *)            end (* compile *)
1039    

Legend:
Removed from v.873  
changed lines
  Added in v.1120

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