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 1137, Sun May 1 20:39:30 2011 UTC
# Line 119  Line 119 
119            letPRIM(var, IR.T_FLOAT, IR.ADD, [termOne, termTwo], stmt)            letPRIM(var, IR.T_FLOAT, IR.ADD, [termOne, termTwo], stmt)
120            ))))            ))))
121    
122           | _ => raise Fail "Unable to create random float for specified distribution."           | _ => raise Fail "Unable to create random float for specified distribution"
123         (* end case *))         (* end case *))
124       in       in
125       (case domain       (case domain
# Line 133  Line 133 
133           letPRIM("scale", IR.T_FLOAT, IR.MULT, [diff, rand], fn scale =>           letPRIM("scale", IR.T_FLOAT, IR.MULT, [diff, rand], fn scale =>
134           letPRIM( fltVar, IR.T_FLOAT, IR.ADD, [psvToIRVar(env, max), scale], stmt )           letPRIM( fltVar, IR.T_FLOAT, IR.ADD, [psvToIRVar(env, max), scale], stmt )
135           )))           )))
136         | _ => raise Fail "Cannot generate float in specified domain."         | _ => raise Fail ("Cannot generate float in specified domain: " ^ (P.dToStr domain))
137       (* end case *))       (* end case *))
138      end      end
139    
# Line 150  Line 150 
150                  letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)                  letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)
151    
152              | P.D_LINE({pt1, pt2}) =>              | P.D_LINE({pt1, pt2}) =>
153    
154                (* Lerp between the points. *)                (* Lerp between the points. *)
155                  letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>                  letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
156                  letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>                  letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>
# Line 195  Line 196 
196    
197    
198              | P.D_TRIANGLE{pt1, pt2, pt3} =>              | P.D_TRIANGLE{pt1, pt2, pt3} =>
199    
200                  letPRIM ("pt1ToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn pt1ToPt2 =>                  letPRIM ("pt1ToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn pt1ToPt2 =>
201                  letPRIM ("pt1ToPt3", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt3), psvToIRVar(env, pt1)], fn pt1ToPt3 =>                  letPRIM ("pt1ToPt3", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt3), psvToIRVar(env, pt1)], fn pt1ToPt3 =>
202                  letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>                  letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>
# Line 227  Line 229 
229                   end                   end
230    
231              | P.D_DISC {pt, normal, irad, orad} =>              | P.D_DISC {pt, normal, irad, orad} =>
232    
233                (* Get a random angle... *)                (* Get a random angle... *)
234                  letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>                  letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>
235                  letPRIM ("t", IR.T_FLOAT, IR.MULT, [randForAng, IR.newConst("fullCir", IR.C_FLOAT (2.0 * pi))], fn randAng =>                  letPRIM ("t", IR.T_FLOAT, IR.MULT, [randForAng, IR.newConst("fullCir", IR.C_FLOAT (2.0 * pi))], fn randAng =>
236    
237                (* Get a random radius *)                (* Get a random radius *)
238                  letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>                  letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>
239                  letPRIM ("e0sq", IR.T_FLOAT, IR.MULT, [newRand, newRand], fn randRadSq =>                  letPRIM ("e0sq", IR.T_FLOAT, IR.MULT, [newRand, newRand], fn randRadSq =>
240                  letPRIM ("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>                  letPRIM ("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
241                  letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>                  letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>
242                  letPRIM ("newRad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), newRadDist], fn newRad =>                  letPRIM ("newRad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), newRadDist], fn newRad =>
243    
244                (* Find a vector in the plane of the disc, and then                (* Find a vector in the plane of the disc, and then
245                 * translate it to the center.               * translate it to the center. *)
                *)  
246                  letPRIM ("ntoc", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn normToCen =>                  letPRIM ("ntoc", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn normToCen =>
247                  letPRIM ("v", IR.T_VEC, IR.CROSS, [psvToIRVar(env, pt), normToCen], fn vecInDisc =>                  letPRIM ("v", IR.T_VEC, IR.CROSS, [psvToIRVar(env, pt), normToCen], fn vecInDisc =>
248                  letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>                  letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>
249                  letPRIM ("p", IR.T_VEC, IR.CROSS, [vecInDiscNorm, psvToIRVar(env, normal)], fn ptInDisc =>                  letPRIM ("p", IR.T_VEC, IR.CROSS, [vecInDiscNorm, psvToIRVar(env, normal)], fn ptInDisc =>
250                  letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>                  letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>
251    
252                (* Figure out x and y values for our new radius and angle *)                (* Figure out x and y values for our new radius and angle *)
253                  letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>                  letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>
254                  letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>                  letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>
# Line 252  Line 257 
257                  letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>                  letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>
258                  letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>                  letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>
259                  letPRIM ("res", IR.T_VEC, IR.ADD_VEC, [resVecOne, resVecTwo], fn result =>                  letPRIM ("res", IR.T_VEC, IR.ADD_VEC, [resVecOne, resVecTwo], fn result =>
260                  letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt))))))))))))))))))))  
261                letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [result, psvToIRVar(env, pt)], stmt)
262                )))))))))))))))))))
263    
264              | P.D_CONE{pt1, pt2, irad, orad} => let              | P.D_CONE{pt1, pt2, irad, orad} => let
265                  val normVar = PSV.new("local_ht", PSV.T_VEC3F)                  val normVar = PSV.new("local_ht", PSV.T_VEC3F)
# Line 269  Line 276 
276                      letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>                      letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>
277                      letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>                      letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>
278                      letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>                      letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>
279                      letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))               letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)
280                 ))))))))
281                  end                  end
282    
283                  | P.D_SPHERE{center, irad, orad} =>                  | P.D_SPHERE{center, irad, orad} =>
284    
285            (* generate two random angles... *)                    (* Source: http://mathworld.wolfram.com/SpherePointPicking.html *)
286            letPRIM("r1", IR.T_FLOAT, IR.RAND, [], fn randForAngOne =>  
287            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
288            letPRIM("r2", IR.T_FLOAT, IR.RAND, [], fn randForAngTwo =>             * represent cos(theta), and the other will be called v and will
289            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] *)
290              letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn rv =>
291            (* Generate vector in the sphere ... *)            letPRIM("dblRandVal", IR.T_FLOAT, IR.MULT, [rv, IR.newConst("Two", IR.C_FLOAT 2.0)], fn drv =>
292            (* 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 =>
293             * <(cos t1)(cos t2), (sin t1)(cos t2), sin t2>  
294             * This is different from wikipedia's article on spherical coordinates            letPRIM("rv2", IR.T_FLOAT, IR.RAND, [], fn rv2 =>
295             * 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 =>
296             * it's irrelevant.  
297             *)            letPRIM("cosTheta", IR.T_FLOAT, IR.COS, [theta], fn cosT =>
298            letPRIM("cost1", IR.T_FLOAT, IR.COS, [randAngOne], fn cost1 =>            letPRIM("sinTheta", IR.T_FLOAT, IR.SIN, [theta], fn sinT =>
299            letPRIM("cost2", IR.T_FLOAT, IR.COS, [randAngTwo], fn cost2 =>  
300            letPRIM("sint1", IR.T_FLOAT, IR.SIN, [randAngOne], fn sint1 =>            letPRIM("usq", IR.T_FLOAT, IR.MULT, [u, u], fn usq =>
301            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 =>
302              letPRIM("sinPhi", IR.T_FLOAT, IR.SQRT, [usqInv], fn sinP =>
303            letPRIM("xVal", IR.T_FLOAT, IR.MULT, [cost1, cost2], fn xVal =>  
304            letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sint1, cost2], fn yVal =>            letPRIM("xVal", IR.T_FLOAT, IR.MULT, [sinP, cosT], fn xVal =>
305            (* zval is just sint2 *)            letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sinP, sinT], fn yVal =>
306              (* zval is just u *)
307            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 =>  
308            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 =>  
309    
310            (* Generate a random radius... *)            (* Generate a random radius... *)
311                    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 319  Line 322 
322                    letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [rad, vec], fn sVec =>                    letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [rad, vec], fn sVec =>
323                    letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [sVec, psvToIRVar(env, center)], stmt)                    letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [sVec, psvToIRVar(env, center)], stmt)
324                    ))))))))))                    ))))))))))
325                    ))))))))))))                    )))))))))))))
                   ))))  
