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 1129, Mon Apr 25 18:55:18 2011 UTC revision 1158, Thu May 19 02:08:17 2011 UTC
# 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    
 (*  
     datatype particle_state = PS of {  
       pos : IR.var,             (* vec3 *)  
       vel : IR.var,             (* vec3 *)  
       size : IR.var,    (* float *)  
       ttl : IR.var,             (* float *)  
       color : IR.var,   (* vec3 (NOTE: should be vector4) *)  
       user : IR.var list  
     }  
 *)  
     type particle_state = IR.var list  
   
23    (* special PSV global variables *)    (* special PSV global variables *)
24      val epsilon = PSV.constf(0.00001)      val epsilon = PSV.constf(0.00001)
25    
26    (* constants *)    (* constants *)
27      val pi = 3.14159265358979      val pi = 3.14159265358979
28    
     fun retState s = IR.mkRETURN s  
   
29    (* translation environment *)    (* translation environment *)
30      datatype env = TE of (IR.block list ref * IR.var PSV.Map.map)      datatype ir_env = TE of (IR.block list ref * IR.var PSV.Map.map * IR.var PSV.SVMap.map)
31      fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))      fun insertVar (TE(blks, v_env, sv_env), x, x') = TE(blks, PSV.Map.insert (v_env, x, x'), sv_env)
32        fun insertSVar (TE(blks, v_env, sv_env), x, x') = (case (PSV.SVMap.find (sv_env, x))
33            of NONE => raise Fail("Changing mapping to state var that doesn't exist.")
34             | SOME var => (
35               IR.setRenderVar(x', IR.isRenderVar var);
36               TE(blks, v_env, PSV.SVMap.insert (sv_env, x, x'))
37             )
38          (* end case *))
39    
40        fun retState (TE(_, _, sv_env)) = IR.mkRETURN (PSV.SVMap.listItems sv_env)
41    
42    (* Interaction with environment and state variables *)    (* Interaction with environment and psys variables *)
43      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)
44             of SOME x' => x'             of SOME x' => x'
45              | 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])
46              (* end case *))              (* end case *))
47    
48          fun findIRVarByName (state, name) = let      fun pssvToIRVar (TE(_, _, env), x as PSV.SV{name, id, ...}) = (case PSV.SVMap.find(env, x)
49            fun eq (var as IR.V{name=st_name, ...}) = st_name = ("ps_" ^ name)             of SOME x' => x'
50           in              | NONE => raise Fail (String.concat["unknown state variable ", name, " with ID ", Int.toString id])
           (case (List.find eq state)  
             of SOME sv => sv  
              | NONE => raise Fail ("Could not find var mapping.")  
51            (* end case *))            (* end case *))
          end  
   
         fun getIRVarForSV (v as PSV.SV{name, ...}, state) = findIRVarByName(state, name)  
52    
53     (* create a block that implements the given continuation *)     (* create a block that implements the given continuation *)
54      fun newBlockWithArgs (TE(blks, _), state , args, k : particle_state -> IR.stmt) = let      fun newBlockWithArgs (env as TE(blks, _, sv_env), args, k : ir_env -> IR.stmt) = let
55         fun copyVar(v as IR.V{name, varType, ...}) = IR.newParam(name, varType)         fun copyVar(v as IR.V{name, varType, ...}) = IR.newParam(name, varType)
56         val newState = List.map copyVar state         val newState = List.map copyVar (PSV.SVMap.listItems sv_env)
57             val blk = IR.newBlock (newState @ args, k newState)         fun inssv((oldv, newv), TE(theBlks, v_env, svenv)) = let
58             val theKey =
59               List.find
60                (fn v => IR.varEq(PSV.SVMap.lookup(svenv, v), oldv))
61                (PSV.SVMap.listKeys svenv)
62             val sv = (case theKey
63               of SOME x => x
64                | NONE => raise Fail("Trying to create new mapping for variable that doesn't already exist.")
65             (* end case *))
66            in
67             IR.setRenderVar(newv, IR.isRenderVar oldv);
68             TE(theBlks, v_env, PSV.SVMap.insert(svenv, sv, newv))
69            end
70    
71               val blk = IR.newBlock (
72                   newState @ args,
73                   k (List.foldl inssv env
74                       (ListPair.zipEq
75                           (PSV.SVMap.listItems sv_env, newState)
76                       )
77                   )
78                )
79            in            in
80             blks := blk :: !blks;             blks := blk :: !blks;
81             blk             blk
82            end            end
83    
84          fun newBlock (env, state, k) = newBlockWithArgs(env, state, [], k)          fun newBlock (env, k) = newBlockWithArgs(env, [], k)
   
     fun gotoWithArgs(state, args, blk) = IR.mkGOTO(blk, state @ args)  
     fun goto (state, blk) = gotoWithArgs(state, [], blk)  
85    
86      fun letPRIM (x, ty, p, args, body) = let      fun letPRIM (x, ty, p, args, body) = let
87            val x' = IR.newLocal(x, ty, (p, args))            val x' = IR.newLocal(x, ty, (p, args))
# Line 82  Line 89 
89              IR.mkPRIM(x', p, args, body x')              IR.mkPRIM(x', p, args, body x')
90            end            end
91    
92       fun gotoWithArgs(TE(_, _, env), args, blk) = let
93    
94         fun copyVar(v as IR.V{name, varType, ...}) = IR.newLocal(name^"_copy", varType, (IR.RAND, []))
95    
96         fun copyRenderVar (oldv, newv) = IR.setRenderVar (newv, IR.isRenderVar oldv)
97    
98         val vars = ((PSV.SVMap.listItems env) @ args)
99         val varCopies = List.map copyVar vars
100    
101         fun mkCopy(newv, oldv, k) = IR.mkPRIM(newv, IR.COPY, [oldv], k)
102        in
103         List.app copyRenderVar (ListPair.zipEq (vars, varCopies));
104         ListPair.foldr mkCopy (IR.mkGOTO(blk, varCopies)) (varCopies, vars)
105        end
106    
107       fun goto (env, blk) = gotoWithArgs(env, [], blk)
108    
109    
110    (* 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
111     * basically this creates the XOR'd value of var1 and var2 and     * basically this creates the XOR'd value of var1 and var2 and
112     * stores it in result.     * stores it in result. *)
    *)  
