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 1107 - (download) (annotate)
Wed Apr 6 22:46:51 2011 UTC (8 years, 5 months ago) by pavelk
File size: 38067 byte(s)
Work on particle system stuff. Still a WIP, just checking it in so that I can work on it some more from home.
(* 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")

(*
    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

  (* special PSV global variables *)
    val epsilon = PSV.constf(0.00001)
    
  (* constants *)  
    val pi = 3.14159265358979
    
    fun constructUserDefs([]) = []
      | constructUserDefs(IR.V{id, ...} :: users) = 
          (IR.USER_DEF id) :: constructUserDefs(users)
          
    fun userVarsFromState(PS{user, ...}) = user
    fun userVarsFromEmit(P.EMIT{...}) = []
    
    fun retState s = let
      val PS{pos, vel, size, ttl, color, user} = s
     in
      IR.mkRETURN (
        [pos, vel, size, ttl, color] @ user, 
        [IR.POS, IR.VEL, IR.SZ, IR.TTL, IR.COLOR] @ constructUserDefs(user)
      )
     end

  (* translation environment *)
    datatype env = TE of (IR.block list ref * IR.var PSV.Map.map * IR.var PSV.SVMap.map)

    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 insertVar (TE(blks, varEnv, svarEnv), x, x') = TE(blks, PSV.Map.insert (varenv, x, x'), svarEnv)
    fun insertSVar (TE(blks, varEnv, svarEnv), x, x') = TE(blks, varenv, PSV.Map.insert (svarEnv, x, x'))

  (* create a block that implements the given continuation *)
  
    fun createUserVarCopies( [ ], _ ) = [ ]
      | createUserVarCopies( IR.V{varType, ...} :: vars, i) =
      IR.newParam ("ps_user" ^ (Int.toString i), varType) :: (createUserVarCopies(vars, i+1))
  
    fun newBlockWithArgs (TE(blks, _, _), state , args, k : particle_state -> IR.stmt) = let
	   val blk = IR.newBlock (state @ args, k state)
	  in
	   blks := blk :: !blks;
	   blk
	  end
	  
	fun newBlock (env, state, k) = newBlockWithArgs(env, state, [], k)

    fun gotoWithArgs(state, args, blk) = IR.mkGOTO(blk, state @ args)
    fun goto (state, blk) = gotoWithArgs(state, [], 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."
     (* 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, 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", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, 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", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, 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} =>
		  
          (* generate two random angles... *)
          letPRIM("r1", IR.T_FLOAT, IR.RAND, [], fn randForAngOne =>
          letPRIM("t1", IR.T_FLOAT, IR.MULT, [randForAngOne, IR.newConst("fullCit", IR.C_FLOAT (2.0 * pi))], fn randAngOne =>
          letPRIM("r2", IR.T_FLOAT, IR.RAND, [], fn randForAngTwo =>
          letPRIM("t2", IR.T_FLOAT, IR.MULT, [randForAngTwo, IR.newConst("fullCit", IR.C_FLOAT (2.0 * pi))], fn randAngTwo =>

          (* Generate vector in the sphere ... *)
          (* If my math is correct this should be
           * <(cos t1)(cos t2), (sin t1)(cos t2), sin t2>
           * This is different from wikipedia's article on spherical coordinates
           * because of a phase shift, but for the generation of random numbers,
           * it's irrelevant.
           *)
          letPRIM("cost1", IR.T_FLOAT, IR.COS, [randAngOne], fn cost1 =>
          letPRIM("cost2", IR.T_FLOAT, IR.COS, [randAngTwo], fn cost2 =>
          letPRIM("sint1", IR.T_FLOAT, IR.SIN, [randAngOne], fn sint1 =>
          letPRIM("sint2", IR.T_FLOAT, IR.SIN, [randAngTwo], fn sint2 =>

          letPRIM("xVal", IR.T_FLOAT, IR.MULT, [cost1, cost2], fn xVal =>
          letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sint1, cost2], fn yVal =>
          (* zval is just sint2 *)

          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 =>
          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("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 =>
          
          (* 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."
	  (* 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
	  *)
	  
  (* 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 mkWithinVar (boolVar, env, var, d, 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 domain."
	    (* end case *)
	  end (*end let *)
	  

  (* generate code to produce a random particle state from a domain *)
    fun newParticle (posDomain, (szDom : Float.float P.domain, szDist), velDomain, colDomain, env, k : particle_state -> IR.stmt) = 
	    (* genVecVar (vecVar, env, domain, stmt) *)
	    genVecVar("ps_pos", env, posDomain, fn newPos =>
	    genVecVar("ps_vel", env, velDomain, fn newVel =>
	    genVecVar("ps_col", env, colDomain, fn newCol =>
	    genFloatVar("ps_size", env, szDom, szDist, fn newSize =>
	    letPRIM ("ps_ttl", IR.T_FLOAT, IR.COPY, [IR.newConst("fbool", IR.C_FLOAT 10000.0)], fn newIsDead =>
	      k(PS{pos = newPos, 
	      	   vel = newVel, 
	      	   size = newSize, 
	      	   ttl = newIsDead, 
	      	   color = newCol,
	      	   user = []})
	    )))))

    (* 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, state, k : IR.var -> particle_state -> IR.stmt) = let
      val newNorm = IR.newParam("n", IR.T_VEC)
      val nextBlk = newBlockWithArgs(env, userVarsFromState(state), [newNorm], k(newNorm))
      val PS{pos, ...} = state
     in
      (case d
	  of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)], 
	      fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
	   | P.D_DISC{pt, normal, irad, orad} => 
	      mkWithinVar("inP", env, pos, d, fn inPlane =>
		  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))
		   )
		 )
         
	   | P.D_SPHERE{center, irad, orad} => let
	      val PS{pos, ...} = state
	      in
		    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 state
		    ))
	      end
           
	   | _ => raise Fail("Cannot find normal to point of specified domain.")
	 (* end case *))
	end
	
	fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let

	  val P.EMIT{freq, sv_gens} = emit
	  val blk = newBlock (env, user, k)
	 in
	  letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>
      IR.mkIF(isDead,
       (* then *)
       genFloatVar("t1", env, rDom, rDist, fn t1 =>
       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 (posDomain, szDomain, velDomain, colDomain, env,
         fn state' => retState state'),
        (* else *)
        IR.DISCARD)))))),
       (* else *)
       retState state))
     end
	
	fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
	  val PS{pos, vel, ...} = state
	  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

    fun compile (P.PG{
       emit as P.EMIT{freq, sv_gens}, act, render,
       vars, state_vars, render_vars
    }) = let
      val blks = ref[]
      val 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 *)
		   
		 fun convertToIR PSV.SV{name, ty, id, ...} = IR.newParam(name, IR.psvTyToIRTy ty)
		 fun inssv (x, map) = PSV.SVMap.insert(map, x, convertToIR x)
		in
		  TE(
		   blks, 
		   PSV.Set.foldl insv PSV.Map.empty pgm_vars, 
		   PSV.SVSet.foldl inssv PSV.SVMap.empty state_vars
		  )
		end (* env *)
		
      fun evalActs f [] state = f [] state
	    | evalActs f (psa :: psal) state = (case psa 
	      of P.SEQ(acts) => (case acts
	         of [] => raise Fail "Should never reach here."
	          | [act] => trAct(act, env, state, evalActs f psal)
	          | act :: rest => trAct(act, env, state, evalActs f (P.SEQ(rest) :: psal))
	        (* end case *))
	       | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) => let
                val cblk = newBlock(env, userVarsFromState(state), evalActs f psal)
                fun trPredActs [] state' = goto(state', cblk)
                  | trPredActs _ _ = raise Fail "Should never reach here."
		     in
	           trPred(pred, env, state, evalActs trPredActs t, evalActs trPredActs e)
		     end
	      (* end case *))

          (* At the highest level, we want to return when we reach the end of the action list *)
	  fun trActs [] state = retState state
        | trActs _ _ = raise Fail "Should never reach here"
	  
	  (* The entry block is the first block of the program, or in other words, the emitter. *)
	  val entryBlock = newBlock (
	    env,
	    List.map convertToIR state_vars,
	    fn pstate => trEmitter(
	      emit, 
	      env, 
	      pstate, 
	      fn state => evalActs trActs root_act state
	    )
	  )

      (* 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 *))
        
      fun extractVarMap(TE(blks, map)) = map
      
	  val outPgm = PSysIR.PGM {
	    globals = PSV.Map.filter isGlobal (extractVarMap env),
	    persistents = [],
	    uveOptimized = false,
        emitter = entryBlock,
	    physics = List.nth(!blks, 1),
	    render = render
	  }

	  val optimized = if (Checker.checkIR(outPgm)) then (printErr "Pre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm 

	  in
	    (* IR.outputPgm(TextIO.stdErr, outPgm); *)
	    
	    (* 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