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

SCM Repository

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

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

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

revision 1639, Wed Nov 16 01:48:07 2011 UTC revision 1640, Wed Nov 16 02:19:51 2011 UTC
# Line 22  Line 22 
22      structure VMap = Var.Map      structure VMap = Var.Map
23      structure VSet = Var.Set      structure VSet = Var.Set
24      structure IL = HighIL      structure IL = HighIL
25        structure Op = HighOps
26      structure DstTy = HighILTypes      structure DstTy = HighILTypes
27      structure Census = HighILCensus      structure Census = HighILCensus
28    
29        val cvtTy = TranslateTy.tr
30    
31    (* maps from SimpleAST variables to the current corresponding SSA variable *)    (* maps from SimpleAST variables to the current corresponding SSA variable *)
32      type env = IL.var VMap.map      type env = IL.var VMap.map
33    
34    (* +DEBUG *)
35        fun prEnv (prefix, env) = let
36              val wid = ref 0
37              fun pr s = (print s; wid := !wid + size s)
38              fun nl () = if (!wid > 0) then (print "\n"; wid := 0) else ()
39              fun prElem (src, dst) = let
40                    val s = String.concat [
41                            " ", Var.uniqueNameOf src, "->", IL.Var.toString dst
42                          ]
43                    in
44                      pr s;
45                      if (!wid >= 100) then (nl(); pr " ") else ()
46                    end
47              in
48                pr prefix; pr " ENV: {"; nl(); pr " ";
49                VMap.appi prElem env;
50                nl(); pr "}"; nl()
51              end
52    (* -DEBUG *)
53    
54      fun lookup env x = (case VMap.find (env, x)      fun lookup env x = (case VMap.find (env, x)
55             of SOME x' => x'             of SOME x' => x'
56              | NONE => raise Fail(concat[              | NONE => raise Fail(concat[
# Line 35  Line 58 
58                  ])                  ])
59            (* end case *))            (* end case *))
60    
     fun cvtTy ty = (case TypeUtil.prune ty  
            of Ty.T_Bool => DstTy.BoolTy  
             | Ty.T_Int => DstTy.IntTy  
             | Ty.T_String => DstTy.StringTy  
             | Ty.T_Kernel _ => DstTy.KernelTy  
             | Ty.T_Tensor(Ty.Shape dd) => let  
                 fun cvtDim (Ty.DimConst 1) = NONE  
                   | cvtDim (Ty.DimConst d) = SOME d  
                 in  
                   DstTy.TensorTy(List.mapPartial cvtDim dd)  
                 end  
             | Ty.T_Image{dim=Ty.DimConst d, shape} => DstTy.ImageTy d  
             | Ty.T_Field fld => DstTy.FieldTy  
             | ty => raise Fail("cvtTy: unexpected " ^ TypeUtil.toString ty)  
           (* end case *))  
   
