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

Parent Directory | Revision Log | Patch

	revision 901, Fri May 28 19:15:30 2010 UTC	revision 1146, Wed May 4 21:06:27 2011 UTC
#	Line 1	Line 1
1	(* translate.sml	(* translate.sml
2	*
3	* COPYRIGHT (c) 2009 John Reppy (http://cs.uchicago.edu/~jhr)	* COPYRIGHT (c) 2009 John Reppy (http://cs.uchicago.edu/~jhr)
4	* All rights reserved.	* All rights reserved.
5	*	*
#	Line 8	Line 8
8
9	structure Translate : sig	structure Translate : sig
10
11	val compile : Particles.particle_group -> PSysIR.program	val compile : Particles.program -> PSysIR.program
12
13	end = struct	end = struct
14
#	Line 20	Line 20
20
21	fun printErr s = TextIO.output(TextIO.stdErr, s ^ "\n")	fun printErr s = TextIO.output(TextIO.stdErr, s ^ "\n")
22
23		(*
24	datatype particle_state = PS of {	datatype particle_state = PS of {
25	pos : IR.var,           (* vec3 *)	pos : IR.var,           (* vec3 *)
26	vel : IR.var,           (* vec3 *)	vel : IR.var,           (* vec3 *)
27	size : IR.var,          (* float *)	size : IR.var,          (* float *)
28	isDead : IR.var,        (* bool *)	ttl : IR.var,             (* float *)
29	color : IR.var,         (* vec3 (NOTE: should be vector4) *)	color : IR.var,         (* vec3 (NOTE: should be vector4) *)
30	pos2 : IR.var,          (* vec3 *)	user : IR.var list
	dummy : IR.var
31	}	}
32		*)
33		type particle_state = IR.var list
34
35	(* special PSV global variables *)	(* special PSV global variables *)
	val timeStep = PSV.new("g_timeStep", PSV.T_FLOAT)   (* physics timestep *)
	val numDead = PSV.new("g_numDead", PSV.T_INT)       (* # of dead particles *)
36	val epsilon = PSV.constf(0.00001)	val epsilon = PSV.constf(0.00001)
37
38	(* constants *)	(* constants *)
39	val pi = 3.14159265358979	val pi = 3.14159265358979
40
41	(* dummy placeholder *)	fun retState s = IR.mkRETURN s
	fun dummy (state, k) =
	IR.mkPRIM(
	IR.newLocal(
	"temp",
	IR.T_BOOL,
	(IR.COPY, [IR.newConst("c", IR.C_BOOL false)])
	),
	IR.COPY,
	[IR.newConst("c", IR.C_BOOL false)],
	k state
	)
	fun retState s = let
	val PS{pos, vel, size, isDead, color, pos2, dummy} = s
	in
	IR.mkRETURN [pos, vel, size, isDead, color, pos2, dummy]
	end
42
43	(* translation environment *)	(* translation environment *)
44	datatype env = TE of (IR.block list ref * IR.var PSV.Map.map)	datatype env = TE of (IR.block list ref * IR.var PSV.Map.map)
45		fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))
46
47		(* Interaction with environment and state variables *)
48	fun psvToIRVar (TE(_, env), x as PSV.V{name, id, ...}) = (case PSV.Map.find(env, x)	fun psvToIRVar (TE(_, env), x as PSV.V{name, id, ...}) = (case PSV.Map.find(env, x)
49	of SOME x' => x'	of SOME x' => x'
50	| NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])	| NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])
51	(* end case *))	(* end case *))
52
53	fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))	fun findIRVarByName (state, name) = let
54		fun eq (var as IR.V{name=st_name, ...}) = st_name = ("ps_" ^ name)
	(* create a block that implements the given continuation *)
	fun newBlock (TE(blks, _), k : particle_state -> IR.stmt) = let
	val pos = IR.newParam ("ps_pos", IR.T_VEC)
	val vel = IR.newParam ("ps_vel", IR.T_VEC)
	val size = IR.newParam ("ps_size", IR.T_FLOAT)
	val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)
	val color = IR.newParam ("ps_color", IR.T_VEC)
	val dummy = IR.newParam ("ps_dummy", IR.T_FLOAT)
	val pos2 = IR.newParam ("ps_pos2", IR.T_VEC)
	val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color, pos2=pos2, dummy=dummy}
	val blk = IR.newBlock ([pos, vel, size, isDead, color, pos2, dummy], k state)
55	in	in
56	blks := blk :: !blks;	(case (List.find eq state)
57	blk	of SOME sv => sv
58		| NONE => raise Fail ("Could not find var mapping.")
59		(* end case *))
60	end	end
61
62	fun newBlockWithArgs (TE(blks, _), args, k : particle_state -> IR.stmt) = let	fun getIRVarForSV (v as PSV.SV{name, ...}, state) = findIRVarByName(state, name)
63	val pos = IR.newParam ("ps_pos", IR.T_VEC)
64	val vel = IR.newParam ("ps_vel", IR.T_VEC)	(* create a block that implements the given continuation *)
65	val size = IR.newParam ("ps_size", IR.T_FLOAT)	fun newBlockWithArgs (TE(blks, _), state , args, k : particle_state -> IR.stmt) = let
66	val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)	fun copyVar(v as IR.V{name, varType, ...}) = IR.newParam(name, varType)
67	val color = IR.newParam ("ps_color", IR.T_VEC)	val newState = List.map copyVar state
68	val dummy = IR.newParam ("ps_dummy", IR.T_FLOAT)	val blk = IR.newBlock (newState @ args, k newState)
	val pos2 = IR.newParam ("ps_pos2", IR.T_VEC)
	val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color, pos2=pos2, dummy = dummy}
	val blk = IR.newBlock ([pos, vel, size, isDead, color, pos2, dummy] @ args, k state)
69	in	in
70	blks := blk :: !blks;	blks := blk :: !blks;
71	blk	blk
72	end	end
73
74	fun goto (PS{pos, vel, size, isDead, color, pos2, dummy}, blk) =	fun newBlock (env, state, k) = newBlockWithArgs(env, state, [], k)
	IR.mkGOTO(blk, [pos, vel, size, isDead, color, pos2, dummy])
