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 769, Mon Feb 15 22:52:36 2010 UTC revision 873, Wed May 5 20:18:00 2010 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 *)          isDead : IR.var,        (* bool *)
28          color : IR.var          (* vec3 (NOTE: should be vector4) *)          color : IR.var,         (* vec3 (NOTE: should be vector4) *)
29            dummy : IR.var
30        }        }
31    
32    (* special PSV global variables *)    (* special PSV global variables *)
# Line 47  Line 50 
50              k state              k state
51            )            )
52    
53    
54        fun retState s = let
55          val PS{pos, vel, size, isDead, color, dummy} = s
56         in
57          IR.mkRETURN [pos, vel, size, isDead, color, dummy]
58         end
59    
60    (* translation environment *)    (* translation environment *)
61      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)
62    
63      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)
64             of SOME x' => x'             of SOME x' => x'
65              | NONE => raise Fail ("unknown variable " ^ name)              | NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])
66            (* end case *))            (* end case *))
67    
68      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 64  Line 74 
74            val size = IR.newParam ("ps_size", IR.T_FLOAT)            val size = IR.newParam ("ps_size", IR.T_FLOAT)
75            val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)            val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)
76            val color = IR.newParam ("ps_color", IR.T_VEC)            val color = IR.newParam ("ps_color", IR.T_VEC)
77            val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color}            val dummy = IR.newParam ("ps_dummy", IR.T_FLOAT)
78            val blk = IR.newBlock ([pos, vel, size, isDead, color], k state)            val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color, dummy=dummy}
79              val blk = IR.newBlock ([pos, vel, size, isDead, color, dummy], k state)
80            in            in
81              blks := blk :: !blks;              blks := blk :: !blks;
82              blk              blk
# Line 77  Line 88 
88            val size = IR.newParam ("ps_size", IR.T_FLOAT)            val size = IR.newParam ("ps_size", IR.T_FLOAT)
89            val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)            val isDead = IR.newParam ("ps_isDead", IR.T_BOOL)
90            val color = IR.newParam ("ps_color", IR.T_VEC)            val color = IR.newParam ("ps_color", IR.T_VEC)
91            val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color}            val dummy = IR.newParam ("ps_dummy", IR.T_FLOAT)
92            val blk = IR.newBlock ([pos, vel, size, isDead, color] @ args, k state)            val state = PS{pos=pos, vel=vel, size=size, isDead=isDead, color=color, dummy = dummy}
93              val blk = IR.newBlock ([pos, vel, size, isDead, color, dummy] @ args, k state)
94            in            in
95              blks := blk :: !blks;              blks := blk :: !blks;
96              blk              blk
97            end            end
98    
99      fun goto (PS{pos, vel, size, isDead, color}, blk) =      fun goto (PS{pos, vel, size, isDead, color, dummy}, blk) =
100            IR.mkGOTO(blk, [pos, vel, size, isDead, color])            IR.mkGOTO(blk, [pos, vel, size, isDead, color, dummy])
101    
102          fun gotoWithArgs(PS{pos, vel, size, isDead, color}, args, blk) =          fun gotoWithArgs(PS{pos, vel, size, isDead, color, dummy}, args, blk) =
103            IR.mkGOTO(blk, [pos, vel, size, isDead, color] @ args)            IR.mkGOTO(blk, [pos, vel, size, isDead, color, dummy] @ args)
104    
105      fun letPRIM (x, ty, p, args, body) = let      fun letPRIM (x, ty, p, args, body) = let
106            val x' = IR.newLocal(x, ty, (p, args))            val x' = IR.newLocal(x, ty, (p, args))
# Line 98  Line 110 
110    
111    (* prim bound to state variable (S_LOCAL for now) *)    (* prim bound to state variable (S_LOCAL for now) *)
112      fun letSPRIM(x, ty, p, args, body) = let      fun letSPRIM(x, ty, p, args, body) = let
113            val x' = IR.new(x, IR.S_LOCAL(p, args), ty)            val x' = IR.new(x, IR.S_LOCAL(ref (p, args)), ty)
114            in            in
115              IR.mkPRIM(x', p, args, body x')              IR.mkPRIM(x', p, args, body x')
116            end            end
# Line 127  Line 139 
139                  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 =>
140                  letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))                  letPRIM (vecVar, IR.T_VEC, IR.ADD_VEC, [pt1ScaleVec, pt2ScaleVec], stmt)))))
141    
142            (* This is a bit more complicated if we're trying to avoid accessing              | P.D_BOX{max, min} =>
143             * the vector variables themselves. Basically the way we can do it is to                  (* Extract the componentwise vector variables *)
144             * decompose the vector connecting min and max into the basis vectors,                  letPRIM("minX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, min)], fn minX =>
145             * scale them independently, and then add them back together.                  letPRIM("maxX", IR.T_FLOAT, IR.EXTRACT_X, [psvToIRVar(env, max)], fn maxX =>
146             *                  letPRIM("minY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, min)], fn minY =>
147             * !FIXME! Actually do that. Don't have time right now...                  letPRIM("maxY", IR.T_FLOAT, IR.EXTRACT_Y, [psvToIRVar(env, max)], fn maxY =>
148             *)                  letPRIM("minZ", IR.T_FLOAT, IR.EXTRACT_Z, [psvToIRVar(env, min)], fn minZ =>
149              | 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 =>
150    
151                    (* Find the distance in each component *)
152                    letPRIM("distX", IR.T_FLOAT, IR.SUB, [maxX, minX], fn distX =>
153                    letPRIM("distY", IR.T_FLOAT, IR.SUB, [maxY, minY], fn distY =>
154                    letPRIM("distZ", IR.T_FLOAT, IR.SUB, [maxZ, minZ], fn distZ =>
155    
156                    (* Get three random numbers for each of the components *)
157                    letPRIM("randX", IR.T_FLOAT, IR.RAND, [], fn randX =>
158                    letPRIM("randY", IR.T_FLOAT, IR.RAND, [], fn randY =>
159                    letPRIM("randZ", IR.T_FLOAT, IR.RAND, [], fn randZ =>
160    
161                    (* Scale the distances by these random numbers *)
162                    letPRIM("scaledX", IR.T_FLOAT, IR.MULT, [randX, distX], fn scaledX =>
163                    letPRIM("scaledY", IR.T_FLOAT, IR.MULT, [randY, distY], fn scaledY =>
164                    letPRIM("scaledZ", IR.T_FLOAT, IR.MULT, [randZ, distZ], fn scaledZ =>
165    
166                    (* Add them to the minimum vec in order to create a new vec inside
167                     * of the box.
168                     *)
169                    letPRIM("newX", IR.T_FLOAT, IR.ADD, [minX, scaledX], fn newX =>
170                    letPRIM("newY", IR.T_FLOAT, IR.ADD, [minY, scaledY], fn newY =>
171                    letPRIM("newZ", IR.T_FLOAT, IR.ADD, [minZ, scaledZ], fn newZ =>
172    
173                    (* Gen the vector *)
174                    letPRIM(vecVar, IR.T_VEC, IR.GEN_VEC, [newX, newY, newZ], stmt
175    
176                    )))))))))))))))))))
177    
178    
179              | P.D_TRIANGLE{pt1, pt2, pt3} =>              | P.D_TRIANGLE{pt1, pt2, pt3} =>
180                  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 262 
262     * 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
263     * state is within the domain, and then pass the continuation on.     * state is within the domain, and then pass the continuation on.
264     *)     *)
265      fun mkWithinVar (boolVar, env, state, d, stmt : IR.var -> IR.stmt) = let      fun mkWithinVar (boolVar, env, var, d, stmt : IR.var -> IR.stmt) = let
266            val PS{pos, vel, size, isDead, color} = state            val pos = var
267            in            in
268              case d              case d
269               of P.D_POINT(pt) =>               of P.D_POINT(pt) =>
# Line 304  Line 344 
344              genVecVar("ps_col", env, colDomain, fn newCol =>              genVecVar("ps_col", env, colDomain, fn newCol =>
345              letSPRIM ("ps_size", IR.T_FLOAT, IR.RAND, [], fn newSize =>              letSPRIM ("ps_size", IR.T_FLOAT, IR.RAND, [], fn newSize =>
346              letSPRIM ("ps_isDead", IR.T_BOOL, IR.COPY, [IR.newConst("fbool", IR.C_BOOL false)], fn newIsDead =>              letSPRIM ("ps_isDead", IR.T_BOOL, IR.COPY, [IR.newConst("fbool", IR.C_BOOL false)], fn newIsDead =>
347                k(PS{pos = newPos, vel = newVel, size = newSize, isDead = newIsDead, color = newCol}))))))                k(PS{pos = newPos,
348                       vel = newVel,
349                       size = newSize,
350                       isDead = newIsDead,
351                       color = newCol,
352                       dummy = IR.newConst("dmy", IR.C_FLOAT 0.01)})
353                )))))
354    
355      (* 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
356       * 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 359 
359      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
360        val newNorm = IR.newParam("n", IR.T_VEC)        val newNorm = IR.newParam("n", IR.T_VEC)
361        val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))        val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))
362          val PS{pos, ...} = state
363       in       in
364        (case d        (case d
365            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)],
366                fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))                fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
367             | P.D_DISC{pt, normal, irad, orad} =>             | P.D_DISC{pt, normal, irad, orad} =>
368                mkWithinVar("inP", env, state, d, fn inPlane =>                mkWithinVar("inP", env, pos, d, fn inPlane =>
369                    IR.mkIF(inPlane,                    IR.mkIF(inPlane,
370                      (* then *)                      (* then *)
371                      letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],                      letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
# Line 333  Line 380 
380                   )                   )
381    
382             | P.D_SPHERE{center, irad, orad} => let             | P.D_SPHERE{center, irad, orad} => let
383                val PS{pos, vel, size, isDead, color} = state                val PS{pos, ...} = state
384                in                in
385                      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 =>
386                  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 391 
391           (* end case *))           (* end case *))
392          end          end
393    
394            fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let
395    
396              val PS{isDead, ...} = state
397              val P.EMIT{maxNum, posDomain, velDomain, colDomain, ...} = emit
398              val blk = newBlock (env, k)
399             in
400          IR.mkIF(isDead,
401           (* then *)
402           letPRIM("t1", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, maxNum)], fn t1 =>
403           letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, numDead)], fn t2 =>
404           letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
405           letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
406           letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
407           IR.mkIF(t3,
408            (* then *)
409            newParticle (posDomain, velDomain, colDomain, env,
410             fn state' => retState state'),
411            (* else *)
412            IR.DISCARD)))))),
413           (* else *)
414           retState state)
415         end
416    
417          fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let          fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
418            val PS{pos, vel, size, isDead, color} = state            val PS{pos, vel, ...} = state
419            val P.PR{ifstmt, ...} = pred            val P.PR{ifstmt, ...} = pred
           val thenBlk = newBlock(env, thenk)  
           val elseBlk = newBlock(env, elsek)  