61    (* create a new instance of a variable *)    (* create a new instance of a variable *)
62      fun newVar x = IL.Var.new (Var.nameOf x, cvtTy(Var.monoTypeOf x))      fun newVar x = IL.Var.new (Var.nameOf x, cvtTy(Var.monoTypeOf x))
63    
# Line 156  Line 163 
163    
164    (* expression translation *)    (* expression translation *)
165      fun cvtExp (env : env, lhs, exp) = (case exp      fun cvtExp (env : env, lhs, exp) = (case exp
166             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]             of S.E_Var x => [IL.ASSGN(lhs, IL.VAR(lookup env x))]
167              | S.E_Lit lit => [(lhs, IL.LIT lit)]              | S.E_Lit lit => [IL.ASSGN(lhs, IL.LIT lit)]
168              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
169              | S.E_Apply(f, tyArgs, args, ty) => let              | S.E_Apply(f, tyArgs, args, ty) => let
170                  val args' = List.map (lookup env) args                  val args' = List.map (lookup env) args
171                  in                  in
172                    TranslateBasis.translate (lhs, f, tyArgs, args')                    TranslateBasis.translate (lhs, f, tyArgs, args')
173                  end                  end
174              | S.E_Cons args => [(lhs, IL.CONS(IL.Var.ty lhs, List.map (lookup env) args))]              | S.E_Cons args => [IL.ASSGN(lhs, IL.CONS(IL.Var.ty lhs, List.map (lookup env) args))]
175              | S.E_Slice(x, indices, ty) => let              | S.E_Slice(x, indices, ty) => let
176                  val x = lookup env x                  val x = lookup env x
177                  val mask = List.map isSome indices                  val mask = List.map isSome indices
# Line 173  Line 180 
180                  val indices = List.mapPartial cvt indices                  val indices = List.mapPartial cvt indices
181                  in                  in
182                    if List.all (fn b => b) mask                    if List.all (fn b => b) mask
183                      then [(lhs, IL.OP(HighOps.Subscript(IL.Var.ty x), x::indices))]                      then [IL.ASSGN(lhs, IL.OP(HighOps.TensorSub(IL.Var.ty x), x::indices))]
184                      else [(lhs, IL.OP(HighOps.Slice(IL.Var.ty lhs, mask), x::indices))]                      else [IL.ASSGN(lhs, IL.OP(HighOps.Slice(IL.Var.ty lhs, mask), x::indices))]
185                  end                  end
186              | S.E_Input(_, name, desc, NONE) =>              | S.E_Input(_, name, desc, NONE) =>
187                  [(lhs, IL.OP(HighOps.Input(IL.Var.ty lhs, name, desc), []))]                  [IL.ASSGN(lhs, IL.OP(HighOps.Input(IL.Var.ty lhs, name, desc), []))]
188              | S.E_Input(_, name, desc, SOME dflt) =>              | S.E_Input(_, name, desc, SOME dflt) =>
189                  [(lhs, IL.OP(HighOps.InputWithDefault(IL.Var.ty lhs, name, desc), [lookup env dflt]))]                  [IL.ASSGN(lhs, IL.OP(HighOps.InputWithDefault(IL.Var.ty lhs, name, desc), [lookup env dflt]))]
190              | S.E_LoadImage(info, name) => [(lhs, IL.OP(HighOps.LoadImage info, [lookup env name]))]              | S.E_LoadImage(info, name) => [IL.ASSGN(lhs, IL.OP(HighOps.LoadImage info, [lookup env name]))]
191            (* end case *))            (* end case *))
192    
193      (* add nodes to save the strand state, followed by an exit node *)
194        fun saveStrandState (env, (srcState, dstState), exit) = let
195              val stateOut = List.map (lookup env) srcState
196              fun save (x, x', cfg) = IL.CFG.appendNode (cfg, IL.Node.mkSAVE(x, x'))
197              in
198                IL.CFG.appendNode (
199                  ListPair.foldlEq save IL.CFG.empty (dstState, stateOut),
200                  exit)
201              end
202    handle ex => raise ex
203    
204      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let
205            fun cvt (env : env, cfg, []) = (cfg, env)            fun cvt (env : env, cfg, []) = (cfg, env)
206              | cvt (env, cfg, stm::stms) = (case stm              | cvt (env, cfg, stm::stms) = (case stm
# Line 257  Line 275 
275                    | S.S_Die => (                    | S.S_Die => (
276                        killPath joinStk;                        killPath joinStk;
277                        (IL.CFG.appendNode (cfg, IL.Node.mkDIE ()), env))                        (IL.CFG.appendNode (cfg, IL.Node.mkDIE ()), env))
278                    | S.S_Stabilize => let                    | S.S_Stabilize => (
                       val stateOut = List.map (lookup env) state  
                       in  
279                          killPath joinStk;                          killPath joinStk;
280                          (IL.CFG.appendNode (cfg, IL.Node.mkSTABILIZE stateOut), env)                        (IL.CFG.concat (cfg, saveStrandState (env, state, IL.Node.mkSTABILIZE())), env))
281                      | S.S_Print args => let
282                          val args = List.map (lookup env) args
283                          val nd = IL.Node.mkMASSIGN([], Op.Print(List.map IL.Var.ty args), args)
284                          in
285                            cvt (env, IL.CFG.appendNode (cfg, nd), stms)
286                        end                        end
287                  (* end case *))                  (* end case *))
288            in            in
# Line 270  Line 291 
291  (*DEBUG*)handle ex => raise ex  (*DEBUG*)handle ex => raise ex
292    
293      fun cvtTopLevelBlock (env, blk, mkExit) = let      fun cvtTopLevelBlock (env, blk, mkExit) = let
294            val (cfg, env) = cvtBlock ([], env, [], blk)            val (cfg, env) = cvtBlock (([], []), env, [], blk)
295            val entry = IL.Node.mkENTRY ()            val cfg = IL.CFG.prependNode (IL.Node.mkENTRY(), cfg)
296            val exit = mkExit env            val cfg = IL.CFG.concat (cfg, mkExit env)
297            in            in
298              if IL.CFG.isEmpty cfg              (cfg, env)
               then IL.Node.addEdge (entry, exit)  
               else (  
                 IL.Node.addEdge (entry, IL.CFG.entry cfg);  
               (* NOTE: this addEdge could fail if all control paths end in DIE or STABILIZE,  
                * so we wrap it in a handler  
                *)  
                 IL.Node.addEdge (IL.CFG.exit cfg, exit) handle _ => ());  
             (IL.CFG{entry = entry, exit = exit}, env)  
