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 758, Tue Feb 9 04:46:06 2010 UTC revision 770, Mon Feb 22 00:17:15 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.block list
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 *)
# Line 50  Line 52 
52    (* translation environment *)    (* translation environment *)
53      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)
54    
55      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)
56             of SOME x' => x'             of SOME x' => x'
57              | NONE => raise Fail ("unknown variable " ^ name)              | NONE => raise Fail (String.concat["unknown variable ", name, " with ID ", Int.toString id])
58            (* end case *))            (* end case *))
59    
60      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 222  Line 224 
224     * 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
225     * state is within the domain, and then pass the continuation on.     * state is within the domain, and then pass the continuation on.
226     *)     *)
227      fun mkWithinVar (boolVar, env, state, d, stmt : IR.var -> IR.stmt) = let      fun mkWithinVar (boolVar, env, var, d, stmt : IR.var -> IR.stmt) = let
228            val PS{pos, vel, size, isDead, color} = state            val pos = var
229            in            in
230              case d              case d
231               of P.D_POINT(pt) =>               of P.D_POINT(pt) =>
# Line 313  Line 315 
315      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
316        val newNorm = IR.newParam("n", IR.T_VEC)        val newNorm = IR.newParam("n", IR.T_VEC)
317        val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))        val nextBlk = newBlockWithArgs(env, [newNorm], k(newNorm))
318          val PS{pos, ...} = state
319       in       in
320        (case d        (case d
321            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)],
322                fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))                fn newNormVar => gotoWithArgs(state, [newNormVar], nextBlk))
323             | P.D_DISC{pt, normal, irad, orad} =>             | P.D_DISC{pt, normal, irad, orad} =>
324                mkWithinVar("inP", env, state, d, fn inPlane =>                mkWithinVar("inP", env, pos, d, fn inPlane =>
325                    IR.mkIF(inPlane,                    IR.mkIF(inPlane,
326                      (* then *)                      (* then *)
327                      letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],                      letPRIM(retNorm, IR.T_VEC, IR.COPY, [psvToIRVar(env, normal)],
# Line 344  Line 347 
347           (* end case *))           (* end case *))
348          end          end
349    
350            fun trEmitter(emit, env, state, k : particle_state -> IR.stmt) = let
351              val PS{pos, vel, size, isDead, color} = state
352              val P.EMIT{maxNum, posDomain, velDomain, colDomain, ...} = emit
353              val blk = newBlock (env, k)
354             in
355          IR.mkIF(isDead,
356           (* then *)
357           letPRIM("t1", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, maxNum)], fn t1 =>
358           letPRIM("t2", IR.T_FLOAT, IR.ITOF, [psvToIRVar (env, numDead)], fn t2 =>
359           letPRIM("prob", IR.T_FLOAT, IR.DIV, [t1, t2], fn prob =>
360           letPRIM("r", IR.T_FLOAT, IR.RAND, [], fn r =>
361           letPRIM("t3", IR.T_BOOL, IR.GT, [prob, r], fn t3 =>
362           IR.mkIF(t3,
363            (* then *)
364            newParticle (posDomain, velDomain, colDomain, env,
365             fn state' => goto (state', blk)),
366            (* else *)
367            IR.DISCARD)))))),
368           (* else *)
369           goto (state, blk))
370         end
371    
372            fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
373              val PS{pos, vel, size, isDead, color} = state
374              val P.PR{ifstmt, ...} = pred
375              val thenBlk = newBlock(env, thenk)
376              val elseBlk = newBlock(env, elsek)
377             in
378              case ifstmt
379               of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>
380                IR.mkIF(withinVar, goto(state, thenBlk), goto(state, elseBlk)))
381                | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>
382                IR.mkIF(withinVar, goto(state, thenBlk), goto(state, elseBlk)))
383             end
384    
385      fun trAct (action, env, state, k : particle_state -> IR.stmt) = let      fun trAct (action, env, state, k : particle_state -> IR.stmt) = let
386            val PS{pos, vel, size, isDead, color} = state            val PS{pos, vel, size, isDead, color} = state
387            in            in
# Line 354  Line 392 
392                    in                    in
393                      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 =>
394                      letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>                      letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
395                      mkWithinVar("wnp", env, state, d, fn withinNextPos =>                      mkWithinVar("wnp", env, pos, d, fn withinNextPos =>
396                      IR.mkIF(withinNextPos,                      IR.mkIF(withinNextPos,
397                        (*then*)                        (*then*)
398                          normAtPoint("n", d, env, state, fn normAtD => fn state' => let                          normAtPoint("n", d, env, state, fn normAtD => fn state' => let
# Line 391  Line 429 
429                        goto(state, blk)))))                        goto(state, blk)))))
430                    end                    end
431    
               | 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  
   