75
76	fun gotoWithArgs(PS{pos, vel, size, isDead, color, pos2, dummy}, args, blk) =	fun gotoWithArgs(state, args, blk) = IR.mkGOTO(blk, state @ args)
77	IR.mkGOTO(blk, [pos, vel, size, isDead, color, pos2, dummy] @ args)	fun goto (state, blk) = gotoWithArgs(state, [], blk)
78
79	fun letPRIM (x, ty, p, args, body) = let	fun letPRIM (x, ty, p, args, body) = let
80	val x' = IR.newLocal(x, ty, (p, args))	val x' = IR.newLocal(x, ty, (p, args))
#	Line 111	Line 82
82	IR.mkPRIM(x', p, args, body x')	IR.mkPRIM(x', p, args, body x')
83	end	end
84
	(* prim bound to state variable (S_LOCAL for now) *)
	fun letSPRIM(x, ty, p, args, body) = let
	val x' = IR.new(x, IR.S_LOCAL(ref (p, args)), ty)
	in
	IR.mkPRIM(x', p, args, body x')
	end
85	(* Not sure if this should be made into a primitive or not, but	(* Not sure if this should be made into a primitive or not, but
86	* basically this creates the XOR'd value of var1 and var2 and	* basically this creates the XOR'd value of var1 and var2 and
87	* stores it in result.	* stores it in result.
#	Line 128	Line 92
92	letPRIM("testNAND", IR.T_BOOL, IR.NOT, [testAND], fn testNAND =>	letPRIM("testNAND", IR.T_BOOL, IR.NOT, [testAND], fn testNAND =>
93	letPRIM(result, IR.T_BOOL, IR.AND, [testOR, testNAND], stmt))))	letPRIM(result, IR.T_BOOL, IR.AND, [testOR, testNAND], stmt))))
94
95		fun genFloatVar (fltVar, env, domain : Float.float P.domain, dist, stmt : IR.var -> IR.stmt) = let
96		fun genRandVal(var, stmt : IR.var -> IR.stmt) = (case dist
97		of P.DIST_UNIFORM =>
98		letPRIM(var, IR.T_FLOAT, IR.RAND, [], stmt)
99
100		(* The PDF here is f(x) = 2x when 0 < x <= 1, so the CDF is going
101		* to be the integral of f from 0 -> y => y^2. Hence, whenever we
102		* generate a random number, in order to get the random value according
103		* to this probability distribution, we just square it.
104		*)
105		| P.DIST_INC_LIN =>
106		letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
107		letPRIM(var, IR.T_FLOAT, IR.MULT, [randVal, randVal], stmt))
108
109		(* The PDF here is f(x) = -2x + 2 when 0 <= x < 1, so the CDF is going
110		* to be the integral of f from 0 -> y => -(y^2) + 2y. Hence, whenever we
111		* generate a random number, in order to get the random value according
112		* to this probability distribution, we just square it.
113		*)
114		| P.DIST_DEC_LIN =>
115		letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn randVal =>
116		letPRIM("randSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randSq =>
117		letPRIM("termOne", IR.T_FLOAT, IR.MULT, [randSq, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn termOne =>
118		letPRIM("termTwo", IR.T_FLOAT, IR.MULT, [randVal, IR.newConst("negOne", IR.C_FLOAT 2.0)], fn termTwo =>
119		letPRIM(var, IR.T_FLOAT, IR.ADD, [termOne, termTwo], stmt)
120		))))
121
122		| _ => raise Fail "Unable to create random float for specified distribution"
123		(* end case *))
124		in
125		(case domain
126		of P.D_POINT(pt) =>
127		(* Our options here are pretty limited... *)
128		letPRIM (fltVar, IR.T_FLOAT, IR.COPY, [psvToIRVar(env, pt)], stmt)
129
130		| P.D_BOX{max, min} =>
131		genRandVal("randf", fn rand =>
132		letPRIM("boxDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, max), psvToIRVar(env, max)], fn diff =>
133		letPRIM("scale", IR.T_FLOAT, IR.MULT, [diff, rand], fn scale =>
134		letPRIM( fltVar, IR.T_FLOAT, IR.ADD, [psvToIRVar(env, max), scale], stmt )
135		)))
136		| _ => raise Fail ("Cannot generate float in specified domain: " ^ (P.dToStr domain))
137		(* end case *))
138		end
139
140	(* Generates a random vector within the given domain and puts it in vecVar *)	(* Generates a random vector within the given domain and puts it in vecVar *)
141	fun genVecVar (vecVar, env, domain, stmt : IR.var -> IR.stmt) = (case domain	fun genVecVar (
142		vecVar,
143		env,
144		domain : Vec3f.vec3 P.domain,
145		dist : Vec3f.vec3 P.distribution,
146		stmt : IR.var -> IR.stmt
147		) = (case domain
148	of P.D_POINT(pt) =>	of P.D_POINT(pt) =>
149	(* Our options here are pretty limited... *)	(* Our options here are pretty limited... *)
150	letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)	letPRIM (vecVar, IR.T_VEC, IR.COPY, [psvToIRVar(env, pt)], stmt)
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 180	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 200	Line 217
217	letPRIM("htInv", IR.T_FLOAT, IR.DIV, [IR.newConst("one", IR.C_FLOAT 1.0), height], fn htInv =>	letPRIM("htInv", IR.T_FLOAT, IR.DIV, [IR.newConst("one", IR.C_FLOAT 1.0), height], fn htInv =>
218	letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>	letPRIM("n", IR.T_VEC, IR.SCALE, [htInv, normVec], fn norm =>
219	(* Generate a point in the lower disc. *)	(* Generate a point in the lower disc. *)
220	genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>	genVecVar("ptInDisc",
221		insert(env, normVar, norm),
222		P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
223		dist,
224		fn ptInDisc =>
225	(* Now add this point to a random scaling of the normVec. *)	(* Now add this point to a random scaling of the normVec. *)
226	letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>	letPRIM("s", IR.T_FLOAT, IR.MULT, [height, ourRand], fn scale =>
227	letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>	letPRIM("sn", IR.T_VEC, IR.SCALE, [scale, normVec], fn scaledNormVec =>
#	Line 208	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 233	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 241	Line 267
267	letPRIM("eh",  IR.T_FLOAT, IR.RAND, [], fn ourRand =>	letPRIM("eh",  IR.T_FLOAT, IR.RAND, [], fn ourRand =>
268	letPRIM("nv", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>	letPRIM("nv", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn normVec =>
269	letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>	letPRIM("n", IR.T_VEC, IR.NORM, [normVec], fn norm =>
270	genVecVar("ptInDisc", insert(env, normVar, norm), P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad}, fn ptInDisc =>	genVecVar("ptInDisc",
271		insert(env, normVar, norm),
272		P.D_DISC{pt = pt1, normal = normVar, irad = irad, orad = orad},
273		dist,
274		fn ptInDisc =>
275	letPRIM("gptt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), ptInDisc], fn genPtToTip =>	letPRIM("gptt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), ptInDisc], fn genPtToTip =>
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	| _ => raise Fail "Cannot generate point in specified domain."	| P.D_SPHERE{center, irad, orad} =>
	(* 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
	*)
284
285		(* Source: http://mathworld.wolfram.com/SpherePointPicking.html *)
286
287		(* generate two random values... one will be called u and will
288		* represent cos(theta), and the other will be called v and will
289		* represent a random value in [0, 2 * pi] *)
290		letPRIM("randVal", IR.T_FLOAT, IR.RAND, [], fn rv =>
291		letPRIM("dblRandVal", IR.T_FLOAT, IR.MULT, [rv, IR.newConst("Two", IR.C_FLOAT 2.0)], fn drv =>
292		letPRIM("rand", IR.T_FLOAT, IR.SUB, [drv, IR.newConst("One", IR.C_FLOAT 1.0)], fn u =>
293
294		letPRIM("rv2", IR.T_FLOAT, IR.RAND, [], fn rv2 =>
295		letPRIM("rand2", IR.T_FLOAT, IR.MULT, [rv2, IR.newConst("TwoPi", IR.C_FLOAT (2.0 * Float.M_PI))], fn theta =>
296
297		letPRIM("cosTheta", IR.T_FLOAT, IR.COS, [theta], fn cosT =>
298		letPRIM("sinTheta", IR.T_FLOAT, IR.SIN, [theta], fn sinT =>
299
300		letPRIM("usq", IR.T_FLOAT, IR.MULT, [u, u], fn usq =>
301		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
304		letPRIM("xVal", IR.T_FLOAT, IR.MULT, [sinP, cosT], fn xVal =>
305		letPRIM("yVal", IR.T_FLOAT, IR.MULT, [sinP, sinT], fn yVal =>
306		(* zval is just u *)
307
308		letPRIM("vec", IR.T_VEC, IR.GEN_VEC, [xVal, yVal, u], fn vec =>
309
310		(* Generate a random radius... *)
311		letPRIM("ratio", IR.T_FLOAT, IR.DIV, [psvToIRVar(env, irad), psvToIRVar(env, orad)], fn ratio =>
312		letPRIM("invRatio", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), ratio], fn invRatio =>
313		letPRIM("randVar", IR.T_FLOAT, IR.RAND, [], fn rand =>
314		letPRIM("randScale", IR.T_FLOAT, IR.MULT, [rand, invRatio], fn randScale =>
315		letPRIM("randVal", IR.T_FLOAT, IR.ADD, [randScale, ratio], fn randVal =>
316		letPRIM("randValSq", IR.T_FLOAT, IR.MULT, [randVal, randVal], fn randValSq =>
317		letPRIM("radDiff", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, orad), psvToIRVar(env, irad)], fn radDiff =>
318		letPRIM("randRadVal", IR.T_FLOAT, IR.MULT, [radDiff, randValSq], fn randRadVal =>
319		letPRIM("rad", IR.T_FLOAT, IR.ADD, [psvToIRVar(env, irad), randRadVal], fn rad =>
320
321		(* Normalize the vector and scale it by the radius. *)
322		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)
324		))))))))))
325		)))))))))))))
326
327		| _ => raise Fail ("Cannot generate point in specified domain: "  ^ (P.dToStr domain))
328		(* end case *))
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 265	Line 333
333	* We set the boolean to whether or not the current particle given by the particle	* We set the boolean to whether or not the current particle given by the particle
334	* state is within the domain, and then pass the continuation on.	* state is within the domain, and then pass the continuation on.
335	*)	*)
336	fun mkWithinVar (boolVar, env, var, d, stmt : IR.var -> IR.stmt) = let	fun mkVecWithinVar (boolVar, env, var, d : Vec3f.vec3 P.domain, stmt : IR.var -> IR.stmt) = let
337	val pos = var	val pos = var
338	in	in
339	case d	case d
#	Line 294	Line 362
362	* behind it (with respect to the normal)	* behind it (with respect to the normal)
363	*)	*)
364	| P.D_PLANE{pt, normal} =>	| P.D_PLANE{pt, normal} =>
365	letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn posToPt =>	letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
366	letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>	letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
367	letPRIM(boolVar, IR.T_BOOL, IR.GT, [dotProd, IR.newConst("zero", IR.C_FLOAT 0.0)], stmt)))	letPRIM(boolVar, IR.T_BOOL, IR.GT, [dotProd, IR.newConst("zero", IR.C_FLOAT 0.0)], stmt)))
368
#	Line 305	Line 373
373	* orad.	* orad.
374	*)	*)
375	| P.D_DISC{pt, normal, orad, irad} =>	| P.D_DISC{pt, normal, orad, irad} =>
376	letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt), pos], fn posToPt =>	letPRIM("posToPt", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt)], fn posToPt =>
	letPRIM("posToPtLen", IR.T_FLOAT, IR.LEN, [posToPt], fn posToPtLen =>
377	letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>	letPRIM("dot", IR.T_FLOAT, IR.DOT, [posToPt, psvToIRVar(env, normal)], fn dotProd =>
378	letPRIM("inDisc", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.01), dotProd], fn inDisc =>	letPRIM("inDisc", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.01), dotProd], fn inDisc =>
379	letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOrad =>
380	letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIrad =>	letPRIM("parPosToP", IR.T_VEC, IR.SCALE, [dotProd, psvToIRVar(env, normal)], fn posToPtParallelToNormal =>
381		letPRIM("perpPosToP", IR.T_VEC, IR.SUB_VEC, [posToPt, posToPtParallelToNormal], fn posToPtPerpToNormal =>
382		letPRIM("inDiscLen", IR.T_FLOAT, IR.LEN, [posToPtPerpToNormal], fn posToPtLen =>
383
384		letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOradGt =>
385		letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), posToPtLen], fn inOradEq =>
386		letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
387
388		letPRIM("inIradGt", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIradGt =>
389		letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [posToPtLen, psvToIRVar(env, irad)], fn inIradEq =>
390		letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
391
392	letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>	letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
393	letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))
394		letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))))))))
395
396	(* Simply see whether or not the distance from the center is within the	(* Simply see whether or not the distance from the center is within the
397	* specified bounds.	* specified bounds.
#	Line 323	Line 402
402	letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToCLen], fn inOrad =>	letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToCLen], fn inOrad =>
403	letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToCLen, psvToIRVar(env, irad)], fn inIrad =>	letPRIM("inIrad", IR.T_BOOL, IR.GT, [posToCLen, psvToIRVar(env, irad)], fn inIrad =>
404	letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))	letPRIM(boolVar, IR.T_BOOL, IR.AND, [inIrad, inOrad], stmt)))))
405
406		| P.D_CYLINDER {pt1, pt2, irad, orad} =>
407
408		(* !FIXME! Right now, we see whether or not the point is within the two planes defined
409		* by the endpoints of the cylinder, and then testing to see whether or not the smallest
410		* distance to the line segment falls within the radii. It might be faster to find the
411		* closest point to the line defined by the endpoints and then see whether or not the point
412		* is within the segment.
413		*)
414
415		(* Is it in one plane *)
416		letPRIM("plane1Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn plane1Norm =>
417		letPRIM("posToPt1", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt1)], fn posToPt1 =>
418		letPRIM("dot1", IR.T_FLOAT, IR.DOT, [posToPt1, plane1Norm], fn dot1Prod =>
419		letPRIM("inPlane1", IR.T_BOOL, IR.GT, [dot1Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane1=>
420
421		(* Is it in another plane *)
422		letPRIM("plane2Norm", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), psvToIRVar(env, pt2)], fn plane2Norm =>
423		letPRIM("posToPt2", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, pt2)], fn posToPt2 =>
424		letPRIM("dot2", IR.T_FLOAT, IR.DOT, [posToPt2, plane2Norm], fn dot2Prod =>
425		letPRIM("inPlane2", IR.T_BOOL, IR.GT, [dot2Prod, IR.newConst("zero", IR.C_FLOAT 0.0)], fn inPlane2=>
426
427		(* Is it in both planes? *)
428		letPRIM("inPlanes", IR.T_BOOL, IR.AND, [inPlane1, inPlane2], fn inPlanes =>
429
430		(* Find distance from segment *)
431		letPRIM("a", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt2), psvToIRVar(env, pt1)], fn a =>
432		letPRIM("b", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, pt1), pos], fn b =>
433		letPRIM("alen", IR.T_FLOAT, IR.LEN, [a], fn alen =>
434		letPRIM("axb", IR.T_VEC, IR.CROSS, [a, b], fn axb =>
435		letPRIM("axblen", IR.T_FLOAT, IR.LEN, [axb], fn axblen =>
436		letPRIM("dist", IR.T_FLOAT, IR.DIV, [axblen, alen], fn dist =>
437
438		(* Is distance in both radii? *)
439		letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), dist], fn inOradGt =>
440		letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), dist], fn inOradEq =>
441		letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
442
443		letPRIM("inIradGt", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, irad)], fn inIradGt =>
444		letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [dist, psvToIRVar(env, irad)], fn inIradEq =>
445		letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
446
447		letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
448
449		(* It's in the cylinder (tube) if it's within both radii and in both planes... *)
450		letPRIM(boolVar, IR.T_BOOL, IR.AND, [inPlanes, inBothRad], stmt)
451		))))))))))))))))))))))
452	(*	(*
453	| P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}	| P.D_TRIANGLE {pt1: vec3f var, pt2: vec3f var, pt3: vec3f var}
454	| P.D_PLANE {pt: vec3f var, normal: vec3f var}	| P.D_PLANE {pt: vec3f var, normal: vec3f var}
455	| P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}	| P.D_RECT {pt: vec3f var, htvec: vec3f var, wdvec: vec3f var}
456	| P.D_BOX {min: vec3f var, max: vec3f var}	| P.D_BOX {min: vec3f var, max: vec3f var}
457	| P.D_SPHERE {center: vec3f var, irad: vec3f var, orad: vec3f var}	| P.D_SPHERE {center: vec3f var, irad: vec3f var, orad: vec3f var}
	| P.D_CYLINDER {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}