299            end            end
300  (*DEBUG*)handle ex => raise ex  (*DEBUG*)handle ex => raise ex
301    
302  (* FIXME: the following function could be refactored with cvtTopLevelBlock to share code *)  (* FIXME: the following function could be refactored with cvtTopLevelBlock to share code *)
303      fun cvtFragmentBlock (env0, blk) = let      fun cvtFragmentBlock (env0, blk) = let
304            val (cfg, env) = cvtBlock ([], env0, [], blk)            val (cfg, env) = cvtBlock (([], []), env0, [], blk)
305            val entry = IL.Node.mkENTRY ()            val entry = IL.Node.mkENTRY ()
306          (* the live variables out are those that were not live coming in *)          (* the live variables out are those that were not live coming in *)
307            val liveOut = VMap.foldli            val liveOut = VMap.foldli
# Line 305  Line 318 
318            end            end
319  (*DEBUG*)handle ex => raise ex  (*DEBUG*)handle ex => raise ex
320    
321      fun cvtMethod (env, name, state, blk) = let      fun cvtMethod (env, name, state, svars, blk) = let
322          (* allocate fresh variables for the state variables *)          (* load the state into fresh variables *)
323              val (env, loadCFG) = let
324                  (* allocate shadow variables for the state variables *)
325            val (env, stateIn) = freshVars (env, state)            val (env, stateIn) = freshVars (env, state)
326                    fun load (x, x') = IL.ASSGN(x, IL.STATE x')
327                    in
328                      (env, IL.CFG.mkBlock (ListPair.map load (stateIn, svars)))
329                    end
330          (* convert the body of the method *)          (* convert the body of the method *)
331            val (cfg, env) = cvtBlock (state, env, [], blk)            val (cfg, env) = cvtBlock ((state, svars), env, [], blk)
332          (* add the entry/exit nodes *)          (* add the entry/exit nodes *)
           val stateOut = List.map (lookup env) state  