432                | P.GRAVITY(dir) =>                | P.GRAVITY(dir) =>
433                      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 =>
434                      letPRIM("nextVel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>                      letPRIM("nextVel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>
# Line 420  Line 438 
438                  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 =>
439                      letPRIM("nextPos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>                      letPRIM("nextPos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
440                        k(PS{pos = newPos, vel = vel, size = size, isDead = isDead, color = color})))                        k(PS{pos = newPos, vel = vel, size = size, isDead = isDead, color = color})))
441                  (*
442                | P.SINK({d, kill_inside}) =>                | P.SINK({d, kill_inside}) =>
443                      mkWithinVar("isWithin", env, state, d, fn withinVal =>                      mkWithinVar("isWithin", env, state, d, fn withinVal =>
444                      mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),                      mkXOR ("shouldNotKill", withinVal, psvToIRVar(env, kill_inside),
# Line 429  Line 447 
447                      letPRIM("isReallyDead", IR.T_BOOL, IR.OR, [shouldKill, isDead], fn isReallyDead =>                      letPRIM("isReallyDead", IR.T_BOOL, IR.OR, [shouldKill, isDead], fn isReallyDead =>
448                      k(PS{pos = pos, vel = vel, size = size, isDead = isReallyDead, color = color})                      k(PS{pos = pos, vel = vel, size = size, isDead = isReallyDead, color = color})
449                          ))))                          ))))
450                  *)
451    
452                | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let                | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let
453                    val blk = newBlock (env, k)                    val blk = newBlock (env, k)
# Line 458  Line 477 
477                    )))))))                    )))))))
478                  )))))))))))                  )))))))))))
479                  end                  end
480    
481                  (* just kill it. *)
482                  | P.DIE => k(PS{pos = pos, vel = vel, size = size, isDead = IR.newConst("falseVar", IR.C_BOOL true), color = color})
483                | _ => raise Fail("Action not implemented...")                | _ => raise Fail("Action not implemented...")
484              (* end case *)              (* end case *)
485            end            end
486    
487      fun compile (P.PSAE{action, vars}) = let      fun compile (P.PG{emit as P.EMIT{maxNum, vars=emitVars, ...}, act as P.PSAE{action=root_act, vars=actionVars}, ...}) = let
488            val blks = ref[]            val blks = ref[]
489            val env = let            val env = let
490                (* add special globals to free vars *)                (* add special globals to free vars *)
491                  val vars = PSV.Set.addList(vars, [numDead, timeStep, epsilon])                  val vars = PSV.Set.union(emitVars, PSV.Set.addList(actionVars, [maxNum, numDead, timeStep, epsilon]))
492                  fun ins (x as PSV.V{name, ty, binding, ...}, map) = let                  fun ins (x as PSV.V{name, ty, binding, id, ...}, map) = let
493                        val x' = (case (ty, !binding)                        val x' = (case (ty, !binding)
494                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)                               of (PSV.T_BOOL,  PSV.UNDEF) => IR.newGlobal(x, IR.T_BOOL)
495                                | (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 480  Line 502 
502                                | _ => raise Fail("Error in setup, type mismatch between IR and PSV vars.")                                | _ => raise Fail("Error in setup, type mismatch between IR and PSV vars.")
503                              (* end case *))                              (* end case *))
504                        in                        in
505                        (* printErr (String.concat["Inserting ", name, " with ID ", Int.toString id, " to IR Var list: ", IR.varToString x']); *)
506                          PSV.Map.insert (map, x, x')                          PSV.Map.insert (map, x, x')
507                        end                        end
508                  in                  in
# Line 490  Line 513 
513                  in                  in
514                    IR.mkRETURN[ pos, vel, size, isDead, color ]                    IR.mkRETURN[ pos, vel, size, isDead, color ]
515                  end (* trActs *)                  end (* trActs *)
516              | trActs (psa :: psal) state = trAct(psa, env, state, trActs psal)              | trActs (psa :: psal) state = (case psa
517            val entryBlock = newBlock (env, fn state => trActs action state)                of P.SEQ(acts) => (case acts
518                     of [] => raise Fail "Should never reach here."
519                      | [act] => trAct(act, env, state, trActs psal)
520                      | act :: rest => trAct(act, env, state, trActs (P.SEQ(rest) :: psal))
521                    (* end case *))
522                   | P.PRED(pred as P.PR{thenstmt=t, elsestmt=e, ...}) =>
523                      trPred(pred, env, state, trActs (t @ psal), trActs (e @ psal))
524                  (* end case *))
525    
526              val entryBlock = newBlock (env, fn pstate => trEmitter(emit, env, pstate, fn state => trActs root_act state))
527            in            in
528              IR.output(TextIO.stdErr, !blks);              IR.output(TextIO.stdErr, !blks);
529              if Checker.checkIR(!blks) then              if Checker.checkIR(!blks) then

Legend:
Removed from v.758  
changed lines
  Added in v.770

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