113      fun mkXOR (result, var1, var2, stmt : IR.var -> IR.stmt) =      fun mkXOR (result, var1, var2, stmt : IR.var -> IR.stmt) =
114            letPRIM("testOR", IR.T_BOOL, IR.OR, [var1, var2], fn testOR =>            letPRIM("testOR", IR.T_BOOL, IR.OR, [var1, var2], fn testOR =>
115            letPRIM("testAND", IR.T_BOOL, IR.AND, [var1, var2], fn testAND =>            letPRIM("testAND", IR.T_BOOL, IR.AND, [var1, var2], fn testAND =>
# Line 100  Line 124 
124           (* The PDF here is f(x) = 2x when 0 < x <= 1, so the CDF is going           (* The PDF here is f(x) = 2x when 0 < x <= 1, so the CDF is going
125            * to be the integral of f from 0 -> y => y^2. Hence, whenever we            * to be the integral of f from 0 -> y => y^2. Hence, whenever we
126            * generate a random number, in order to get the random value according            * generate a random number, in order to get the random value according
127            * to this probability distribution, we just square it.            * to this probability distribution, we just square it. *)
           *)  
128           | P.DIST_INC_LIN =>           | P.DIST_INC_LIN =>
129            letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>            letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
130            letPRIM(var, IR.T_FLOAT, IR.MULT, [randVal, randVal], stmt))            letPRIM(var, IR.T_FLOAT, IR.MULT, [randVal, randVal], stmt))
# Line 119  Line 142 
142            letPRIM(var, IR.T_FLOAT, IR.ADD, [termOne, termTwo], stmt)            letPRIM(var, IR.T_FLOAT, IR.ADD, [termOne, termTwo], stmt)
143            ))))            ))))
144    
145           | _ => raise Fail "Unable to create random float for specified distribution."           | _ => raise Fail "Unable to create random float for specified distribution"
146         (* end case *))         (* end case *))
147       in       in
148       (case domain       (case domain
# Line 133  Line 156 
156           letPRIM("scale", IR.T_FLOAT, IR.MULT, [diff, rand], fn scale =>           letPRIM("scale", IR.T_FLOAT, IR.MULT, [diff, rand], fn scale =>
157           letPRIM( fltVar, IR.T_FLOAT, IR.ADD, [psvToIRVar(env, max), scale], stmt )           letPRIM( fltVar, IR.T_FLOAT, IR.ADD, [psvToIRVar(env, max), scale], stmt )
158           )))           )))
159         | _ => raise Fail "Cannot generate float in specified domain."         | _ => raise Fail ("Cannot generate float in specified domain: " ^ (P.dToStr domain))
160       (* end case *))       (* end case *))
161      end      end
162    
# Line 150  Line 173 
173                  letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)                  letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)
174    
175              | P.D_LINE({pt1, pt2}) =>              | P.D_LINE({pt1, pt2}) =>
176    
177                (* Lerp between the points. *)                (* Lerp between the points. *)
178                  letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>                  letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
179                  letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>                  letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>
# Line 195  Line 219 
219    
220    
221              | P.D_TRIANGLE{pt1, pt2, pt3} =>              | P.D_TRIANGLE{pt1, pt2, pt3} =>
222    
223                  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 =>
224                  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 =>
225                  letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>                  letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>
# Line 216  Line 241 
241                    letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>                    letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>
242                    (* Generate a point in the lower disc. *)                    (* Generate a point in the lower disc. *)
243                      genVecVar("ptInDisc",                      genVecVar("ptInDisc",
244                        insert(env, normVar, norm),                        insertVar(env, normVar, norm),
245                        P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},                        P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
246                        dist,                        dist,
247                        fn ptInDisc =>                        fn ptInDisc =>
# Line 227  Line 252 
252                   end                   end
253    
254              | P.D_DISC {pt, normal, irad, orad} =>              | P.D_DISC {pt, normal, irad, orad} =>
255    
256                (* Get a random angle... *)                (* Get a random angle... *)
257                  letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>                  letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>
258                  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 =>
259    
260                (* Get a random radius *)                (* Get a random radius *)
261                  letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>                  letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>
262                  letPRIM ("e0sq", IR.T_FLOAT, IR.MULT, [newRand, newRand], fn randRadSq =>              letPRIM ("e0sq", IR.T_FLOAT, IR.SQRT, [newRand], fn randRadSq =>
263                  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 =>
264                  letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>                  letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>
265                  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 =>
266    
267                (* Find a vector in the plane of the disc, and then                (* Find a vector in the plane of the disc, and then
268                 * translate it to the center.               * translate it to the center. *)
                *)  
269                  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 =>
270                  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 =>
271                  letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>                  letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>
272                  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 =>
273                  letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>                  letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>
274    
275                (* Figure out x and y values for our new radius and angle *)                (* Figure out x and y values for our new radius and angle *)
276                  letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>                  letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>
277                  letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>                  letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>
# Line 252  Line 280 
280                  letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>                  letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>
281                  letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>                  letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>
282                  letPRIM ("res", IR.T_VEC, IR.ADD_VEC, [resVecOne, resVecTwo], fn result =>                  letPRIM ("res", IR.T_VEC, IR.ADD_VEC, [resVecOne, resVecTwo], fn result =>
                 letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt))))))))))))))))))))  