333            val entry = IL.Node.mkENTRY ()            val entry = IL.Node.mkENTRY ()
334              val loadCFG = IL.CFG.prependNode (entry, loadCFG)
335            val exit = (case name            val exit = (case name
336                   of MethodName.Update => IL.Node.mkACTIVE stateOut                   of StrandUtil.Update => IL.Node.mkACTIVE ()
337                    | MethodName.Stabilize => IL.Node.mkRETURN stateOut                    | StrandUtil.Stabilize => IL.Node.mkRETURN []
338                  (* end case *))                  (* end case *))
339              val body = IL.CFG.concat (loadCFG, cfg)
340    (*DEBUG**val _ = prEnv (StrandUtil.nameToString name, env);*)
341    (* FIXME: the following code doesn't work properly *)
342              val body = if IL.Node.hasSucc(IL.CFG.exit body)
343                    then IL.CFG.concat (body, saveStrandState (env, (state, svars), exit))
344                    else IL.CFG{entry = IL.CFG.entry body, exit = exit}
345            in            in
             if IL.CFG.isEmpty cfg  
               then IL.Node.addEdge (entry, exit)  
               else (  
                 IL.Node.addEdge (entry, IL.CFG.entry cfg);  
               (* NOTE: this addEdge could fail if all control paths end in DIE or STABILIZE,  
                * so we wrap it in a handler  
                *)  
                 IL.Node.addEdge (IL.CFG.exit cfg, exit) handle _ => ());  
346              IL.Method{              IL.Method{
347                  name = name,                  name = name,
348                  stateIn = stateIn,                  body = body
                 body = IL.CFG{entry = entry, exit = exit}  
349                }                }
350            end            end
351  (*DEBUG*)handle ex => (print(concat["error in cvtMethod(", MethodName.toString name, ", ...)\n"]); raise ex)  (*DEBUG*)handle ex => (print(concat["error in cvtMethod(", StrandUtil.nameToString name, ", ...)\n"]); raise ex)
352    
353    (* convert the initially code *)    (* convert the initially code *)
354      fun cvtInitially (env, S.Initially{isArray, rangeInit, create, iters}) = let      fun cvtInitially (env, S.Initially{isArray, rangeInit, create, iters}) = let
# Line 356  Line 372 
372                }                }
373            end            end
374    
375      (* check strands for properties *)
376        fun checkProps strands = let
377              val hasDie = ref false
378              val hasNew = ref false
379              fun chkStm e = (case e
380                     of S.S_IfThenElse(_, b1, b2) => (chkBlk b1; chkBlk b2)
381                      | S.S_New _ => (hasNew := true)
382                      | S.S_Die => (hasDie := true)
383                      | _ => ()
384                  (* end case *))
385              and chkBlk (S.Block body) = List.app chkStm body
386              fun chkStrand (S.Strand{stateInit, methods, ...}) = let
387                    fun chkMeth (S.Method(_, body)) = chkBlk body
388                    in
389                      chkBlk stateInit;
390                      List.app chkMeth methods
391                    end
392              fun condCons (x, v, l) = if !x then v::l else l
393              in
394                List.app chkStrand strands;
395                condCons (hasDie, StrandUtil.StrandsMayDie,
396                condCons (hasNew, StrandUtil.NewStrands, []))
397              end
398    
399      fun translate (S.Program{globals, globalInit, init, strands}) = let      fun translate (S.Program{globals, globalInit, init, strands}) = let
400            val (globalInit, env) =            val (globalInit, env) = let
401                  cvtTopLevelBlock (                  fun mkExit env = let
402                    VMap.empty, globalInit,                        val nd = IL.Node.mkRETURN(VMap.listItems env)
403                    fn env => IL.Node.mkRETURN(VMap.listItems env))                        in
404                            IL.CFG{entry = nd, exit = nd}
405                          end
406                    in
407                      cvtTopLevelBlock (VMap.empty, globalInit, mkExit)
408                    end
409          (* construct a reduced environment that just defines the globals. *)          (* construct a reduced environment that just defines the globals. *)
410            val env = let            val env = let
411                  val lookup = lookup env                  val lookup = lookup env
# Line 382  Line 427 
427                        in                        in
428                          (env, List.rev params)                          (env, List.rev params)
429                        end                        end
430                  (* create the state variables *)
431                    val svars = let
432                          fun newSVar x = IL.StateVar.new (
433                                Var.kindOf x = S.StrandOutputVar,
434                                Var.nameOf x, cvtTy(Var.monoTypeOf x))
435                          in
436                            List.map newSVar state
437                          end
438                (* convert the state initialization code *)                (* convert the state initialization code *)
439                  val (stateInit, env) = let                  val (stateInit, env) = let
440                        fun mkExit env = IL.Node.mkSINIT(List.map (lookup env) state)                        fun mkExit env = saveStrandState (env, (state, svars), IL.Node.mkSINIT())
441                        in                        in
442                          cvtTopLevelBlock (env, stateInit, mkExit)                          cvtTopLevelBlock (env, stateInit, mkExit)
443                        end                        end
444                (* the state-variable list is constructed by generating fresh variables for the                  fun cvtMeth (S.Method(name, blk)) = cvtMethod (env, name, state, svars, blk)
                * state variables and pairing them with a boolean that is true if the variable  
                * is an output variable.  Note that these IL variables are not defined or used.  
                *)  
                 val state' = let  
                       fun cvtStateVar x = (Var.kindOf x = S.StrandOutputVar, newVar x)  
                       in  
                         List.map cvtStateVar state  
                       end  
                 fun cvtMeth (S.Method(name, blk)) = cvtMethod (env, name, state, blk)  
445                  in                  in
446                    IL.Strand{                    IL.Strand{
447                        name = name,                        name = name,
448                        params = params,                        params = params,
449                        state = state',                        state = svars,
450                        stateInit = stateInit,                        stateInit = stateInit,
451                        methods = List.map cvtMeth methods                        methods = List.map cvtMeth methods
452                      }                      }
453                  end                  end
454            val prog = IL.Program{            val prog = IL.Program{
455                      props = checkProps strands,
456                    globalInit = globalInit,                    globalInit = globalInit,
457                    initially = init,                    initially = init,
458                    strands = List.map cvtStrand strands                    strands = List.map cvtStrand strands
Legend:
Removed from v.1639  
changed lines
  Added in v.1640
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge