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

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

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