458	| P.D_CONE {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}	| P.D_CONE {pt1: vec3f var, pt2: vec3f var, irad: float var, orad: float var}
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 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
466		fun mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) = (case d
467		of P.D_POINT(pt) => letPRIM(boolVar, IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, pt), var], stmt)
468		| P.D_BOX {min, max} =>
469		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 =>
471		letPRIM(boolVar, IR.T_BOOL, IR.AND, [bigMin, smallMax], stmt)))
472		| _ => raise Fail ("Cannot determine within-ness for specified float domain: " ^ (P.dToStr d))
473		(* end case *))
474
475	(* generate code to produce a random particle state from a domain *)	fun mkIntBool(env, p1var, p2var, d : Vec3f.vec3 P.domain, state, k : IR.var -> particle_state -> IR.stmt) = let
476	fun newParticle (posDomain, velDomain, colDomain, env, k : particle_state -> IR.stmt) =	val _ = ()
477	(* genVecVar (vecVar, env, domain, stmt) *)	in
478	genVecVar("ps_pos", env, posDomain, fn newPos =>	(case d
479	genVecVar("ps_vel", env, velDomain, fn newVel =>	of P.D_POINT(pt) =>
480	genVecVar("ps_col", env, colDomain, fn newCol =>
481	letSPRIM ("ps_size", IR.T_FLOAT, IR.RAND, [], fn newSize =>	(* Get vectors *)
482	letSPRIM ("ps_isDead", IR.T_BOOL, IR.COPY, [IR.newConst("fbool", IR.C_BOOL false)], fn newIsDead =>	letPRIM("p1ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p1var], fn p1ToPt =>
483	k(PS{pos = newPos,	letPRIM("p2ToPt", IR.T_VEC, IR.SUB_VEC, [psvToIRVar (env, pt), p2var], fn p2ToPt =>
484	vel = newVel,	letPRIM("p1ToP2", IR.T_VEC, IR.SUB_VEC, [p2var, p1var], fn p1ToP2 =>
485	size = newSize,
486	isDead = newIsDead,	(* Get distances *)
487	color = newCol,	letPRIM("p1ToPtLen", IR.T_FLOAT, IR.LEN, [p1ToPt], fn p1ToPtLen =>
488	pos2 = IR.newConst("p2", IR.C_VEC {x=0.0, y=0.0, z=0.0}),	letPRIM("p2ToPtLen", IR.T_FLOAT, IR.LEN, [p2ToPt], fn p2ToPtLen =>
489	dummy = IR.newConst("dmy", IR.C_FLOAT 0.01)})	letPRIM("p1ToP2Len", IR.T_FLOAT, IR.LEN, [p1ToP2], fn p1ToP2Len =>
490	)))))
491		(* Add & subtract ... *)
492		letPRIM("distSum", IR.T_FLOAT, IR.ADD, [p1ToPtLen, p2ToPtLen], fn distSum =>
493		letPRIM("distDiff", IR.T_FLOAT, IR.SUB, [distSum, p1ToP2Len], fn distDiff =>
494		letPRIM("distDiffAbs", IR.T_FLOAT, IR.ABS, [distDiff], fn distDiffAbs =>
495
496		(* Do the boolean stuff... *)
497		letPRIM("intersect", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), distDiffAbs], fn intVar => k intVar state)
498
499		)))
500		)))
501		)))
502
503		| 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 *))
555
556		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
560		val _ = ()
561		in
562		(case d
563		of P.D_POINT(pt) => k (psvToIRVar (env, pt))
564
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 *))
581		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, 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, [newNorm], k(newNorm))	val nextBlk = newBlockWithArgs(env, state, [newNorm], k(newNorm))
	val PS{pos, ...} = state
