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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 750, Tue Feb 2 16:12:23 2010 UTC revision 1008, Sun Jan 16 17:04:08 2011 UTC
# Line 8  Line 8 
8    
9  structure Translate : sig  structure Translate : sig
10    
11      val compile : Particles.action -> PSysIR.block list      val compile : Particles.particle_group -> PSysIR.program
12    
13    end = struct    end = struct
14    
# Line 18  Line 18 
18      structure PSV = P.PSV      structure PSV = P.PSV
19      structure IR = PSysIR      structure IR = PSysIR
20    
21        fun printErr s = TextIO.output(TextIO.stdErr, s ^ "\n")
22    
23      datatype particle_state = PS of {      datatype particle_state = PS of {
24          pos : IR.var,           (* vec3 *)          pos : IR.var,           (* vec3 *)
25          vel : IR.var,           (* vec3 *)          vel : IR.var,           (* vec3 *)
26          size : IR.var,          (* float *)          size : IR.var,          (* float *)
27          isDead : IR.var,        (* bool *)          ttl : IR.var,           (* float *)
28          color : IR.var          (* vec3 (NOTE: should be vector4) *)          color : IR.var,         (* vec3 (NOTE: should be vector4) *)
29            pos2 : IR.var,          (* vec3 *)
30            dummy : IR.var
31        }        }
32    
33    (* 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 *)  
34      val epsilon = PSV.constf(0.00001)      val epsilon = PSV.constf(0.00001)
35    
36    (* constants *)    (* constants *)
# Line 47  Line 49 
49              k state              k state
50            )            )
51    
52    
53        fun retState s = let
54          val PS{pos, vel, size, ttl, color, pos2, dummy} = s
55         in
56          IR.mkRETURN (
57            [pos, vel, size, ttl, color, pos2, dummy],
58            [IR.POS, IR.VEL, IR.SZ, IR.TTL, IR.COLOR, IR.POS2, IR.DUMMY]
59          )
60         end
61    
62    (* translation environment *)    (* translation environment *)
63      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)
64    
65      fun psvToIRVar (TE(_, env), x as PSV.V{name, ...}) = (case PSV.Map.find(env, x)      fun psvToIRVar (TE(_, env), x as PSV.V{name, id, ...}) = (case PSV.Map.find(env, x)
66             of SOME x' => x'             of SOME x' => x'
67              | NONE => raise Fail ("unknown variable " ^ name)              | NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])
68            (* end case *))            (* end case *))
69    
70      fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))      fun insert (TE(blks, env), x, x') = TE(blks, PSV.Map.insert (env, x, x'))
# Line 62  Line 74 
74            val pos = IR.newParam ("ps_pos", IR.T_VEC)            val pos = IR.newParam ("ps_pos", IR.T_VEC)
75            val vel = IR.newParam ("ps_vel", IR.T_VEC)            val vel = IR.newParam ("ps_vel", IR.T_VEC)
76            val size = IR.newParam ("ps_size", IR.T_FLOAT)            val size = IR.newParam ("ps_size", IR.T_FLOAT)
77            val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)            val ttl = IR.newParam ("ps_ttl", IR.T_FLOAT)
78            val color = IR.newParam ("ps_color", IR.T_VEC)            val color = IR.newParam ("ps_color", IR.T_VEC)
79            val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color}            val dummy = IR.newParam ("ps_dummy", IR.T_FLOAT)
80            val blk = IR.newBlock ([pos, vel, size, isDead, color], k state)            val pos2 = IR.newParam ("ps_pos2", IR.T_VEC)
81              val state = PS{pos=pos, vel=vel, size=size, ttl=ttl, color=color, pos2=pos2, dummy=dummy}
82              val blk = IR.newBlock ([pos, vel, size, ttl, color, pos2, dummy], k state)
83            in            in
84              blks := blk :: !blks;              blks := blk :: !blks;
85              blk              blk
# Line 75  Line 89 
89            val pos = IR.newParam ("ps_pos", IR.T_VEC)            val pos = IR.newParam ("ps_pos", IR.T_VEC)
90            val vel = IR.newParam ("ps_vel", IR.T_VEC)            val vel = IR.newParam ("ps_vel", IR.T_VEC)
91            val size = IR.newParam ("ps_size", IR.T_FLOAT)            val size = IR.newParam ("ps_size", IR.T_FLOAT)
92            val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)            val ttl = IR.newParam ("ps_ttl", IR.T_FLOAT)
93            val color = IR.newParam ("ps_color", IR.T_VEC)            val color = IR.newParam ("ps_color", IR.T_VEC)
94            val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color}            val dummy = IR.newParam ("ps_dummy", IR.T_FLOAT)
95            val blk = IR.newBlock ([pos, vel, size, isDead, color] @ args, k state)            val pos2 = IR.newParam ("ps_pos2", IR.T_VEC)
96              val state = PS{pos=pos, vel=vel, size=size, ttl=ttl, color=color, pos2=pos2, dummy = dummy}
97              val blk = IR.newBlock ([pos, vel, size, ttl, color, pos2, dummy] @ args, k state)
98            in            in
99              blks := blk :: !blks;              blks := blk :: !blks;
100              blk              blk
101            end            end
102    
103      fun goto (PS{pos, vel, size, isDead, color}, blk) =      fun goto (PS{pos, vel, size, ttl, color, pos2, dummy}, blk) =
104            IR.mkGOTO(blk, [pos, vel, size, isDead, color])            IR.mkGOTO(blk, [pos, vel, size, ttl, color, pos2, dummy])
105    
106          fun gotoWithArgs(PS{pos, vel, size, isDead, color}, args, blk) =          fun gotoWithArgs(PS{pos, vel, size, ttl, color, pos2, dummy}, args, blk) =
107            IR.mkGOTO(blk, [pos, vel, size, isDead, color] @ args)            IR.mkGOTO(blk, [pos, vel, size, ttl, color, pos2, dummy] @ args)
108    
109      fun letPRIM (x, ty, p, args, body) = let      fun letPRIM (x, ty, p, args, body) = let
110            val x' = IR.newLocal(x, ty, (p, args))            val x' = IR.newLocal(x, ty, (p, args))
# Line 98  Line 114 
114    
115    (* prim bound to state variable (S_LOCAL for now) *)    (* prim bound to state variable (S_LOCAL for now) *)
116      fun letSPRIM(x, ty, p, args, body) = let      fun letSPRIM(x, ty, p, args, body) = let
117            val x' = IR.new(x, IR.S_LOCAL(p, args), ty)            val x' = IR.new(x, IR.S_LOCAL(ref (p, args)), ty)
118            in            in
119              IR.mkPRIM(x', p, args, body x')              IR.mkPRIM(x', p, args, body x')
120            end            end
# Line 127  Line 143 
143                  letPRIM ("pt2s", IR.T_VEC, IR.SCALE, [randInv, psvToIRVar(env, pt2)], fn pt2ScaleVec =>                  letPRIM ("pt2s", IR.T_VEC, IR.SCALE, [randInv, psvToIRVar(env, pt2)], fn pt2ScaleVec =>
144                  letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))                  letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))
145    
146            (* This is a bit more complicated if we're trying to avoid accessing              | P.D_BOX{max, min} =>
147             * the vector variables themselves. Basically the way we can do it is to                  (* Extract the componentwise vector variables *)
148             * decompose the vector connecting min and max into the basis vectors,                  letPRIM("minX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, min)], fn minX =>
149             * scale them independently, and then add them back together.                  letPRIM("maxX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, max)], fn maxX =>
150             *                  letPRIM("minY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, min)], fn minY =>
151             * !FIXME! Actually do that. Don't have time right now...                  letPRIM("maxY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, max)], fn maxY =>
152             *)                  letPRIM("minZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, min)], fn minZ =>
153              | P.D_BOX{max, min} => raise Fail "Cannot generate point in D_BOX."                  letPRIM("maxZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, max)], fn maxZ =>
154    
155                    (* Find the distance in each component *)
156                    letPRIM("distX", IR.T_FLOAT, IR.SUB, [maxX, minX], fn distX =>
157                    letPRIM("distY", IR.T_FLOAT, IR.SUB, [maxY, minY], fn distY =>
158                    letPRIM("distZ", IR.T_FLOAT, IR.SUB, [maxZ, minZ], fn distZ =>
159    
160                    (* Get three random numbers for each of the components *)
161                    letPRIM("randX", IR.T_FLOAT, IR.RAND, [], fn randX =>
162                    letPRIM("randY", IR.T_FLOAT, IR.RAND, [], fn randY =>
163                    letPRIM("randZ", IR.T_FLOAT, IR.RAND, [], fn randZ =>
164    
165                    (* Scale the distances by these random numbers *)
166                    letPRIM("scaledX", IR.T_FLOAT, IR.MULT, [randX, distX], fn scaledX =>
167                    letPRIM("scaledY", IR.T_FLOAT, IR.MULT, [randY, distY], fn scaledY =>
168                    letPRIM("scaledZ", IR.T_FLOAT, IR.MULT, [randZ, distZ], fn scaledZ =>
169    
170                    (* Add them to the minimum vec in order to create a new vec inside
171                     * of the box.
172                     *)
173                    letPRIM("newX", IR.T_FLOAT, IR.ADD, [minX, scaledX], fn newX =>
174                    letPRIM("newY", IR.T_FLOAT, IR.ADD, [minY, scaledY], fn newY =>
175                    letPRIM("newZ", IR.T_FLOAT, IR.ADD, [minZ, scaledZ], fn newZ =>
176    
177                    (* Gen the vector *)
178                    letPRIM(vecVar, IR.T_VEC, IR.GEN_VEC, [newX, newY, newZ], stmt
179    
180                    )))))))))))))))))))
181    
182    
183              | P.D_TRIANGLE{pt1, pt2, pt3} =>              | P.D_TRIANGLE{pt1, pt2, pt3} =>
184                  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 =>
# Line 222  Line 266 
266     * 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
267     * state is within the domain, and then pass the continuation on.     * state is within the domain, and then pass the continuation on.
268     *)     *)
269      fun mkWithinVar (boolVar, env, state, d, stmt : IR.var -> IR.stmt) = let      fun mkWithinVar (boolVar, env, var, d, stmt : IR.var -> IR.stmt) = let
270            val PS{pos, vel, size, isDead, color} = state            val pos = var
271            in            in
272              case d              case d
273               of P.D_POINT(pt) =>               of P.D_POINT(pt) =>
# Line 251  Line 295 
295               * behind it (with respect to the normal)               * behind it (with respect to the normal)
296               *)               *)
297                | P.D_PLANE{pt, normal} =>                | P.D_PLANE{pt, normal} =>
298                    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 =>
299                    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 =>
300                    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)))
301    
# Line 262  Line 306 
306               * orad.               * orad.
307               *)               *)
308                | P.D_DISC{pt, normal, orad, irad} =>                | P.D_DISC{pt, normal, orad, irad} =>
309                    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 =>  
310                    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 =>
311                    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 =>
312                    letPRIM("inOrad", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOrad =>  
313                    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 =>
314                      letPRIM("perpPosToP", IR.T_VEC, IR.SUB_VEC, [posToPt, posToPtParallelToNormal], fn posToPtPerpToNormal =>
315                      letPRIM("inDiscLen", IR.T_FLOAT, IR.LEN, [posToPtPerpToNormal], fn posToPtLen =>
316    
317                      letPRIM("inOradGt", IR.T_BOOL, IR.GT, [psvToIRVar(env, orad), posToPtLen], fn inOradGt =>
318                      letPRIM("inOradEq", IR.T_BOOL, IR.EQUALS, [psvToIRVar(env, orad), posToPtLen], fn inOradEq =>
319                      letPRIM("inOrad", IR.T_BOOL, IR.OR, [inOradGt, inOradEq], fn inOrad =>
320    
321                      letPRIM("inIradGt", IR.T_BOOL, IR.GT, [posToPtLen, psvToIRVar(env, irad)], fn inIradGt =>
322                      letPRIM("inIradEq", IR.T_BOOL, IR.EQUALS, [posToPtLen, psvToIRVar(env, irad)], fn inIradEq =>
323                      letPRIM("inIrad", IR.T_BOOL, IR.OR, [inIradGt, inIradEq], fn inIrad =>
324    
325                    letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>                    letPRIM("inBothRad", IR.T_BOOL, IR.AND, [inIrad, inOrad], fn inBothRad =>
326                    letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))  
327                      letPRIM(boolVar, IR.T_BOOL, IR.AND, [inDisc, inBothRad], stmt))))))))))))))
328    
329              (* 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
330               * specified bounds.               * specified bounds.
# Line 302  Line 357 
357              genVecVar("ps_pos", env, posDomain, fn newPos =>              genVecVar("ps_pos", env, posDomain, fn newPos =>
358              genVecVar("ps_vel", env, velDomain, fn newVel =>              genVecVar("ps_vel", env, velDomain, fn newVel =>
359              genVecVar("ps_col", env, colDomain, fn newCol =>              genVecVar("ps_col", env, colDomain, fn newCol =>
360              letSPRIM ("ps_size", IR.T_FLOAT, IR.RAND, [], fn newSize =>              letPRIM ("randSize", IR.T_FLOAT, IR.RAND, [], fn randSize =>
361              letSPRIM ("ps_isDead", IR.T_BOOL, IR.COPY, [IR.newConst("fbool", IR.C_BOOL false)], fn newIsDead =>              letPRIM ("halvedSize", IR.T_FLOAT, IR.MULT, [randSize, IR.newConst("halver", IR.C_FLOAT 0.5)], fn halfSize =>
362                k(PS{pos = newPos, vel = newVel, size = newSize, isDead = newIsDead, color = newCol}))))))              letSPRIM("ps_size", IR.T_FLOAT, IR.ADD, [halfSize, IR.newConst("scalar", IR.C_FLOAT 0.5)], fn newSize =>
363                letSPRIM ("ps_ttl", IR.T_FLOAT, IR.COPY, [IR.newConst("fbool", IR.C_FLOAT 10000.0)], fn newIsDead =>
364                  k(PS{pos = newPos,
365                       vel = newVel,
366                       size = newSize,
367                       ttl = newIsDead,
368                       color = newCol,
369                       pos2 = IR.newConst("ps_pos2", IR.C_VEC {x=0.0, y=0.0, z=0.0}),
370                       dummy = IR.newConst("ps_dummy", IR.C_FLOAT 0.01)})
371                )))))))
372    
373      (* 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
374       * 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
# Line 313  Line 377 
377      fun normAtPoint(retNorm, d, env, state, k : IR.var -> particle_state -> IR.stmt) = let      fun normAtPoint(retNorm, d, env, state, k : IR.var -> particle_state -> IR.stmt) = let
378        val newNorm = IR.newParam("n", IR.T_VEC)        val newNorm = IR.newParam("n", IR.T_VEC)
379        val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))        val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))
380          val PS{pos, ...} = state
381       in       in
382        (case d        (case d
383            of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],            of P.D_PLANE{pt, normal} => letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
384                fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))                fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
385             | P.D_DISC{pt, normal, irad, orad} =>             | P.D_DISC{pt, normal, irad, orad} =>
386                mkWithinVar("inP", env, state, d, fn inPlane =>                mkWithinVar("inP", env, pos, d, fn inPlane =>
387                    IR.mkIF(inPlane,                    IR.mkIF(inPlane,
388                      (* then *)                      (* then *)
389                      letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],                      letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
# Line 333  Line 398 
398                   )                   )
399    
400             | P.D_SPHERE{center, irad, orad} => let             | P.D_SPHERE{center, irad, orad} => let
401                val PS{pos, vel, size, isDead, color} = state                val PS{pos, ...} = state
402                in                in
403                      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 =>
404                  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
# Line 344  Line 409 
409           (* end case *))           (* end case *))
410          end          end
411    
412            fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let
413    
414              val PS{ttl, ...} = state
415              val P.EMIT{maxNum, posDomain, velDomain, colDomain, ...} = emit
416              val blk = newBlock (env, k)
417             in
418              letPRIM("isDead", IR.T_BOOL, IR.GT, [IR.newConst("small", IR.C_FLOAT 0.1), ttl], fn isDead =>
419          IR.mkIF(isDead,
420           (* then *)
421           letPRIM("t1", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, maxNum)], fn t1 =>
422           letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, PSV.numDead)], fn t2 =>
423           letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
424           letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
425           letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
426           IR.mkIF(t3,
427            (* then *)
428            newParticle (posDomain, velDomain, colDomain, env,
429             fn state' => retState state'),
430            (* else *)
431            IR.DISCARD)))))),
432           (* else *)
433           retState state))
434         end
435    
436            fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
437              val PS{pos, vel, ...} = state
438              val P.PR{ifstmt, ...} = pred
439             in
440              case ifstmt
441               of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>
442                IR.mkIF(withinVar, thenk(state), elsek(state)))
443                | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>
444                IR.mkIF(withinVar, thenk(state), elsek(state)))
445             end
446    
447      fun trAct (action, env, state, k : particle_state -> IR.stmt) = let      fun trAct (action, env, state, k : particle_state -> IR.stmt) = let
448            val PS{pos, vel, size, isDead, color} = state            val PS{pos, vel, size, ttl, color, pos2, dummy} = state
449            in            in
450              case action              case action
451               of P.BOUNCE{friction, resilience, cutoff, d} => let               of P.BOUNCE{friction, resilience, cutoff, d} => let
452                    val blk = newBlock (env, k)                    val blk = newBlock (env, k)
453                    val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)                    val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)
454                    in                    in
455                      letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn velScale =>                      letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn velScale =>
456                      letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>                      letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
457                      mkWithinVar("wnp", env, state, d, fn withinNextPos =>                      mkWithinVar("wcp", env, pos, d, fn withinCurPos =>
458                      IR.mkIF(withinNextPos,                      mkWithinVar("wnp", env, nextPos, d, fn withinNextPos =>
459                        letPRIM("nwcp", IR.T_BOOL, IR.NOT, [withinCurPos], fn notWithinCurPos =>
460                        letPRIM("sb", IR.T_BOOL, IR.AND, [notWithinCurPos, withinNextPos], fn shouldBounce =>
461                        IR.mkIF(shouldBounce,
462                        (*then*)                        (*then*)
463                          normAtPoint("n", d, env, state, fn normAtD => fn state' => let                          normAtPoint("n", d, env, state, fn normAtD => fn state' => let
464                 val PS{pos=nextPos, vel=nextVel, size=nextSize, isDead=nextIsDead, color=nextColor} = state'                 val PS{pos=nextPos, vel=nextVel, size=nextSize, ttl=nextIsDead, color=nextColor, pos2=nextPos2, dummy=nextDummy} = state'
465                            in                            in
466                             letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>                             letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>
467                             letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>                             letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>
# Line 377  Line 480 
480                               letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>                               letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>
481                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>
482                               letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>                               letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
483                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor}, blk)                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, pos2=nextPos2, dummy=nextDummy}, blk)
484                              )))),                              )))),
485                               (*else*)                               (*else*)
486                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>
487                               letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>                               letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
488                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor}, blk)                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, pos2=nextPos2, dummy=nextDummy}, blk)
489                               ))                               ))
490                           )))))))))                           )))))))))
491                           end                           end
492                        ),                        ),
493                        (*else*)                        (*else*)
494                        goto(state, blk)))))                        goto(state, blk))))))))
495                    end                    end
496    
497                | P.SOURCE({maxNum, posDomain, velDomain, colDomain}) => let                | P.ACCEL dir =>
498                    val blk = newBlock (env, k)                      letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), psvToIRVar(env, dir)], fn theScale =>
499                    in                      letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>
500                      IR.mkIF(isDead,                        k(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, pos2=pos2, dummy=dummy})))
                       (* then *)  
                           letPRIM("t1", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, maxNum)], fn t1 =>  
                           letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, 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, velDomain, colDomain, env,  
                                 fn state' => goto (state', blk)),  
                             (* else *)  
                               IR.DISCARD)))))),  
                       (* else *)  
                         goto (state, blk))  
                   end  
   
               | P.GRAVITY(dir) =>  
                     letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), psvToIRVar(env, dir)], fn theScale =>  
                     letPRIM("nextVel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>  
                       k(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color})))  
