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 190, Sat Jul 31 04:39:18 2010 UTC revision 1444, Mon Jul 11 12:11:53 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 x      fun lookup env x = (case VMap.find (env, x)
32             of SOME x' => x'             of SOME x' => x'
33              | NONE => raise Fail(concat[              | NONE => raise Fail(concat[
34                    "no binding for ", Var.toString x, " in environment"                    "no binding for ", Var.uniqueNameOf x, " in environment"
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.newVar (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 cvtExpr (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_Slice(x, indices, ty) => let
169                    val x = lookup env x
170                    val mask = List.map isSome indices
171                    fun cvt NONE = NONE
172                      | cvt (SOME x) = SOME(lookup env x)
173                    val indices = List.mapPartial cvt indices
174                    in
175                      if List.all (fn b => b) mask
176                        then [(lhs, IL.OP(HighOps.Subscript(IL.Var.ty x), x::indices))]
177                        else [(lhs, IL.OP(HighOps.Slice(IL.Var.ty lhs, mask), x::indices))]
178                    end
179                | S.E_Input(_, name, desc, NONE) =>
180                    [(lhs, IL.OP(HighOps.Input(IL.Var.ty lhs, name, desc), []))]
181                | S.E_Input(_, name, desc, SOME dflt) =>
182                    [(lhs, IL.OP(HighOps.InputWithDefault(IL.Var.ty lhs, name, desc), [lookup env dflt]))]
183                | S.E_LoadImage(info, name) => [(lhs, IL.OP(HighOps.LoadImage info, [lookup env name]))]
184            (* end case *))            (* end case *))
185    
186      fun cvtBlock (env, S.Block stms) =      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let
187              fun cvt (env : env, cfg, []) = (cfg, env)
188    (* convert a statement, where env is the mapping from Simple AST variables to              | cvt (env, cfg, stm::stms) = (case stm
189     * their current SSA name, assigned is the set of AST variables assigned to                   of S.S_Var x => let
    * in the current context, and stm is the statement to convert.  
    *)  
     and cvtStmt (env, assigned, stm, preStms, k) = (case stm  
            of S.S_Assign(x, e) => let  
190                  val x' = newVar x                  val x' = newVar x
                 val stms = cvtExp(env, x', e)  
                 val assigned = VSet.add(assigned, x)  
                 val env = VMap.insert(env, x, x')  
191                  in                  in
192                    k (env, assigned, stm::preStms)                          cvt (VMap.insert (env, x, x'), cfg, stms)
193                          end
194                      | S.S_Assign(lhs, rhs) => let
195                          val lhs' = newVar lhs
196                          val assigns = cvtExp (env, lhs', rhs)
197                          in
198    (*
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              | S.S_IfThenElse(x, b1, b2) => let                    | S.S_IfThenElse(x, b0, b1) => let
208                  val x' = lookup env x                  val x' = lookup env x
209                  val (b1, env1, assigned1) = block(env, b1)                        val join = newJoin (env, 2)
210                  val (b2, env2, assigned2) = block(env, b2)                        val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, b0)
211                  val assigned = VSet.union(assigned1, assigned2)                        val (cfg1, _) = cvtBlock (state, env, (1, join)::joinStk, b1)
212                  val (env, phis) = let                        val cond = IL.Node.mkCOND {
213                        fun mkPhi (x, (env, phis) = let                                cond = x',
214                              val x1 = lookup(env1, x)                                trueBranch = IL.Node.dummy,
215                              val x2 = lookup(env2, x)                                falseBranch = IL.Node.dummy
216                              val x' = newVar x                              }
217                              in                              in
218                                (VMap.insert(env, x, x'), (x', [x1, x2])::phis)                          IL.Node.addEdge (IL.CFG.exit cfg, cond);
219                            case commitJoin (joinStk, join)
220                             of (env, SOME joinNd) => (
221                                  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 *)
248                              end                              end
249                      | S.S_New(strandId, args) => let
250                          val nd = IL.Node.mkNEW{
251                                  strand = strandId,
252                                  args = List.map (lookup env) args
253                                }
254                        in                        in
255                          VSet.foldl mkPhi (env, []) assigned                          cvt (env, IL.CFG.appendNode (cfg, nd), stms)
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                  in
263                            killPath joinStk;
264                            (IL.CFG.appendNode (cfg, IL.Node.mkSTABILIZE stateOut), env)
265                  end                  end
             | S.S_New(name, xs) =>  
             | S.S_Die =>  
             | S.S_Stabilize =>  
266            (* end case *))            (* end case *))
267              in
268                cvt (env, IL.CFG.empty, stms)
269              end
270    (*DEBUG*)handle ex => raise ex
271    
272      fun newBlock (??, stm) =      fun cvtTopLevelBlock (env, blk, mkExit) = let
273              val (cfg, env) = cvtBlock ([], env, [], blk)
274              val entry = IL.Node.mkENTRY ()
275              val exit = mkExit env
276              in
277                if IL.CFG.isEmpty cfg
278                  then IL.Node.addEdge (entry, exit)
279                  else (
280                    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      and nextStmt (env, assigned, stm, ??) =  (* 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      and join (env      fun cvtMethod (env, name, state, blk) = let
309      fun translate (S.Program{globals, globaInit, actors}) = ??          (* 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 = (case name
317                     of MethodName.Update => IL.Node.mkACTIVE stateOut
318                      | MethodName.Stabilize => IL.Node.mkRETURN stateOut
319                    (* end case *))
320              in
321                if IL.CFG.isEmpty cfg
322                  then IL.Node.addEdge (entry, exit)
323                  else (
324                    IL.Node.addEdge (entry, IL.CFG.entry cfg);
325                  (* NOTE: this addEdge could fail if all control paths end in DIE or STABILIZE,
326                   * so we wrap it in a handler
327                   *)
328                    IL.Node.addEdge (IL.CFG.exit cfg, exit) handle _ => ());
329                IL.Method{
330                    name = name,
331                    stateIn = stateIn,
332                    body = IL.CFG{entry = entry, exit = exit}
333                  }
334              end
335    (*DEBUG*)handle ex => (print(concat["error in cvtMethod(", MethodName.toString name, ", ...)\n"]); raise ex)
336    
337      (* convert the initially code *)
338        fun cvtInitially (env, S.Initially{isArray, rangeInit, create, iters}) = let
339              val S.C_Create{argInit, name, args} = create
340              fun cvtIter ({param, lo, hi}, (env, iters)) = let
341                    val param' = newVar param
342                    val env = VMap.insert (env, param, param')
343                    val iter = (param', lookup env lo, lookup env hi)
344                    in
345                      (env, iter::iters)
346                    end
347              val (cfg, env) = cvtFragmentBlock (env, rangeInit)
348              val (env, iters) = List.foldl cvtIter (env, []) iters
349              val (argInitCFG, env) = cvtFragmentBlock (env, argInit)
350              in
351                IL.Initially{
352                    isArray = isArray,
353                    rangeInit = cfg,
354                    iters = List.rev iters,
355                    create = (argInitCFG, name, List.map (lookup env) args)
356                  }
357              end
358    
359        fun translate (S.Program{globals, globalInit, init, strands}) = let
360              val (globalInit, env) =
361                    cvtTopLevelBlock (
362                      VMap.empty, globalInit,
363                      fn env => IL.Node.mkRETURN(VMap.listItems env))
364            (* construct a reduced environment that just defines the globals. *)
365              val env = let
366                    val lookup = lookup env
367                    fun cvtVar (x, env) = VMap.insert(env, x, lookup x)
368                    val env = List.foldl cvtVar VMap.empty globals
369                    in
370                      env
371                    end
372              val init = cvtInitially (env, init)
373              fun cvtStrand (S.Strand{name, params, state, stateInit, methods}) = let
374                  (* extend the global environment with the strand's parameters *)
375                    val (env, params) = let
376                          fun cvtParam (x, (env, xs)) = let
377                                val x' = newVar x
378                                in
379                                  (VMap.insert(env, x, x'), x'::xs)
380                                end
381                          val (env, params) = List.foldl cvtParam (env, []) params
382                          in
383                            (env, List.rev params)
384                          end
385                  (* convert the state initialization code *)
386                    val (stateInit, env) = let
387                          fun mkExit env = IL.Node.mkSINIT(List.map (lookup env) state)
388                          in
389                            cvtTopLevelBlock (env, stateInit, mkExit)
390                          end
391                  (* the state-variable list is constructed by generating fresh variables for the
392                   * state variables and pairing them with a boolean that is true if the variable
393                   * is an output variable.  Note that these IL variables are not defined or used.
394                   *)
395                    val state' = let
396                          fun cvtStateVar x = (Var.kindOf x = S.StrandOutputVar, newVar x)
397                          in
398                            List.map cvtStateVar state
399                          end
400                    fun cvtMeth (S.Method(name, blk)) = cvtMethod (env, name, state, blk)
401                    in
402                      IL.Strand{
403                          name = name,
404                          params = params,
405                          state = state',
406                          stateInit = stateInit,
407                          methods = List.map cvtMeth methods
408                        }
409                    end
410              val prog = IL.Program{
411                      globalInit = globalInit,
412                      initially = init,
413                      strands = List.map cvtStrand strands
414                    }
415              in
416                Census.init prog;
417                prog
418              end
419    
420    end    end

Legend:
Removed from v.190  
changed lines
  Added in v.1444

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