589	in	in
590	(case d	(case d
591	of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],	of P.D_PLANE{pt, normal} =>
592	fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))	letPRIM("inVec", IR.T_VEC, IR.SUB, [psvToIRVar(env, pt), pos], fn inVec =>
593		letPRIM("dotNorm", IR.T_FLOAT, IR.DOT, [psvToIRVar(env, normal), inVec], fn dotNorm =>
594		letPRIM("eqZero", IR.T_BOOL, IR.EQUALS, [dotNorm, IR.newConst("One", IR.C_FLOAT 0.0)], fn eqZero =>
595		IR.mkIF(eqZero,
596		(*thenStmt*)
597		gotoWithArgs(state, [psvToIRVar(env, normal)], nextBlk),
598		(*elseStmt*)
599		letPRIM("dnRecip", IR.T_FLOAT, IR.DIV, [IR.newConst("One", IR.C_FLOAT 1.0), dotNorm], fn dnRecip =>
600		letPRIM("absR", IR.T_FLOAT, IR.ABS, [dnRecip], fn absR =>
601		letPRIM("sign", IR.T_FLOAT, IR.MULT, [absR, dotNorm], fn sign =>
602		letPRIM(retNorm, IR.T_VEC, IR.SCALE, [sign, psvToIRVar(env, normal)],
603		fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk)))))
604		))))
605
606	| P.D_DISC{pt, normal, irad, orad} =>	| P.D_DISC{pt, normal, irad, orad} =>
607	mkWithinVar("inP", env, pos, d, fn inPlane =>	normAtPoint(retNorm, P.D_PLANE{pt=pt, normal=normal}, env, pos, state, k)
	IR.mkIF(inPlane,
	(* then *)
	letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
	fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk)),
	(* else *)
	letPRIM(retNorm,
	IR.T_VEC,
	IR.SCALE,
	[IR.newConst("negOne", IR.C_FLOAT ~1.0), psvToIRVar(env, normal)],
	fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
	)
	)
