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 256, Mon Aug 9 17:28:57 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    (* expression translation *)    (* generate fresh SSA variables and add them to the environment *)
58      fun cvtExp (env, lhs, exp) = (case exp      fun freshVars (env, xs) = let
59             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]            fun cvtVar (x, (env, xs)) = let
60              | S.E_Lit lit => [(lhs, IL.LIT lit)]                  val x' = newVar x
             | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"  
             | S.E_Apply(f, tyArgs, args, ty) => let  
                 val args' = List.map (lookup env) args  
61                  in                  in
62                    TranslateBasis.translate (lhs, f, tyArgs, args')                    (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                  end
             | S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]  
             | S.E_Input(_, name, NONE) => [(lhs, IL.OP(HighOps.Input name, []))]  
             | S.E_Input(_, name, SOME dflt) =>  
                 [(lhs, IL.OP(HighOps.InputWithDefault name, [lookup env dflt]))]  
             | S.E_Field fld => [(lhs, IL.OP(HighOps.Field fld, []))]  
             | S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]  
           (* end case *))  
68    
69    (* convert a Simple AST block to an IL statement.  We return the statement that represents the    (* a pending-join node tracks the phi nodes needed to join the assignments
70     * block, plus the environment mapping Simple AST variables to their current SSA representations     * that flow into the join node.
    * and the set of Simple AST variables that were assigned to in the block.  
71     *)     *)
72      fun cvtBlock (env, S.Block stms, optExit) = let      datatype join = JOIN of {
73            fun toBlock (env, assigned, [], assignments) = let          env : env,                      (* the environment that was current at the conditional *)
74                  val stm = IL.Stmt.mkBLOCK(List.rev assignments, optExit)                                          (* associated with this node. *)
75                  in          arity : int ref,                (* actual number of predecessors *)
76                    (stm, IL.Stmt.tail stm, env, assigned)          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                  end
121              | toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let                      | SOME(lhs, rhs) => let
122                  val x' = newVar x                          fun update (i, l as x::r) = if (i = predIndex)
123                  val stms = cvtExp(env, x', e)                                then dstVar::r
124                  val assigned = VSet.add(assigned, x)                                else x::update(i+1, r)
125                  val env = VMap.insert(env, x, x')                            | update _ = raise Fail "invalid predecessor index"
126                  in                  in
127                    toBlock (env, assigned, rest, stms@assignments)                            phiMap := VMap.insert (m, srcVar, (lhs, update(0, rhs)))
128                  end                  end
129              | toBlock (env, assigned, stms, assignments) = let                    (* end case *))
130                  val (next, last, env, assigned) = toStmt (env, assigned, stms)              (* end case *)
                 val blk = IL.Stmt.mkBLOCK(List.rev assignments, SOME next)  
                 in  
                   IL.Node.addEdge (IL.Stmt.tail blk, IL.Stmt.entry next);  
                   (blk, last, env, assigned)  
131                  end                  end
132            and toStmt (env, assigned, []) = let  
133                (* this case only occurs for the empty else arm of an if-then-else statement *)    (* complete a pending join operation by filling in the phi nodes from the phi map and
134                  val stm = IL.Stmt.mkBLOCK([], optExit)     * 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                  in
151                    (stm, IL.Stmt.tail stm, env, assigned)                      phis := phis';
152                        (env, SOME nd)
153                  end                  end
154              | toStmt (env, assigned, stms as stm::rest) = (case stm                  else raise Fail "FIXME: prune killed paths."
155                   of S.S_Assign _ => toBlock (env, assigned, stms, [])            (* end case *))
156                    | S.S_IfThenElse(x, b1, b2) => let  
157                        val x' = lookup env x    (* expression translation *)
158                        val (s1, last1, env1, assigned1) = cvtBlock(env, b1, NONE)      fun cvtExp (env : env, lhs, exp) = (case exp
159                        val (s2, last2, env2, assigned2) = cvtBlock(env, b2, NONE)             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
160                        val assigned = VSet.union(assigned1, assigned2)              | S.E_Lit lit => [(lhs, IL.LIT lit)]
161  (* PROBLEM: what about variables that are assigned for the first time in one branch              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
162   * and not the other?  This situation should only occur for variables who's scope is              | S.E_Apply(f, tyArgs, args, ty) => let
163   * the branch of the if.  Short-term solution is to ignore variables that are defined                  val args' = List.map (lookup env) args
  * 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  
                                         val x' = newVar x  
164                                          in                                          in
165                                            (VMap.insert(env, x, x'), (x', [x1, x2])::phis)                    TranslateBasis.translate (lhs, f, tyArgs, args')
166                                          end                                          end
167                                      | _ => (env, phis)              | 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 (state, env : env, joinStk, S.Block stms) = let
187              fun cvt (env : env, cfg, []) = (cfg, env)
188                | cvt (env, cfg, stm::stms) = (case stm
189                     of S.S_Var x => let
190                          val x' = newVar x
191                              in                              in
192                                VSet.foldl mkPhi (env, []) assigned                          cvt (VMap.insert (env, x, x'), cfg, stms)
193                              end                              end
194                      | S.S_Assign(lhs, rhs) => let
195                          val lhs' = newVar lhs
196                          val assigns = cvtExp (env, lhs', rhs)
197                        in                        in
198                          case rest  (*
199                           of [] => let  print "doAssign\n";
200                                val join = IL.Stmt.mkJOIN (phis, optExit)  *)
201                                val joinNd = IL.Stmt.entry join                          recordAssign (joinStk, lhs, lhs');
202                                val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)                          cvt (
203                                in                            VMap.insert(env, lhs, lhs'),
204                                  IL.Node.addEdge (last2, joinNd);                            IL.CFG.concat(cfg, IL.CFG.mkBlock assigns),
205                                  IL.Node.addEdge (last1, joinNd);                            stms)
                                 (stm, joinNd, env, assigned)  
206                                end                                end
207                            | _ => let                    | S.S_IfThenElse(x, b0, b1) => let
208                                val (next, last, env, assigned) = toStmt (env, assigned, rest)                        val x' = lookup env x
209                                val join = IL.Stmt.mkJOIN (phis, SOME next)                        val join = newJoin (env, 2)
210                                val joinNd = IL.Stmt.entry join                        val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, b0)
211                                val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)                        val (cfg1, _) = cvtBlock (state, env, (1, join)::joinStk, b1)
212                          val cond = IL.Node.mkCOND {
213                                  cond = x',
214                                  trueBranch = IL.Node.dummy,
215                                  falseBranch = IL.Node.dummy
216                                }
217                                in                                in
218                                  IL.Node.addEdge (last2, joinNd);                          IL.Node.addEdge (IL.CFG.exit cfg, cond);
219                                  IL.Node.addEdge (last1, joinNd);                          case commitJoin (joinStk, join)
220                                  IL.Node.addEdge (joinNd, IL.Stmt.entry next);                           of (env, SOME joinNd) => (
221                                  (stm, last, env, assigned)                                if IL.CFG.isEmpty cfg0
222                                end                                  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 [] => 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()  
254                        in                        in
255                          (stm, IL.Stmt.tail stm, 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                    | S.S_Stabilize => let
261                        val stm = IL.Stmt.mkSTABILIZE()                        val stateOut = List.map (lookup env) state
262                        in                        in
263                          (stm, IL.Stmt.tail stm, env, assigned)                          killPath joinStk;
264                            (IL.CFG.appendNode (cfg, IL.Node.mkSTABILIZE stateOut), env)
265                        end                        end
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 cvtTopLevelBlock (env, blk) = let      fun cvtTopLevelBlock (env, blk, mkExit) = let
273            val exit = IL.Stmt.mkEXIT ()            val (cfg, env) = cvtBlock ([], env, [], blk)
274            val (stm, last, env, assigned) = cvtBlock (env, blk, SOME exit)            val entry = IL.Node.mkENTRY ()
275            val entry = IL.Stmt.mkENTRY (SOME stm)            val exit = mkExit env
276            in            in
277              IL.Node.addEdge (IL.Stmt.tail entry, IL.Stmt.entry stm);              if IL.CFG.isEmpty cfg
278            (* NOTE: this could fail if all control paths end in DIE or STABILIZE, so we                then IL.Node.addEdge (entry, exit)
279             * wrap it in a handler                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 (last, IL.Stmt.entry exit) handle _ => ();                  IL.Node.addEdge (IL.CFG.exit cfg, exit) handle _ => ());
285              (entry, env)              (IL.CFG{entry = entry, exit = exit}, env)
286            end            end
287    (*DEBUG*)handle ex => raise ex
288    
289    (* generate fresh SSA variables and add them to the environment *)  (* FIXME: the following function could be refactored with cvtTopLevelBlock to share code *)
290      fun freshVars (env, xs) = let      fun cvtFragmentBlock (env0, blk) = let
291            fun cvtVar (x, (env, xs)) = let            val (cfg, env) = cvtBlock ([], env0, [], blk)
292                  val x' = newVar x            val entry = IL.Node.mkENTRY ()
293                  in          (* the live variables out are those that were not live coming in *)
294                    (VMap.insert(env, x, x'), x'::xs)            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                  end
306            val (env, xs) = List.foldl cvtVar (env, []) xs  (*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            in
318              (env, List.rev xs)              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    (*DEBUG*)handle ex => (print(concat["error in cvtMethod(", Atom.toString name, ", ...)\n"]); raise ex)
333    
334      fun translate (S.Program{globals, globalInit, actors}) = let    (* convert the initially code *)
335            val (globalInit, env) = cvtTopLevelBlock (VMap.empty, globalInit)      fun cvtInitially (env, S.Initially{isArray, rangeInit, create, iters}) = let
336          (* get the SSA names for the globals and a reduced environment that just defines            val S.C_Create{argInit, name, args} = create
337           * the globals.            fun cvtIter ({param, lo, hi}, (env, iters)) = let
338           *)                  val param' = newVar param
339            val (env, globs) = let                  val env = VMap.insert (env, param, param')
340                  val lookup = lookup env                  val iter = (param', lookup env lo, lookup env hi)
341                  fun cvtVar (x, (env, globs)) = let                  in
342                        val x' = lookup x                    (env, iter::iters)
343                        in                  end
344                          (VMap.insert(env, x, x'), x'::globs)            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                        end
355                  val (env, globs) = List.foldl cvtVar (VMap.empty, []) globals  
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 209  Line 379 
379                        in                        in
380                          (env, List.rev params)                          (env, List.rev params)
381                        end                        end
382                  val (stateInit, env) = cvtTopLevelBlock (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                      (* allocate fresh variables for the state variables *)                        in
386                        val (env, stateIn) = freshVars (env, state)                          cvtTopLevelBlock (env, stateInit, mkExit)
387                        val (body, env) = cvtTopLevelBlock (env, blk)                        end
388                        val stateOut = List.map (lookup env) state                (* 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=name, stateIn=stateIn, stateOut=stateOut, body=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.256  
changed lines
  Added in v.1339

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