283    
284                letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt)
285                )))))))))))))))))))
286    
287            (* !FIXME! This isn't right. The values will be generated more towards
288             * the tip of the cone than the base. The scale needs to be adjusted based
289             * on the area of the base (although I don't know how). *)
290              | P.D_CONE{pt1, pt2, irad, orad} => let              | P.D_CONE{pt1, pt2, irad, orad} => let
291                  val normVar = PSV.new("local_ht", PSV.T_VEC3F)                  val normVar = PSV.new("local_ht", PSV.T_VEC3F)
292                  in                  in
# Line 261  Line 294 
294                    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 =>
295                    letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>                    letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>
296                      genVecVar("ptInDisc",                      genVecVar("ptInDisc",
297                        insert(env, normVar, norm),                insertVar(env, normVar, norm),
298                        P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},                        P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
299                        dist,                        dist,
300                        fn ptInDisc =>                        fn ptInDisc =>
# Line 269  Line 302 
302                      letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>                      letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>
303                      letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>                      letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>
304                      letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>                      letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>
305                      letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))               letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)
306                 ))))))))
307                  end                  end
308    
309                  | P.D_SPHERE{center, irad, orad} =>                  | P.D_SPHERE{center, irad, orad} =>
310    
311            (* generate two random angles... *)                    (* Source: http://mathworld.wolfram.com/SpherePointPicking.html *)
312            letPRIM("r1", IR.T_FLOAT, IR.RAND, [], fn randForAngOne =>  
313            letPRIM("t1", IR.T_FLOAT, IR.MULT, [randForAngOne, IR.newConst("fullCit", IR.C_FLOAT (2.0 * pi))], fn randAngOne =>            (* generate two random values... one will be called u and will
314            letPRIM("r2", IR.T_FLOAT, IR.RAND, [], fn randForAngTwo =>             * represent cos(theta), and the other will be called v and will
315            letPRIM("t2", IR.T_FLOAT, IR.MULT, [randForAngTwo, IR.newConst("fullCit", IR.C_FLOAT (2.0 * pi))], fn randAngTwo =>             * represent a random value in [0, 2 * pi] *)
316              letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn rv =>
317            (* Generate vector in the sphere ... *)            letPRIM("dblRandVal", IR.T_FLOAT, IR.MULT, [rv, IR.newConst("Two", IR.C_FLOAT 2.0)], fn drv =>
318            (* If my math is correct this should be            letPRIM("rand", IR.T_FLOAT, IR.SUB, [drv, IR.newConst("One", IR.C_FLOAT 1.0)], fn u =>
319             * <(cos t1)(cos t2), (sin t1)(cos t2), sin t2>  
320             * This is different from wikipedia's article on spherical coordinates            letPRIM("rv2", IR.T_FLOAT, IR.RAND, [], fn rv2 =>
321             * because of a phase shift, but for the generation of random numbers,            letPRIM("rand2", IR.T_FLOAT, IR.MULT, [rv2, IR.newConst("TwoPi", IR.C_FLOAT (2.0 * Float.M_PI))], fn theta =>
322             * it's irrelevant.  
323             *)            letPRIM("cosTheta", IR.T_FLOAT, IR.COS, [theta], fn cosT =>
324            letPRIM("cost1", IR.T_FLOAT, IR.COS, [randAngOne], fn cost1 =>            letPRIM("sinTheta", IR.T_FLOAT, IR.SIN, [theta], fn sinT =>
325            letPRIM("cost2", IR.T_FLOAT, IR.COS, [randAngTwo], fn cost2 =>  
326            letPRIM("sint1", IR.T_FLOAT, IR.SIN, [randAngOne], fn sint1 =>            letPRIM("usq", IR.T_FLOAT, IR.MULT, [u, u], fn usq =>
327            letPRIM("sint2", IR.T_FLOAT, IR.SIN, [randAngTwo], fn sint2 =>            letPRIM("usqInv", IR.T_FLOAT, IR.SUB, [IR.newConst("One", IR.C_FLOAT 1.0), usq], fn usqInv =>
328              letPRIM("sinPhi", IR.T_FLOAT, IR.SQRT, [usqInv], fn sinP =>
329            letPRIM("xVal", IR.T_FLOAT, IR.MULT, [cost1, cost2], fn xVal =>  
330            letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sint1, cost2], fn yVal =>            letPRIM("xVal", IR.T_FLOAT, IR.MULT, [sinP, cosT], fn xVal =>
331            (* zval is just sint2 *)            letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sinP, sinT], fn yVal =>
332              (* zval is just u *)
333            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 =>  
334            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 =>            letPRIM("vec", IR.T_VEC, IR.GEN_VEC, [xVal, yVal, u], fn vec =>
           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 =>  
   
           letPRIM("addedVecs", IR.T_VEC, IR.ADD_VEC, [xVec, yVec], fn addedVecs =>  
           letPRIM("notNormVec", IR.T_VEC, IR.ADD_VEC, [addedVecs, zVec], fn nnVec =>  
           letPRIM("vec", IR.T_VEC, IR.NORM, [nnVec], fn vec =>  
335    
336            (* Generate a random radius... *)            (* Generate a random radius... *)
337                    letPRIM("ratio", IR.T_FLOAT, IR.DIV, [psvToIRVar(env, irad), psvToIRVar(env, orad)], fn ratio =>                    letPRIM("ratio", IR.T_FLOAT, IR.DIV, [psvToIRVar(env, irad), psvToIRVar(env, orad)], fn ratio =>
# Line 310  Line 339 
339                    letPRIM("randVar", IR.T_FLOAT, IR.RAND, [], fn rand =>                    letPRIM("randVar", IR.T_FLOAT, IR.RAND, [], fn rand =>
340                    letPRIM("randScale", IR.T_FLOAT, IR.MULT, [rand, invRatio], fn randScale =>                    letPRIM("randScale", IR.T_FLOAT, IR.MULT, [rand, invRatio], fn randScale =>
341                    letPRIM("randVal", IR.T_FLOAT, IR.ADD, [randScale, ratio], fn randVal =>                    letPRIM("randVal", IR.T_FLOAT, IR.ADD, [randScale, ratio], fn randVal =>
342                    letPRIM("randValSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randValSq =>                    letPRIM("randValSq", IR.T_FLOAT, IR.SQRT, [randVal], fn randValSq =>
343                    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 =>
344                    letPRIM("randRadVal", IR.T_FLOAT, IR.MULT, [radDiff, randValSq], fn randRadVal =>                    letPRIM("randRadVal", IR.T_FLOAT, IR.MULT, [radDiff, randValSq], fn randRadVal =>
345                    letPRIM("rad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), randRadVal], fn rad =>                    letPRIM("rad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), randRadVal], fn rad =>
# Line 319  Line 348 
348                    letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [rad, vec], fn sVec =>                    letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [rad, vec], fn sVec =>
349                    letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [sVec, psvToIRVar(env, center)], stmt)                    letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [sVec, psvToIRVar(env, center)], stmt)
350                    ))))))))))                    ))))))))))
351                    ))))))))))))                    )))))))))))))
                   ))))  
352    
353              | _ => raise Fail "Cannot generate point in specified domain."              | _ => raise Fail ("Cannot generate point in specified domain: "  ^ (P.dToStr domain))
354            (* end case *))            (* 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  
           *)  