326    
327              | _ => raise Fail "Cannot generate point in specified domain."              | _ => raise Fail ("Cannot generate point in specified domain: "  ^ (P.dToStr domain))
328            (* 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  
           *)  
329    
330    (* This function takes an IR boolean, its environment, a particle state, domain,    (* This function takes an IR boolean, its environment, a particle state, domain,
331     * and continuation.     * and continuation.
# Line 463  Line 459 
459                | P.D_BLOB {center: vec3f var, stddev: float var}                | P.D_BLOB {center: vec3f var, stddev: float var}
460                | P.D_DISC {pt: vec3f var, normal: vec3f var, irad: float var, orad: float var}                | P.D_DISC {pt: vec3f var, normal: vec3f var, irad: float var, orad: float var}
461  *)  *)
462                | _ => raise Fail "Cannot determine within-ness for specified vec3 domain."                | _ => raise Fail ("Cannot determine within-ness for specified vec3 domain: " ^ (P.dToStr d))
463              (* end case *)              (* end case *)
464            end (*end let *)            end (*end let *)
465    
# Line 473  Line 469 
469               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 =>
470               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 =>
471               letPRIM(boolVar, IR.T_BOOL, IR.AND, [bigMin, smallMax], stmt)))               letPRIM(boolVar, IR.T_BOOL, IR.AND, [bigMin, smallMax], stmt)))
472             | _ => raise Fail "Cannot determine within-ness for specified float domain."             | _ => raise Fail ("Cannot determine within-ness for specified float domain: " ^ (P.dToStr d))
473           (* end case *))           (* end case *))
474    
475          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, state, k : IR.var -> particle_state -> IR.stmt) = let
476            val _ = ()            val _ = ()
477           in           in
478            (case d            (case d
# Line 498  Line 494 
494               letPRIM("distDiffAbs", IR.T_FLOAT, IR.ABS, [distDiff], fn distDiffAbs =>               letPRIM("distDiffAbs", IR.T_FLOAT, IR.ABS, [distDiff], fn distDiffAbs =>
495    
496               (* Do the boolean stuff... *)               (* Do the boolean stuff... *)
497               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 state)
498    
499               )))               )))
500               )))               )))
501               )))               )))
502    
503              | _ => raise Fail ("Cannot calculate intersection for specified domain")              | P.D_PLANE {pt, normal} =>
504                  letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
505                  letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
506                  letPRIM("p2d", IR.T_FLOAT, IR.DOT, [p2var, psvToIRVar(env, normal)], fn p2d =>
507                  letPRIM("p1dist", IR.T_FLOAT, IR.SUB, [d, p1d], fn p1dist =>
508                  letPRIM("p2dist", IR.T_FLOAT, IR.SUB, [d, p2d], fn p2dist =>
509                  letPRIM("distProd", IR.T_FLOAT, IR.MULT, [p1dist, p2dist], fn distProd =>
510                  letPRIM("intersect", IR.T_BOOL, IR.GT, [IR.newConst("zero", IR.C_FLOAT 0.0), distProd], fn intVar => k intVar state)
511                  ))))))
512    
513                | P.D_DISC {pt, normal, orad, irad} => let
514                  val boolVar = IR.newParam("intersect", IR.T_BOOL)
515                  val newBlk = newBlockWithArgs(env, state, [boolVar], k boolVar)
516                 in
517                  letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
518                  letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
519    
520                  (* Early out... does it intersect the plane?
521                   *
522                   * !SPEED! Due to the perceived slowness of branching on
523                   * GPUs, this might not actually be faster on all runtime environments *)
524    
525                  letPRIM("p2d", IR.T_FLOAT, IR.DOT, [p2var, psvToIRVar(env, normal)], fn p2d =>
526                  letPRIM("p1dist", IR.T_FLOAT, IR.SUB, [d, p1d], fn p1dist =>
527                  letPRIM("p2dist", IR.T_FLOAT, IR.SUB, [d, p2d], fn p2dist =>
528                  letPRIM("distProd", IR.T_FLOAT, IR.MULT, [p1dist, p2dist], fn distProd =>
529                  letPRIM("earlyOut", IR.T_BOOL, IR.GT, [distProd, IR.newConst("zero", IR.C_FLOAT 0.0)], fn earlyOut =>
530                  IR.mkIF(earlyOut,
531                    (* then *)
532                    letPRIM("intersect", IR.T_BOOL, IR.NOT, [earlyOut], fn var => gotoWithArgs(state, [var], newBlk)),
533                    (* else *)
534                    letPRIM("v", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn v =>
535                    letPRIM("vDotn", IR.T_FLOAT, IR.DOT, [v, psvToIRVar(env, normal)], fn vdn =>
536                    letPRIM("t", IR.T_FLOAT, IR.DIV, [p1dist, vdn], fn t =>
537    
538                    (* !TODO! Add some sort of assert mechanism to make sure that t is
539                     * in the interval [0, 1]... *)
540                    letPRIM("vscale", IR.T_VEC, IR.SCALE, [t, v], fn vscale =>
541                    letPRIM("ppt", IR.T_VEC, IR.ADD_VEC, [p1var, vscale], fn ppt =>
542                    letPRIM("lenVec", IR.T_VEC, IR.SUB_VEC, [ppt, psvToIRVar(env, pt)], fn cv =>
543                    letPRIM("len", IR.T_FLOAT, IR.LEN, [cv], fn len =>
544    
545                    (* Check to see whether or not it's within the radius... *)
546                    letPRIM("gtirad", IR.T_BOOL, IR.GT, [len, psvToIRVar(env, irad)], fn gtirad =>
547                    letPRIM("ltorad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), len], fn ltorad =>
548                    letPRIM("intersect", IR.T_BOOL, IR.AND, [gtirad, ltorad], fn var => gotoWithArgs(state, [var], newBlk))
549                   ))))))))))
550                 )))))))
551                end (* P.D_DISC *)
552    
553                | _ => raise Fail ("Cannot calculate intersection bool for specified domain: " ^ (P.dToStr d))
554            (* end case *))            (* end case *))
555    
556           end (* mkIntBool *)           end (* mkIntBool *)
557    
558            (* We assume that the segment already intersects with the domain. *)
559          fun mkIntPt(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let          fun mkIntPt(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let
560            val _ = ()            val _ = ()
561           in           in
562            (case d            (case d
563              of P.D_POINT(pt) => k (psvToIRVar (env, pt))              of P.D_POINT(pt) => k (psvToIRVar (env, pt))
564               | _ => raise Fail ("Cannot calculate intersection for specified domain")  
565                 | P.D_PLANE {pt, normal} =>
566                   letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
567                   letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
568                   letPRIM("num", IR.T_FLOAT, IR.SUB, [d, p1d], fn num =>
569                   letPRIM("v", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn v =>
570                   letPRIM("den", IR.T_FLOAT, IR.DOT, [v, psvToIRVar(env, normal)], fn den =>
571                   letPRIM("t", IR.T_FLOAT, IR.DIV, [num, den], fn t =>
572                   letPRIM("vsc", IR.T_VEC, IR.SCALE, [t, v], fn vs =>
573                   letPRIM("intPt", IR.T_VEC, IR.ADD_VEC, [p1var, vs], k)
574                   )))))))
575    
576                 (* Since we already know they intersect, the intersection point must be
577                  * just the point that's on the plane... *)
578                 | P.D_DISC {pt, normal, orad, irad} => mkIntPt(env, p1var, p2var, P.D_PLANE{pt = pt, normal = normal}, k)
579                 | _ => raise Fail ("Cannot calculate intersection point for specified domain: "  ^ (P.dToStr d))
580            (* end case *))            (* end case *))
581           end (* mkIntPt *)           end (* mkIntPt *)
582    
583      (* Find the normal at the given position of the particle for the specified      (* Find the normal at the given position of the particle for the specified
584       * domain. Note, that the particle doesn't necessarily need to be on the       * domain. Note, that the particle doesn't necessarily need to be on the
585       * domain, but if it's not then the behavior is undefined.       * domain, but if it's not then the behavior is undefined. *)
      *)  
586      fun normAtPoint(retNorm, d, env, pos, state, k : IR.var -> particle_state -> IR.stmt) = let      fun normAtPoint(retNorm, d, env, pos, state, k : IR.var -> particle_state -> IR.stmt) = let
587        val newNorm = IR.newParam("n", IR.T_VEC)        val newNorm = IR.newParam("n", IR.T_VEC)
588        val nextBlk = newBlockWithArgs(env, state, [newNorm], k(newNorm))        val nextBlk = newBlockWithArgs(env, state, [newNorm], k(newNorm))
# Line 549  Line 610 
610                  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
611                    ))                    ))
612    
613             | _ => raise Fail("Cannot find normal to point of specified domain.")             | _ => raise Fail("Cannot find normal to point of specified domain." ^ (P.dToStr d))
614           (* end case *))           (* end case *))
615          end          end
616    
# Line 589  Line 650 
650           in           in
651            (case (vt1, vt2)            (case (vt1, vt2)
652              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], k)
653               | (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], k)
654               | _ => raise Fail ("Type mismatch to SCALE expression")               | _ => raise Fail (String.concat["Type mismatch to SCALE expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
655            (* end case *))            (* end case *))
656           end))           end))
657    
# Line 603  Line 664 
664           in           in
665            (case (vt1, vt2)            (case (vt1, vt2)
666              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], k)
667               | _ => raise Fail ("Type mismatch to DIV expression")               | _ => raise Fail (String.concat["Type mismatch to DIV expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
668            (* end case *))            (* end case *))
669           end))           end))
670    
# Line 662  Line 723 
723            val IR.V{varType, ...} = evar            val IR.V{varType, ...} = evar
724           in           in
725            (case varType            (case varType
726              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], k)
727               | _ => raise Fail ("Type mismatch to LENGTH expression")               | _ => raise Fail ("Type mismatch to LENGTH expression")
728            (* end case *))            (* end case *))
729           end)           end)
# Line 693  Line 754 
754            (* end case *))            (* end case *))
755           end)           end)
756    
757           | P.LOOKUP (varName) => let
758             fun findVar (IR.V{name, ...}) = name = varName
759            in
760             (case (List.find findVar state)
761               of SOME v => k v
762                | NONE => raise Fail("Compiler Error: Undefined variable: " ^ varName)
763             (* end case *))
764            end
765    
766            (* end case expr *))            (* end case expr *))
767    
768            (* generate code to produce a random particle state from a domain *)            (* generate code to produce a random particle state from a domain *)
# Line 740  Line 810 
810         retState state))         retState state))
811       end       end
812    
 (*  
 //  
     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  
 *)  
   
