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 1115, Thu May 5 04:42:18 2011 UTC revision 1116, Thu May 5 04:49:02 2011 UTC
# Line 3  Line 3 
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.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 18  Line 23 
23      structure VSet = Var.Set      structure VSet = Var.Set
24      structure IL = HighIL      structure IL = HighIL
25      structure DstTy = HighILTypes      structure DstTy = HighILTypes
26        structure Census = HighILCensus
27    
28      structure Census = CensusFn (IL)    (* maps from SimpleAST variables to the current corresponding SSA variable *)
   
29      type env = IL.var VMap.map      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)
# Line 41  Line 46 
46                  in                  in
47                    DstTy.TensorTy(List.mapPartial cvtDim dd)                    DstTy.TensorTy(List.mapPartial cvtDim dd)
48                  end                  end
49              | Ty.T_Image _ => DstTy.ImageTy              | Ty.T_Image{dim=Ty.DimConst d, shape} => DstTy.ImageTy d
50              | Ty.T_Field _ => DstTy.FieldTy              | Ty.T_Field fld => DstTy.FieldTy
51              | ty => raise Fail("cvtTy: unexpected " ^ TypeUtil.toString ty)              | ty => raise Fail("cvtTy: unexpected " ^ TypeUtil.toString ty)
52            (* end case *))            (* 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, cvtTy(Var.monoTypeOf 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            arity : int ref,                (* actual number of predecessors *)
74            nd : IL.node,                   (* the CFG node for this pending join *)
75            phiMap : IL.phi VMap.map ref,   (* a mapping from Simple AST variables that are assigned *)
76                                            (* to their phi nodes. *)
77            predKill : bool array           (* killed predecessor edges (because of DIE or STABILIZE *)
78          }
79    
80      (* a stack of pending joins.  The first component specifies the path index of the current
81       * path to the join.
82       *)
83        type pending_joins = (int * join) list
84    
85      (* create a new pending-join node *)
86        fun newJoin arity = JOIN{
87                arity = ref arity, nd = IL.Node.mkJOIN [], phiMap = ref VMap.empty,
88                predKill = Array.array(arity, false)
89              }
90    
91      (* record that a path to the top join in the stack has been killed because f DIE or STABILIZE *)
92        fun killPath ((i, JOIN{arity, predKill, ...}) :: _) = (
93              arity := !arity - 1;
94              Array.update (predKill, i, true))
95          | killPath _ = ()
96    
97      (* record an assignment to the IL variable dstVar (corresponding to the Simple AST variable
98       * srcVar) in the current pending-join node.  The predIndex specifies which path into the
99       * JOIN node this assignment occurs on.
100       *)
101        fun recordAssign (_, [], _, _) = ()
102          | recordAssign (env, (predIndex, JOIN{phiMap, predKill, ...})::_, srcVar, dstVar) = let
103              val arity = Array.length predKill (* the original arity before any killPath calls *)
104              val m = !phiMap
105              in
106                case VMap.find (env, srcVar)
107                 of NONE => () (* local temporary *)
108                  | SOME dstVar' => (case VMap.find (m, srcVar)
109                       of NONE => let
110                            val lhs = newVar srcVar
111                            val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')
112                            in
113                              phiMap := VMap.insert (m, srcVar, (lhs, rhs))
114                            end
115                        | SOME(lhs, rhs) => let
116                            fun update (i, l as x::r) = if (i = predIndex)
117                                  then dstVar::r
118                                  else x::update(i+1, r)
119                              | update _ = raise Fail "invalid predecessor index"
120                            in
121                              phiMap := VMap.insert (m, srcVar, (lhs, update(0, rhs)))
122                            end
123                      (* end case *))
124                (* end case *)
125              end
126    
127      (* complete a pending join operation by filling in the phi nodes from the phi map and
128       * updating the environment.
129       *)
130        fun commitJoin (env, joinStk, JOIN{arity, nd, phiMap, predKill}) = (case !arity
131               of 0 => (env, NONE)
132                | 1 => (* there is only one path to the join, so we do not need phi nodes *)
133                    (env, SOME nd)
134                | n => if (n = Array.length predKill)
135                    then let
136                      val IL.ND{kind=IL.JOIN{phis, ...}, ...} = nd
137                      fun doVar (srcVar, phi as (dstVar, _), (env, phis)) = (
138                            recordAssign (env, joinStk, srcVar, dstVar);
139                            (VMap.insert (env, srcVar, dstVar), phi::phis))
140                      val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)
141                      in
142                        phis := phis';
143                        (env, SOME nd)
144                      end
145                    else raise Fail "FIXME: prune killed paths."
146              (* end case *))
147    
148    (* expression translation *)    (* expression translation *)
149      fun cvtExp (env, lhs, exp) = (case exp      fun cvtExp (env : env, lhs, exp) = (case exp
150             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
151              | S.E_Lit lit => [(lhs, IL.LIT lit)]              | S.E_Lit lit => [(lhs, IL.LIT lit)]
152              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
# Line 59  Line 155 
155                  in                  in
156                    TranslateBasis.translate (lhs, f, tyArgs, args')                    TranslateBasis.translate (lhs, f, tyArgs, args')
157                  end                  end
158              | 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))]
159              | S.E_Slice(x, indices, ty) => let              | S.E_Slice(x, indices, ty) => let
160                  val x = lookup env x                  val x = lookup env x
161                  val mask = List.map isSome indices                  val mask = List.map isSome indices
# Line 75  Line 171 
171                  [(lhs, IL.OP(HighOps.Input(IL.Var.ty lhs, name), []))]                  [(lhs, IL.OP(HighOps.Input(IL.Var.ty lhs, name), []))]
172              | S.E_Input(_, name, SOME dflt) =>              | S.E_Input(_, name, SOME dflt) =>
173                  [(lhs, IL.OP(HighOps.InputWithDefault(IL.Var.ty lhs, name), [lookup env dflt]))]                  [(lhs, IL.OP(HighOps.InputWithDefault(IL.Var.ty lhs, name), [lookup env dflt]))]
174              | S.E_Field fld => [(lhs, IL.OP(HighOps.Field fld, []))]              | S.E_LoadImage(info, name) => [(lhs, IL.OP(HighOps.LoadImage info, [lookup env name]))]
             | S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]  
