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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1147 - (download) (annotate)
Fri May 6 06:39:09 2011 UTC (8 years, 5 months ago) by pavelk
File size: 46083 byte(s)
Changed the plane normal vector calculation. Also, got rid of the notion of particle state, and made it so that block parameters are passed through an environment that keeps track of particle state variable to IR variable mappings.
(* translate.sml
 
 * COPYRIGHT (c) 2009 John Reppy (http://cs.uchicago.edu/~jhr)
 * All rights reserved.
 *
 * Translate a particle system to the IR.
 *)

structure Translate : sig

    val compile : Particles.program -> PSysIR.program

  end = struct

    open SML3dTypeUtil

    structure P = ParticlesImp
    structure PSV = P.PSV
    structure IR = PSysIR
    
    fun printErr s = TextIO.output(TextIO.stdErr, s ^ "\n")

  (* special PSV global variables *)
    val epsilon = PSV.constf(0.00001)
    
  (* constants *)  
    val pi = 3.14159265358979
    
  (* translation environment *)
    datatype ir_env = TE of (IR.block list ref * IR.var PSV.Map.map * IR.var PSV.SVMap.map)
    fun insertVar (TE(blks, v_env, sv_env), x, x') = TE(blks, PSV.Map.insert (v_env, x, x'), sv_env)
    fun insertSVar (TE(blks, v_env, sv_env), x, x') = TE(blks, v_env, PSV.SVMap.insert (sv_env, x, x'))

    fun retState (TE(_, _, sv_env)) = IR.mkRETURN (PSV.SVMap.listItems sv_env)

  (* Interaction with environment and psys variables *)
    fun psvToIRVar (TE(_, env, _), x as PSV.V{name, id, ...}) = (case PSV.Map.find(env, x)
	   of SOME x' => x'
	    | NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])
	    (* end case *))

    fun pssvToIRVar (TE(_, _, env), x as PSV.SV{name, id, ...}) = (case PSV.SVMap.find(env, x)
	   of SOME x' => x'
	    | NONE => raise Fail (String.concat["unknown state variable ", name, " with ID ", Int.toString id])
	    (* end case *))
	    	 
   (* create a block that implements the given continuation *)  
    fun newBlockWithArgs (env as TE(blks, _, sv_env), args, k : ir_env -> IR.stmt) = let
       fun copyVar(v as IR.V{name, varType, ...}) = IR.newParam(name, varType)
       val newState = List.map copyVar (PSV.SVMap.listItems sv_env)
       fun inssv((oldv, newv), TE(theBlks, v_env, svenv)) = let
         val theKey = 
           List.find 
            (fn v => IR.varEq(PSV.SVMap.lookup(svenv, v), oldv)) 
            (PSV.SVMap.listKeys svenv)
        in
         (case theKey
           of SOME sv => TE(theBlks, v_env, PSV.SVMap.insert(svenv, sv, newv))
            | NONE => raise Fail("Trying to create new mapping for variable that doesn't already exist.")
         (* end case *))
        end
        
	   val blk = IR.newBlock (
	       newState @ args, 
	       k (List.foldl inssv env 
	           (ListPair.zipEq 
	               (PSV.SVMap.listItems sv_env, newState)
	           )
	       )
	    )
	  in
	   blks := blk :: !blks;
	   blk
	  end
	  
	fun newBlock (env, k) = newBlockWithArgs(env, [], k)

    fun gotoWithArgs(TE(_, _, env), args, blk) = IR.mkGOTO(blk, (PSV.SVMap.listItems env) @ args)
    fun goto (env, blk) = gotoWithArgs(env, [], blk)

    fun letPRIM (x, ty, p, args, body) = let
	  val x' = IR.newLocal(x, ty, (p, args))
	  in
	    IR.mkPRIM(x', p, args, body x')
	  end

  (* Not sure if this should be made into a primitive or not, but
   * basically this creates the XOR'd value of var1 and var2 and
   * stores it in result. *)
    fun mkXOR (result, var1, var2, stmt : IR.var -> IR.stmt) =
	  letPRIM("testOR", IR.T_BOOL, IR.OR, [var1, var2], fn testOR =>
	  letPRIM("testAND", IR.T_BOOL, IR.AND, [var1, var2], fn testAND =>
	  letPRIM("testNAND", IR.T_BOOL, IR.NOT, [testAND], fn testNAND =>
	  letPRIM(result, IR.T_BOOL, IR.AND, [testOR, testNAND], stmt))))
      	  
    fun genFloatVar (fltVar, env, domain : Float.float P.domain, dist, stmt : IR.var -> IR.stmt) = let
      fun genRandVal(var, stmt : IR.var -> IR.stmt) = (case dist
        of P.DIST_UNIFORM =>
          letPRIM(var, IR.T_FLOAT, IR.RAND, [], stmt)
         
         (* The PDF here is f(x) = 2x when 0 < x <= 1, so the CDF is going
          * to be the integral of f from 0 -> y => y^2. Hence, whenever we
          * generate a random number, in order to get the random value according
          * to this probability distribution, we just square it. *)
         | P.DIST_INC_LIN =>
          letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
          letPRIM(var, IR.T_FLOAT, IR.MULT, [randVal, randVal], stmt))
          
         (* The PDF here is f(x) = -2x + 2 when 0 <= x < 1, so the CDF is going
          * to be the integral of f from 0 -> y => -(y^2) + 2y. Hence, whenever we
          * generate a random number, in order to get the random value according
          * to this probability distribution, we just square it.
          *)
         | P.DIST_DEC_LIN =>
          letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
          letPRIM("randSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randSq =>
          letPRIM("termOne", IR.T_FLOAT, IR.MULT, [randSq, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn termOne =>
          letPRIM("termTwo", IR.T_FLOAT, IR.MULT, [randVal, IR.newConst("negOne", IR.C_FLOAT 2.0)], fn termTwo =>
          letPRIM(var, IR.T_FLOAT, IR.ADD, [termOne, termTwo], stmt)
          ))))
         
         | _ => raise Fail "Unable to create random float for specified distribution"
       (* end case *))
     in
     (case domain
      of P.D_POINT(pt) =>
         (* Our options here are pretty limited... *)
         letPRIM (fltVar, IR.T_FLOAT, IR.COPY, [psvToIRVar(env, pt)], stmt)
	
       | P.D_BOX{max, min} =>
         genRandVal("randf", fn rand =>
         letPRIM("boxDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, max), psvToIRVar(env, max)], fn diff =>
         letPRIM("scale", IR.T_FLOAT, IR.MULT, [diff, rand], fn scale =>
         letPRIM( fltVar, IR.T_FLOAT, IR.ADD, [psvToIRVar(env, max), scale], stmt )
         )))
       | _ => raise Fail ("Cannot generate float in specified domain: " ^ (P.dToStr domain))
     (* end case *))
    end
	  
  (* Generates a random vector within the given domain and puts it in vecVar *)
    fun genVecVar (
      vecVar, 
      env, 
      domain : Vec3f.vec3 P.domain, 
      dist : Vec3f.vec3 P.distribution,
      stmt : IR.var -> IR.stmt
    ) = (case domain
	   of P.D_POINT(pt) =>
	     (* Our options here are pretty limited... *)
		letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)
	  
	    | P.D_LINE({pt1, pt2}) =>
	    
	        (* Lerp between the points. *)
            letPRIM ("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
            letPRIM ("randInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), randVal], fn randInv =>
            letPRIM ("pt1s", IR.T_VEC, IR.SCALE, [randVal, psvToIRVar(env, pt1)], fn pt1ScaleVec =>
            letPRIM ("pt2s", IR.T_VEC, IR.SCALE, [randInv, psvToIRVar(env, pt2)], fn pt2ScaleVec =>
            letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))
	  
	    | P.D_BOX{max, min} => 
	    	(* Extract the componentwise vector variables *)
	    	letPRIM("minX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, min)], fn minX =>
	    	letPRIM("maxX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, max)], fn maxX =>
	    	letPRIM("minY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, min)], fn minY =>
	    	letPRIM("maxY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, max)], fn maxY =>
	    	letPRIM("minZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, min)], fn minZ =>
	    	letPRIM("maxZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, max)], fn maxZ =>
	    	
	    	(* Find the distance in each component *)
	    	letPRIM("distX", IR.T_FLOAT, IR.SUB, [maxX, minX], fn distX =>
	    	letPRIM("distY", IR.T_FLOAT, IR.SUB, [maxY, minY], fn distY =>
	    	letPRIM("distZ", IR.T_FLOAT, IR.SUB, [maxZ, minZ], fn distZ =>
	    	
	    	(* Get three random numbers for each of the components *)
	    	letPRIM("randX", IR.T_FLOAT, IR.RAND, [], fn randX =>
	    	letPRIM("randY", IR.T_FLOAT, IR.RAND, [], fn randY =>
	    	letPRIM("randZ", IR.T_FLOAT, IR.RAND, [], fn randZ =>
	    	
	    	(* Scale the distances by these random numbers *)
	    	letPRIM("scaledX", IR.T_FLOAT, IR.MULT, [randX, distX], fn scaledX =>
	    	letPRIM("scaledY", IR.T_FLOAT, IR.MULT, [randY, distY], fn scaledY =>
	    	letPRIM("scaledZ", IR.T_FLOAT, IR.MULT, [randZ, distZ], fn scaledZ =>
	    	
	    	(* Add them to the minimum vec in order to create a new vec inside
	    	 * of the box.
	    	 *)
	    	letPRIM("newX", IR.T_FLOAT, IR.ADD, [minX, scaledX], fn newX =>
	    	letPRIM("newY", IR.T_FLOAT, IR.ADD, [minY, scaledY], fn newY =>
	    	letPRIM("newZ", IR.T_FLOAT, IR.ADD, [minZ, scaledZ], fn newZ =>
	    	
	    	(* Gen the vector *)
	    	letPRIM(vecVar, IR.T_VEC, IR.GEN_VEC, [newX, newY, newZ], stmt
	    	
	    	)))))))))))))))))))
	    	
	   
        | P.D_TRIANGLE{pt1, pt2, pt3} =>

            letPRIM ("pt1ToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn pt1ToPt2 =>
            letPRIM ("pt1ToPt3", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt3), psvToIRVar(env, pt1)], fn pt1ToPt3 =>
            letPRIM ("randOne", IR.T_FLOAT, IR.RAND, [], fn rand1 =>
            letPRIM ("randTwo", IR.T_FLOAT, IR.RAND, [], fn rand2 =>
            letPRIM ("randTwoInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), rand2], fn rand2Inv =>
            letPRIM ("scaleOne", IR.T_VEC, IR.SCALE, [rand1, pt1ToPt2], fn scale1 =>
            letPRIM ("nextScale1", IR.T_VEC, IR.SCALE, [rand2Inv, scale1], fn nextScale1 =>
            letPRIM ("scaleTwo", IR.T_VEC, IR.SCALE, [rand2, pt1ToPt3], fn scale2 =>
            letPRIM ("tempAdd", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, pt1), nextScale1], fn tempAdd =>
            letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [tempAdd, scale2], stmt))))))))))
      
	    | P.D_CYLINDER {pt1, pt2, irad, orad} => let 
		  val normVar = PSV.new("local_ht", PSV.T_VEC3F)
		 in
		  letPRIM("rand", IR.T_FLOAT, IR.RAND, [], fn ourRand =>
		  letPRIM("n", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
		  letPRIM("ht", IR.T_FLOAT, IR.LEN, [normVec], fn height =>
		  letPRIM("htInv", IR.T_FLOAT, IR.DIV, [IR.newConst("one", IR.C_FLOAT 1.0), height], fn htInv =>
		  letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>
		  (* Generate a point in the lower disc. *)
		    genVecVar("ptInDisc", 
		      insertVar(env, normVar, norm), 
		      P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
		      dist,
		      fn ptInDisc =>
		  (* Now add this point to a random scaling of the normVec. *)
		    letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>
		    letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>
		    letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)))))))))
		 end

        | P.D_DISC {pt, normal, irad, orad} =>

            (* Get a random angle... *)
            letPRIM ("r", IR.T_FLOAT, IR.RAND, [], fn randForAng =>
            letPRIM ("t", IR.T_FLOAT, IR.MULT, [randForAng, IR.newConst("fullCir", IR.C_FLOAT (2.0 * pi))], fn randAng =>
            
            (* Get a random radius *)
            letPRIM ("e0", IR.T_FLOAT, IR.RAND, [], fn newRand =>
            letPRIM ("e0sq", IR.T_FLOAT, IR.MULT, [newRand, newRand], fn randRadSq =>
            letPRIM ("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
            letPRIM ("newRadDist", IR.T_FLOAT, IR.MULT, [randRadSq, radDiff], fn newRadDist =>
            letPRIM ("newRad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), newRadDist], fn newRad =>
            
            (* Find a vector in the plane of the disc, and then
             * translate it to the center. *)
            letPRIM ("ntoc", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn normToCen =>
            letPRIM ("v", IR.T_VEC, IR.CROSS, [psvToIRVar(env, pt), normToCen], fn vecInDisc =>
            letPRIM ("vidn", IR.T_VEC, IR.NORM, [vecInDisc], fn vecInDiscNorm =>
            letPRIM ("p", IR.T_VEC, IR.CROSS, [vecInDiscNorm, psvToIRVar(env, normal)], fn ptInDisc =>
            letPRIM ("pidn", IR.T_VEC, IR.NORM, [ptInDisc], fn ptInDiscNorm =>
            
            (* Figure out x and y values for our new radius and angle *)
            letPRIM ("rx", IR.T_FLOAT, IR.COS, [randAng], fn radX =>
            letPRIM ("ar1", IR.T_FLOAT, IR.MULT, [newRad, radX], fn amtVecOne =>
            letPRIM ("rv1", IR.T_VEC, IR.SCALE, [amtVecOne, vecInDiscNorm], fn resVecOne =>
            letPRIM ("ry", IR.T_FLOAT, IR.SIN, [randAng], fn radY =>
            letPRIM ("ar2", IR.T_FLOAT, IR.MULT, [newRad, radY], fn amtVecTwo =>
            letPRIM ("rv2", IR.T_VEC, IR.SCALE, [amtVecTwo, ptInDiscNorm], fn resVecTwo =>
            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)
            )))))))))))))))))))
         
        | P.D_CONE{pt1, pt2, irad, orad} => let
             val normVar = PSV.new("local_ht", PSV.T_VEC3F)
            in
             letPRIM("eh",  IR.T_FLOAT, IR.RAND, [], fn ourRand =>
             letPRIM("nv", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
             letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>
             genVecVar("ptInDisc", 
              insertVar(env, normVar, norm), 
              P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
              dist,
              fn ptInDisc => 
             letPRIM("gptt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), ptInDisc], fn genPtToTip =>
             letPRIM("gpttlen", IR.T_FLOAT, IR.LEN, [genPtToTip], fn genPtToTipLen =>
             letPRIM("s", IR.T_FLOAT, IR.MULT, [genPtToTipLen, ourRand], fn scale =>
             letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, genPtToTip], fn scaledNormVec =>
             letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [ptInDisc, scaledNormVec], stmt)
             ))))))))
            end
		
		| P.D_SPHERE{center, irad, orad} =>
		  
		  (* Source: http://mathworld.wolfram.com/SpherePointPicking.html *)
		
          (* generate two random values... one will be called u and will 
           * represent cos(theta), and the other will be called v and will
           * represent a random value in [0, 2 * pi] *)
          letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn rv =>
          letPRIM("dblRandVal", IR.T_FLOAT, IR.MULT, [rv, IR.newConst("Two", IR.C_FLOAT 2.0)], fn drv =>
          letPRIM("rand", IR.T_FLOAT, IR.SUB, [drv, IR.newConst("One", IR.C_FLOAT 1.0)], fn u =>
          
          letPRIM("rv2", IR.T_FLOAT, IR.RAND, [], fn rv2 =>
          letPRIM("rand2", IR.T_FLOAT, IR.MULT, [rv2, IR.newConst("TwoPi", IR.C_FLOAT (2.0 * Float.M_PI))], fn theta =>          

          letPRIM("cosTheta", IR.T_FLOAT, IR.COS, [theta], fn cosT =>
          letPRIM("sinTheta", IR.T_FLOAT, IR.SIN, [theta], fn sinT =>
          
          letPRIM("usq", IR.T_FLOAT, IR.MULT, [u, u], fn usq =>
          letPRIM("usqInv", IR.T_FLOAT, IR.SUB, [IR.newConst("One", IR.C_FLOAT 1.0), usq], fn usqInv =>
          letPRIM("sinPhi", IR.T_FLOAT, IR.SQRT, [usqInv], fn sinP =>
          
          letPRIM("xVal", IR.T_FLOAT, IR.MULT, [sinP, cosT], fn xVal =>
          letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sinP, sinT], fn yVal =>
          (* zval is just u *)

          letPRIM("vec", IR.T_VEC, IR.GEN_VEC, [xVal, yVal, u], fn vec =>
          
          (* Generate a random radius... *)
		  letPRIM("ratio", IR.T_FLOAT, IR.DIV, [psvToIRVar(env, irad), psvToIRVar(env, orad)], fn ratio =>
		  letPRIM("invRatio", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), ratio], fn invRatio =>
		  letPRIM("randVar", IR.T_FLOAT, IR.RAND, [], fn rand =>
		  letPRIM("randScale", IR.T_FLOAT, IR.MULT, [rand, invRatio], fn randScale =>
		  letPRIM("randVal", IR.T_FLOAT, IR.ADD, [randScale, ratio], fn randVal =>
		  letPRIM("randValSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randValSq =>
		  letPRIM("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
		  letPRIM("randRadVal", IR.T_FLOAT, IR.MULT, [radDiff, randValSq], fn randRadVal =>
		  letPRIM("rad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), randRadVal], fn rad =>
		  
		  (* Normalize the vector and scale it by the radius. *)
		  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [rad, vec], fn sVec =>
		  letPRIM(vecVar, IR.T_VEC, IR.ADD_VEC, [sVec, psvToIRVar(env, center)], stmt)
		  ))))))))))
		  )))))))))))))
     
	    | _ => raise Fail ("Cannot generate point in specified domain: "  ^ (P.dToStr domain))
	  (* end case *))
	  
  (* This function takes an IR boolean, its environment, a particle state, domain, 
   * and continuation.
   *
   * We set the boolean to whether or not the current particle given by the particle
   * state is within the domain, and then pass the continuation on.
   *)
    fun mkVecWithinVar (boolVar, env, var, d : Vec3f.vec3 P.domain, stmt : IR.var -> IR.stmt) = let
	   val pos = var
	  in
	    case d
	     of P.D_POINT(pt) => 
		  letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn subVec =>
		  letPRIM("vecLen", IR.T_FLOAT, IR.LEN, [subVec], fn vecLen =>
		  letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), vecLen], stmt)))

        (* Take the vectors going from our position to pt1, and pt2. Then
         * after we normalize them, if their dot product is equal to -1, then
         * they are pointing in opposite directions meaning that the position
         * is inbetween pt1 and pt2 as desired.
         *)
	      | P.D_LINE{pt1, pt2} =>
		  letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn posToPt1 =>
		  letPRIM("posToPt1Norm", IR.T_VEC, IR.NORM, [posToPt1], fn posToPt1Norm =>
		  letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), pos], fn posToPt2 =>
		  letPRIM("posToPt2Norm", IR.T_VEC, IR.NORM, [posToPt2], fn posToPt2Norm =>
		  letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt2, posToPt1], fn dotProd =>
		  letPRIM("testMe", IR.T_FLOAT, IR.SUB, [dotProd, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn testVal =>
		  letPRIM(boolVar, IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), testVal], stmt)))))))
	    
	    (* Just see whether or not the dot product between the normal
	     * and the vector from a point on the plane to our position is
	     * greater than zero. Essentially, we're "within" a plane if we're
	     * behind it (with respect to the normal)
	     *)
	      | P.D_PLANE{pt, normal} => 
		  letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
		  letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
		  letPRIM(boolVar, IR.T_BOOL, IR.GT, [dotProd, IR.newConst("zero", IR.C_FLOAT 0.0)], stmt)))
	    
	    (* Similar to checking to see whether or not we're within a plane,
	     * here all we have to do is see how far we are from the center
	     * of the disc (pt), and then see whther or not we're perpendicular to
	     * the normal, and that our distance is greater than irad but less than
	     * orad.
	     *)
	      | P.D_DISC{pt, normal, orad, irad} => 
            letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
            letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
            letPRIM("inDisc", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.01), dotProd], fn inDisc =>
            
            letPRIM("parPosToP", IR.T_VEC, IR.SCALE, [dotProd, psvToIRVar(env, normal)], fn posToPtParallelToNormal =>
            letPRIM("perpPosToP", IR.T_VEC, IR.SUB_VEC, [posToPt, posToPtParallelToNormal], fn posToPtPerpToNormal =>
            letPRIM("inDiscLen", IR.T_FLOAT, IR.LEN, [posToPtPerpToNormal], fn posToPtLen =>
            
            letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOradGt =>
            letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), posToPtLen], fn inOradEq =>
            letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
            
            letPRIM("inIradGt", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIradGt =>
            letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [posToPtLen, psvToIRVar(env, irad)], fn inIradEq =>
            letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
            
            letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
            
            letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))))))))
		  
	    (* Simply see whether or not the distance from the center is within the 
	     * specified bounds.
	     *)
	      | P.D_SPHERE{center, orad, irad} =>
		  letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn posToC =>
		  letPRIM("posToPtLen", IR.T_VEC, IR.LEN, [posToC], fn posToCLen =>
		  letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToCLen], fn inOrad =>
		  letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToCLen, psvToIRVar(env, irad)], fn inIrad =>
		  letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))
		  
		  | P.D_CYLINDER {pt1, pt2, irad, orad} =>
		  
		  (* !FIXME! Right now, we see whether or not the point is within the two planes defined
		   * by the endpoints of the cylinder, and then testing to see whether or not the smallest
		   * distance to the line segment falls within the radii. It might be faster to find the
		   * closest point to the line defined by the endpoints and then see whether or not the point
		   * is within the segment.
		   *)
		  
		  (* Is it in one plane *)
		  letPRIM("plane1Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn plane1Norm =>
		  letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt1)], fn posToPt1 =>
		  letPRIM("dot1", IR.T_FLOAT, IR.DOT, [posToPt1, plane1Norm], fn dot1Prod =>
		  letPRIM("inPlane1", IR.T_BOOL, IR.GT, [dot1Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane1=>
		  
		  (* Is it in another plane *)
		  letPRIM("plane2Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), psvToIRVar(env, pt2)], fn plane2Norm =>
		  letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt2)], fn posToPt2 =>
		  letPRIM("dot2", IR.T_FLOAT, IR.DOT, [posToPt2, plane2Norm], fn dot2Prod =>
		  letPRIM("inPlane2", IR.T_BOOL, IR.GT, [dot2Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane2=>
		  
		  (* Is it in both planes? *)
		  letPRIM("inPlanes", IR.T_BOOL, IR.AND, [inPlane1, inPlane2], fn inPlanes =>
		  
		  (* Find distance from segment *)
		  letPRIM("a", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn a =>
		  letPRIM("b", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn b =>
		  letPRIM("alen", IR.T_FLOAT, IR.LEN, [a], fn alen =>
		  letPRIM("axb", IR.T_VEC, IR.CROSS, [a, b], fn axb =>
		  letPRIM("axblen", IR.T_FLOAT, IR.LEN, [axb], fn axblen =>
		  letPRIM("dist", IR.T_FLOAT, IR.DIV, [axblen, alen], fn dist =>
		  
		  (* Is distance in both radii? *)
		  letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), dist], fn inOradGt =>
		  letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), dist], fn inOradEq =>
  		  letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
  		  
		  letPRIM("inIradGt", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, irad)], fn inIradGt =>
		  letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [dist, psvToIRVar(env, irad)], fn inIradEq =>
		  letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
		  
		  letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>		  
		  
		  (* It's in the cylinder (tube) if it's within both radii and in both planes... *)
		  letPRIM(boolVar, IR.T_BOOL, IR.AND, [inPlanes, inBothRad], stmt)
		  ))))))))))))))))))))))