355    
356    (* This function takes an IR boolean, its environment, a particle state, domain,    (* This function takes an IR boolean, its environment, a particle state, domain,
357     * and continuation.     * and continuation.
# Line 463  Line 485 
485                | P.D_BLOB {center: vec3f var, stddev: float var}                | P.D_BLOB {center: vec3f var, stddev: float var}
486                | 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}
487  *)  *)
488                | _ => raise Fail "Cannot determine within-ness for specified vec3 domain."                | _ => raise Fail ("Cannot determine within-ness for specified vec3 domain: " ^ (P.dToStr d))
489              (* end case *)              (* end case *)
490            end (*end let *)            end (*end let *)
491    
# Line 473  Line 495 
495               letPRIM("bigMin", IR.T_BOOL, IR.GT, [var, psvToIRVar(env, min)], fn bigMin =>               letPRIM("bigMin", IR.T_BOOL, IR.GT, [var, psvToIRVar(env, min)], fn bigMin =>
496               letPRIM("smallMax", IR.T_BOOL, IR.GT, [psvToIRVar(env, max), var], fn smallMax =>               letPRIM("smallMax", IR.T_BOOL, IR.GT, [psvToIRVar(env, max), var], fn smallMax =>
497               letPRIM(boolVar, IR.T_BOOL, IR.AND, [bigMin, smallMax], stmt)))               letPRIM(boolVar, IR.T_BOOL, IR.AND, [bigMin, smallMax], stmt)))
498             | _ => raise Fail "Cannot determine within-ness for specified float domain."             | _ => raise Fail ("Cannot determine within-ness for specified float domain: " ^ (P.dToStr d))
499           (* end case *))           (* end case *))
500    
501          fun mkIntBool(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let          fun mkIntBool(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> ir_env -> IR.stmt) = let
502            val _ = ()            val _ = ()
503           in           in
504            (case d            (case d
# Line 498  Line 520 
520               letPRIM("distDiffAbs", IR.T_FLOAT, IR.ABS, [distDiff], fn distDiffAbs =>               letPRIM("distDiffAbs", IR.T_FLOAT, IR.ABS, [distDiff], fn distDiffAbs =>
521    
522               (* Do the boolean stuff... *)               (* Do the boolean stuff... *)
523               letPRIM("intersect", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), distDiffAbs], k)               letPRIM("intersect", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), distDiffAbs], fn intVar => k intVar env)
524    
525               )))               )))
526               )))               )))
527               )))               )))
528    
529              | _ => raise Fail ("Cannot calculate intersection for specified domain")              | P.D_PLANE {pt, normal} =>
530                  letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
531                  letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
532                  letPRIM("p2d", IR.T_FLOAT, IR.DOT, [p2var, psvToIRVar(env, normal)], fn p2d =>
533                  letPRIM("p1dist", IR.T_FLOAT, IR.SUB, [d, p1d], fn p1dist =>
534                  letPRIM("p2dist", IR.T_FLOAT, IR.SUB, [d, p2d], fn p2dist =>
535                  letPRIM("distProd", IR.T_FLOAT, IR.MULT, [p1dist, p2dist], fn distProd =>
536                  letPRIM("intersect", IR.T_BOOL, IR.GT, [IR.newConst("zero", IR.C_FLOAT 0.0), distProd], fn intVar => k intVar env)
537                  ))))))
538    
539                | P.D_DISC {pt, normal, orad, irad} => let
540                  val boolVar = IR.newParam("intersect", IR.T_BOOL)
541                  val newBlk = newBlockWithArgs(env, [boolVar], k boolVar)
542                 in
543                  letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
544                  letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
545    
546                  (* Early out... does it intersect the plane?
547                   *
548                   * !SPEED! Due to the perceived slowness of branching on
549                   * GPUs, this might not actually be faster on all runtime environments *)
550    
551                  letPRIM("p2d", IR.T_FLOAT, IR.DOT, [p2var, psvToIRVar(env, normal)], fn p2d =>
552                  letPRIM("p1dist", IR.T_FLOAT, IR.SUB, [d, p1d], fn p1dist =>
553                  letPRIM("p2dist", IR.T_FLOAT, IR.SUB, [d, p2d], fn p2dist =>
554                  letPRIM("distProd", IR.T_FLOAT, IR.MULT, [p1dist, p2dist], fn distProd =>
555                  letPRIM("earlyOut", IR.T_BOOL, IR.GT, [distProd, IR.newConst("zero", IR.C_FLOAT 0.0)], fn earlyOut =>
556                  IR.mkIF(earlyOut,
557                    (* then *)
558                    letPRIM("intersect", IR.T_BOOL, IR.NOT, [earlyOut], fn var => gotoWithArgs(env, [var], newBlk)),
559                    (* else *)
560                    letPRIM("v", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn v =>
561                    letPRIM("vDotn", IR.T_FLOAT, IR.DOT, [v, psvToIRVar(env, normal)], fn vdn =>
562                    letPRIM("t", IR.T_FLOAT, IR.DIV, [p1dist, vdn], fn t =>
563    
564                    (* !TODO! Add some sort of assert mechanism to make sure that t is
565                     * in the interval [0, 1]... *)
566                    letPRIM("vscale", IR.T_VEC, IR.SCALE, [t, v], fn vscale =>
567                    letPRIM("ppt", IR.T_VEC, IR.ADD_VEC, [p1var, vscale], fn ppt =>
568                    letPRIM("lenVec", IR.T_VEC, IR.SUB_VEC, [ppt, psvToIRVar(env, pt)], fn cv =>
569                    letPRIM("len", IR.T_FLOAT, IR.LEN, [cv], fn len =>
570    
571                    (* Check to see whether or not it's within the radius... *)
572                    letPRIM("gtirad", IR.T_BOOL, IR.GT, [len, psvToIRVar(env, irad)], fn gtirad =>
573                    letPRIM("ltorad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), len], fn ltorad =>
574                    letPRIM("intersect", IR.T_BOOL, IR.AND, [gtirad, ltorad], fn var => gotoWithArgs(env, [var], newBlk))
575                   ))))))))))
576                 )))))))
577                end (* P.D_DISC *)
578    
579                | _ => raise Fail ("Cannot calculate intersection bool for specified domain: " ^ (P.dToStr d))
580            (* end case *))            (* end case *))
581    
582           end (* mkIntBool *)           end (* mkIntBool *)
583    
584            (* We assume that the segment already intersects with the domain. *)
585          fun mkIntPt(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let          fun mkIntPt(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let
586            val _ = ()            val _ = ()
587           in           in
588            (case d            (case d
589              of P.D_POINT(pt) => k (psvToIRVar (env, pt))              of P.D_POINT(pt) => k (psvToIRVar (env, pt))
590               | _ => raise Fail ("Cannot calculate intersection for specified domain")  
591                 | P.D_PLANE {pt, normal} =>
592                   letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
593                   letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
594                   letPRIM("num", IR.T_FLOAT, IR.SUB, [d, p1d], fn num =>
595                   letPRIM("v", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn v =>
596                   letPRIM("den", IR.T_FLOAT, IR.DOT, [v, psvToIRVar(env, normal)], fn den =>
597                   letPRIM("t", IR.T_FLOAT, IR.DIV, [num, den], fn t =>
598                   letPRIM("vsc", IR.T_VEC, IR.SCALE, [t, v], fn vs =>
599                   letPRIM("intPt", IR.T_VEC, IR.ADD_VEC, [p1var, vs], k)
600                   )))))))
601    
602                 (* Since we already know they intersect, the intersection point must be
603                  * just the point that's on the plane... *)
604                 | P.D_DISC {pt, normal, orad, irad} => mkIntPt(env, p1var, p2var, P.D_PLANE{pt = pt, normal = normal}, k)
605                 | _ => raise Fail ("Cannot calculate intersection point for specified domain: "  ^ (P.dToStr d))
606            (* end case *))            (* end case *))
607           end (* mkIntPt *)           end (* mkIntPt *)
608    
609      (* 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
610       * 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
611       * domain, but if it's not then the behavior is undefined.       * domain, but if it's not then the behavior is undefined. *)
612       *)      fun normAtPoint(retNorm, d, env, pos, k : IR.var -> ir_env -> IR.stmt) = let
     fun normAtPoint(retNorm, d, env, pos, state, k : IR.var -> particle_state -> IR.stmt) = let  
613        val newNorm = IR.newParam("n", IR.T_VEC)        val newNorm = IR.newParam("n", IR.T_VEC)
614        val nextBlk = newBlockWithArgs(env, state, [newNorm], k(newNorm))        val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))
615       in       in
616        (case d        (case d
617            of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],            of P.D_PLANE{pt, normal} =>
618                fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))               letPRIM("inVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn inVec =>
619                 letPRIM("dotNorm", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, normal), inVec], fn dotNorm =>
620                 letPRIM("absDot", IR.T_FLOAT, IR.ABS, [dotNorm], fn absDot =>
621                 letPRIM("avoidZero", IR.T_FLOAT, IR.MAX, [psvToIRVar(env, epsilon), absDot], fn dot =>
622             letPRIM("dnRecip", IR.T_FLOAT, IR.DIV, [IR.newConst("One", IR.C_FLOAT 1.0), dot], fn dnRecip =>
623             letPRIM("sign", IR.T_FLOAT, IR.MULT, [dnRecip, dotNorm], fn sign =>
624             (* sign here can still be zero... *)
625             letPRIM("signOffset", IR.T_FLOAT, IR.ADD, [sign, IR.newConst("half", IR.C_FLOAT 0.5)], fn signOffset =>
626             letPRIM("soRecip", IR.T_FLOAT, IR.DIV, [IR.newConst("One", IR.C_FLOAT 1.0), signOffset], fn soRecip =>
627             letPRIM("absSign", IR.T_FLOAT, IR.ABS, [soRecip], fn absSign =>
628             letPRIM("signFinal", IR.T_FLOAT, IR.MULT, [absSign, signOffset], fn signFinal =>
629    
630             letPRIM("notNorm", IR.T_VEC, IR.SCALE, [signFinal, psvToIRVar(env, normal)], fn notNorm =>
631             letPRIM(retNorm, IR.T_VEC, IR.NORM, [notNorm],
632               fn newNormVar => gotoWithArgs(env, [newNormVar], nextBlk)))))
633             ))))))))
634    
635             | P.D_DISC{pt, normal, irad, orad} =>             | P.D_DISC{pt, normal, irad, orad} =>
636                mkVecWithinVar("inP", env, pos, d, fn inPlane =>                normAtPoint(retNorm, P.D_PLANE{pt=pt, normal=normal}, env, pos, 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))  
                    )  
                  )  