175            (* end case *))            (* end case *))
176    
177    (* convert a Simple AST block to an IL statement.  We return the statement that represents the      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let
178     * block, plus the environment mapping Simple AST variables to their current SSA representations            fun cvt (env : env, cfg, []) = (cfg, env)
179     * and the set of Simple AST variables that were assigned to in the block.              | cvt (env, cfg, stm::stms) = (case stm
180     *)                   of S.S_Var x => let
     fun cvtBlock (env, S.Block stms, optExit) = let  
           fun toBlock (env, assigned, [], assignments) = let  
                 val stm = IL.Stmt.mkBLOCK(List.rev assignments, optExit)  
                 in  
                   (stm, IL.Stmt.tail stm, env, assigned)  
                 end  
             | toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let  
181                  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')  
182                  in                  in
183                    toBlock (env, assigned, rest, stms@assignments)                          cvt (VMap.insert (env, x, x'), cfg, stms)
184                  end                  end
185              | toBlock (env, assigned, stms, assignments) = let                    | S.S_Assign(lhs, rhs) => let
186                  val (next, last, env, assigned) = toStmt (env, assigned, stms)                        val lhs' = newVar lhs
187                  val blk = IL.Stmt.mkBLOCK(List.rev assignments, SOME next)                        val assigns = cvtExp (env, lhs', rhs)
188                  in                        in
189                    IL.Node.addEdge (IL.Stmt.tail blk, IL.Stmt.entry next);                          recordAssign (env, joinStk, lhs, lhs');
190                    (blk, last, env, assigned)                          cvt (
191                  end                            VMap.insert(env, lhs, lhs'),
192            and toStmt (env, assigned, []) = let                            IL.CFG.concat(cfg, IL.CFG.mkBlock assigns),
193                (* this case only occurs for the empty else arm of an if-then-else statement *)                            stms)
                 val stm = IL.Stmt.mkBLOCK([], optExit)  
                 in  
                   (stm, IL.Stmt.tail stm, env, assigned)  
194                  end                  end
195              | toStmt (env, assigned, stms as stm::rest) = (case stm                    | S.S_IfThenElse(x, b0, b1) => let
                  of S.S_Assign _ => toBlock (env, assigned, stms, [])  
                   | S.S_IfThenElse(x, b1, b2) => let  
196                        val x' = lookup env x                        val x' = lookup env x
197                        val (s1, last1, env1, assigned1) = cvtBlock(env, b1, NONE)                        val join = newJoin 2
198                        val (s2, last2, env2, assigned2) = cvtBlock(env, b2, NONE)                        val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, b0)
199                        val assigned = VSet.union(assigned1, assigned2)                        val (cfg1, _) = cvtBlock (state, env, (1, join)::joinStk, b1)
200  (* PROBLEM: what about variables that are assigned for the first time in one branch                        val cond = IL.Node.mkCOND {
201   * and not the other?  This situation should only occur for variables who's scope is                                cond = x',
202   * the branch of the if.  Short-term solution is to ignore variables that are defined                                trueBranch = IL.Node.dummy,
203   * in only one branch.                                falseBranch = IL.Node.dummy
204   *)                              }
                       val (env, phis) = let  
                             fun mkPhi (x, (env, phis)) = (  
                                   case (VMap.find(env1, x), VMap.find(env2, x))  
                                    of (SOME x1, SOME x2) => let  
                                         val x' = newVar x  
                                         in  
                                           (VMap.insert(env, x, x'), (x', [x1, x2])::phis)  
                                         end  
                                     | _ => (env, phis)  
                                   (* end case *))  
                             in  
                               VSet.foldl mkPhi (env, []) assigned  
                             end  
205                        in                        in
206                          case rest                          IL.Node.addEdge (IL.CFG.exit cfg, cond);
207                           of [] => let                          case commitJoin (env, joinStk, join)
208                                val join = IL.Stmt.mkJOIN (phis, optExit)                           of (env, SOME joinNd) => (
209                                val joinNd = IL.Stmt.entry join                                if IL.CFG.isEmpty cfg0
210                                val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)                                  then (
211                                in                                    IL.Node.setTrueBranch (cond, joinNd);
212                                  IL.Node.addEdge (last2, joinNd);                                    IL.Node.setPred (joinNd, cond))
213                                  IL.Node.addEdge (last1, joinNd);                                  else (
214                                  (stm, joinNd, env, assigned)                                    IL.Node.setTrueBranch (cond, IL.CFG.entry cfg0);
215                                end                                    IL.Node.setPred (IL.CFG.entry cfg0, cond);
216                            | _ => let                                    IL.Node.addEdge (IL.CFG.exit cfg0, joinNd));
217                                val (next, last, env, assigned) = toStmt (env, assigned, rest)                                if IL.CFG.isEmpty cfg1
218                                val join = IL.Stmt.mkJOIN (phis, SOME next)                                  then (
219                                val joinNd = IL.Stmt.entry join                                    IL.Node.setFalseBranch (cond, joinNd);
220                                val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)                                    IL.Node.setPred (joinNd, cond))
221                                in                                  else (
222                                  IL.Node.addEdge (last2, joinNd);                                    IL.Node.setFalseBranch (cond, IL.CFG.entry cfg1);
223                                  IL.Node.addEdge (last1, joinNd);                                    IL.Node.setPred (IL.CFG.entry cfg1, cond);
224                                  IL.Node.addEdge (joinNd, IL.Stmt.entry next);                                    IL.Node.addEdge (IL.CFG.exit cfg1, joinNd));
225                                  (stm, last, env, assigned)                                cvt (
226                                end                                  env,
227                                    IL.CFG{entry = IL.CFG.entry cfg, exit = joinNd},
228                                    stms))
229                            (* the join node has only zero predecessors, so
230                             * it was killed.
231                             *)
232                              | (env, NONE) => raise Fail "unimplemented" (* FIXME *)
233                          (* end case *)                          (* end case *)
234                        end                        end
235                    | S.S_New(name, xs) => let                    | S.S_New(strandId, args) => let
236                        val xs' = List.map (lookup env) xs                        val nd = IL.Node.mkNEW{
237                        in                                strand = strandId,
238                          case rest                                args = List.map (lookup env) args
239                           of [] => let                              }
                               val stm = IL.Stmt.mkNEW(name, xs', optExit)  
                               in  
                                 (stm, IL.Stmt.tail stm, env, assigned)  
                               end  
                           | _ => let  
                               val (next, last, env, assigned) = toStmt (env, assigned, rest)  
                               val stm = IL.Stmt.mkNEW(name, xs', SOME next)  
                               in  
                                 IL.Node.addEdge (IL.Stmt.tail stm, IL.Stmt.entry next);  
                                 (stm, last, env, assigned)  
                               end  
                       end  
                   | S.S_Die => let  
                       val stm = IL.Stmt.mkDIE()  
240                        in                        in
241                          (stm, IL.Stmt.tail stm, env, assigned)                          cvt (env, IL.CFG.appendNode (cfg, nd), stms)
242                        end                        end
243                      | S.S_Die => (
244                          killPath joinStk;
245                          (IL.CFG.appendNode (cfg, IL.Node.mkDIE ()), env))
246                    | S.S_Stabilize => let                    | S.S_Stabilize => let
247                        val stm = IL.Stmt.mkSTABILIZE()                        val stateOut = List.map (lookup env) state
248                        in                        in
249                          (stm, IL.Stmt.tail stm, env, assigned)                          killPath joinStk;
250                            (IL.CFG.appendNode (cfg, IL.Node.mkSTABILIZE stateOut), env)
251                        end                        end
252                  (* end case *))                  (* end case *))
253            in            in
254              toStmt (env, VSet.empty, stms)              cvt (env, IL.CFG.empty, stms)
255            end            end
256    
257      fun cvtTopLevelBlock (env, blk) = let      fun cvtTopLevelBlock (env, blk) = let
258            val exit = IL.Stmt.mkEXIT ()            val (cfg, env) = cvtBlock ([], env, [], blk)
259            val (stm, last, env, assigned) = cvtBlock (env, blk, SOME exit)            val entry = IL.Node.mkENTRY ()
260            val entry = IL.Stmt.mkENTRY (SOME stm)            val exit = IL.Node.mkRETURN (VMap.listItems env)
261            in            in
262              IL.Node.addEdge (IL.Stmt.tail entry, IL.Stmt.entry stm);              if IL.CFG.isEmpty cfg
263            (* NOTE: this could fail if all control paths end in DIE or STABILIZE, so we                then IL.Node.addEdge (entry, exit)
264             * wrap it in a handler                else (
265                    IL.Node.addEdge (entry, IL.CFG.entry cfg);
266                  (* NOTE: this addEdge could fail if all control paths end in DIE or STABILIZE,
267                   * so we wrap it in a handler
268             *)             *)
269              IL.Node.addEdge (last, IL.Stmt.entry exit) handle _ => ();                  IL.Node.addEdge (IL.CFG.exit cfg, exit) handle _ => ());
270              (entry, env)              (IL.CFG{entry = entry, exit = exit}, env)
271            end            end
272    
273    (* generate fresh SSA variables and add them to the environment *)  (* FIXME: the following function could be refactored with cvtTopLevelBlock to share code *)
274      fun freshVars (env, xs) = let      fun cvtFragmentBlock (env, blk) = let
275            fun cvtVar (x, (env, xs)) = let            val (cfg, env) = cvtBlock ([], env, [], blk)
276                  val x' = newVar x            val entry = IL.Node.mkENTRY ()
277                  in            val exit = IL.Node.mkFRAGMENT []
278                    (VMap.insert(env, x, x'), x'::xs)            in
279                if IL.CFG.isEmpty cfg
280                  then IL.Node.addEdge (entry, exit)
281                  else (
282                    IL.Node.addEdge (entry, IL.CFG.entry cfg);
283                  (* NOTE: this addEdge could fail if all control paths end in DIE or STABILIZE,
284                   * so we wrap it in a handler
285                   *)
286                    IL.Node.addEdge (IL.CFG.exit cfg, exit) handle _ => ());
287                (IL.CFG{entry = entry, exit = exit}, env)
288                  end                  end
289            val (env, xs) = List.foldl cvtVar (env, []) xs  
290        fun cvtMethod (env, name, state, blk) = let
291            (* allocate fresh variables for the state variables *)
292              val (env, stateIn) = freshVars (env, state)
293            (* convert the body of the method *)
294              val (cfg, env) = cvtBlock (state, env, [], blk)
295            (* add the entry/exit nodes *)
296              val stateOut = List.map (lookup env) state
297              val entry = IL.Node.mkENTRY ()
298              val exit = IL.Node.mkACTIVE stateOut
299            in            in
300              (env, List.rev xs)              if IL.CFG.isEmpty cfg
301                  then IL.Node.addEdge (entry, exit)
302                  else (
303                    IL.Node.addEdge (entry, IL.CFG.entry cfg);
304                  (* NOTE: this addEdge could fail if all control paths end in DIE or STABILIZE,
305                   * so we wrap it in a handler
306                   *)
307                    IL.Node.addEdge (IL.CFG.exit cfg, exit) handle _ => ());
308                IL.Method{
309                    name = name,
310                    stateIn = stateIn,
311                    body = IL.CFG{entry = entry, exit = exit}
312                  }
313            end            end
314    
315      fun translate (S.Program{globals, globalInit, strands}) = let    (* convert the initially code *)
316        fun cvtInitially (env, S.Initially{isArray, rangeInit, create, iters}) = let
317              val S.C_Create{argInit, name, args} = create
318              fun cvtIter ({param, lo, hi}, (env, iters)) = let
319                    val param' = newVar param
320                    val env = VMap.insert (env, param, param')
321                    val iter = (param', lookup env lo, lookup env hi)
322                    in
323                      (env, iter::iters)
324                    end
325              val (cfg, env) = cvtFragmentBlock (env, rangeInit)
326              val (env, iters) = List.foldl cvtIter (env, []) iters
327              val (argInitCFG, env) = cvtFragmentBlock (env, argInit)
328              in
329                IL.Initially{
330                    isArray = isArray,
331                    rangeInit = cfg,
332                    iters = List.rev iters,
333                    create = (argInitCFG, name, List.map (lookup env) args)
334                  }
335              end
336    
337        fun translate (S.Program{globals, globalInit, init, strands}) = let
338            val (globalInit, env) = cvtTopLevelBlock (VMap.empty, globalInit)            val (globalInit, env) = cvtTopLevelBlock (VMap.empty, globalInit)
339          (* get the SSA names for the globals and a reduced environment that just defines          (* construct a reduced environment that just defines the globals. *)
340           * the globals.            val env = let
          *)  
           val (env, globs) = let  
341                  val lookup = lookup env                  val lookup = lookup env
342                  fun cvtVar (x, (env, globs)) = let                  fun cvtVar (x, env) = VMap.insert(env, x, lookup x)
343                        val x' = lookup x                  val env = List.foldl cvtVar VMap.empty globals
344                        in                        in
345                          (VMap.insert(env, x, x'), x'::globs)                    env
                       end  
                 val (env, globs) = List.foldl cvtVar (VMap.empty, []) globals  
                 in  
                   (env, List.rev globs)  
346                  end                  end
347              val init = cvtInitially (env, init)
348            fun cvtStrand (S.Strand{name, params, state, stateInit, methods}) = let            fun cvtStrand (S.Strand{name, params, state, stateInit, methods}) = let
349                  val (env, params) = let                  val (env, params) = let
350                        fun cvtParam (x, (env, xs)) = let                        fun cvtParam (x, (env, xs)) = let
# Line 244  Line 357 
357                          (env, List.rev params)                          (env, List.rev params)
358                        end                        end
359                  val (stateInit, env) = cvtTopLevelBlock (env, stateInit)                  val (stateInit, env) = cvtTopLevelBlock (env, stateInit)
360                  val state' = List.map (lookup env) state                  val state' = let
361                  fun cvtMethod (S.Method(name, blk)) = let                        fun cvtStateVar x = (Var.kindOf x = S.StrandOutputVar, lookup env x)
                     (* allocate fresh variables for the state variables *)  
                       val (env, stateIn) = freshVars (env, state)  
                       val (body, env) = cvtTopLevelBlock (env, blk)  
                       val stateOut = List.map (lookup env) state  
362                        in                        in
363                          IL.Method{name=name, stateIn=stateIn, stateOut=stateOut, body=body}                          List.map cvtStateVar state
364                        end                        end
365                    fun cvtMeth (S.Method(name, blk)) = cvtMethod (env, name, state, blk)
366                  in                  in
367                    IL.Strand{                    IL.Strand{
368                        name = name,                        name = name,
369                        params = params,                        params = params,
370                        state = state',                        state = state',
371                        stateInit = stateInit,                        stateInit = stateInit,
372                        methods = List.map cvtMethod methods                        methods = List.map cvtMeth methods
373                      }                      }
374                  end                  end
375            val prog = IL.Program{            val prog = IL.Program{
                 globals = globs,  
376                  globalInit = globalInit,                  globalInit = globalInit,
377                      initially = init,
378                  strands = List.map cvtStrand strands                  strands = List.map cvtStrand strands
379                }                }
380            in            in

Legend:
Removed from v.1115  
changed lines
  Added in v.1116

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