608
609	| P.D_SPHERE{center, irad, orad} => let	| P.D_SPHERE{center, irad, orad} =>
	val PS{pos, ...} = state
	in
610	letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, center)], fn subVec =>	letPRIM("sv", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, center)], fn subVec =>
611	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
612	))	))
613
614		| _ => raise Fail("Cannot find normal to point of specified domain." ^ (P.dToStr d))
615		(* end case *))
616	end	end
617
618	| _ => raise Fail("Cannot find normal to point of specified domain.")	fun trExpr(expr, env, state, k : IR.var -> particle_state -> IR.stmt) = (case expr
619		of P.CONSTF f => k (IR.newConst ("c", IR.C_FLOAT f)) state
620
621		| P.CONST3F v => k (IR.newConst ("c", IR.C_VEC v)) state
622
623		| P.VAR v => k (psvToIRVar (env, v)) state
624
625		| P.STATE_VAR sv => k (getIRVarForSV (sv, state)) state
626
627		| P.GENERATE3F (dom, dist) => genVecVar("genVec", env, dom, dist, fn var => k var state)
628
629		| P.GENERATEF (dom, dist) => genFloatVar("genFlt", env, dom, dist, fn var => k var state)
630
631		| P.ADD(e1, e2) =>
632		trExpr(e1, env, state, fn e1var => fn state' =>
633		trExpr(e2, env, state', fn e2var => fn state'' =>
634		let
635		val IR.V{varType=vt1, ...} = e1var
636		val IR.V{varType=vt2, ...} = e2var
637		in
638		(case (vt1, vt2)
639		of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("addVar", IR.T_FLOAT, IR.ADD, [e1var, e2var], fn var => k var state'')
640		| (IR.T_VEC, IR.T_VEC) => letPRIM("addVar", IR.T_VEC, IR.ADD_VEC, [e1var, e2var], fn var => k var state'')
641		| _ => raise Fail ("Type mismatch to ADD expression")
642		(* end case *))
643		end))
644
645		| P.SCALE (e1, e2) =>
646		trExpr(e1, env, state, fn e1var => fn state' =>
647		trExpr(e2, env, state', fn e2var => fn state'' =>
648		let
649		val IR.V{varType=vt1, ...} = e1var
650		val IR.V{varType=vt2, ...} = e2var
651		in
652		(case (vt1, vt2)
653		of (IR.T_FLOAT, IR.T_VEC) => letPRIM("scaleVar", IR.T_VEC, IR.SCALE, [e1var, e2var], fn var => k var state'')
654		| (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("scaleVar", IR.T_FLOAT, IR.MULT, [e1var, e2var], fn var => k var state'')
655		| _ => raise Fail (String.concat["Type mismatch to SCALE expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
656		(* end case *))
657		end))
658
659		| P.DIV (e1, e2) =>
660		trExpr(e1, env, state, fn e1var => fn state' =>
661		trExpr(e2, env, state', fn e2var => fn state'' =>
662		let
663		val IR.V{varType=vt1, ...} = e1var
664		val IR.V{varType=vt2, ...} = e2var
665		in
666		(case (vt1, vt2)
667		of (IR.T_FLOAT, IR.T_FLOAT) => letPRIM("divVar", IR.T_FLOAT, IR.DIV, [e1var, e2var], fn var => k var state'')
668		| _ => raise Fail (String.concat["Type mismatch to DIV expression: ", IR.ty2Str vt1, ", ", IR.ty2Str vt2])
669		(* end case *))
670		end))
671
672		| P.NEG e =>
673		trExpr(e, env, state, fn evar => fn state' =>
674		let
675		val IR.V{varType, ...} = evar
676		in
677		(case varType
678		of IR.T_FLOAT => letPRIM("negVar", IR.T_FLOAT, IR.MULT, [evar, IR.newConst("negOne", IR.C_FLOAT ~1.0)], fn var => k var state')
679		| IR.T_VEC => letPRIM("negVar", IR.T_VEC, IR.NEG_VEC, [evar], fn var => k var state')
680		| _ => raise Fail ("Type mismatch to NEG expression")
681		(* end case *))
682		end)
683
684		| P.DOT (e1, e2) =>
685		trExpr(e1, env, state, fn e1var => fn state' =>
686		trExpr(e2, env, state', fn e2var => fn state'' =>
687		let
688		val IR.V{varType=vt1, ...} = e1var
689		val IR.V{varType=vt2, ...} = e2var
690		in
691		(case (vt1, vt2)
692		of (IR.T_VEC, IR.T_VEC) => letPRIM("dotVar", IR.T_FLOAT, IR.DOT, [e1var, e2var], fn var => k var state'')
693		| _ => raise Fail ("Type mismatch to DOT expression")
694		(* end case *))
695		end))
696
697		| P.CROSS (e1, e2) =>
698		trExpr(e1, env, state, fn e1var => fn state' =>
699		trExpr(e2, env, state', fn e2var => fn state'' =>
700		let
701		val IR.V{varType=vt1, ...} = e1var
702		val IR.V{varType=vt2, ...} = e2var
703		in
704		(case (vt1, vt2)
705		of (IR.T_VEC, IR.T_VEC) => letPRIM("crossVar", IR.T_VEC, IR.CROSS, [e1var, e2var], fn var => k var state'')
706		| _ => raise Fail ("Type mismatch to CROSS expression")
707		(* end case *))
708		end))
709
710		| P.NORMALIZE e =>
711		trExpr(e, env, state, fn evar => fn state' =>
712		let
713		val IR.V{varType, ...} = evar
714		in
715		(case varType
716		of IR.T_VEC => letPRIM("normVar", IR.T_VEC, IR.NORM, [evar], fn var => k var state')
717		| _ => raise Fail ("Type mismatch to NORMALIZE expression")
718		(* end case *))
719		end)
720
721		| P.LENGTH e =>
722		trExpr(e, env, state, fn evar => fn state' =>
723		let
724		val IR.V{varType, ...} = evar
725		in
726		(case varType
727		of IR.T_VEC => letPRIM("lenVar", IR.T_FLOAT, IR.LEN, [evar], fn var => k var state')
728		| _ => raise Fail ("Type mismatch to LENGTH expression")
729		(* end case *))
730		end)
731
732		(* !SPEED! We're assuming that there is an intersection here... *)
733		| P.INTERSECT {p1, p2, d} =>
734		trExpr(p1, env, state, fn p1var => fn state' =>
735		trExpr(p2, env, state', fn p2var => fn state'' =>
736		let
737		val IR.V{varType=vt1, ...} = p1var
738		val IR.V{varType=vt2, ...} = p2var
739		in
740		(case (vt1, vt2)
741		of (IR.T_VEC, IR.T_VEC) => mkIntPt(env, p1var, p2var, d, fn var => k var state'')
742		| _ => raise Fail("Type mismatch to INTERSECT expression")
743		(* end case *))
744		end))
745
746		| P.NORMALTO (e, d) =>
747		trExpr(e, env, state, fn evar => fn state' =>
748		let
749		val IR.V{varType, ...} = evar
750		fun cont s = k s
751		in
752		(case varType
753		of IR.T_VEC => normAtPoint("normVar", d, env, evar, state', k)
754		| _ => raise Fail("Type mismatch to NORMALTO expression")
755		(* end case *))
756		end)
757
758		| P.LOOKUP (varName) => let
759		fun findVar (IR.V{name, ...}) = name = varName
760		in
761		(case (List.find findVar state)
762		of SOME v => k v state
763		| NONE => raise Fail("Compiler Error: Undefined variable: " ^ varName)
764	(* end case *))	(* end case *))
765	end	end
766
767	fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let	(* end case expr *))
768
769		(* generate code to produce a random particle state from a domain *)
770		fun newParticle (sv_gens, env, state, k : particle_state -> IR.stmt) = let
771
772		fun createVar(P.GEN{var, ...}) = let
773		val P.PSV.SV{name, ty, ...} = var
774		in
775		IR.newLocal("ps_" ^ name, IR.psvTyToIRTy ty, (IR.RAND, []))
776		end
777
778		val newState = List.map createVar sv_gens
779
780		fun genVar((sv_gen, var), cont) = let
781		val P.GEN{exp, ...} = sv_gen
782		val IR.V{varType, ...} = var
783		in
784		(* This is kind of a hack, but it'll get optimized out.
785		* Also, I think it's OK to leave the state' unused since we're
786		* creating variables here and its assumed that they're independent. *)
787		trExpr(exp, env, state, fn newVal => fn state' => IR.mkPRIM(var, IR.COPY, [newVal], cont))
788		end (* genVar *)
789
790		in
791		List.foldr (fn (x, y) => genVar(x, y)) (k newState) (ListPair.zipEq (sv_gens, newState))
792		end (* new particle *)
793
794	val PS{isDead, ...} = state	fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let
795	val P.EMIT{maxNum, posDomain, velDomain, colDomain, ...} = emit	val P.EMIT{freq, sv_gens} = emit
796	val blk = newBlock (env, k)	val blk = newBlock (env, state, k)
797		val ttl = findIRVarByName(state, "ttl")
798	in	in
799		letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>
800	IR.mkIF(isDead,	IR.mkIF(isDead,
801	(* then *)	(* then *)
802	letPRIM("t1", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, maxNum)], fn t1 =>	trExpr(freq, env, state, fn t1 => fn state' =>
803	letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, numDead)], fn t2 =>	letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, PSV.numDead)], fn t2 =>
804	letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>	letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
805	letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>	letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
806	letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>	letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
807	IR.mkIF(t3,	IR.mkIF(t3,
808	(* then *)	(* then *)
809	newParticle (posDomain, velDomain, colDomain, env,	newParticle (sv_gens, env, state', fn state'' => retState state''),
	fn state' => retState state'),
810	(* else *)	(* else *)
811	IR.DISCARD)))))),	IR.DISCARD)))))),
812	(* else *)	(* else *)
813	retState state)	retState state))
814	end	end
815
816	fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let	(* trExpr(expr, env, state, k : IR.var -> IR.stmt) *)
817	val PS{pos, vel, ...} = state	(* mkFloatWithinVar (boolVar, env, var, d : Float.float P.domain, stmt : IR.var -> IR.stmt) *)
818	val P.PR{ifstmt, ...} = pred	fun trPred(cond, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
819	in	fun grabVar(cond, env, state, k : IR.var -> particle_state -> IR.stmt) = (case cond
820	case ifstmt	of P.WITHINF(d, expr) =>
821	of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>	trExpr(expr, env, state, fn checkMe => fn state' =>
822	IR.mkIF(withinVar, thenk(state), elsek(state)))	mkFloatWithinVar("wv", env, checkMe, d, fn var => k var state'))
823	| P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>
824	IR.mkIF(withinVar, thenk(state), elsek(state)))	| P.WITHIN3F(d, expr) =>
825	end	trExpr(expr, env, state, fn checkMe => fn state' =>
826		mkVecWithinVar("wv", env, checkMe, d, fn var => k var state'))
827
828		| P.DO_INTERSECT {p1, p2, d} =>
829		trExpr(p1, env, state, fn p1var => fn state' =>
830		trExpr(p2, env, state', fn p2var => fn state'' =>
831		mkIntBool(env, p1var, p2var, d, state'', k)))
832
833		| P.GTHAN (e1, e2) =>
834		trExpr(e1, env, state, fn e1var => fn state' =>
835		trExpr(e2, env, state', fn e2var => fn state'' =>
836		letPRIM("gtVar", IR.T_BOOL, IR.GT, [e1var, e2var], fn var => k var state'')))
837
838		| P.AND(c1, c2) =>
839		grabVar(c1, env, state, fn c1Var => fn state' =>
840		grabVar(c2, env, state', fn c2Var => fn state'' =>
841		letPRIM("andVar", IR.T_BOOL, IR.AND, [c1Var, c2Var], fn var => k var state'')))
842
843		| P.OR(c1, c2) =>
844		grabVar(c1, env, state, fn c1Var => fn state' =>
845		grabVar(c2, env, state', fn c2Var => fn state'' =>
846		letPRIM("andVar", IR.T_BOOL, IR.OR, [c1Var, c2Var], fn var => k var state'')))
847
848		| P.XOR(c1, c2) =>
849		grabVar(c1, env, state, fn c1Var => fn state' =>
850		grabVar(c2, env, state', fn c2Var => fn state'' =>
851		mkXOR ("xorVar", c1Var, c2Var, fn var => k var state'')))
852
853		| P.NOT(c) =>
854		grabVar(c, env, state, fn cvar => fn state' =>
855		letPRIM("notVar", IR.T_BOOL, IR.NOT, [cvar], fn var => k var state'))
856
857	fun trAct (action, env, state, k : particle_state -> IR.stmt) = let	(* end case *))
	val PS{pos, vel, size, isDead, color, pos2, dummy} = state
	in
	case action
	of P.BOUNCE{friction, resilience, cutoff, d} => let
	val blk = newBlock (env, k)
	val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)
	in
	letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn velScale =>
	letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
	mkWithinVar("wnp", env, pos, d, fn withinNextPos =>
	IR.mkIF(withinNextPos,
	(*then*)
	normAtPoint("n", d, env, state, fn normAtD => fn state' => let
	val PS{pos=nextPos, vel=nextVel, size=nextSize, isDead=nextIsDead, color=nextColor, pos2=nextPos2, dummy=nextDummy} = state'
858	in	in
859	letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>	grabVar(cond, env, state, fn result => fn state' =>
860	letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>	IR.mkIF(result, thenk(state'), elsek(state')))
	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, isDead=nextIsDead, color=nextColor, pos2=nextPos2, dummy=nextDummy}, blk)
	)))),
	(*else*)
	letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>
	letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
	goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor, pos2=nextPos2, dummy=nextDummy}, blk)
	))
	)))))))))
	end
	),
	(*else*)
	goto(state, blk)))))
