Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Diff of /branches/vis15/src/compiler/translate/translate.sml
ViewVC logotype

Diff of /branches/vis15/src/compiler/translate/translate.sml

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

revision 3476, Wed Dec 2 20:44:59 2015 UTC revision 3493, Fri Dec 11 18:29:21 2015 UTC
# Line 21  Line 21 
21    
22      structure S = Simple      structure S = Simple
23      structure Ty = SimpleTypes      structure Ty = SimpleTypes
24      structure VMap = SimpleVar.Map      structure SV = SimpleVar
25      structure VSet = SimpleVar.Set      structure VMap = SV.Map
26        structure VSet = SV.Set
27      structure IR = HighIR      structure IR = HighIR
28      structure Op = HighOps      structure Op = HighOps
29      structure DstTy = HighTypes      structure DstTy = HighTypes
30      structure Census = HighCensus      structure Census = HighCensus
31        structure Inp = Inputs
32    
33      val cvtTy = TranslateTy.tr      val cvtTy = TranslateTy.tr
34    
# Line 40  Line 42 
42            fun nl () = if (!wid > 0) then (print "\n"; wid := 0) else ()            fun nl () = if (!wid > 0) then (print "\n"; wid := 0) else ()
43            fun prElem (src, dst) = let            fun prElem (src, dst) = let
44                  val s = String.concat [                  val s = String.concat [
45                          " ", SimpleVar.uniqueNameOf src, "->", IR.Var.toString dst                          " ", SV.uniqueNameOf src, "->", IR.Var.toString dst
46                        ]                        ]
47                  in                  in
48                    pr s;                    pr s;
# Line 56  Line 58 
58      fun lookup env x = (case VMap.find (env, x)      fun lookup env x = (case VMap.find (env, x)
59             of SOME x' => x'             of SOME x' => x'
60              | NONE => raise Fail(concat[              | NONE => raise Fail(concat[
61                    "no binding for ", SimpleVar.uniqueNameOf x, " in environment"                    "no binding for ", SV.uniqueNameOf x, " in environment"
62                  ])                  ])
63            (* end case *))            (* end case *))
64    
65    (* create a new instance of a variable *)    (* create a new instance of a variable *)
66      fun newVar x = IR.Var.new (SimpleVar.nameOf x, cvtTy(SimpleVar.typeOf x))      fun newVar x = IR.Var.new (SV.nameOf x, cvtTy(SV.typeOf x))
67    
68    (* generate fresh SSA variables and add them to the environment *)    (* generate fresh SSA variables and add them to the environment *)
69      fun freshVars (env, xs) = let      fun freshVars (env, xs) = let
# Line 123  Line 125 
125                          val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')                          val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')
126                          in                          in
127  (*  (*
128  print(concat["recordAssign: ", SimpleVar.uniqueNameOf srcVar, " --> ", IR.Var.toString lhs,  print(concat["recordAssign: ", SV.uniqueNameOf srcVar, " --> ", IR.Var.toString lhs,
129  " @ ", IR.Node.toString nd, "\n"]);  " @ ", IR.Node.toString nd, "\n"]);
130  *)  *)
131                            phiMap := VMap.insert (m, srcVar, (lhs, rhs))                            phiMap := VMap.insert (m, srcVar, (lhs, rhs))
# Line 175  Line 177 
177                          val dstVar = List.nth(xs, ix)                          val dstVar = List.nth(xs, ix)
178                          in                          in
179  (*  (*
180  print(concat["doVar (", SimpleVar.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);  print(concat["doVar (", SV.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);
181  *)  *)
182                            recordAssign (joinStk, srcVar, dstVar);                            recordAssign (joinStk, srcVar, dstVar);
183                            VMap.insert (env, srcVar, dstVar)                            VMap.insert (env, srcVar, dstVar)
# Line 197  Line 199 
199                              end                              end
200                        fun doVar (srcVar, phi as (dstVar, srcVars), (env, phis)) = (                        fun doVar (srcVar, phi as (dstVar, srcVars), (env, phis)) = (
201  (*  (*
202  print(concat["doVar (", SimpleVar.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);  print(concat["doVar (", SV.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);
203  *)  *)
204                              recordAssign (joinStk, srcVar, dstVar);                              recordAssign (joinStk, srcVar, dstVar);
205                              (VMap.insert (env, srcVar, dstVar), (dstVar, filterPhiRHS srcVars) ::phis))                              (VMap.insert (env, srcVar, dstVar), (dstVar, filterPhiRHS srcVars) ::phis))
# Line 211  Line 213 
213                            val xs = List.map SOME xs                            val xs = List.map SOME xs
214                            in                            in
215  (*  (*
216  print(concat["doVar (", SimpleVar.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);  print(concat["doVar (", SV.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);
217  *)  *)
218                              recordAssign (joinStk, srcVar, dstVar);                              recordAssign (joinStk, srcVar, dstVar);
219                              IR.Var.setBinding (dstVar, IR.VB_PHI xs);                              IR.Var.setBinding (dstVar, IR.VB_PHI xs);
# Line 229  Line 231 
231      fun cvtExp (env : env, lhs, exp) = (case exp      fun cvtExp (env : env, lhs, exp) = (case exp
232             of S.E_Var x => [IR.ASSGN(lhs, IR.VAR(lookup env x))]             of S.E_Var x => [IR.ASSGN(lhs, IR.VAR(lookup env x))]
233              | S.E_Lit lit => [IR.ASSGN(lhs, IR.LIT lit)]              | S.E_Lit lit => [IR.ASSGN(lhs, IR.LIT lit)]
234              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"              | S.E_Select(x, fld) => raise Fail "FIXME"
235              | S.E_Apply _ => raise Fail "unexpected E_Apply"              | S.E_Apply _ => raise Fail "unexpected E_Apply"
236              | S.E_Prim(f, tyArgs, args, ty) => let              | S.E_Prim(f, tyArgs, args, ty) => let
237                  val args' = List.map (lookup env) args                  val args' = List.map (lookup env) args
238                  in                  in
239                    TranslateBasis.translate (lhs, f, tyArgs, args')                    TranslateBasis.translate (lhs, f, tyArgs, args')
240                  end                  end
241              | S.E_Cons(args, _) => [IR.ASSGN(lhs, IR.CONS(List.map (lookup env) args, IR.Var.ty lhs))]              | S.E_Tensor(args, _) => [IR.ASSGN(lhs, IR.CONS(List.map (lookup env) args, IR.Var.ty lhs))]
242              | S.E_Seq(args, _) => [IR.ASSGN(lhs, IR.SEQ(List.map (lookup env) args, IR.Var.ty lhs))]              | S.E_Seq(args, _) => [IR.ASSGN(lhs, IR.SEQ(List.map (lookup env) args, IR.Var.ty lhs))]
243              | S.E_Slice(x, indices, ty) => let              | S.E_Slice(x, indices, ty) => let
244                  val x = lookup env x                  val x = lookup env x
# Line 252  Line 254 
254              | S.E_Coerce{srcTy, dstTy, x} => (case (srcTy, dstTy)              | S.E_Coerce{srcTy, dstTy, x} => (case (srcTy, dstTy)
255                   of (Ty.T_Int, Ty.T_Tensor _) =>                   of (Ty.T_Int, Ty.T_Tensor _) =>
256                        [IR.ASSGN(lhs, IR.OP(Op.IntToReal, [lookup env x]))]                        [IR.ASSGN(lhs, IR.OP(Op.IntToReal, [lookup env x]))]
257                    | (Ty.T_Sequence(ty, n), Ty.T_DynSequence _) =>                    | (Ty.T_Sequence(ty, SOME n), Ty.T_Sequence(_, NONE)) =>
258                        [IR.ASSGN(lhs, IR.OP(Op.MkDynamic(cvtTy ty, n), [lookup env x]))]                        [IR.ASSGN(lhs, IR.OP(Op.MkDynamic(cvtTy ty, n), [lookup env x]))]
259                    | (Ty.T_Field _, Ty.T_Field _) =>                    | (Ty.T_Field _, Ty.T_Field _) =>
260                      (* change in continuity is a no-op *)                      (* change in continuity is a no-op *)
# Line 280  Line 282 
282      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let
283            fun cvt (env : env, cfg, []) = (cfg, env)            fun cvt (env : env, cfg, []) = (cfg, env)
284              | cvt (env, cfg, stm::stms) = (case stm              | cvt (env, cfg, stm::stms) = (case stm
285                   of S.S_Var x => let                   of S.S_Var(x, NONE) => let
286                        val x' = newVar x                        val x' = newVar x
287                        in                        in
288                          cvt (VMap.insert (env, x, x'), cfg, stms)                          cvt (VMap.insert (env, x, x'), cfg, stms)
289                        end                        end
290                      | S.S_Var(x, SOME e) => let
291                          val x' = newVar x
292                          val assigns = cvtExp (env, x', e)
293                          in
294                            recordAssign (joinStk, x, x');
295                            cvt (
296                              VMap.insert(env, x, x'),
297                              IR.CFG.concat(cfg, IR.CFG.mkBlock assigns),
298                              stms)
299                          end
300                    | S.S_Assign(lhs, rhs) => let                    | S.S_Assign(lhs, rhs) => let
301                        val lhs' = newVar lhs                        val lhs' = newVar lhs
302                        val assigns = cvtExp (env, lhs', rhs)                        val assigns = cvtExp (env, lhs', rhs)
# Line 366  Line 378 
378            end            end
379  (*DEBUG*)handle ex => raise ex  (*DEBUG*)handle ex => raise ex
380    
     fun cvtFragmentBlock (env0, prefixCFG, blk) = let  
           val (cfg, env) = cvtBlock (([], []), env0, [], blk)  
           val cfg = IR.CFG.concat(prefixCFG, cfg)  
           val entry = IR.Node.mkENTRY ()  
         (* the live variables out are those that were not live coming in *)  
           val liveOut = VMap.foldli  
                 (fn (x, x', xs) => if VMap.inDomain(env0, x) then xs else x'::xs)  
                   [] env  
           val exit = IR.Node.mkFRAGMENT liveOut  
           in  
             if IR.CFG.isEmpty cfg  
               then IR.Node.addEdge (entry, exit)  
               else (  
                 IR.Node.addEdge (entry, IR.CFG.entry cfg);  
                 IR.Node.addEdge (IR.CFG.exit cfg, exit));  
             (IR.CFG{entry = entry, exit = exit}, env)  
           end  
 (*DEBUG*)handle ex => raise ex  
   
381      fun cvtMethod (loadGlobals, env, name, state, svars, blk) = let      fun cvtMethod (loadGlobals, env, name, state, svars, blk) = let
382          (* load the globals into fresh variables *)          (* load the globals into fresh variables *)
383            val (loadGlobsCFG, env) = loadGlobals env            val (loadGlobsCFG, env) = loadGlobals env
# Line 421  Line 414 
414            end            end
415  (*DEBUG*)handle ex => (print(concat["error in cvtMethod(", StrandUtil.nameToString name, ", ...)\n"]); raise ex)  (*DEBUG*)handle ex => (print(concat["error in cvtMethod(", StrandUtil.nameToString name, ", ...)\n"]); raise ex)
416    
417    (* convert the initially code *)    (* convert the initial strand creation code *)
418      fun cvtInitially (loadGlobals, S.Initially{isArray, rangeInit, create, iters}) = let      fun cvtCreate (loadGlobals, S.Create{dim, code}) = let
419            (* load the globals into fresh variables *)
420            val (loadCFG, env) = loadGlobals VMap.empty            val (loadCFG, env) = loadGlobals VMap.empty
421            val S.C_Create{argInit, name, args} = create          (* convert the code *)
422            fun cvtIter ({param, lo, hi}, (env, iters)) = let            val (cfg, _) = cvtBlock (([], []), env, [], code)
                 val param' = newVar param  
                 val env = VMap.insert (env, param, param')  
                 val iter = (param', lookup env lo, lookup env hi)  
                 in  
                   (env, iter::iters)  
                 end  
           val (cfg, env) = cvtFragmentBlock (env, loadCFG, rangeInit)  
           val (env, iters) = List.foldl cvtIter (env, []) iters  
           val (argInitCFG, env) = cvtFragmentBlock (env, IR.CFG.empty, argInit)  
423            in            in
424              IR.Initially{              IR.Initially{
425                  isArray = isArray,                  isArray = isArray,
# Line 461  Line 446 
446    
447      fun cvtInputs (inputInit, inputs) = let      fun cvtInputs (inputInit, inputs) = let
448            val (initBlk, env) = cvtBlock (([], []), VMap.empty, [], inputInit)            val (initBlk, env) = cvtBlock (([], []), VMap.empty, [], inputInit)
449              fun cvt (S.INP{var, desc, init}, (gvs, stms)) = let
450                    val name = SV.nameOf var
451                    val var' = newVar var
452                    val ty' = IR.Var.ty var'
453                    val gVar = IR.GlobalVar.new(true, name, ty')
454                    val rhs = (case init
455                           of S.NoDefault =>
456                                Op.Input(Inp.INP{ty = ty', name = name, desc = desc, init = NONE})
457                            | S.ConstExpr => ??
458                            | S.LoadSeq nrrd => ??
459                            | S.Proxy(nrrd, info) => ??
460                            | S.Image info =>
461                                Op.InputWithDefault(Inp.INP{
462                                })
463                          (* end case *))
464                    val stms = IR.ASSGN(var', rhs) :: IR.GASSGN(gVar, var') :: stms
465                    in
466                      ((var, gVar)::gvs, stms)
467                    end
468            fun cvt ((x, inp), (gvs, stms)) = let            fun cvt ((x, inp), (gvs, stms)) = let
469                  val x' = newVar x                  val x' = newVar x
470                  val gx = IR.GlobalVar.new(                  val gx = IR.GlobalVar.new(
471                          true,                          true,
472                          SimpleVar.nameOf x,                          SV.nameOf x,
473                          cvtTy(SimpleVar.typeOf x))                          cvtTy(SV.typeOf x))
474                  val rhs = (case VMap.find(env, x)                  val rhs = (case VMap.find(env, x)
475                         of SOME dflt => IR.OP(Op.InputWithDefault(Inputs.map cvtTy inp), [dflt])                         of SOME dflt => IR.OP(Op.InputWithDefault(Inputs.map cvtTy inp), [dflt])
476                          | NONE => IR.OP(Op.Input(Inputs.map cvtTy inp), [])                          | NONE => IR.OP(Op.Input(Inputs.map cvtTy inp), [])
477                        (* end case *))                        (* end case *))
478                  val stms =  IR.ASSGN(x', rhs) :: IR.GASSGN(gx, x') :: stms                  val stms =  IR.ASSGN(x', rhs) :: IR.GASSGN(gx, x') :: stms
479                  in                  in
                   IR.GlobalVar.setBinding (gx, x');  
480                    ((x, gx)::gvs, stms)                    ((x, gx)::gvs, stms)
481                  end                  end
482            val (gvs, stms) = List.foldr cvt ([], []) inputs            val (gvs, stms) = List.foldr cvt ([], []) inputs
# Line 491  Line 494 
494            fun cvt x = let            fun cvt x = let
495                  val gx = IR.GlobalVar.new(                  val gx = IR.GlobalVar.new(
496                          false,                          false,
497                          SimpleVar.nameOf x,                          SV.nameOf x,
498                          cvtTy(SimpleVar.typeOf x))                          cvtTy(SV.typeOf x))
499                  in                  in
500                    (x, gx)                    (x, gx)
501                  end                  end
# Line 500  Line 503 
503              List.map cvt globals              List.map cvt globals
504            end            end
505    
506      fun translate (S.Program{props, inputDefaults, inputs, globals, globalInit, init, strands, ...}) = let      fun translate prog = let
507              val S.Program{
508                      props, consts, inputs, constInit, globals, funcs, init, strand, create, update
509                    } = prog
510            val (inputInit, inputGlobs) = cvtInputs (inputDefaults, inputs)            val (inputInit, inputGlobs) = cvtInputs (inputDefaults, inputs)
511            val globals = cvtGlobals globals            val globals = cvtGlobals globals
512          (* create the global initialization code *)          (* create the global initialization code *)
# Line 515  Line 521 
521                        fun saveGlob (x, gx) = let                        fun saveGlob (x, gx) = let
522                              val x' = lookup env x (* the local variable that holds the global *)                              val x' = lookup env x (* the local variable that holds the global *)
523                              in                              in
                               IR.GlobalVar.setBinding (gx, x');  
524                                IR.GASSGN(gx, x')                                IR.GASSGN(gx, x')
525                              end                              end
526                        in                        in
# Line 545  Line 550 
550                (* create the state variables *)                (* create the state variables *)
551                  val svars = let                  val svars = let
552                        fun newSVar x = IR.StateVar.new (                        fun newSVar x = IR.StateVar.new (
553                              SimpleVar.kindOf x = S.StrandOutputVar,                              SV.kindOf x = SV.StrandOutputVar,
554                              SimpleVar.nameOf x, cvtTy(SimpleVar.typeOf x))                              SV.nameOf x, cvtTy(SV.typeOf x))
555                        in                        in
556                          List.map newSVar state                          List.map newSVar state
557                        end                        end

Legend:
Removed from v.3476  
changed lines
  Added in v.3493

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