501    
502                | P.MOVE =>                | P.MOVE =>
503                  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn theScale =>                  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn theScale =>
504                      letPRIM("nextPos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>                      letPRIM("ps_pos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
505                        k(PS{pos = newPos, vel = vel, size = size, isDead = isDead, color = color})))                        k(PS{pos = newPos, vel = vel, size = size, ttl = ttl, color = color, pos2=pos2, dummy=dummy})))
506                  (*
507                | P.SINK({d, kill_inside}) => let                | P.SINK({d, kill_inside}) =>
                   val deadState = PS{  
                           pos = pos, vel = vel, size = size,  
                           isDead = IR.newConst("reallyDead", IR.C_BOOL true),  
                           color = color  
                       }  
                   val blk = newBlock (env, k)  
                   in  
508                      mkWithinVar("isWithin", env, state, d, fn withinVal =>                      mkWithinVar("isWithin", env, state, d, fn withinVal =>
509                      mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),                      mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),
510                        fn shouldNotKill =>                        fn shouldNotKill =>
511                          IR.mkIF(shouldNotKill,                      letPRIM("shouldKill", IR.T_BOOL, IR.NOT, [shouldNotKill], fn shouldKill =>
512                            (*then*) goto(state, blk),                      letPRIM("isReallyDead", IR.T_BOOL, IR.OR, [shouldKill, ttl], fn isReallyDead =>
513                            (*else*) goto(deadState, blk))                      k(PS{pos = pos, vel = vel, size = size, ttl = isReallyDead, color = color})
514                          ))                          ))))
515                    end                *)
516    
517                | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let                | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let
518                    val blk = newBlock (env, k)                    val blk = newBlock (env, k)
# Line 458  Line 534 
534                    letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>                    letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>
535                    letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>                    letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
536                    letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>                    letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
537                    letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, timeStep)], fn totMag =>                    letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>
538                    letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>                    letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>
539                    letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>                    letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>
540                    letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>                    letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
541                    goto(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color}, blk)                    goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, pos2=pos2, dummy=dummy}, blk)
542                    )))))))                    )))))))
543                  )))))))))))                  )))))))))))
544                  end                  end
545    
546                  (* just kill it. *)
547                  (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, ttl = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)
548                  | P.DIE => IR.DISCARD
549                | _ => raise Fail("Action not implemented...")                | _ => raise Fail("Action not implemented...")
550              (* end case *)              (* end case *)
551            end            end
552    
553      fun compile (P.PSAE{action, vars}) = let      fun compile (P.PG{
554           emit as P.EMIT{maxNum, vars=emitVars, ...},
555           act as P.PSAE{action=root_act, vars=actionVars},
556           render
557        }) = let
558            val blks = ref[]            val blks = ref[]
559            val env = let            val env = let
560                (* add special globals to free vars *)                (* add special globals to free vars *)
561                  val vars = PSV.Set.addList(vars, [numDead, timeStep, epsilon])                  val vars = PSV.Set.union(emitVars, PSV.Set.addList(actionVars, [maxNum, PSV.numDead, PSV.timeStep, epsilon]))
562                  fun ins (x as PSV.V{name, ty, binding, ...}, map) = let                  fun ins (x as PSV.V{name, ty, binding, id, ...}, map) = let
563                        val x' = (case (ty, !binding)                        val x' = (case (ty, !binding)
564                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
565                                | (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 485  Line 569 
569                                | (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))
570                                | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)                                | (PSV.T_VEC3F, PSV.UNDEF) => IR.newGlobal(x, IR.T_VEC)
571                                | (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))
572                                | _ => 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.")
573                              (* end case *))                              (* end case *))
574                        in                        in
575                          PSV.Map.insert (map, x, x')                          PSV.Map.insert (map, x, x')
# Line 493  Line 577 
577                  in                  in
578                    TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)                    TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)
579                  end                  end
580    
581          fun evalActs f [] state = f [] state
582                | evalActs f (psa :: psal) state = (case psa
583                  of P.SEQ(acts) => (case acts
584                     of [] => raise Fail "Should never reach here."
585                      | [act] => trAct(act, env, state, evalActs f psal)
586                      | act :: rest => trAct(act, env, state, evalActs f (P.SEQ(rest) :: psal))
587                    (* end case *))
588                   | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) => let
589                       val cblk = newBlock(env, evalActs f psal)
590                       fun trPredActs [] state' = goto(state', cblk)
591                         | trPredActs _ _ = raise Fail "Should never reach here."
592                      in
593                       trPred(pred, env, state, evalActs trPredActs t, evalActs trPredActs e)
594                      end
595                  (* end case *))
596    
597              (* At the highest level, we want to return when we reach the end of the action list *)
598            fun trActs [] state = let            fun trActs [] state = let
599                  val PS{pos, vel, size, isDead, color} = state                  val PS{pos, vel, size, ttl, color, pos2, dummy} = state
600                  in                  in
601                    IR.mkRETURN[ pos, vel, size, isDead, color ]                    IR.mkRETURN (
602                        [ pos, vel, size, ttl, color, pos2, dummy ],
603                        [IR.POS, IR.VEL, IR.SZ, IR.TTL, IR.COLOR, IR.POS2, IR.DUMMY]
604                      )
605                  end (* trActs *)                  end (* trActs *)
606              | trActs (psa :: psal) state = trAct(psa, env, state, trActs psal)              | trActs _ _ = raise Fail "Should never reach here"
607            val entryBlock = newBlock (env, fn state => trActs action state)  
608              (* The entry block is the first block of the program, or in other words, the emitter. *)
609              val entryBlock = newBlock (
610                env,
611                fn pstate => trEmitter(
612                  emit,
613                  env,
614                  pstate,
615                  fn state => evalActs trActs root_act state
616                )
617              )
618    
619          (* The entry block is the emitter, and the rest of the blocks define the physics processing. *)
620    
621          fun isGlobal(IR.V{scope, ...}) = (case scope
622            of IR.S_GLOBAL(v) => true
623             | _ => false
624            (* end case *))
625    
626          fun extractVarMap(TE(blks, map)) = map
627    
628              val outPgm = PSysIR.PGM {
629                globals = PSV.Map.filter isGlobal (extractVarMap env),
630            emitter = entryBlock,
631                physics = List.nth(!blks, 1),
632                render = render
633              }
634    
635              val optimized = if (Checker.checkIR(outPgm)) then (printErr "Pre-optimization complete."; Optimize.optimizeIR(outPgm)) else outPgm
636    
637            in            in
638              IR.output(TextIO.stdErr, !blks);              (* IR.outputPgm(TextIO.stdErr, outPgm); *)
639              if Checker.checkIR(!blks) then              if Checker.checkIR(optimized) then
640                (* note that the entryBlock will be the first block *)               printErr "Compilation succeeded." (* Note: it only succeeds if we can optimize, too *)
               (IR.output(TextIO.stdErr, Optimize.optimizeIR(!blks));  
               !blks)  
641              else              else
642                []               ();
643                optimized
644            end (* compile *)            end (* compile *)
645    
646      end (* Translate *)      end (* Translate *)

Legend:
Removed from v.750  
changed lines
  Added in v.1008

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