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

SCM Repository

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

Diff of /trunk/src/compiler/translate/translate.sml

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

revision 240, Fri Aug 6 04:59:16 2010 UTC revision 1339, Mon Jun 13 19:56:59 2011 UTC
# Line 1  Line 1 
1  (* translate.sml  (* translate.sml
2   *   *
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * Translate Simple-AST code into the IL representation.   * Translate Simple-AST code into the IL representation.  This translation is based on the
7     * algorithm described in
8     *
9     *      Single-pass generation of static single assignment form for structured languages
10     *      ACM TOPLAS, Nov. 1994
11     *      by Brandis and MossenBock.
12   *)   *)
13    
14  structure Translate : sig  structure Translate : sig
# Line 13  Line 18 
18    end = struct    end = struct
19    
20      structure S = Simple      structure S = Simple
21        structure Ty = Types
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 DstTy = HighILTypes
26        structure Census = HighILCensus
27    
28      (* maps from SimpleAST variables to the current corresponding SSA variable *)
29        type env = IL.var VMap.map
30    
31      fun lookup env x = (case VMap.find (env, x)      fun lookup env x = (case VMap.find (env, x)
32             of SOME x' => x'             of SOME x' => x'
# Line 24  Line 35 
35                  ])                  ])
36            (* end case *))            (* end case *))
37    
38        fun cvtTy ty = (case TypeUtil.prune ty
39               of Ty.T_Bool => DstTy.BoolTy
40                | Ty.T_Int => DstTy.IntTy
41                | Ty.T_String => DstTy.StringTy
42                | Ty.T_Kernel _ => DstTy.KernelTy
43                | Ty.T_Tensor(Ty.Shape dd) => let
44                    fun cvtDim (Ty.DimConst 1) = NONE
45                      | cvtDim (Ty.DimConst d) = SOME d
46                    in
47                      DstTy.TensorTy(List.mapPartial cvtDim dd)
48                    end
49                | Ty.T_Image{dim=Ty.DimConst d, shape} => DstTy.ImageTy d
50                | Ty.T_Field fld => DstTy.FieldTy
51                | ty => raise Fail("cvtTy: unexpected " ^ TypeUtil.toString ty)
52              (* end case *))
53    
54    (* create a new instance of a variable *)    (* create a new instance of a variable *)
55      fun newVar x = IL.Var.new (Var.nameOf x)      fun newVar x = IL.Var.new (Var.nameOf x, cvtTy(Var.monoTypeOf x))
56    
57      (* generate fresh SSA variables and add them to the environment *)
58        fun freshVars (env, xs) = let
59              fun cvtVar (x, (env, xs)) = let
60                    val x' = newVar x
61                    in
62                      (VMap.insert(env, x, x'), x'::xs)
63                    end
64              val (env, xs) = List.foldl cvtVar (env, []) xs
65              in
66                (env, List.rev xs)
67              end
68    
69      (* a pending-join node tracks the phi nodes needed to join the assignments
70       * that flow into the join node.
71       *)
72        datatype join = JOIN of {
73            env : env,                      (* the environment that was current at the conditional *)
74                                            (* associated with this node. *)
75            arity : int ref,                (* actual number of predecessors *)
76            nd : IL.node,                   (* the CFG node for this pending join *)
77            phiMap : IL.phi VMap.map ref,   (* a mapping from Simple AST variables that are assigned *)
78                                            (* to their phi nodes. *)
79            predKill : bool array           (* killed predecessor edges (because of DIE or STABILIZE *)
80          }
81    
82      (* a stack of pending joins.  The first component specifies the path index of the current
83       * path to the join.
84       *)
85        type pending_joins = (int * join) list
86    
87      (* create a new pending-join node *)
88        fun newJoin (env, arity) = JOIN{
89                env = env, arity = ref arity, nd = IL.Node.mkJOIN [], phiMap = ref VMap.empty,
90                predKill = Array.array(arity, false)
91              }
92    
93      (* record that a path to the top join in the stack has been killed because f DIE or STABILIZE *)
94        fun killPath ((i, JOIN{arity, predKill, ...}) :: _) = (
95              arity := !arity - 1;
96              Array.update (predKill, i, true))
97          | killPath _ = ()
98    
99      (* record an assignment to the IL variable dstVar (corresponding to the Simple AST variable
100       * srcVar) in the current pending-join node.  The predIndex specifies which path into the
101       * JOIN node this assignment occurs on.
102       *)
103        fun recordAssign ([], _, _) = ()
104          | recordAssign ((predIndex, JOIN{env, phiMap, predKill, nd, ...})::_, srcVar, dstVar) = let
105              val arity = Array.length predKill (* the original arity before any killPath calls *)
106              val m = !phiMap
107              in
108                case VMap.find (env, srcVar)
109                 of NONE => () (* local temporary *)
110                  | SOME dstVar' => (case VMap.find (m, srcVar)
111                       of NONE => let
112                            val lhs = newVar srcVar
113                            val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')
114                            in
115    (*
116    print(concat["recordAssign: ", Var.uniqueNameOf srcVar, " --> ", IL.Var.toString lhs,
117    " @ ", IL.Node.toString nd, "\n"]);
118    *)
119                              phiMap := VMap.insert (m, srcVar, (lhs, rhs))
120                            end
121                        | SOME(lhs, rhs) => let
122                            fun update (i, l as x::r) = if (i = predIndex)
123                                  then dstVar::r
124                                  else x::update(i+1, r)
125                              | update _ = raise Fail "invalid predecessor index"
126                            in
127                              phiMap := VMap.insert (m, srcVar, (lhs, update(0, rhs)))
128                            end
129                      (* end case *))
130                (* end case *)
131              end
132    
133      (* complete a pending join operation by filling in the phi nodes from the phi map and
134       * updating the environment.
135       *)
136        fun commitJoin (joinStk, JOIN{env, arity, nd, phiMap, predKill}) = (case !arity
137               of 0 => (env, NONE)
138                | 1 => (* there is only one path to the join, so we do not need phi nodes *)
139                    (env, SOME nd)
140                | n => if (n = Array.length predKill)
141                    then let
142                      val IL.ND{kind=IL.JOIN{phis, ...}, ...} = nd
143                      fun doVar (srcVar, phi as (dstVar, _), (env, phis)) = (
144    (*
145    print(concat["doVar (", Var.uniqueNameOf srcVar, ", ", IL.phiToString phi, ", _) @ ", IL.Node.toString nd, "\n"]);
146    *)
147                            recordAssign (joinStk, srcVar, dstVar);
148                            (VMap.insert (env, srcVar, dstVar), phi::phis))
149                      val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)
150                      in
151                        phis := phis';
152                        (env, SOME nd)
153                      end
154                    else raise Fail "FIXME: prune killed paths."
155              (* end case *))
156    
157    (* expression translation *)    (* expression translation *)
158      fun cvtExp (env, lhs, exp) = (case exp      fun cvtExp (env : env, lhs, exp) = (case exp
159             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
160              | S.E_Lit lit => [(lhs, IL.LIT lit)]              | S.E_Lit lit => [(lhs, IL.LIT lit)]
161              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
# Line 37  Line 164 
164                  in                  in
165                    TranslateBasis.translate (lhs, f, tyArgs, args')                    TranslateBasis.translate (lhs, f, tyArgs, args')
166                  end                  end
167              | S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]              | S.E_Cons args => [(lhs, IL.CONS(IL.Var.ty lhs, List.map (lookup env) args))]
168              | S.E_Input(_, name, NONE) => [(lhs, IL.OP(HighOps.Input name, []))]              | S.E_Slice(x, indices, ty) => let
169              | S.E_Input(_, name, SOME dflt) =>                  val x = lookup env x
170                  [(lhs, IL.OP(HighOps.InputWithDefault name, [lookup env dflt]))]                  val mask = List.map isSome indices
171              | S.E_Field fld => [(lhs, IL.OP(HighOps.Field fld, []))]                  fun cvt NONE = NONE
172              | S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]                    | cvt (SOME x) = SOME(lookup env x)
173            (* end case *))                  val indices = List.mapPartial cvt indices
174                    in
175    (* convert a Simple AST block to an IL statement.  We return the statement that represents the                    if List.all (fn b => b) mask
176     * block, plus the environment mapping Simple AST variables to their current SSA representations                      then [(lhs, IL.OP(HighOps.Subscript(IL.Var.ty x), x::indices))]
177     * and the set of Simple AST variables that were assigned to in the block.                      else [(lhs, IL.OP(HighOps.Slice(IL.Var.ty lhs, mask), x::indices))]
178     *)                  end
179      fun cvtBlock (env, S.Block stms) = let              | S.E_Input(_, name, desc, NONE) =>
180            fun toBlock (env, assigned, [], assignments) =                  [(lhs, IL.OP(HighOps.Input(IL.Var.ty lhs, name, desc), []))]
181                  (IL.mkBLOCK{succ=IL.dummy, body=List.rev assignments}, env, assigned)              | S.E_Input(_, name, desc, SOME dflt) =>
182              | toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let                  [(lhs, IL.OP(HighOps.InputWithDefault(IL.Var.ty lhs, name, desc), [lookup env dflt]))]
183                  val x' = newVar x              | S.E_LoadImage(info, name) => [(lhs, IL.OP(HighOps.LoadImage info, [lookup env name]))]
184                  val stms = cvtExp(env, x', e)            (* end case *))
185                  val assigned = VSet.add(assigned, x)  
186                  val env = VMap.insert(env, x, x')      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let
187                  in            fun cvt (env : env, cfg, []) = (cfg, env)
188                    toBlock (env, assigned, rest, stms@assignments)              | cvt (env, cfg, stm::stms) = (case stm
189                  end                   of S.S_Var x => let
             | toBlock (env, assigned, stms, assignments) = let  
                 val (succ, env, assigned) = toStmt (env, assigned, stms)  
                 val blk = IL.mkBLOCK{succ=succ, body=List.rev assignments}  
                 in  
                   IL.addPred (succ, blk);  
                   (blk, env, assigned)  
                 end  
           and toStmt (env, assigned, []) =  
                 (IL.mkBLOCK{succ=IL.dummy, body=[]}, env, assigned)  
             | toStmt (env, assigned, stms as stm::rest) = (case stm  
                  of S.S_Assign _ => toBlock (env, assigned, stms, [])  
                   | S.S_IfThenElse(x, b1, b2) => let  
                       val x' = lookup env x  
                       val (s1, env1, assigned1) = cvtBlock(env, b1)  
                       val (s2, env2, assigned2) = cvtBlock(env, b2)  
                       val assigned = VSet.union(assigned1, assigned2)  
 (* PROBLEM: what about variables that are assigned for the first time in one branch  
  * and not the other?  This situation should only occur for variables who's scope is  
  * the branch of the if.  Short-term solution is to ignore variables that are defined  
  * in only one branch.  
  *)  
                       val (env, phis) = let  
                             fun mkPhi (x, (env, phis)) = (  
                                   case (VMap.find(env1, x), VMap.find(env2, x))  
                                    of (SOME x1, SOME x2) => let  
190                                          val x' = newVar x                                          val x' = newVar x
191                                          in                                          in
192                                            (VMap.insert(env, x, x'), (x', [x1, x2])::phis)                          cvt (VMap.insert (env, x, x'), cfg, stms)
193                                          end                                          end
194                                      | _ => (env, phis)                    | S.S_Assign(lhs, rhs) => let
195                                    (* end case *))                        val lhs' = newVar lhs
196                          val assigns = cvtExp (env, lhs', rhs)
197                              in                              in
198                                VSet.foldl mkPhi (env, []) assigned  (*
199    print "doAssign\n";
200    *)
201                            recordAssign (joinStk, lhs, lhs');
202                            cvt (
203                              VMap.insert(env, lhs, lhs'),
204                              IL.CFG.concat(cfg, IL.CFG.mkBlock assigns),
205                              stms)
206                              end                              end
207                        val stm = IL.mkIF{cond=x', thenBranch=s1, elseBranch=s2}                    | S.S_IfThenElse(x, b0, b1) => let
208                        in                        val x' = lookup env x
209                          case rest                        val join = newJoin (env, 2)
210                           of [] => (stm, env, assigned)                        val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, b0)
211                            | _ => let                        val (cfg1, _) = cvtBlock (state, env, (1, join)::joinStk, b1)
212                                val (join, env, assigned) = toStmt (env, assigned, rest)                        val cond = IL.Node.mkCOND {
213                                  cond = x',
214                                  trueBranch = IL.Node.dummy,
215                                  falseBranch = IL.Node.dummy
216                                }
217                                in                                in
218                                  IL.addPred (join, stm);                          IL.Node.addEdge (IL.CFG.exit cfg, cond);
219                                  IL.setSucc (stm, join);                          case commitJoin (joinStk, join)
220                                  (stm, env, assigned)                           of (env, SOME joinNd) => (
221                                end                                if IL.CFG.isEmpty cfg0
222                                    then (
223                                      IL.Node.setTrueBranch (cond, joinNd);
224                                      IL.Node.setPred (joinNd, cond))
225                                    else (
226                                      IL.Node.setTrueBranch (cond, IL.CFG.entry cfg0);
227                                      IL.Node.setPred (IL.CFG.entry cfg0, cond);
228                                      IL.Node.addEdge (IL.CFG.exit cfg0, joinNd));
229                                  if IL.CFG.isEmpty cfg1
230                                    then (
231                                      IL.Node.setFalseBranch (cond, joinNd);
232                                      IL.Node.setPred (joinNd, cond))
233                                    else (
234                                      IL.Node.setFalseBranch (cond, IL.CFG.entry cfg1);
235                                      IL.Node.setPred (IL.CFG.entry cfg1, cond);
236                                      IL.Node.addEdge (IL.CFG.exit cfg1, joinNd));
237                                  cvt (
238                                    env,
239                                    IL.CFG.concat (
240                                      cfg,
241                                      IL.CFG{entry = cond, exit = joinNd}),
242                                    stms))
243                            (* the join node has only zero predecessors, so
244                             * it was killed.
245                             *)
246                              | (env, NONE) => raise Fail "unimplemented" (* FIXME *)
247                          (* end case *)                          (* end case *)
248                        end                        end
249                    | S.S_New(name, xs) => let                    | S.S_New(strandId, args) => let
250                        val xs' = List.map (lookup env) xs                        val nd = IL.Node.mkNEW{
251                        in                                strand = strandId,
252                          case rest                                args = List.map (lookup env) args
253                           of [] => (IL.mkNEW{actor=name, args=xs', succ=IL.dummy}, env, assigned)                              }
                           | _ => let  
                               val (succ, env, assigned) = toStmt (env, assigned, rest)  
                               val stm = IL.mkNEW{actor=name, args=xs', succ=succ}  
254                                in                                in
255                                  IL.addPred (succ, stm);                          cvt (env, IL.CFG.appendNode (cfg, nd), stms)
                                 (stm, env, assigned)  
256                                end                                end
257                      | S.S_Die => (
258                          killPath joinStk;
259                          (IL.CFG.appendNode (cfg, IL.Node.mkDIE ()), env))
260                      | S.S_Stabilize => let
261                          val stateOut = List.map (lookup env) state
262                          in
263                            killPath joinStk;
264                            (IL.CFG.appendNode (cfg, IL.Node.mkSTABILIZE stateOut), env)
265                        end                        end
                   | S.S_Die => (IL.mkDIE(), env, assigned)  
                   | S.S_Stabilize => (IL.mkSTABILIZE(), env, assigned)  
266                  (* end case *))                  (* end case *))
267            in            in
268              toStmt (env, VSet.empty, stms)              cvt (env, IL.CFG.empty, stms)
269            end            end
270    (*DEBUG*)handle ex => raise ex
271    
272      fun translate (S.Program{globals, globalInit, actors}) = let      fun cvtTopLevelBlock (env, blk, mkExit) = let
273            val (globalInit, env, _) = cvtBlock (VMap.empty, globalInit)            val (cfg, env) = cvtBlock ([], env, [], blk)
274          (* get the SSA names for the globals and a reduced environment *)            val entry = IL.Node.mkENTRY ()
275            val (env, globs) = let            val exit = mkExit env
276                  val lookup = lookup env            in
277                  fun cvtVar (x, (env, globs)) = let              if IL.CFG.isEmpty cfg
278                        val x' = lookup x                then IL.Node.addEdge (entry, exit)
279                        in                else (
280                          (VMap.insert(env, x, x'), x'::globs)                  IL.Node.addEdge (entry, IL.CFG.entry cfg);
281                  (* NOTE: this addEdge could fail if all control paths end in DIE or STABILIZE,
282                   * so we wrap it in a handler
283                   *)
284                    IL.Node.addEdge (IL.CFG.exit cfg, exit) handle _ => ());
285                (IL.CFG{entry = entry, exit = exit}, env)
286              end
287    (*DEBUG*)handle ex => raise ex
288    
289    (* FIXME: the following function could be refactored with cvtTopLevelBlock to share code *)
290        fun cvtFragmentBlock (env0, blk) = let
291              val (cfg, env) = cvtBlock ([], env0, [], blk)
292              val entry = IL.Node.mkENTRY ()
293            (* the live variables out are those that were not live coming in *)
294              val liveOut = VMap.foldli
295                    (fn (x, x', xs) => if VMap.inDomain(env0, x) then xs else x'::xs)
296                      [] env
297              val exit = IL.Node.mkFRAGMENT liveOut
298              in
299                if IL.CFG.isEmpty cfg
300                  then IL.Node.addEdge (entry, exit)
301                  else (
302                    IL.Node.addEdge (entry, IL.CFG.entry cfg);
303                    IL.Node.addEdge (IL.CFG.exit cfg, exit));
304                (IL.CFG{entry = entry, exit = exit}, env)
305              end
306    (*DEBUG*)handle ex => raise ex
307    
308        fun cvtMethod (env, name, state, blk) = let
309            (* allocate fresh variables for the state variables *)
310              val (env, stateIn) = freshVars (env, state)
311            (* convert the body of the method *)
312              val (cfg, env) = cvtBlock (state, env, [], blk)
313            (* add the entry/exit nodes *)
314              val stateOut = List.map (lookup env) state
315              val entry = IL.Node.mkENTRY ()
316              val exit = IL.Node.mkACTIVE stateOut
317              in
318                if IL.CFG.isEmpty cfg
319                  then IL.Node.addEdge (entry, exit)
320                  else (
321                    IL.Node.addEdge (entry, IL.CFG.entry cfg);
322                  (* NOTE: this addEdge could fail if all control paths end in DIE or STABILIZE,
323                   * so we wrap it in a handler
324                   *)
325                    IL.Node.addEdge (IL.CFG.exit cfg, exit) handle _ => ());
326                IL.Method{
327                    name = name,
328                    stateIn = stateIn,
329                    body = IL.CFG{entry = entry, exit = exit}
330                  }
331                        end                        end
332                  val (env, globs) = List.foldl cvtVar (VMap.empty, []) globals  (*DEBUG*)handle ex => (print(concat["error in cvtMethod(", Atom.toString name, ", ...)\n"]); raise ex)
333    
334      (* convert the initially code *)
335        fun cvtInitially (env, S.Initially{isArray, rangeInit, create, iters}) = let
336              val S.C_Create{argInit, name, args} = create
337              fun cvtIter ({param, lo, hi}, (env, iters)) = let
338                    val param' = newVar param
339                    val env = VMap.insert (env, param, param')
340                    val iter = (param', lookup env lo, lookup env hi)
341                    in
342                      (env, iter::iters)
343                    end
344              val (cfg, env) = cvtFragmentBlock (env, rangeInit)
345              val (env, iters) = List.foldl cvtIter (env, []) iters
346              val (argInitCFG, env) = cvtFragmentBlock (env, argInit)
347              in
348                IL.Initially{
349                    isArray = isArray,
350                    rangeInit = cfg,
351                    iters = List.rev iters,
352                    create = (argInitCFG, name, List.map (lookup env) args)
353                  }
354              end
355    
356        fun translate (S.Program{globals, globalInit, init, strands}) = let
357              val (globalInit, env) =
358                    cvtTopLevelBlock (
359                      VMap.empty, globalInit,
360                      fn env => IL.Node.mkRETURN(VMap.listItems env))
361            (* construct a reduced environment that just defines the globals. *)
362              val env = let
363                    val lookup = lookup env
364                    fun cvtVar (x, env) = VMap.insert(env, x, lookup x)
365                    val env = List.foldl cvtVar VMap.empty globals
366                  in                  in
367                    (env, List.rev globs)                    env
368                  end                  end
369            fun cvtActor (S.Actor{name, params, state, stateInit, methods}) = let            val init = cvtInitially (env, init)
370              fun cvtStrand (S.Strand{name, params, state, stateInit, methods}) = let
371                  (* extend the global environment with the strand's parameters *)
372                  val (env, params) = let                  val (env, params) = let
373                        fun cvtParam (x, (env, xs)) = let                        fun cvtParam (x, (env, xs)) = let
374                              val x' = newVar x                              val x' = newVar x
# Line 152  Line 379 
379                        in                        in
380                          (env, List.rev params)                          (env, List.rev params)
381                        end                        end
382                  val (stateInit, env, _) = cvtBlock (env, stateInit)                (* convert the state initialization code *)
383                  val state = List.map (lookup env) state                  val (stateInit, env) = let
384                  fun cvtMethod (S.Method(name, blk)) = let                        fun mkExit env = IL.Node.mkSINIT(List.map (lookup env) state)
385                        val (body, _, _) = cvtBlock (env, blk)                        in
386                            cvtTopLevelBlock (env, stateInit, mkExit)
387                          end
388                  (* the state-variable list is constructed by generating fresh variables for the
389                   * state variables and pairing them with a boolean that is true if the variable
390                   * is an output variable.  Note that these IL variables are not defined or used.
391                   *)
392                    val state' = let
393                          fun cvtStateVar x = (Var.kindOf x = S.StrandOutputVar, newVar x)
394                        in                        in
395                          IL.Method(name, body)                          List.map cvtStateVar state
396                        end                        end
397                    fun cvtMeth (S.Method(name, blk)) = cvtMethod (env, name, state, blk)
398                  in                  in
399                    IL.Actor{                    IL.Strand{
400                        name = name,                        name = name,
401                        params = params,                        params = params,
402                        state = state,                        state = state',
403                        stateInit = stateInit,                        stateInit = stateInit,
404                        methods = List.map cvtMethod methods                        methods = List.map cvtMeth methods
405                      }                      }
406                  end                  end
407            in            val prog = IL.Program{
             IL.Program{  
                 globals = globs,  
408                  globalInit = globalInit,                  globalInit = globalInit,
409                  actors = List.map cvtActor actors                    initially = init,
410                      strands = List.map cvtStrand strands
411                }                }
412              in
413                Census.init prog;
414                prog
415            end            end
416    
417    end    end

Legend:
Removed from v.240  
changed lines
  Added in v.1339

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