861	end	end
862
863	| P.GRAVITY(dir) =>	fun compile (P.PG{
864	letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), psvToIRVar(env, dir)], fn theScale =>	emit as P.EMIT{freq, sv_gens}, act, render,
865	letPRIM("nextVel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>	vars, state_vars, render_vars
866	k(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color, pos2=pos2, dummy=dummy})))	}) = let
867		val blks = ref[]
	| P.MOVE =>
	letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn theScale =>
	letPRIM("nextPos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
	k(PS{pos = newPos, vel = vel, size = size, isDead = isDead, color = color, pos2=pos2, dummy=dummy})))
	(*
	| P.SINK({d, kill_inside}) =>
	mkWithinVar("isWithin", env, state, d, fn withinVal =>
	mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),
	fn shouldNotKill =>
	letPRIM("shouldKill", IR.T_BOOL, IR.NOT, [shouldNotKill], fn shouldKill =>
	letPRIM("isReallyDead", IR.T_BOOL, IR.OR, [shouldKill, isDead], fn isReallyDead =>
	k(PS{pos = pos, vel = vel, size = size, isDead = isReallyDead, color = color})
	))))
	*)
868
869	| P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let	fun printVar (PSV.V{name, id, ...}) =
870	val blk = newBlock (env, k)	printErr (String.concat[name, ": ", Int.toString id])
	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, 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("newVel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
	goto(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color, pos2=pos2, dummy=dummy}, blk)
	)))))))
	)))))))))))
	end
871
872	(* just kill it. *)	val demand = IR.getDemand(render)
873	(* | P.DIE => k(PS{pos = pos, vel = vel, size = size, isDead = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)	fun getIRNameForSV (v as PSV.SV{name, ...}) =
874	| P.DIE => IR.DISCARD	(case (PSV.SVMap.find (render_vars, v))
875	| _ => raise Fail("Action not implemented...")	of SOME na => let
876	(* end case *)	fun inDemand n = List.exists (fn x => #1 x = "ps_" ^ n) demand
877		in
878		(* Sanity check *)
879		if not (inDemand na) then
880		raise Fail (String.concat["Variable with name ", name," marked for rendering but not in demand."])
881		else
882		"ps_" ^ na
883	end	end
884		| NONE => "ps_" ^ name
885		(* end case *))
886
887	fun compile (P.PG{	fun convertToIR (v as PSV.SV{ty, ...}) = IR.newParam(getIRNameForSV v, IR.psvTyToIRTy ty)
	emit as P.EMIT{maxNum, vars=emitVars, ...},
	act as P.PSAE{action=root_act, vars=actionVars},
	render
	}) = let
	val blks = ref[]
888	val env = let	val env = let
889	(* add special globals to free vars *)	(* add special globals to free vars *)
890	val vars = PSV.Set.union(emitVars, PSV.Set.addList(actionVars, [maxNum, numDead, timeStep, epsilon]))	val pgm_vars = PSV.Set.union(PSV.Set.singleton epsilon, vars)
891	fun ins (x as PSV.V{name, ty, binding, id, ...}, map) = let	fun insv (x as PSV.V{name, ty, binding, id, ...}, map) = let
892	val x' = (case (ty, !binding)	val x' = (case (ty, !binding)
893	of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)	of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
894	| (PSV.T_BOOL,  PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))	| (PSV.T_BOOL,  PSV.BOOL boolVal) => IR.newConst(name, IR.C_BOOL(boolVal))
#	Line 551	Line 898
898	| (PSV.T_FLOAT, PSV.FLOAT floatVal) => IR.newConst(name, IR.C_FLOAT(floatVal))	| (PSV.T_FLOAT, PSV.FLOAT floatVal) => IR.newConst(name, IR.C_FLOAT(floatVal))
899	| (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)	| (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
900	| (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))	| (PSV.T_VEC3F, PSV.VEC3F vecVal) => IR.newConst(name, IR.C_VEC(vecVal))
901	| _ => raise Fail("Error in setup, type mismatch between IR and PSV vars.")	| _ => raise Fail("Error in setup, type mismatch between PSV vars and their binding.")
902	(* end case *))	(* end case *))
903	in	in
904	PSV.Map.insert (map, x, x')	PSV.Map.insert (map, x, x')
905		end (* ins *)
906		in
907		TE( blks, PSV.Set.foldl insv PSV.Map.empty pgm_vars )
908		end (* env *)
909
910		fun evalActs theAct state f = (case theAct
911		of P.SEQ(acts) => (case acts
912		of [] => f state
913		| oneAct :: rest => evalActs oneAct state (fn state' => (evalActs (P.SEQ(rest)) state' f))
914		(* end case *))
915
916		| P.PRED(cond, thenAct, elseAct) => let
917		val joinBlk = newBlock (env, state, fn state' => f state')
918		fun joinActs state = IR.mkGOTO(joinBlk, state)
919		in
920		trPred(cond, env, state,
921		fn state' => evalActs thenAct state' joinActs,
922		fn state' => evalActs elseAct state' joinActs
923		)
924	end	end
925
926		| P.DIE => IR.DISCARD
927
928		| P.ASSIGN(sv, expr) => let
929		val PSV.SV{ty, ...} = sv
930		fun replaceStateVar (var, []) = [var]
931		| replaceStateVar (var, nv :: svars) = let
932		val IR.V{name=nvname, ...} = nv
933		val IR.V{name=varname, ...} = var
934	in	in
935	TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)	if nvname = varname then
936		var :: svars
937		else
938		nv :: replaceStateVar(var, svars)
939		end
940		in
941		trExpr(expr, env, state, fn newVar => fn state' =>
942		letPRIM(getIRNameForSV sv, IR.psvTyToIRTy ty, IR.COPY, [newVar],
943		fn thisVar => f (replaceStateVar(thisVar, state'))))
944	end	end
945
946		| P.LET(P.V(varName), exp, act) =>
947		trExpr(exp, env, state, fn newVar => fn state' => let
948
949	fun evalActs f [] state = f [] state	val joinBlk = newBlock(env, state', f)
950	| evalActs f (psa :: psal) state = (case psa
951	of P.SEQ(acts) => (case acts	fun inOriginalState (IR.V{name=vn, ...}) = let
952	of [] => raise Fail "Should never reach here."	fun nameCompare (IR.V{name=vn1, ...}) = vn = vn1
	| [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, evalActs f psal)
	fun trPredActs [] state' = goto(state', cblk)
	| trPredActs _ _ = raise Fail "Should never reach here."
953	in	in
954	trPred(pred, env, state, evalActs trPredActs t, evalActs trPredActs e)	List.exists nameCompare state'
955	end	end
	(* end case *))
956
957	(* At the highest level, we want to return when we reach the end of the action list *)	fun gotoJoinBlk state'' = goto(List.filter inOriginalState state'', joinBlk)
958	fun trActs [] state = let
959	val PS{pos, vel, size, isDead, color, pos2, dummy} = state	val IR.V{varType, ...} = newVar
960		val newParam = IR.newParam(varName, varType)
961		val newState = newParam :: state'
962
963		val blk = newBlock(env, newState, fn state'' => evalActs act state'' gotoJoinBlk)
964	in	in
965	IR.mkRETURN[ pos, vel, size, isDead, color, pos2, dummy ]	goto(newVar :: state', blk)
966	end (* trActs *)	end
967	| trActs _ _ = raise Fail "Should never reach here"	)
968
969		(* end case *))
970
971	(* 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. *)
972	val entryBlock = newBlock (	val entryBlock = newBlock (
973	env,	env,
974		List.map convertToIR (PSV.SVSet.listItems state_vars),
975	fn pstate => trEmitter(	fn pstate => trEmitter(
976	emit,	emit,
977	env,	env,
978	pstate,	pstate,
979	fn state => evalActs trActs root_act state	fn state => evalActs act state retState
980	)	)
981	)	)
982
983	(* The entry block is the emitter, and the rest of the blocks define the physics processing. *)	(* The entry block is the emitter, and the rest of the blocks define the physics processing. *)
984
985		fun isGlobal(IR.V{scope, ...}) = (case scope
986		of IR.S_GLOBAL(v) => true
987		| _ => false
988		(* end case *))
989
990		fun extractVarMap(TE(blks, map)) = map
991
992	val outPgm = PSysIR.PGM {	val outPgm = PSysIR.PGM {
993		globals = PSV.Map.filter isGlobal (extractVarMap env),
994		persistents = demand,
995		uveOptimized = false,
996	emitter = entryBlock,	emitter = entryBlock,
997	physics = List.drop(!blks, 1),	physics = List.nth(!blks, 1),
998	render = render	render = render
999	}	}
1000
1001	val optimized = if (Checker.checkIR(outPgm)) then Optimize.optimizeIR(outPgm) else outPgm	val _ = IR.outputPgm(TextIO.stdErr, outPgm)
1002		val optimized = if (Checker.checkIR(outPgm)) then (printErr "\nPre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
1003	in	in
1004	IR.outputPgm(TextIO.stdErr, outPgm);	(* Note: it only succeeds if we can optimize, too *)
1005	if Checker.checkIR(optimized) then	if Checker.checkIR(optimized) then printErr "Compilation succeeded." else ();
1006	printErr "Compilation succeeded." (* Note: it only succeeds if we can optimize, too *)
	else
	();
	IR.outputPgm(TextIO.stdErr, optimized);
1007	optimized	optimized
1008	end (* compile *)	end (* compile *)
1009

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.901   changed lines   Added in v.1146

---

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