637    
638             | P.D_SPHERE{center, irad, orad} =>             | P.D_SPHERE{center, irad, orad} =>
639                      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 =>
640                  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 env
641                    ))                    ))
642    
643             | _ => raise Fail("Cannot find normal to point of specified domain.")             | _ => raise Fail("Cannot find normal to point of specified domain." ^ (P.dToStr d))
644           (* end case *))           (* end case *))
645          end          end
646    
647          fun trExpr(expr, env, state, k : IR.var -> IR.stmt) = (case expr          fun trExpr(expr, env, k : IR.var -> ir_env -> IR.stmt) = (case expr
648            of P.CONSTF f => k (IR.newConst ("c", IR.C_FLOAT f))            of P.CONSTF f => k (IR.newConst ("c", IR.C_FLOAT f)) env
649    
650         | P.CONST3F v => k (IR.newConst ("c", IR.C_VEC v))         | P.CONST3F v => k (IR.newConst ("c", IR.C_VEC v)) env
651    
652         | P.VAR v => k (psvToIRVar (env, v))         | P.VAR v => k (psvToIRVar (env, v)) env
653    
654         | P.STATE_VAR sv => k (getIRVarForSV (sv, state))         | P.STATE_VAR sv => k (pssvToIRVar (env, sv)) env
655    
656         | P.GENERATE3F (dom, dist) => genVecVar("genVec", env, dom, dist, k)         | P.GENERATE3F (dom, dist) => genVecVar("genVec", env, dom, dist, fn var => k var env)
657    
658         | P.GENERATEF (dom, dist) => genFloatVar("genFlt", env, dom, dist, k)         | P.GENERATEF (dom, dist) => genFloatVar("genFlt", env, dom, dist, fn var => k var env)
659    
660         | P.ADD(e1, e2) =>         | P.ADD(e1, e2) =>
661           trExpr(e1, env, state, fn e1var =>           trExpr(e1, env, fn e1var => fn env' =>
662           trExpr(e2, env, state, fn e2var =>           trExpr(e2, env', fn e2var => fn env'' =>
663           let           let
664            val IR.V{varType=vt1, ...} = e1var            val IR.V{varType=vt1, ...} = e1var
665            val IR.V{varType=vt2, ...} = e2var            val IR.V{varType=vt2, ...} = e2var
666           in           in
667            (case (vt1, vt2)            (case (vt1, vt2)
668              of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("addVar", IR.T_FLOAT, IR.ADD, [e1var, e2var], k)              of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("addVar", IR.T_FLOAT, IR.ADD, [e1var, e2var], fn var => k var env'')
669               | (IR.T_VEC, IR.T_VEC) => letPRIM("addVar", IR.T_VEC, IR.ADD_VEC, [e1var, e2var], k)               | (IR.T_VEC, IR.T_VEC) => letPRIM("addVar", IR.T_VEC, IR.ADD_VEC, [e1var, e2var], fn var => k var env'')
670               | _ => raise Fail ("Type mismatch to ADD expression")               | _ => raise Fail ("Type mismatch to ADD expression")
671            (* end case *))            (* end case *))
672           end))           end))
673    
674         | P.SCALE (e1, e2) =>         | P.SCALE (e1, e2) =>
675           trExpr(e1, env, state, fn e1var =>           trExpr(e1, env, fn e1var => fn env' =>
676           trExpr(e2, env, state, fn e2var =>           trExpr(e2, env', fn e2var => fn env'' =>
677           let           let
678            val IR.V{varType=vt1, ...} = e1var            val IR.V{varType=vt1, ...} = e1var
679            val IR.V{varType=vt2, ...} = e2var            val IR.V{varType=vt2, ...} = e2var
680           in           in
681            (case (vt1, vt2)            (case (vt1, vt2)
682              of (IR.T_FLOAT, IR.T_VEC) => letPRIM("scaleVar", IR.T_VEC, IR.SCALE, [e1var, e2var], k)              of (IR.T_FLOAT, IR.T_VEC) => letPRIM("scaleVar", IR.T_VEC, IR.SCALE, [e1var, e2var], fn var => k var env'')
683               | (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("addVar", IR.T_FLOAT, IR.MULT, [e1var, e2var], k)               | (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("scaleVar", IR.T_FLOAT, IR.MULT, [e1var, e2var], fn var => k var env'')
684               | _ => raise Fail ("Type mismatch to SCALE expression")               | _ => raise Fail (String.concat["Type mismatch to SCALE expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
685            (* end case *))            (* end case *))
686           end))           end))
687    
688         | P.DIV (e1, e2) =>         | P.DIV (e1, e2) =>
689           trExpr(e1, env, state, fn e1var =>           trExpr(e1, env, fn e1var => fn env' =>
690           trExpr(e2, env, state, fn e2var =>           trExpr(e2, env', fn e2var => fn env'' =>
691           let           let
692            val IR.V{varType=vt1, ...} = e1var            val IR.V{varType=vt1, ...} = e1var
693            val IR.V{varType=vt2, ...} = e2var            val IR.V{varType=vt2, ...} = e2var
694           in           in
695            (case (vt1, vt2)            (case (vt1, vt2)
696              of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("divVar", IR.T_FLOAT, IR.DIV, [e1var, e2var], k)              of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("divVar", IR.T_FLOAT, IR.DIV, [e1var, e2var], fn var => k var env'')
697               | _ => raise Fail ("Type mismatch to DIV expression")               | _ => raise Fail (String.concat["Type mismatch to DIV expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
698            (* end case *))            (* end case *))
699           end))           end))
700    
701         | P.NEG e =>         | P.NEG e =>
702           trExpr(e, env, state, fn evar =>           trExpr(e, env, fn evar => fn env' =>
703           let           let
704            val IR.V{varType, ...} = evar            val IR.V{varType, ...} = evar
705           in           in
706            (case varType            (case varType
707              of IR.T_FLOAT => letPRIM("negVar", IR.T_FLOAT, IR.MULT, [evar, IR.newConst("negOne", IR.C_FLOAT ~1.0)], k)              of IR.T_FLOAT => letPRIM("negVar", IR.T_FLOAT, IR.MULT, [evar, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn var => k var env')
708               | IR.T_VEC => letPRIM("negVar", IR.T_VEC, IR.NEG_VEC, [evar], k)               | IR.T_VEC => letPRIM("negVar", IR.T_VEC, IR.NEG_VEC, [evar], fn var => k var env')
709               | _ => raise Fail ("Type mismatch to NEG expression")               | _ => raise Fail ("Type mismatch to NEG expression")
710            (* end case *))            (* end case *))
711           end)           end)
712    
713         | P.DOT (e1, e2) =>         | P.DOT (e1, e2) =>
714           trExpr(e1, env, state, fn e1var =>           trExpr(e1, env, fn e1var => fn env' =>
715           trExpr(e2, env, state, fn e2var =>           trExpr(e2, env', fn e2var => fn env'' =>
716           let           let
717            val IR.V{varType=vt1, ...} = e1var            val IR.V{varType=vt1, ...} = e1var
718            val IR.V{varType=vt2, ...} = e2var            val IR.V{varType=vt2, ...} = e2var
719           in           in
720            (case (vt1, vt2)            (case (vt1, vt2)
721              of (IR.T_VEC, IR.T_VEC) => letPRIM("dotVar", IR.T_FLOAT, IR.DOT, [e1var, e2var], k)              of (IR.T_VEC, IR.T_VEC) => letPRIM("dotVar", IR.T_FLOAT, IR.DOT, [e1var, e2var], fn var => k var env'')
722               | _ => raise Fail ("Type mismatch to DOT expression")               | _ => raise Fail ("Type mismatch to DOT expression")
723            (* end case *))            (* end case *))
724           end))           end))
725    
726         | P.CROSS (e1, e2) =>         | P.CROSS (e1, e2) =>
727           trExpr(e1, env, state, fn e1var =>           trExpr(e1, env, fn e1var => fn env' =>
728           trExpr(e2, env, state, fn e2var =>           trExpr(e2, env', fn e2var => fn env'' =>
729           let           let
730            val IR.V{varType=vt1, ...} = e1var            val IR.V{varType=vt1, ...} = e1var
731            val IR.V{varType=vt2, ...} = e2var            val IR.V{varType=vt2, ...} = e2var
732           in           in
733            (case (vt1, vt2)            (case (vt1, vt2)
734              of (IR.T_VEC, IR.T_VEC) => letPRIM("crossVar", IR.T_VEC, IR.CROSS, [e1var, e2var], k)              of (IR.T_VEC, IR.T_VEC) => letPRIM("crossVar", IR.T_VEC, IR.CROSS, [e1var, e2var], fn var => k var env'')
735               | _ => raise Fail ("Type mismatch to CROSS expression")               | _ => raise Fail ("Type mismatch to CROSS expression")
736            (* end case *))            (* end case *))
737           end))           end))
738    
739         | P.NORMALIZE e =>         | P.NORMALIZE e =>
740           trExpr(e, env, state, fn evar =>           trExpr(e, env, fn evar => fn env' =>
741           let           let
742            val IR.V{varType, ...} = evar            val IR.V{varType, ...} = evar
743           in           in
744            (case varType            (case varType
745              of IR.T_VEC => letPRIM("normVar", IR.T_VEC, IR.NORM, [evar], k)              of IR.T_VEC => letPRIM("normVar", IR.T_VEC, IR.NORM, [evar], fn var => k var env')
746               | _ => raise Fail ("Type mismatch to NORMALIZE expression")               | _ => raise Fail ("Type mismatch to NORMALIZE expression")
747            (* end case *))            (* end case *))
748           end)           end)
749    
750         | P.LENGTH e =>         | P.LENGTH e =>
751           trExpr(e, env, state, fn evar =>           trExpr(e, env, fn evar => fn env' =>
752           let           let
753            val IR.V{varType, ...} = evar            val IR.V{varType, ...} = evar
754           in           in
755            (case varType            (case varType
756              of IR.T_VEC => letPRIM("lenVar", IR.T_VEC, IR.LEN, [evar], k)              of IR.T_VEC => letPRIM("lenVar", IR.T_FLOAT, IR.LEN, [evar], fn var => k var env')
757               | _ => raise Fail ("Type mismatch to LENGTH expression")               | _ => raise Fail ("Type mismatch to LENGTH expression")
758            (* end case *))            (* end case *))
759           end)           end)
760    
761         (* !SPEED! We're assuming that there is an intersection here... *)         (* !SPEED! We're assuming that there is an intersection here... *)
762         | P.INTERSECT {p1, p2, d} =>         | P.INTERSECT {p1, p2, d} =>
763           trExpr(p1, env, state, fn p1var =>           trExpr(p1, env, fn p1var => fn env' =>
764           trExpr(p2, env, state, fn p2var =>           trExpr(p2, env', fn p2var => fn env'' =>
765           let           let
766            val IR.V{varType=vt1, ...} = p1var            val IR.V{varType=vt1, ...} = p1var
767            val IR.V{varType=vt2, ...} = p2var            val IR.V{varType=vt2, ...} = p2var
768           in           in
769            (case (vt1, vt2)            (case (vt1, vt2)
770              of (IR.T_VEC, IR.T_VEC) => mkIntPt(env, p1var, p2var, d, k)              of (IR.T_VEC, IR.T_VEC) => mkIntPt(env, p1var, p2var, d, fn var => k var env'')
771               | _ => raise Fail("Type mismatch to INTERSECT expression")               | _ => raise Fail("Type mismatch to INTERSECT expression")
772            (* end case *))            (* end case *))
773           end))           end))
774    
775         | P.NORMALTO (e, d) =>         | P.NORMALTO (e, d) =>
776           trExpr(e, env, state, fn evar =>           trExpr(e, env, fn evar => fn env' =>
777           let           let
778            val IR.V{varType, ...} = evar            val IR.V{varType, ...} = evar
779            fun cont s = k s            fun cont s = k s
780           in           in
781            (case varType            (case varType
782              of IR.T_VEC => normAtPoint("normVar", d, env, evar, state, fn var => fn state' => k var)              of IR.T_VEC => normAtPoint("normVar", d, env', evar, k)
783               | _ => raise Fail("Type mismatch to NORMALTO expression")               | _ => raise Fail("Type mismatch to NORMALTO expression")
784            (* end case *))            (* end case *))
785           end)           end)
# Line 696  Line 787 
787            (* end case expr *))            (* end case expr *))
788    
789            (* generate code to produce a random particle state from a domain *)            (* generate code to produce a random particle state from a domain *)
790      fun newParticle (sv_gens, env, state, k : particle_state -> IR.stmt) = let      fun newParticle (sv_gens, env, k : ir_env -> IR.stmt) = let
791    
792        fun createVar(P.GEN{var, ...}) = let        fun createVar(P.GEN{var, ...}) = let
793          val P.PSV.SV{name, ty, ...} = var          val P.PSV.SV{name, ty, ...} = var
# Line 707  Line 798 
798        val newState = List.map createVar sv_gens        val newState = List.map createVar sv_gens
799    
800        fun genVar((sv_gen, var), cont) = let        fun genVar((sv_gen, var), cont) = let
801          val P.GEN{exp, ...} = sv_gen          val P.GEN{exp, var=svar} = sv_gen
802          val IR.V{varType, ...} = var          val IR.V{varType, ...} = var
803         in         in
804          (* This is kind of a hack, but it'll get optimized out. *)          fn env' => trExpr(exp, env', fn newVal => fn env'' => cont (insertSVar(env'', svar, newVal)))
         trExpr(exp, env, state, fn newVal => IR.mkPRIM(var, IR.COPY, [newVal], cont))  
805         end (* genVar *)         end (* genVar *)
806    
807       in       in
808        List.foldr (fn (x, y) => genVar(x, y)) (k newState) (ListPair.zipEq (sv_gens, newState))        (List.foldr (fn (x, y) => genVar(x, y)) k (ListPair.zipEq (sv_gens, newState))) env
809       end (* new particle *)       end (* new particle *)
810    
811      fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let      fun trEmitter(emit, env, k) = let
812        val P.EMIT{freq, sv_gens} = emit        val P.EMIT{freq, sv_gens} = emit
813        val blk = newBlock (env, state, k)        val ttl = pssvToIRVar(env, P.sv_ttl)
       val ttl = findIRVarByName(state, "ttl")  
814       in       in
815        letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>        letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>
816        IR.mkIF(isDead,        IR.mkIF(isDead,
817         (* then *)         (* then *)
818         trExpr(freq, env, state, fn t1 =>         trExpr(freq, env, fn t1 => fn env' =>
819         letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, PSV.numDead)], fn t2 =>         letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env', PSV.numDead)], fn t2 =>
820         letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>         letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
821         letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>         letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
822         letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>         letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
823         IR.mkIF(t3,         IR.mkIF(t3,
824          (* then *)          (* then *)
825          newParticle (sv_gens, env, state, fn state' => retState state'),          newParticle (sv_gens, env', fn env'' => k env''),
826          (* else *)          (* else *)
827          IR.DISCARD)))))),          IR.DISCARD)))))),
828         (* else *)         (* else *)
829         retState state))         k env))
830       end       end
831    
 (*  
 //  
     fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let  
       val P.PR{ifstmt, ...} = pred  
     in  
       case ifstmt  
        of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>  
                IR.mkIF(withinVar, thenk(state), elsek(state)))  
          | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>  
                IR.mkIF(withinVar, thenk(state), elsek(state)))  
      end  
 //  
 //    fun trAct (action, env, state, k : particle_state -> IR.stmt) = let/  
 //        val PS{pos, vel, size, ttl, color, user} = state  
 //        in  
 //          case action  
 //           of P.BOUNCE{friction, resilience, cutoff, d} => let  
 //                val blk = newBlock (env, user, k)  
 //                val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)  
 //                in  
 //                  letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn velScale =>  
 //                  letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>  
 //                  mkWithinVar("wcp", env, pos, d, fn withinCurPos =>  
 //                  mkWithinVar("wnp", env, nextPos, d, fn withinNextPos =>  
 //                  letPRIM("nwcp", IR.T_BOOL, IR.NOT, [withinCurPos], fn notWithinCurPos =>  
 //                  letPRIM("sb", IR.T_BOOL, IR.AND, [notWithinCurPos, withinNextPos], fn shouldBounce =>  
 //                  IR.mkIF(shouldBounce,  
 //                    (*then*)  
 //                      normAtPoint("n", d, env, state, fn normAtD => fn state' => let  
 //               val PS{pos=nextPos, vel=nextVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser} = state'  
 //                        in  
 //                         letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>  
 //                         letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>  
 //                         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, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)  
 //                          )))),  
 //                           (*else*)  
 //                           letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>  
 //                           letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>  
 //                            goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)  
 //                           ))  
 //                       )))))))))  
 //                       end  
 //                    ),  
 //                    (*else*)  
 //                    goto(state, blk))))))))  
 //                end  
 //  
 //            | P.ACCEL dir =>  
 //                  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), psvToIRVar(env, dir)], fn theScale =>  
 //                  letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>  
 //                    k(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user = user})))  
 //  
 //            | P.MOVE =>  
 //              letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn theScale =>  
 //                  letPRIM("ps_pos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>  
 //                    k(PS{pos = newPos, vel = vel, size = size, ttl = ttl, color = color, user = user})))  
 //  
 //            | P.ORBITPOINT {center, mag, maxRad} => let  
 //                val blk = newBlock (env, user, k)  
 //               in  
 //                letPRIM("toCenter", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn toCenter =>  
 //                letPRIM("dist", IR.T_FLOAT, IR.LEN, [toCenter], fn dist =>  
 //                letPRIM("radInDist", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, maxRad)], fn radInDist =>  
 //                IR.mkIF(radInDist,  
 //                  (* then *)  
 //                  goto(state, blk),  
 //                  (* else *)  
 //                letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [dist, 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, PSV.timeStep)], fn totMag =>  
 //                letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, toCenter], fn acc =>  
 //                letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>  
 //                goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)  
 //                ))))))))))  
 //               end  
 //  
 //  
 //            | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let  
 //                val blk = newBlock (env, user, k)  
 //              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, PSV.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("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>  
 //                goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)  
 //                )))))))  
 //              )))))))))))  
 //              end  
 //  
 //            (* just kill it. *)  
 //            (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, ttl = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)  
 //            | P.DIE => IR.DISCARD  
 //            | _ => raise Fail("Action not implemented...")  
 //          (* end case *)  
 //        end  
 *)  
   