813      (* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)      (* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)
814      (* 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) *)
815      fun trPred(cond, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let      fun trPred(cond, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
# Line 885  Line 825 
825           | P.DO_INTERSECT {p1, p2, d} =>           | P.DO_INTERSECT {p1, p2, d} =>
826             trExpr(p1, env, state, fn p1var =>             trExpr(p1, env, state, fn p1var =>
827             trExpr(p2, env, state, fn p2var =>             trExpr(p2, env, state, fn p2var =>
828             mkIntBool(env, p1var, p2var, d, k)))             mkIntBool(env, p1var, p2var, d, state, fn var => fn state' => k var)))
829    
830           | P.GTHAN (e1, e2) =>           | P.GTHAN (e1, e2) =>
831             trExpr(e1, env, state, fn e1var =>             trExpr(e1, env, state, fn e1var =>
# Line 923  Line 863 
863      }) = let      }) = let
864        val blks = ref[]        val blks = ref[]
865    
866          fun printVar (PSV.V{name, id, ...}) =
867            printErr (String.concat[name, ": ", Int.toString id])
868    
869        val demand = IR.getDemand(render)        val demand = IR.getDemand(render)
870        fun getIRNameForSV (v as PSV.SV{name, ...}) =        fun getIRNameForSV (v as PSV.SV{name, ...}) =
871         (case (PSV.SVMap.find (render_vars, v))         (case (PSV.SVMap.find (render_vars, v))
# Line 967  Line 910 
910                   | oneAct :: rest => evalActs oneAct state (fn state' => (evalActs (P.SEQ(rest)) state' f))                   | oneAct :: rest => evalActs oneAct state (fn state' => (evalActs (P.SEQ(rest)) state' f))
911                  (* end case *))                  (* end case *))
912    
913                 | P.PRED(cond, thenAct, elseAct) =>                 | P.PRED(cond, thenAct, elseAct) => let
914                       val joinBlk = newBlock (env, state, fn state' => f state')
915                       fun joinActs state = IR.mkGOTO(joinBlk, state)
916                      in
917                   trPred(cond, env, state,                   trPred(cond, env, state,
918                     fn state' => evalActs thenAct state' f,                       fn state' => evalActs thenAct state' joinActs,
919                     fn state' => evalActs elseAct state' f                       fn state' => evalActs elseAct state' joinActs
920                   )                   )
921                      end
922    
923                 | P.DIE => IR.DISCARD                 | P.DIE => IR.DISCARD
924    
# Line 993  Line 940 
940                     fn thisVar => f (replaceStateVar(thisVar, state))))                     fn thisVar => f (replaceStateVar(thisVar, state))))
941                  end                  end
942    
943                   | P.LET(P.V(varName), exp, act) =>
944                     trExpr(exp, env, state, fn newVar => let
945    
946                       val joinBlk = newBlock(env, state, f)
947    
948                       fun inOriginalState (IR.V{name=vn, ...}) = let
949                         fun nameCompare (IR.V{name=vn1, ...}) = vn = vn1
950                        in
951                         List.exists nameCompare state
952                        end
953    
954                       fun gotoJoinBlk state' = goto(List.filter inOriginalState state', joinBlk)
955    
956                       val IR.V{varType, ...} = newVar
957                       val newParam = IR.newParam(varName, varType)
958                       val newState = newParam :: state
959    
960                       val blk = newBlock(env, newState, fn state' => evalActs act state' gotoJoinBlk)
961                      in
962                       goto(newState, blk)
963                      end
964                     )
965    
966                (* end case *))                (* end case *))
967    
968            (* 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. *)
# Line 1027  Line 997 
997              render = render              render = render
998            }            }
999    
1000              val _ = IR.outputPgm(TextIO.stdErr, outPgm)
1001            val optimized = if (Checker.checkIR(outPgm)) then (printErr "Pre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm            val optimized = if (Checker.checkIR(outPgm)) then (printErr "Pre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
1002    
1003            in            in
             (* IR.outputPgm(TextIO.stdErr, outPgm); *)  
   
1004              (* Note: it only succeeds if we can optimize, too *)              (* Note: it only succeeds if we can optimize, too *)
1005          if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();          if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();
1006    

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

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