(*	    	
	      | P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}
	      | P.D_PLANE {pt: vec3f var, normal: vec3f var}
	      | P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}
	      | P.D_BOX {min: vec3f var, max: vec3f var}    
	      | P.D_SPHERE {center: vec3f var, irad: vec3f var, orad: vec3f var}
	      | P.D_CONE {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}
	      | P.D_BLOB {center: vec3f var, stddev: float var}
	      | P.D_DISC {pt: vec3f var, normal: vec3f var, irad: float var, orad: float var}
*)
	      | _ => raise Fail ("Cannot determine within-ness for specified vec3 domain: " ^ (P.dToStr d))
	    (* end case *)
	  end (*end let *)
	  
	fun mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) = (case d
	  of P.D_POINT(pt) => letPRIM(boolVar, IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, pt), var], stmt)
	   | P.D_BOX {min, max} => 
	     letPRIM("bigMin", IR.T_BOOL, IR.GT, [var, psvToIRVar(env, min)], fn bigMin =>
	     letPRIM("smallMax", IR.T_BOOL, IR.GT, [psvToIRVar(env, max), var], fn smallMax =>
	     letPRIM(boolVar, IR.T_BOOL, IR.AND, [bigMin, smallMax], stmt)))
	   | _ => raise Fail ("Cannot determine within-ness for specified float domain: " ^ (P.dToStr d))
	 (* end case *))

	fun mkIntBool(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> ir_env -> IR.stmt) = let
	  val _ = ()
	 in
	  (case d
	    of P.D_POINT(pt) =>
	    
	     (* Get vectors *)
	     letPRIM("p1ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p1var], fn p1ToPt =>
	     letPRIM("p2ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p2var], fn p2ToPt =>
	     letPRIM("p1ToP2", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn p1ToP2 =>
	     
	     (* Get distances *)
	     letPRIM("p1ToPtLen", IR.T_FLOAT, IR.LEN, [p1ToPt], fn p1ToPtLen =>
	     letPRIM("p2ToPtLen", IR.T_FLOAT, IR.LEN, [p2ToPt], fn p2ToPtLen =>
	     letPRIM("p1ToP2Len", IR.T_FLOAT, IR.LEN, [p1ToP2], fn p1ToP2Len =>
	     
	     (* Add & subtract ... *)
	     letPRIM("distSum", IR.T_FLOAT, IR.ADD, [p1ToPtLen, p2ToPtLen], fn distSum => 
	     letPRIM("distDiff", IR.T_FLOAT, IR.SUB, [distSum, p1ToP2Len], fn distDiff =>
	     letPRIM("distDiffAbs", IR.T_FLOAT, IR.ABS, [distDiff], fn distDiffAbs =>
	     
	     (* Do the boolean stuff... *)
	     letPRIM("intersect", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), distDiffAbs], fn intVar => k intVar env)
	     
	     )))
	     )))
	     )))
	     
	    | P.D_PLANE {pt, normal} => 
	      letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
	      letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
	      letPRIM("p2d", IR.T_FLOAT, IR.DOT, [p2var, psvToIRVar(env, normal)], fn p2d =>
	      letPRIM("p1dist", IR.T_FLOAT, IR.SUB, [d, p1d], fn p1dist =>
	      letPRIM("p2dist", IR.T_FLOAT, IR.SUB, [d, p2d], fn p2dist =>
	      letPRIM("distProd", IR.T_FLOAT, IR.MULT, [p1dist, p2dist], fn distProd =>
	      letPRIM("intersect", IR.T_BOOL, IR.GT, [IR.newConst("zero", IR.C_FLOAT 0.0), distProd], fn intVar => k intVar env)
	      ))))))
	    
	    | P.D_DISC {pt, normal, orad, irad} => let
	      val boolVar = IR.newParam("intersect", IR.T_BOOL)
	      val newBlk = newBlockWithArgs(env, [boolVar], k boolVar)
	     in
	      letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
	      letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
	      
	      (* Early out... does it intersect the plane?
	       * 
	       * !SPEED! Due to the perceived slowness of branching on
	       * GPUs, this might not actually be faster on all runtime environments *)

	      letPRIM("p2d", IR.T_FLOAT, IR.DOT, [p2var, psvToIRVar(env, normal)], fn p2d =>
	      letPRIM("p1dist", IR.T_FLOAT, IR.SUB, [d, p1d], fn p1dist =>
	      letPRIM("p2dist", IR.T_FLOAT, IR.SUB, [d, p2d], fn p2dist =>
	      letPRIM("distProd", IR.T_FLOAT, IR.MULT, [p1dist, p2dist], fn distProd =>
	      letPRIM("earlyOut", IR.T_BOOL, IR.GT, [distProd, IR.newConst("zero", IR.C_FLOAT 0.0)], fn earlyOut =>
	      IR.mkIF(earlyOut,
	        (* then *)
	        letPRIM("intersect", IR.T_BOOL, IR.NOT, [earlyOut], fn var => gotoWithArgs(env, [var], newBlk)),
	        (* else *)
	        letPRIM("v", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn v =>
	        letPRIM("vDotn", IR.T_FLOAT, IR.DOT, [v, psvToIRVar(env, normal)], fn vdn =>
	        letPRIM("t", IR.T_FLOAT, IR.DIV, [p1dist, vdn], fn t =>
	        
	        (* !TODO! Add some sort of assert mechanism to make sure that t is
	         * in the interval [0, 1]... *)
	        letPRIM("vscale", IR.T_VEC, IR.SCALE, [t, v], fn vscale =>
	        letPRIM("ppt", IR.T_VEC, IR.ADD_VEC, [p1var, vscale], fn ppt =>
	        letPRIM("lenVec", IR.T_VEC, IR.SUB_VEC, [ppt, psvToIRVar(env, pt)], fn cv =>
	        letPRIM("len", IR.T_FLOAT, IR.LEN, [cv], fn len =>
	        
	        (* Check to see whether or not it's within the radius... *)
	        letPRIM("gtirad", IR.T_BOOL, IR.GT, [len, psvToIRVar(env, irad)], fn gtirad =>
	        letPRIM("ltorad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), len], fn ltorad =>
	        letPRIM("intersect", IR.T_BOOL, IR.AND, [gtirad, ltorad], fn var => gotoWithArgs(env, [var], newBlk))
	       ))))))))))
	     )))))))
	    end (* P.D_DISC *)
	    
	    | _ => raise Fail ("Cannot calculate intersection bool for specified domain: " ^ (P.dToStr d))
	  (* end case *))

	 end (* mkIntBool *)
	    
	(* We assume that the segment already intersects with the domain. *)
	fun mkIntPt(env, p1var, p2var, d : Vec3f.vec3 P.domain, k : IR.var -> IR.stmt) = let
	  val _ = ()
	 in
	  (case d 
	    of P.D_POINT(pt) => k (psvToIRVar (env, pt))
	    
	     | P.D_PLANE {pt, normal} => 
	       letPRIM("d", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, pt), psvToIRVar(env, normal)], fn d =>
	       letPRIM("p1d", IR.T_FLOAT, IR.DOT, [p1var, psvToIRVar(env, normal)], fn p1d =>
	       letPRIM("num", IR.T_FLOAT, IR.SUB, [d, p1d], fn num =>
	       letPRIM("v", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn v =>
	       letPRIM("den", IR.T_FLOAT, IR.DOT, [v, psvToIRVar(env, normal)], fn den =>
	       letPRIM("t", IR.T_FLOAT, IR.DIV, [num, den], fn t =>
	       letPRIM("vsc", IR.T_VEC, IR.SCALE, [t, v], fn vs =>
	       letPRIM("intPt", IR.T_VEC, IR.ADD_VEC, [p1var, vs], k)
	       )))))))
	     
	     (* Since we already know they intersect, the intersection point must be 
	      * just the point that's on the plane... *)
	     | P.D_DISC {pt, normal, orad, irad} => mkIntPt(env, p1var, p2var, P.D_PLANE{pt = pt, normal = normal}, k)
	     | _ => raise Fail ("Cannot calculate intersection point for specified domain: "  ^ (P.dToStr d))
	  (* end case *))	     
	 end (* mkIntPt *)
	    
    (* Find the normal at the given position of the particle for the specified 
     * domain. Note, that the particle doesn't necessarily need to be on the
     * domain, but if it's not then the behavior is undefined. *)
    fun normAtPoint(retNorm, d, env, pos, k : IR.var -> ir_env -> IR.stmt) = let
      val newNorm = IR.newParam("n", IR.T_VEC)
      val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))
     in
      (case d
	  of P.D_PLANE{pt, normal} =>
	     letPRIM("inVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn inVec =>
	     letPRIM("dotNorm", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, normal), inVec], fn dotNorm =>
	     letPRIM("eqZero", IR.T_BOOL, IR.EQUALS, [dotNorm, IR.newConst("One", IR.C_FLOAT 0.0)], fn eqZero =>
	     IR.mkIF(eqZero,
	         (*thenStmt*)
	         gotoWithArgs(env, [psvToIRVar(env, normal)], nextBlk),
             (*elseStmt*)	         
    	     letPRIM("dnRecip", IR.T_FLOAT, IR.DIV, [IR.newConst("One", IR.C_FLOAT 1.0), dotNorm], fn dnRecip =>
    	     letPRIM("absR", IR.T_FLOAT, IR.ABS, [dnRecip], fn absR =>
    	     letPRIM("sign", IR.T_FLOAT, IR.MULT, [absR, dotNorm], fn sign =>
    	     letPRIM(retNorm, IR.T_VEC, IR.SCALE, [sign, psvToIRVar(env, normal)], 
    	     fn newNormVar => gotoWithArgs(env, [newNormVar], nextBlk)))))
    	 ))))
	      
	   | P.D_DISC{pt, normal, irad, orad} => 
	      normAtPoint(retNorm, P.D_PLANE{pt=pt, normal=normal}, env, pos, k)
         
	   | P.D_SPHERE{center, irad, orad} => 
		    letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, center)], fn subVec =>
	        letPRIM(retNorm, IR.T_VEC, IR.NORM, [subVec], fn newNormVar => k newNormVar env
		  ))
           
	   | _ => raise Fail("Cannot find normal to point of specified domain." ^ (P.dToStr d))
	 (* end case *))
	end
	
	fun trExpr(expr, env, k : IR.var -> ir_env -> IR.stmt) = (case expr
	  of P.CONSTF f => k (IR.newConst ("c", IR.C_FLOAT f)) env
	  
       | P.CONST3F v => k (IR.newConst ("c", IR.C_VEC v)) env
       
       | P.VAR v => k (psvToIRVar (env, v)) env
       
       | P.STATE_VAR sv => k (pssvToIRVar (env, sv)) env
       
       | P.GENERATE3F (dom, dist) => genVecVar("genVec", env, dom, dist, fn var => k var env)
       
       | P.GENERATEF (dom, dist) => genFloatVar("genFlt", env, dom, dist, fn var => k var env)
       
       | P.ADD(e1, e2) =>
         trExpr(e1, env, fn e1var => fn env' =>
         trExpr(e2, env', fn e2var => fn env'' =>
         let
          val IR.V{varType=vt1, ...} = e1var
          val IR.V{varType=vt2, ...} = e2var
         in
          (case (vt1, vt2)
            of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("addVar", IR.T_FLOAT, IR.ADD, [e1var, e2var], fn var => k var env'')
             | (IR.T_VEC, IR.T_VEC) => letPRIM("addVar", IR.T_VEC, IR.ADD_VEC, [e1var, e2var], fn var => k var env'')
             | _ => raise Fail ("Type mismatch to ADD expression")
          (* end case *))
         end))
         
       | P.SCALE (e1, e2) =>
         trExpr(e1, env, fn e1var => fn env' =>
         trExpr(e2, env', fn e2var => fn env'' =>
         let
          val IR.V{varType=vt1, ...} = e1var
          val IR.V{varType=vt2, ...} = e2var
         in
          (case (vt1, vt2)
            of (IR.T_FLOAT, IR.T_VEC) => letPRIM("scaleVar", IR.T_VEC, IR.SCALE, [e1var, e2var], fn var => k var env'')
             | (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("scaleVar", IR.T_FLOAT, IR.MULT, [e1var, e2var], fn var => k var env'')
             | _ => raise Fail (String.concat["Type mismatch to SCALE expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
          (* end case *))
         end))
         
       | P.DIV (e1, e2) =>
         trExpr(e1, env, fn e1var => fn env' =>
         trExpr(e2, env', fn e2var => fn env'' =>
         let
          val IR.V{varType=vt1, ...} = e1var
          val IR.V{varType=vt2, ...} = e2var
         in
          (case (vt1, vt2)
            of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("divVar", IR.T_FLOAT, IR.DIV, [e1var, e2var], fn var => k var env'')
             | _ => raise Fail (String.concat["Type mismatch to DIV expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
          (* end case *))
         end))

       | P.NEG e =>
         trExpr(e, env, fn evar => fn env' =>
         let
          val IR.V{varType, ...} = evar
         in
          (case varType
            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') 
             | IR.T_VEC => letPRIM("negVar", IR.T_VEC, IR.NEG_VEC, [evar], fn var => k var env')
             | _ => raise Fail ("Type mismatch to NEG expression")
          (* end case *))
         end)
         
       | P.DOT (e1, e2) =>
         trExpr(e1, env, fn e1var => fn env' =>
         trExpr(e2, env', fn e2var => fn env'' =>
         let
          val IR.V{varType=vt1, ...} = e1var
          val IR.V{varType=vt2, ...} = e2var
         in
          (case (vt1, vt2)
            of (IR.T_VEC, IR.T_VEC) => letPRIM("dotVar", IR.T_FLOAT, IR.DOT, [e1var, e2var], fn var => k var env'')
             | _ => raise Fail ("Type mismatch to DOT expression")
          (* end case *))
         end))
         
       | P.CROSS (e1, e2) =>
         trExpr(e1, env, fn e1var => fn env' =>
         trExpr(e2, env', fn e2var => fn env'' =>
         let
          val IR.V{varType=vt1, ...} = e1var
          val IR.V{varType=vt2, ...} = e2var
         in
          (case (vt1, vt2)
            of (IR.T_VEC, IR.T_VEC) => letPRIM("crossVar", IR.T_VEC, IR.CROSS, [e1var, e2var], fn var => k var env'')
             | _ => raise Fail ("Type mismatch to CROSS expression")
          (* end case *))
         end))
         
       | P.NORMALIZE e =>
         trExpr(e, env, fn evar => fn env' =>
         let
          val IR.V{varType, ...} = evar
         in
          (case varType
            of IR.T_VEC => letPRIM("normVar", IR.T_VEC, IR.NORM, [evar], fn var => k var env')
             | _ => raise Fail ("Type mismatch to NORMALIZE expression")
          (* end case *))
         end)
      
       | P.LENGTH e =>
         trExpr(e, env, fn evar => fn env' =>
         let
          val IR.V{varType, ...} = evar
         in
          (case varType
            of IR.T_VEC => letPRIM("lenVar", IR.T_FLOAT, IR.LEN, [evar], fn var => k var env')
             | _ => raise Fail ("Type mismatch to LENGTH expression")
          (* end case *))
         end)
      
       (* !SPEED! We're assuming that there is an intersection here... *)
       | P.INTERSECT {p1, p2, d} =>
         trExpr(p1, env, fn p1var => fn env' =>
         trExpr(p2, env', fn p2var => fn env'' =>
         let
          val IR.V{varType=vt1, ...} = p1var
          val IR.V{varType=vt2, ...} = p2var
         in
          (case (vt1, vt2) 
            of (IR.T_VEC, IR.T_VEC) => mkIntPt(env, p1var, p2var, d, fn var => k var env'')
             | _ => raise Fail("Type mismatch to INTERSECT expression")
          (* end case *))
         end))
         
       | P.NORMALTO (e, d) =>
         trExpr(e, env, fn evar => fn env' =>
         let
          val IR.V{varType, ...} = evar
          fun cont s = k s
         in
          (case varType
            of IR.T_VEC => normAtPoint("normVar", d, env', evar, k)
             | _ => raise Fail("Type mismatch to NORMALTO expression")
          (* end case *))
         end)
         
	  (* end case expr *))
	  
	(* generate code to produce a random particle state from a domain *)
    fun newParticle (sv_gens, env, k : ir_env -> IR.stmt) = let
    
      fun createVar(P.GEN{var, ...}) = let
        val P.PSV.SV{name, ty, ...} = var
       in
        IR.newLocal("ps_" ^ name, IR.psvTyToIRTy ty, (IR.RAND, []))
       end
       
      val newState = List.map createVar sv_gens
       
      fun genVar((sv_gen, var), cont) = let
        val P.GEN{exp, var=svar} = sv_gen
        val IR.V{varType, ...} = var
       in
        fn env' => trExpr(exp, env', fn newVal => fn env'' => cont (insertSVar(env'', svar, newVal)))
       end (* genVar *)
       
     in
      (List.foldr (fn (x, y) => genVar(x, y)) k (ListPair.zipEq (sv_gens, newState))) env 
     end (* new particle *)

    fun trEmitter(emit, env, k) = let
      val P.EMIT{freq, sv_gens} = emit
      val ttl = pssvToIRVar(env, P.sv_ttl)
     in
      letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>
      IR.mkIF(isDead,
       (* then *)
       trExpr(freq, env, fn t1 => fn env' =>
       letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env', PSV.numDead)], fn t2 =>
       letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
       letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r => 
       letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
       IR.mkIF(t3,
        (* then *)
        newParticle (sv_gens, env', fn env'' => k env''),
        (* else *)
        IR.DISCARD)))))),
       (* else *)
       k env))
     end

    (* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)
    (* mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) *)
    fun trPred(cond, env, thenk : ir_env -> IR.stmt, elsek : ir_env -> IR.stmt) = let
      fun grabVar(cond, env, k : IR.var -> ir_env -> IR.stmt) = (case cond
        of P.WITHINF(d, expr) => 
            trExpr(expr, env, fn checkMe => fn env' =>
            mkFloatWithinVar("wv", env', checkMe, d, fn var => k var env'))            
          
         | P.WITHIN3F(d, expr) => 
            trExpr(expr, env, fn checkMe => fn env' =>
            mkVecWithinVar("wv", env', checkMe, d, fn var => k var env'))
          
         | P.DO_INTERSECT {p1, p2, d} =>
           trExpr(p1, env, fn p1var => fn env' =>
           trExpr(p2, env', fn p2var => fn env'' =>
           mkIntBool(env'', p1var, p2var, d, k)))
         
         | P.GTHAN (e1, e2) =>
           trExpr(e1, env, fn e1var => fn env' =>
           trExpr(e2, env, fn e2var => fn env'' =>
           letPRIM("gtVar", IR.T_BOOL, IR.GT, [e1var, e2var], fn var => k var env'')))
                    
         | P.AND(c1, c2) =>
           grabVar(c1, env, fn c1Var => fn env' =>
           grabVar(c2, env', fn c2Var => fn env'' =>
           letPRIM("andVar", IR.T_BOOL, IR.AND, [c1Var, c2Var], fn var => k var env'')))
         
         | P.OR(c1, c2) =>
           grabVar(c1, env, fn c1Var => fn env' =>
           grabVar(c2, env, fn c2Var => fn env'' =>
           letPRIM("andVar", IR.T_BOOL, IR.OR, [c1Var, c2Var], fn var => k var env'')))
           
         | P.XOR(c1, c2) =>
           grabVar(c1, env, fn c1Var => fn env' =>
           grabVar(c2, env', fn c2Var => fn env'' =>
           mkXOR ("xorVar", c1Var, c2Var, fn var => k var env'')))
           
         | P.NOT(c) =>
           grabVar(c, env, fn cvar => fn env' =>
           letPRIM("notVar", IR.T_BOOL, IR.NOT, [cvar], fn var => k var env'))
           
        (* end case *))
     in
      grabVar(cond, env, fn result => fn env' =>
      IR.mkIF(result, thenk(env'), elsek(env')))
     end

    fun compile (P.PG{
       emit as P.EMIT{freq, sv_gens}, act, render,
       vars, state_vars, render_vars
    }) = let
      val blks = ref[]
      
      fun printVar (PSV.V{name, id, ...}) = 
        printErr (String.concat[name, ": ", Int.toString id])
      
      val demand = IR.getDemand(render)
      fun getIRNameForSV (v as PSV.SV{name, ...}) = 
       (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 *))
      
      fun convertToIR (v as PSV.SV{ty, ...}) = IR.newParam(getIRNameForSV v, IR.psvTyToIRTy ty)
      val v_env = let
	      (* add special globals to free vars *)
        val pgm_vars = PSV.Set.union(PSV.Set.singleton epsilon, vars)
        fun insv (x as PSV.V{name, ty, binding, id, ...}, map) = let
          val x' = (case (ty, !binding)
              of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
               | (PSV.T_BOOL,  PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))
               | (PSV.T_INT,   PSV.UNDEF) => IR.newGlobal(x, IR.T_INT)
               | (PSV.T_INT,   PSV.INT intVal) => IR.newConst(name, IR.C_INT(intVal))
               | (PSV.T_FLOAT, PSV.UNDEF) => IR.newGlobal(x, IR.T_FLOAT)
               | (PSV.T_FLOAT, PSV.FLOAT floatVal) => IR.newConst(name, IR.C_FLOAT(floatVal))
               | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
               | (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))
               | _ => raise Fail("Error in setup, type mismatch between PSV vars and their binding.")
			  (* end case *))
		 in
		  PSV.Map.insert (map, x, x')
		 end (* ins *)
		   
	   in
		PSV.Set.foldl insv PSV.Map.empty pgm_vars
	   end (* env *)
		
      fun evalActs theAct env f = (case theAct 
	      of P.SEQ(acts) => (case acts
	        of [] => f env
	         | oneAct :: rest => evalActs oneAct env (fn env' => (evalActs (P.SEQ(rest)) env' f))
	        (* end case *))
	      
	       | P.PRED(cond, thenAct, elseAct) => let
	           val joinBlk = newBlock (env, fn env' => f env')
	           fun joinActs env = goto(env, joinBlk)
	          in
	           trPred(cond, env, 
	             fn env' => evalActs thenAct env' joinActs, 
	             fn env' => evalActs elseAct env' joinActs
	           )
	          end
	         
	       | P.DIE => IR.DISCARD
	       
	       | P.ASSIGN(sv, expr) => let
	         val PSV.SV{ty, ...} = sv
	        in
	         trExpr(expr, env, fn newVar => fn env' =>
	         letPRIM(getIRNameForSV sv, IR.psvTyToIRTy ty, IR.COPY, [newVar],
	           fn thisVar => f (insertSVar(env', sv, thisVar))))
	        end
	        
	      (* end case *))
	      
	  val sv_env = let
	      (* add special globals to free vars *)
        fun insv (x as PSV.SV{name, ty, ...}, map) = let
          val x' = IR.newParam("ps_" ^ name, IR.psvTyToIRTy ty)
		 in
		  PSV.SVMap.insert (map, x, x')
		 end (* ins *)
		   
	   in
		PSV.SVSet.foldl insv PSV.SVMap.empty state_vars
	   end (* env *)
	  
	  val env = TE(blks, v_env, sv_env)
	  
	  (* The entry block is the first block of the program, or in other words, the emitter. *)
	  val emitterBlock = newBlock (env, fn env => trEmitter(emit, env, retState))
	  val physicsBlock = newBlock (env, fn env => evalActs act env retState)

      (* The entry block is the emitter, and the rest of the blocks define the physics processing. *)
      
      fun isGlobal(IR.V{scope, ...}) = (case scope
        of IR.S_GLOBAL(v) => true 
         | _ => false
        (* end case *))
      
	  val outPgm = PSysIR.PGM {
	    globals = PSV.Map.filter isGlobal v_env,
	    persistents = demand,
	    uveOptimized = false,
        emitter = emitterBlock,
	    physics = physicsBlock,
	    render = render
	  }

	  val _ = IR.outputPgm(TextIO.stdErr, outPgm)
	  val optimized = if (Checker.checkIR(outPgm)) then (printErr "\nPre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
	  in
	    IR.outputPgm(TextIO.stdErr, optimized);
	    (* Note: it only succeeds if we can optimize, too *)
        if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();
        
        optimized
	  end (* compile *)

    end (* Translate *)

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