420           in           in
421            case ifstmt            case ifstmt
422             of P.WITHIN(d) => mkWithinVar("wv", env, state, d, fn withinVar =>             of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>
423              IR.mkIF(withinVar, goto(state, thenBlk), goto(state, elseBlk)))              IR.mkIF(withinVar, thenk(state), elsek(state)))
424                | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>
425                IR.mkIF(withinVar, thenk(state), elsek(state)))
426           end           end
427    
428      fun trAct (action, env, state, k : particle_state -> IR.stmt) = let      fun trAct (action, env, state, k : particle_state -> IR.stmt) = let
429            val PS{pos, vel, size, isDead, color} = state            val PS{pos, vel, size, isDead, color, dummy} = state
430            in            in
431              case action              case action
432               of P.BOUNCE{friction, resilience, cutoff, d} => let               of P.BOUNCE{friction, resilience, cutoff, d} => let
# Line 365  Line 435 
435                    in                    in
436                      letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn velScale =>                      letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn velScale =>
437                      letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>                      letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
438                      mkWithinVar("wnp", env, state, d, fn withinNextPos =>                      mkWithinVar("wnp", env, pos, d, fn withinNextPos =>
439                      IR.mkIF(withinNextPos,                      IR.mkIF(withinNextPos,
440                        (*then*)                        (*then*)
441                          normAtPoint("n", d, env, state, fn normAtD => fn state' => let                          normAtPoint("n", d, env, state, fn normAtD => fn state' => let
442                 val PS{pos=nextPos, vel=nextVel, size=nextSize, isDead=nextIsDead, color=nextColor} = state'                 val PS{pos=nextPos, vel=nextVel, size=nextSize, isDead=nextIsDead, color=nextColor, dummy=nextDummy} = state'
443                            in                            in
444                             letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>                             letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>
445                             letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>                             letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>
# Line 388  Line 458 
458                               letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>                               letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>
459                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>
460                               letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>                               letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
461                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor}, blk)                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor, dummy=nextDummy}, blk)
462                              )))),                              )))),
463                               (*else*)                               (*else*)
464                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>
465                               letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>                               letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
466                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor}, blk)                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, isDead=nextIsDead, color=nextColor, dummy=nextDummy}, blk)
467                               ))                               ))
468                           )))))))))                           )))))))))
469                           end                           end
# Line 402  Line 472 
472                        goto(state, blk)))))                        goto(state, blk)))))
473                    end                    end
474    
               | P.SOURCE({maxNum, posDomain, velDomain, colDomain}) => let  
                   val blk = newBlock (env, k)  
                   in  
                     IR.mkIF(isDead,  
                       (* 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  
   
475                | P.GRAVITY(dir) =>                | P.GRAVITY(dir) =>
476                      letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), psvToIRVar(env, dir)], fn theScale =>                      letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), psvToIRVar(env, dir)], fn theScale =>
477                      letPRIM("nextVel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>                      letPRIM("nextVel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>
478                        k(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color})))                        k(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color, dummy=dummy})))
479    
480                | P.MOVE =>                | P.MOVE =>
481                  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn theScale =>                  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, timeStep), vel], fn theScale =>
482                      letPRIM("nextPos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>                      letPRIM("nextPos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
483                        k(PS{pos = newPos, vel = vel, size = size, isDead = isDead, color = color})))                        k(PS{pos = newPos, vel = vel, size = size, isDead = isDead, color = color, dummy=dummy})))
484                  (*
485                | P.SINK({d, kill_inside}) =>                | P.SINK({d, kill_inside}) =>
486                      mkWithinVar("isWithin", env, state, d, fn withinVal =>                      mkWithinVar("isWithin", env, state, d, fn withinVal =>
487                      mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),                      mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),
# Line 440  Line 490 
490                      letPRIM("isReallyDead", IR.T_BOOL, IR.OR, [shouldKill, isDead], fn isReallyDead =>                      letPRIM("isReallyDead", IR.T_BOOL, IR.OR, [shouldKill, isDead], fn isReallyDead =>
491                      k(PS{pos = pos, vel = vel, size = size, isDead = isReallyDead, color = color})                      k(PS{pos = pos, vel = vel, size = size, isDead = isReallyDead, color = color})
492                          ))))                          ))))
493                  *)
494    
495                | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let                | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let
496                    val blk = newBlock (env, k)                    val blk = newBlock (env, k)
# Line 465  Line 516 
516                    letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>                    letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>
517                    letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>                    letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>
518                    letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>                    letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
519                    goto(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color}, blk)                    goto(PS{pos = pos, vel = newVel, size = size, isDead = isDead, color = color, dummy=dummy}, blk)
520                    )))))))                    )))))))
521                  )))))))))))                  )))))))))))
522                  end                  end
523    
524                  (* just kill it. *)
525                  (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, isDead = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)
526                  | P.DIE => IR.DISCARD
527                | _ => raise Fail("Action not implemented...")                | _ => raise Fail("Action not implemented...")
528              (* end case *)              (* end case *)
529            end            end
530    
531      fun compile (P.PSAE{action, vars}) = let      fun compile (P.PG{
532           emit as P.EMIT{maxNum, vars=emitVars, ...},
533           act as P.PSAE{action=root_act, vars=actionVars},
534           render
535        }) = let
536            val blks = ref[]            val blks = ref[]
537            val env = let            val env = let
538                (* add special globals to free vars *)                (* add special globals to free vars *)
539                  val vars = PSV.Set.addList(vars, [numDead, timeStep, epsilon])                  val vars = PSV.Set.union(emitVars, PSV.Set.addList(actionVars, [maxNum, numDead, timeStep, epsilon]))
540                  fun ins (x as PSV.V{name, ty, binding, ...}, map) = let                  fun ins (x as PSV.V{name, ty, binding, id, ...}, map) = let
541                        val x' = (case (ty, !binding)                        val x' = (case (ty, !binding)
542                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
543                                | (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 496  Line 555 
555                  in                  in
556                    TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)                    TE(blks, PSV.Set.foldl ins PSV.Map.empty vars)
557                  end                  end
558            fun trActs [] state = let  
559                  val PS{pos, vel, size, isDead, color} = state  
560                  in            fun evalActs f [] state = f [] state
561                    IR.mkRETURN[ pos, vel, size, isDead, color ]              | evalActs f (psa :: psal) state = (case psa
                 end (* trActs *)  
             | trActs (psa :: psal) state = (case psa  
562                of P.SEQ(acts) => (case acts                of P.SEQ(acts) => (case acts
563                   of [] => raise Fail "Should never reach here."                   of [] => raise Fail "Should never reach here."
564                    | [act] => trAct(act, env, state, trActs psal)                    | [act] => trAct(act, env, state, evalActs f psal)
565                    | act :: rest => trAct(act, env, state, trActs (P.SEQ(rest) :: psal))                    | act :: rest => trAct(act, env, state, evalActs f (P.SEQ(rest) :: psal))
566                  (* end case *))                  (* end case *))
567                 | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) =>                 | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) => let
568                    trPred(pred, env, state, trActs (t @ psal), trActs (e @ psal))                     val cblk = newBlock(env, evalActs f psal)
569                       fun trPredActs [] state' = goto(state', cblk)
570                         | trPredActs _ _ = raise Fail "Should never reach here."
571                      in
572                       trPred(pred, env, state, evalActs trPredActs t, evalActs trPredActs e)
573                      end
574                (* end case *))                (* end case *))
575    
576            val entryBlock = newBlock (env, fn state => trActs action state)            (* At the highest level, we want to return when we reach the end of the action list *)
577              fun trActs [] state = let
578                    val PS{pos, vel, size, isDead, color, dummy} = state
579                    in
580                      IR.mkRETURN[ pos, vel, size, isDead, color, dummy ]
581                    end (* trActs *)
582                | trActs _ _ = raise Fail "Should never reach here"
583    
584              (* The entry block is the first block of the program, or in other words, the emitter. *)
585              val entryBlock = newBlock (
586                env,
587                fn pstate => trEmitter(
588                  emit,
589                  env,
590                  pstate,
591                  fn state => evalActs trActs root_act state
592                )
593              )
594    
595              (* The entry block is the emitter, and the rest of the blocks define the physics processing. *)
596              val outPgm = PSysIR.PGM {
597                emitter = entryBlock,
598                physics = List.drop(!blks, 1),
599                render = render
600              }
601    
602              val optimized = if (Checker.checkIR(outPgm)) then Optimize.optimizeIR(outPgm) else outPgm
603    
604            in            in
605              IR.output(TextIO.stdErr, !blks);              IR.outputPgm(TextIO.stdErr, outPgm);
606              if Checker.checkIR(!blks) then              if Checker.checkIR(optimized) then
607                (* 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)  
608              else              else
609                []               ();
610                IR.outputPgm(TextIO.stdErr, optimized);
611                optimized
612            end (* compile *)            end (* compile *)
613    
614      end (* Translate *)      end (* Translate *)

Legend:
Removed from v.769  
changed lines
  Added in v.873

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