832      (* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)      (* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)
833      (* mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) *)      (* mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) *)
834      fun trPred(cond, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let      fun trPred(cond, env, thenk : ir_env -> IR.stmt, elsek : ir_env -> IR.stmt) = let
835        fun grabVar(cond, env, state, k : IR.var -> IR.stmt) = (case cond        fun grabVar(cond, env, k : IR.var -> ir_env -> IR.stmt) = (case cond
836          of P.WITHINF(d, expr) =>          of P.WITHINF(d, expr) =>
837              trExpr(expr, env, state, fn checkMe =>              trExpr(expr, env, fn checkMe => fn env' =>
838              mkFloatWithinVar("wv", env, checkMe, d, k))              mkFloatWithinVar("wv", env', checkMe, d, fn var => k var env'))
839    
840           | P.WITHIN3F(d, expr) =>           | P.WITHIN3F(d, expr) =>
841              trExpr(expr, env, state, fn checkMe =>              trExpr(expr, env, fn checkMe => fn env' =>
842              mkVecWithinVar("wv", env, checkMe, d, k))              mkVecWithinVar("wv", env', checkMe, d, fn var => k var env'))
843    
844           | P.DO_INTERSECT {p1, p2, d} =>           | P.DO_INTERSECT {p1, p2, d} =>
845             trExpr(p1, env, state, fn p1var =>             trExpr(p1, env, fn p1var => fn env' =>
846             trExpr(p2, env, state, fn p2var =>             trExpr(p2, env', fn p2var => fn env'' =>
847             mkIntBool(env, p1var, p2var, d, k)))             mkIntBool(env'', p1var, p2var, d, k)))
848    
849           | P.GTHAN (e1, e2) =>           | P.GTHAN (e1, e2) =>
850             trExpr(e1, env, state, fn e1var =>             trExpr(e1, env, fn e1var => fn env' =>
851             trExpr(e2, env, state, fn e2var =>             trExpr(e2, env, fn e2var => fn env'' =>
852             letPRIM("gtVar", IR.T_BOOL, IR.GT, [e1var, e2var], k)))             letPRIM("gtVar", IR.T_BOOL, IR.GT, [e1var, e2var], fn var => k var env'')))
853    
854           | P.AND(c1, c2) =>           | P.AND(c1, c2) =>
855             grabVar(c1, env, state, fn c1Var =>             grabVar(c1, env, fn c1Var => fn env' =>
856             grabVar(c2, env, state, fn c2Var =>             grabVar(c2, env', fn c2Var => fn env'' =>
857             letPRIM("andVar", IR.T_BOOL, IR.AND, [c1Var, c2Var], k)))             letPRIM("andVar", IR.T_BOOL, IR.AND, [c1Var, c2Var], fn var => k var env'')))
858    
859           | P.OR(c1, c2) =>           | P.OR(c1, c2) =>
860             grabVar(c1, env, state, fn c1Var =>             grabVar(c1, env, fn c1Var => fn env' =>
861             grabVar(c2, env, state, fn c2Var =>             grabVar(c2, env, fn c2Var => fn env'' =>
862             letPRIM("andVar", IR.T_BOOL, IR.OR, [c1Var, c2Var], k)))             letPRIM("andVar", IR.T_BOOL, IR.OR, [c1Var, c2Var], fn var => k var env'')))
863    
864           | P.XOR(c1, c2) =>           | P.XOR(c1, c2) =>
865             grabVar(c1, env, state, fn c1Var =>             grabVar(c1, env, fn c1Var => fn env' =>
866             grabVar(c2, env, state, fn c2Var =>             grabVar(c2, env', fn c2Var => fn env'' =>
867             mkXOR ("xorVar", c1Var, c2Var, k)))             mkXOR ("xorVar", c1Var, c2Var, fn var => k var env'')))
868    
869           | P.NOT(c) =>           | P.NOT(c) =>
870             grabVar(c, env, state, fn cvar =>             grabVar(c, env, fn cvar => fn env' =>
871             letPRIM("notVar", IR.T_BOOL, IR.NOT, [cvar], k))             letPRIM("notVar", IR.T_BOOL, IR.NOT, [cvar], fn var => k var env'))
872    
873          (* end case *))          (* end case *))
874       in       in
875        grabVar(cond, env, state, fn result =>        grabVar(cond, env, fn result => fn env' =>
876        IR.mkIF(result, thenk(state), elsek(state)))        IR.mkIF(result, thenk(env'), elsek(env')))
877       end       end
878    
879      fun compile (P.PG{      fun compile (P.PG{
# Line 923  Line 882 
882      }) = let      }) = let
883        val blks = ref[]        val blks = ref[]
884    
885        val demand = IR.getDemand(render)        fun printVar (PSV.V{name, id, ...}) =
886        fun getIRNameForSV (v as PSV.SV{name, ...}) =          printErr (String.concat[name, ": ", Int.toString id])
        (case (PSV.SVMap.find (render_vars, v))  
          of SOME na => let  
            fun inDemand n = List.exists (fn x => #1 x = "ps_" ^ n) demand  
           in  
            (* Sanity check *)  
            if not (inDemand na) then  
              raise Fail (String.concat["Variable with name ", name," marked for rendering but not in demand."])  
            else  
              "ps_" ^ na  
           end  
           | NONE => "ps_" ^ name  
        (* end case *))  
887    
888        fun convertToIR (v as PSV.SV{ty, ...}) = IR.newParam(getIRNameForSV v, IR.psvTyToIRTy ty)        val v_env = let
       val env = let  
889                (* add special globals to free vars *)                (* add special globals to free vars *)
890          val pgm_vars = PSV.Set.union(PSV.Set.singleton epsilon, vars)          val pgm_vars = PSV.Set.union(PSV.Set.singleton epsilon, vars)
891          fun insv (x as PSV.V{name, ty, binding, id, ...}, map) = let          fun insv (x as PSV.V{name, ty, binding, id, ...}, map) = let
# Line 957  Line 903 
903                     in                     in
904                          PSV.Map.insert (map, x, x')                          PSV.Map.insert (map, x, x')
905                     end (* ins *)                     end (* ins *)
906    
907                  in                  in
908                    TE( blks, PSV.Set.foldl insv PSV.Map.empty pgm_vars )                  PSV.Set.foldl insv PSV.Map.empty pgm_vars
909                  end (* env *)                  end (* env *)
910    
911        fun evalActs theAct state f = (case theAct        fun evalActs theAct env f = (case theAct
912                of P.SEQ(acts) => (case acts                of P.SEQ(acts) => (case acts
913                  of [] => f state                  of [] => f env
914                   | oneAct :: rest => evalActs oneAct state (fn state' => (evalActs (P.SEQ(rest)) state' f))                   | oneAct :: rest => evalActs oneAct env (fn env' => (evalActs (P.SEQ(rest)) env' f))
915                  (* end case *))                  (* end case *))
916    
917                 | P.PRED(cond, thenAct, elseAct) =>                 | P.PRED(cond, thenAct, elseAct) => let
918                   trPred(cond, env, state,                     val joinBlk = newBlock (env, fn env' => f env')
919                     fn state' => evalActs thenAct state' f,                     fun joinActs env = goto(env, joinBlk)
920                     fn state' => evalActs elseAct state' f                    in
921                       trPred(cond, env,
922                         fn env' => evalActs thenAct env' joinActs,
923                         fn env' => evalActs elseAct env' joinActs
924                   )                   )
925                      end
926    
927                 | P.DIE => IR.DISCARD                 | P.DIE => IR.DISCARD
928    
929                 | P.ASSIGN(sv, expr) => let                 | P.ASSIGN(sv, expr) => let
930                   val PSV.SV{ty, ...} = sv                   val PSV.SV{name, ty, ...} = sv
                  fun replaceStateVar (var, []) = [var]  
                    | replaceStateVar (var, nv :: svars) = let  
                      val IR.V{name=nvname, ...} = nv  
                      val IR.V{name=varname, ...} = var  
                     in  
                      if nvname = varname then  
                        var :: svars  
                      else  
                        nv :: replaceStateVar(var, svars)  
                     end  
931                  in                  in
932                   trExpr(expr, env, state, fn newVar =>                   trExpr(expr, env, fn newVar => fn env' =>
933                   letPRIM(getIRNameForSV sv, IR.psvTyToIRTy ty, IR.COPY, [newVar],                   letPRIM("ps_" ^ name, IR.psvTyToIRTy ty, IR.COPY, [newVar],
934                     fn thisVar => f (replaceStateVar(thisVar, state))))                     fn thisVar => f (insertSVar(env', sv, thisVar))))
935                  end                  end
936    
937                (* end case *))                (* end case *))
938    
939              val sv_env = let
940                  (* add special globals to free vars *)
941            fun insv (x as PSV.SV{name, ty, ...}, map) = let
942              val x' = IR.newParam("ps_" ^ name, IR.psvTyToIRTy ty)
943                     in
944                      IR.setRenderVar(x', PSV.SVMap.inDomain(render_vars, x));
945                      PSV.SVMap.insert (map, x, x')
946                     end (* ins *)
947    
948               in
949                    PSV.SVSet.foldl insv PSV.SVMap.empty state_vars
950               end (* env *)
951    
952              val env = TE(blks, v_env, sv_env)
953    
954            (* 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. *)
955            val entryBlock = newBlock (            val emitterBlock = newBlock (env, fn env => trEmitter(emit, env, retState))
956              env,            val physicsBlock = newBlock (env, fn env => evalActs act env retState)
             List.map convertToIR (PSV.SVSet.listItems state_vars),  
             fn pstate => trEmitter(  
               emit,  
               env,  
               pstate,  
               fn state => evalActs act state retState  
             )  
           )  
957    
958        (* 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. *)
959    
# Line 1014  Line 962 
962           | _ => false           | _ => false
963          (* end case *))          (* end case *))
964    
       fun extractVarMap(TE(blks, map)) = map  
   
       fun convertDemand (name, x) = ("ps_" ^ name, x)  
   
965            val outPgm = PSysIR.PGM {            val outPgm = PSysIR.PGM {
966              globals = PSV.Map.filter isGlobal (extractVarMap env),              globals = PSV.Map.filter isGlobal v_env,
967              persistents = List.map convertDemand demand,          emitter = emitterBlock,
968              uveOptimized = false,              physics = physicsBlock,
         emitter = entryBlock,  
             physics = List.nth(!blks, 1),  
969              render = render              render = render
970            }            }
971    
972            val optimized = if (Checker.checkIR(outPgm)) then (printErr "Pre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm            val optimized = if (Checker.checkIR(outPgm)) then (printErr "\nPre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
   
973            in            in
             (* IR.outputPgm(TextIO.stdErr, outPgm); *)  
   
974              (* Note: it only succeeds if we can optimize, too *)              (* Note: it only succeeds if we can optimize, too *)
975          if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();          if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();
976    

Legend:
Removed from v.1129  
changed lines
  Added in v.1158

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