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

SCM Repository

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

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

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

revision 3471, Mon Nov 30 18:23:37 2015 UTC revision 3493, Fri Dec 11 18:29:21 2015 UTC
# Line 5  Line 5 
5   * COPYRIGHT (c) 2015 The University of Chicago   * COPYRIGHT (c) 2015 The University of Chicago
6   * All rights reserved.   * All rights reserved.
7   *   *
8   * Translate Simple-AST code into the IL representation.  This translation is based on the   * Translate Simple-AST code into the HighIR representation.  This translation is based on the
9   * algorithm described in   * algorithm described in
10   *   *
11   *      Single-pass generation of static single assignment form for structured languages   *      Single-pass generation of static single assignment form for structured languages
# Line 15  Line 15 
15    
16  structure Translate : sig  structure Translate : sig
17    
18      val translate : Simple.program -> HighIL.program      val translate : Simple.program -> HighIR.program
19    
20    end = struct    end = struct
21    
22      structure S = Simple      structure S = Simple
23      structure Ty = SimpleTypes      structure Ty = SimpleTypes
24      structure VMap = SimpleVar.Map      structure SV = SimpleVar
25      structure VSet = SimpleVar.Set      structure VMap = SV.Map
26      structure IL = HighIL      structure VSet = SV.Set
27        structure IR = HighIR
28      structure Op = HighOps      structure Op = HighOps
29      structure DstTy = HighILTypes      structure DstTy = HighTypes
30      structure Census = HighILCensus      structure Census = HighCensus
31        structure Inp = Inputs
32    
33      val cvtTy = TranslateTy.tr      val cvtTy = TranslateTy.tr
34    
35    (* maps from SimpleAST variables to the current corresponding SSA variable *)    (* maps from SimpleAST variables to the current corresponding SSA variable *)
36      type env = IL.var VMap.map      type env = IR.var VMap.map
37    
38  (* +DEBUG *)  (* +DEBUG *)
39      fun prEnv (prefix, env) = let      fun prEnv (prefix, env) = let
# Line 40  Line 42 
42            fun nl () = if (!wid > 0) then (print "\n"; wid := 0) else ()            fun nl () = if (!wid > 0) then (print "\n"; wid := 0) else ()
43            fun prElem (src, dst) = let            fun prElem (src, dst) = let
44                  val s = String.concat [                  val s = String.concat [
45                          " ", SimpleVar.uniqueNameOf src, "->", IL.Var.toString dst                          " ", SV.uniqueNameOf src, "->", IR.Var.toString dst
46                        ]                        ]
47                  in                  in
48                    pr s;                    pr s;
# Line 56  Line 58 
58      fun lookup env x = (case VMap.find (env, x)      fun lookup env x = (case VMap.find (env, x)
59             of SOME x' => x'             of SOME x' => x'
60              | NONE => raise Fail(concat[              | NONE => raise Fail(concat[
61                    "no binding for ", SimpleVar.uniqueNameOf x, " in environment"                    "no binding for ", SV.uniqueNameOf x, " in environment"
62                  ])                  ])
63            (* end case *))            (* end case *))
64    
65    (* create a new instance of a variable *)    (* create a new instance of a variable *)
66      fun newVar x = IL.Var.new (SimpleVar.nameOf x, cvtTy(SimpleVar.typeOf x))      fun newVar x = IR.Var.new (SV.nameOf x, cvtTy(SV.typeOf x))
67    
68    (* generate fresh SSA variables and add them to the environment *)    (* generate fresh SSA variables and add them to the environment *)
69      fun freshVars (env, xs) = let      fun freshVars (env, xs) = let
# Line 82  Line 84 
84          env : env,                      (* the environment that was current at the conditional *)          env : env,                      (* the environment that was current at the conditional *)
85                                          (* associated with this node. *)                                          (* associated with this node. *)
86          arity : int ref,                (* actual number of predecessors *)          arity : int ref,                (* actual number of predecessors *)
87          nd : IL.node,                   (* the CFG node for this pending join *)          nd : IR.node,                   (* the CFG node for this pending join *)
88          phiMap : (IL.var * IL.var list) VMap.map ref,          phiMap : (IR.var * IR.var list) VMap.map ref,
89                                          (* a mapping from Simple AST variables that are assigned *)                                          (* a mapping from Simple AST variables that are assigned *)
90                                          (* to their phi nodes. *)                                          (* to their phi nodes. *)
91          predKill : bool array           (* killed predecessor edges (because of DIE or STABILIZE *)          predKill : bool array           (* killed predecessor edges (because of DIE or STABILIZE *)
# Line 96  Line 98 
98    
99    (* create a new pending-join node *)    (* create a new pending-join node *)
100      fun newJoin (env, arity) = JOIN{      fun newJoin (env, arity) = JOIN{
101              env = env, arity = ref arity, nd = IL.Node.mkJOIN [], phiMap = ref VMap.empty,              env = env, arity = ref arity, nd = IR.Node.mkJOIN [], phiMap = ref VMap.empty,
102              predKill = Array.array(arity, false)              predKill = Array.array(arity, false)
103            }            }
104    
# Line 106  Line 108 
108            Array.update (predKill, i, true))            Array.update (predKill, i, true))
109        | killPath _ = ()        | killPath _ = ()
110    
111    (* record an assignment to the IL variable dstVar (corresponding to the Simple AST variable    (* record an assignment to the IR variable dstVar (corresponding to the Simple AST variable
112     * srcVar) in the current pending-join node.  The predIndex specifies which path into the     * srcVar) in the current pending-join node.  The predIndex specifies which path into the
113     * JOIN node this assignment occurs on.     * JOIN node this assignment occurs on.
114     *)     *)
# Line 123  Line 125 
125                          val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')                          val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')
126                          in                          in
127  (*  (*
128  print(concat["recordAssign: ", SimpleVar.uniqueNameOf srcVar, " --> ", IL.Var.toString lhs,  print(concat["recordAssign: ", SV.uniqueNameOf srcVar, " --> ", IR.Var.toString lhs,
129  " @ ", IL.Node.toString nd, "\n"]);  " @ ", IR.Node.toString nd, "\n"]);
130  *)  *)
131                            phiMap := VMap.insert (m, srcVar, (lhs, rhs))                            phiMap := VMap.insert (m, srcVar, (lhs, rhs))
132                          end                          end
# Line 144  Line 146 
146     * updating the environment.     * updating the environment.
147     *)     *)
148      fun commitJoin (joinStk, JOIN{env, arity, nd, phiMap, predKill}) = let      fun commitJoin (joinStk, JOIN{env, arity, nd, phiMap, predKill}) = let
149            val IL.JOIN{preds, mask, phis, ...} = IL.Node.kind nd            val IR.JOIN{preds, mask, phis, ...} = IR.Node.kind nd
150          (* update the predKill array based on reachability *)          (* update the predKill array based on reachability *)
151            val _ = let            val _ = let
152                  fun update (_, []) = ()                  fun update (_, []) = ()
153                    | update (i, nd::nds) = (                    | update (i, nd::nds) = (
154                        if IL.Node.isReachable nd then ()                        if IR.Node.isReachable nd then ()
155                        else if Array.sub(predKill, i) then ()                        else if Array.sub(predKill, i) then ()
156                        else (arity := !arity-1; Array.update(predKill, i, true));                        else (arity := !arity-1; Array.update(predKill, i, true));
157                        update (i+1, nds))                        update (i+1, nds))
# Line 175  Line 177 
177                          val dstVar = List.nth(xs, ix)                          val dstVar = List.nth(xs, ix)
178                          in                          in
179  (*  (*
180  print(concat["doVar (", SimpleVar.uniqueNameOf srcVar, ", ", IL.phiToString phi, ", _) @ ", IL.Node.toString nd, "\n"]);  print(concat["doVar (", SV.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);
181  *)  *)
182                            recordAssign (joinStk, srcVar, dstVar);                            recordAssign (joinStk, srcVar, dstVar);
183                            VMap.insert (env, srcVar, dstVar)                            VMap.insert (env, srcVar, dstVar)
# Line 197  Line 199 
199                              end                              end
200                        fun doVar (srcVar, phi as (dstVar, srcVars), (env, phis)) = (                        fun doVar (srcVar, phi as (dstVar, srcVars), (env, phis)) = (
201  (*  (*
202  print(concat["doVar (", SimpleVar.uniqueNameOf srcVar, ", ", IL.phiToString phi, ", _) @ ", IL.Node.toString nd, "\n"]);  print(concat["doVar (", SV.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);
203  *)  *)
204                              recordAssign (joinStk, srcVar, dstVar);                              recordAssign (joinStk, srcVar, dstVar);
205                              (VMap.insert (env, srcVar, dstVar), (dstVar, filterPhiRHS srcVars) ::phis))                              (VMap.insert (env, srcVar, dstVar), (dstVar, filterPhiRHS srcVars) ::phis))
# Line 211  Line 213 
213                            val xs = List.map SOME xs                            val xs = List.map SOME xs
214                            in                            in
215  (*  (*
216  print(concat["doVar (", SimpleVar.uniqueNameOf srcVar, ", ", IL.phiToString phi, ", _) @ ", IL.Node.toString nd, "\n"]);  print(concat["doVar (", SV.uniqueNameOf srcVar, ", ", IR.phiToString phi, ", _) @ ", IR.Node.toString nd, "\n"]);
217  *)  *)
218                              recordAssign (joinStk, srcVar, dstVar);                              recordAssign (joinStk, srcVar, dstVar);
219                              IL.Var.setBinding (dstVar, IL.VB_PHI xs);                              IR.Var.setBinding (dstVar, IR.VB_PHI xs);
220                              (VMap.insert (env, srcVar, dstVar), (dstVar, xs)::phis)                              (VMap.insert (env, srcVar, dstVar), (dstVar, xs)::phis)
221                            end                            end
222                      val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)                      val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)
# Line 227  Line 229 
229    
230    (* expression translation *)    (* expression translation *)
231      fun cvtExp (env : env, lhs, exp) = (case exp      fun cvtExp (env : env, lhs, exp) = (case exp
232             of S.E_Var x => [IL.ASSGN(lhs, IL.VAR(lookup env x))]             of S.E_Var x => [IR.ASSGN(lhs, IR.VAR(lookup env x))]
233              | S.E_Lit lit => [IL.ASSGN(lhs, IL.LIT lit)]              | S.E_Lit lit => [IR.ASSGN(lhs, IR.LIT lit)]
234              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"              | S.E_Select(x, fld) => raise Fail "FIXME"
235              | S.E_Apply _ => raise Fail "unexpected E_Apply"              | S.E_Apply _ => raise Fail "unexpected E_Apply"
236              | S.E_Prim(f, tyArgs, args, ty) => let              | S.E_Prim(f, tyArgs, args, ty) => let
237                  val args' = List.map (lookup env) args                  val args' = List.map (lookup env) args
238                  in                  in
239                    TranslateBasis.translate (lhs, f, tyArgs, args')                    TranslateBasis.translate (lhs, f, tyArgs, args')
240                  end                  end
241              | S.E_Cons(args, _) => [IL.ASSGN(lhs, IL.CONS(List.map (lookup env) args, IL.Var.ty lhs))]              | S.E_Tensor(args, _) => [IR.ASSGN(lhs, IR.CONS(List.map (lookup env) args, IR.Var.ty lhs))]
242              | S.E_Seq(args, _) => [IL.ASSGN(lhs, IL.SEQ(List.map (lookup env) args, IL.Var.ty lhs))]              | S.E_Seq(args, _) => [IR.ASSGN(lhs, IR.SEQ(List.map (lookup env) args, IR.Var.ty lhs))]
243              | S.E_Slice(x, indices, ty) => let              | S.E_Slice(x, indices, ty) => let
244                  val x = lookup env x                  val x = lookup env x
245                  val mask = List.map isSome indices                  val mask = List.map isSome indices
# Line 246  Line 248 
248                  val indices = List.mapPartial cvt indices                  val indices = List.mapPartial cvt indices
249                  in                  in
250                    if List.all (fn b => b) mask                    if List.all (fn b => b) mask
251                      then [IL.ASSGN(lhs, IL.OP(Op.TensorSub(IL.Var.ty x), x::indices))]                      then [IR.ASSGN(lhs, IR.OP(Op.TensorSub(IR.Var.ty x), x::indices))]
252                      else [IL.ASSGN(lhs, IL.OP(Op.Slice(IL.Var.ty x, mask), x::indices))]                      else [IR.ASSGN(lhs, IR.OP(Op.Slice(IR.Var.ty x, mask), x::indices))]
253                  end                  end
254              | S.E_Coerce{srcTy, dstTy, x} => (case (srcTy, dstTy)              | S.E_Coerce{srcTy, dstTy, x} => (case (srcTy, dstTy)
255                   of (Ty.T_Int, Ty.T_Tensor _) =>                   of (Ty.T_Int, Ty.T_Tensor _) =>
256                        [IL.ASSGN(lhs, IL.OP(Op.IntToReal, [lookup env x]))]                        [IR.ASSGN(lhs, IR.OP(Op.IntToReal, [lookup env x]))]
257                    | (Ty.T_Sequence(ty, n), Ty.T_DynSequence _) =>                    | (Ty.T_Sequence(ty, SOME n), Ty.T_Sequence(_, NONE)) =>
258                        [IL.ASSGN(lhs, IL.OP(Op.MkDynamic(cvtTy ty, n), [lookup env x]))]                        [IR.ASSGN(lhs, IR.OP(Op.MkDynamic(cvtTy ty, n), [lookup env x]))]
259                    | (Ty.T_Field _, Ty.T_Field _) =>                    | (Ty.T_Field _, Ty.T_Field _) =>
260                      (* change in continuity is a no-op *)                      (* change in continuity is a no-op *)
261                        [IL.ASSGN(lhs, IL.VAR(lookup env x))]                        [IR.ASSGN(lhs, IR.VAR(lookup env x))]
262                    | _ => raise Fail(concat[                    | _ => raise Fail(concat[
263                          "unsupported type coercion: ", Ty.toString srcTy,                          "unsupported type coercion: ", Ty.toString srcTy,
264                          " ==> ", Ty.toString dstTy                          " ==> ", Ty.toString dstTy
265                        ])                        ])
266                  (* end case *))                  (* end case *))
267              | S.E_LoadSeq(ty, nrrd) => [IL.ASSGN(lhs, IL.OP(Op.LoadSeq(cvtTy ty, nrrd), []))]              | S.E_LoadSeq(ty, nrrd) => [IR.ASSGN(lhs, IR.OP(Op.LoadSeq(cvtTy ty, nrrd), []))]
268              | S.E_LoadImage(_, nrrd, info) => [IL.ASSGN(lhs, IL.OP(Op.LoadImage(DstTy.ImageTy info, nrrd), []))]              | S.E_LoadImage(_, nrrd, info) => [IR.ASSGN(lhs, IR.OP(Op.LoadImage(DstTy.ImageTy info, nrrd), []))]
269            (* end case *))            (* end case *))
270    
271    (* add nodes to save the strand state, followed by an exit node *)    (* add nodes to save the strand state, followed by an exit node *)
272      fun saveStrandState (env, (srcState, dstState), exit) = let      fun saveStrandState (env, (srcState, dstState), exit) = let
273            val stateOut = List.map (lookup env) srcState            val stateOut = List.map (lookup env) srcState
274            fun save (x, x', cfg) = IL.CFG.appendNode (cfg, IL.Node.mkSAVE(x, x'))            fun save (x, x', cfg) = IR.CFG.appendNode (cfg, IR.Node.mkSAVE(x, x'))
275            in            in
276              IL.CFG.appendNode (              IR.CFG.appendNode (
277                ListPair.foldlEq save IL.CFG.empty (dstState, stateOut),                ListPair.foldlEq save IR.CFG.empty (dstState, stateOut),
278                exit)                exit)
279            end            end
280  (*DEBUG*)handle ex => raise ex  (*DEBUG*)handle ex => raise ex
# Line 280  Line 282 
282      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let      fun cvtBlock (state, env : env, joinStk, S.Block stms) = let
283            fun cvt (env : env, cfg, []) = (cfg, env)            fun cvt (env : env, cfg, []) = (cfg, env)
284              | cvt (env, cfg, stm::stms) = (case stm              | cvt (env, cfg, stm::stms) = (case stm
285                   of S.S_Var x => let                   of S.S_Var(x, NONE) => let
286                        val x' = newVar x                        val x' = newVar x
287                        in                        in
288                          cvt (VMap.insert (env, x, x'), cfg, stms)                          cvt (VMap.insert (env, x, x'), cfg, stms)
289                        end                        end
290                      | S.S_Var(x, SOME e) => let
291                          val x' = newVar x
292                          val assigns = cvtExp (env, x', e)
293                          in
294                            recordAssign (joinStk, x, x');
295                            cvt (
296                              VMap.insert(env, x, x'),
297                              IR.CFG.concat(cfg, IR.CFG.mkBlock assigns),
298                              stms)
299                          end
300                    | S.S_Assign(lhs, rhs) => let                    | S.S_Assign(lhs, rhs) => let
301                        val lhs' = newVar lhs                        val lhs' = newVar lhs
302                        val assigns = cvtExp (env, lhs', rhs)                        val assigns = cvtExp (env, lhs', rhs)
# Line 295  Line 307 
307                          recordAssign (joinStk, lhs, lhs');                          recordAssign (joinStk, lhs, lhs');
308                          cvt (                          cvt (
309                            VMap.insert(env, lhs, lhs'),                            VMap.insert(env, lhs, lhs'),
310                            IL.CFG.concat(cfg, IL.CFG.mkBlock assigns),                            IR.CFG.concat(cfg, IR.CFG.mkBlock assigns),
311                            stms)                            stms)
312                        end                        end
313                    | S.S_IfThenElse(x, b0, b1) => let                    | S.S_IfThenElse(x, b0, b1) => let
# Line 303  Line 315 
315                        val join as JOIN{nd=joinNd, ...} = newJoin (env, 2)                        val join as JOIN{nd=joinNd, ...} = newJoin (env, 2)
316                        val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, b0)                        val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, b0)
317                        val (cfg1, _) = cvtBlock (state, env, (1, join)::joinStk, b1)                        val (cfg1, _) = cvtBlock (state, env, (1, join)::joinStk, b1)
318                        val cond = IL.Node.mkCOND x'                        val cond = IR.Node.mkCOND x'
319                        fun addEdgeToJoin nd = (case IL.Node.kind nd                        fun addEdgeToJoin nd = (case IR.Node.kind nd
320                               of IL.EXIT{succ, ...} => (                               of IR.EXIT{succ, ...} => (
321                                    succ := SOME joinNd;                                    succ := SOME joinNd;
322                                    IL.Node.setPred (joinNd, nd))  (* will be converted to fake later *)                                    IR.Node.setPred (joinNd, nd))  (* will be converted to fake later *)
323                                | _ => IL.Node.addEdge(nd, joinNd)                                | _ => IR.Node.addEdge(nd, joinNd)
324                              (* end case *))                              (* end case *))
325                      (* package the CFG the represents the conditional (cond, two blocks, and join) *)                      (* package the CFG the represents the conditional (cond, two blocks, and join) *)
326  (* QUESTION: under what conditions do we insert an UNREACHABLE exit node?  Is it when there  (* QUESTION: under what conditions do we insert an UNREACHABLE exit node?  Is it when there
327   * are no real predecessors to the join and the join stack is empty?   * are no real predecessors to the join and the join stack is empty?
328   *)   *)
329                        val condCFG = (                        val condCFG = (
330                              if IL.CFG.isEmpty cfg0                              if IR.CFG.isEmpty cfg0
331                                then (                                then (
332                                  IL.Node.setTrueBranch (cond, joinNd);                                  IR.Node.setTrueBranch (cond, joinNd);
333                                  IL.Node.setPred (joinNd, cond))                                  IR.Node.setPred (joinNd, cond))
334                                else (                                else (
335                                  IL.Node.setTrueBranch (cond, IL.CFG.entry cfg0);                                  IR.Node.setTrueBranch (cond, IR.CFG.entry cfg0);
336                                  IL.Node.setPred (IL.CFG.entry cfg0, cond);                                  IR.Node.setPred (IR.CFG.entry cfg0, cond);
337                                  addEdgeToJoin (IL.CFG.exit cfg0));                                  addEdgeToJoin (IR.CFG.exit cfg0));
338                              if IL.CFG.isEmpty cfg1                              if IR.CFG.isEmpty cfg1
339                                then (                                then (
340                                  IL.Node.setFalseBranch (cond, joinNd);                                  IR.Node.setFalseBranch (cond, joinNd);
341                                  IL.Node.setPred (joinNd, cond))                                  IR.Node.setPred (joinNd, cond))
342                                else (                                else (
343                                  IL.Node.setFalseBranch (cond, IL.CFG.entry cfg1);                                  IR.Node.setFalseBranch (cond, IR.CFG.entry cfg1);
344                                  IL.Node.setPred (IL.CFG.entry cfg1, cond);                                  IR.Node.setPred (IR.CFG.entry cfg1, cond);
345                                  addEdgeToJoin (IL.CFG.exit cfg1));                                  addEdgeToJoin (IR.CFG.exit cfg1));
346                              IL.CFG{entry = cond, exit = joinNd})                              IR.CFG{entry = cond, exit = joinNd})
347                        val env = commitJoin (joinStk, join)                        val env = commitJoin (joinStk, join)
348                        in                        in
349                          cvt (env, IL.CFG.concat (cfg, condCFG), stms)                          cvt (env, IR.CFG.concat (cfg, condCFG), stms)
350                        end                        end
351                    | S.S_New(strandId, args) => let                    | S.S_New(strandId, args) => let
352                        val nd = IL.Node.mkNEW{                        val nd = IR.Node.mkNEW{
353                                strand = strandId,                                strand = strandId,
354                                args = List.map (lookup env) args                                args = List.map (lookup env) args
355                              }                              }
356                        in                        in
357                          cvt (env, IL.CFG.appendNode (cfg, nd), stms)                          cvt (env, IR.CFG.appendNode (cfg, nd), stms)
358                        end                        end
359                    | S.S_Continue => (                    | S.S_Continue => (
360                        killPath joinStk;                        killPath joinStk;
361                        (IL.CFG.concat (cfg, saveStrandState (env, state, IL.Node.mkACTIVE())), env))                        (IR.CFG.concat (cfg, saveStrandState (env, state, IR.Node.mkACTIVE())), env))
362                    | S.S_Die => (                    | S.S_Die => (
363                        killPath joinStk;                        killPath joinStk;
364                        (IL.CFG.appendNode (cfg, IL.Node.mkDIE ()), env))                        (IR.CFG.appendNode (cfg, IR.Node.mkDIE ()), env))
365                    | S.S_Stabilize => (                    | S.S_Stabilize => (
366                        killPath joinStk;                        killPath joinStk;
367                        (IL.CFG.concat (cfg, saveStrandState (env, state, IL.Node.mkSTABILIZE())), env))                        (IR.CFG.concat (cfg, saveStrandState (env, state, IR.Node.mkSTABILIZE())), env))
368                    | S.S_Return _ => raise Fail "unexpected return"                    | S.S_Return _ => raise Fail "unexpected return"
369                    | S.S_Print args => let                    | S.S_Print args => let
370                        val args = List.map (lookup env) args                        val args = List.map (lookup env) args
371                        val nd = IL.Node.mkMASSIGN([], Op.Print(List.map IL.Var.ty args), args)                        val nd = IR.Node.mkMASSIGN([], Op.Print(List.map IR.Var.ty args), args)
372                        in                        in
373                          cvt (env, IL.CFG.appendNode (cfg, nd), stms)                          cvt (env, IR.CFG.appendNode (cfg, nd), stms)
374                        end                        end
375                  (* end case *))                  (* end case *))
376            in            in
377              cvt (env, IL.CFG.empty, stms)              cvt (env, IR.CFG.empty, stms)
           end  
 (*DEBUG*)handle ex => raise ex  
   
     fun cvtFragmentBlock (env0, prefixCFG, blk) = let  
           val (cfg, env) = cvtBlock (([], []), env0, [], blk)  
           val cfg = IL.CFG.concat(prefixCFG, cfg)  
           val entry = IL.Node.mkENTRY ()  
         (* the live variables out are those that were not live coming in *)  
           val liveOut = VMap.foldli  
                 (fn (x, x', xs) => if VMap.inDomain(env0, x) then xs else x'::xs)  
                   [] env  
           val exit = IL.Node.mkFRAGMENT liveOut  
           in  
             if IL.CFG.isEmpty cfg  
               then IL.Node.addEdge (entry, exit)  
               else (  
                 IL.Node.addEdge (entry, IL.CFG.entry cfg);  
                 IL.Node.addEdge (IL.CFG.exit cfg, exit));  
             (IL.CFG{entry = entry, exit = exit}, env)  
378            end            end
379  (*DEBUG*)handle ex => raise ex  (*DEBUG*)handle ex => raise ex
380    
# Line 392  Line 385 
385            val (env, loadCFG) = let            val (env, loadCFG) = let
386                (* allocate shadow variables for the state variables *)                (* allocate shadow variables for the state variables *)
387                  val (env, stateIn) = freshVars (env, state)                  val (env, stateIn) = freshVars (env, state)
388                  fun load (x, x') = IL.ASSGN(x, IL.STATE x')                  fun load (x, x') = IR.ASSGN(x, IR.STATE x')
389                  val cfg = IL.CFG.mkBlock (ListPair.map load (stateIn, svars))                  val cfg = IR.CFG.mkBlock (ListPair.map load (stateIn, svars))
390                  in                  in
391                    (env, IL.CFG.concat(loadGlobsCFG, cfg))                    (env, IR.CFG.concat(loadGlobsCFG, cfg))
392                  end                  end
393          (* convert the body of the method *)          (* convert the body of the method *)
394            val (cfg, env) = cvtBlock ((state, svars), env, [], blk)            val (cfg, env) = cvtBlock ((state, svars), env, [], blk)
395          (* add the entry/exit nodes *)          (* add the entry/exit nodes *)
396            val entry = IL.Node.mkENTRY ()            val entry = IR.Node.mkENTRY ()
397            val loadCFG = IL.CFG.prependNode (entry, loadCFG)            val loadCFG = IR.CFG.prependNode (entry, loadCFG)
398            val exit = (case name            val exit = (case name
399                   of StrandUtil.Initially => IL.Node.mkACTIVE ()                   of StrandUtil.Initially => IR.Node.mkACTIVE ()
400                    | StrandUtil.Update => IL.Node.mkACTIVE ()                    | StrandUtil.Update => IR.Node.mkACTIVE ()
401                    | StrandUtil.Stabilize => IL.Node.mkRETURN []                    | StrandUtil.Stabilize => IR.Node.mkRETURN []
402                  (* end case *))                  (* end case *))
403            val body = IL.CFG.concat (loadCFG, cfg)            val body = IR.CFG.concat (loadCFG, cfg)
404  (*DEBUG**val _ = prEnv (StrandUtil.nameToString name, env);*)  (*DEBUG**val _ = prEnv (StrandUtil.nameToString name, env);*)
405  (* FIXME: the following code doesn't work properly *)  (* FIXME: the following code doesn't work properly *)
406            val body = if IL.Node.hasSucc(IL.CFG.exit body)            val body = if IR.Node.hasSucc(IR.CFG.exit body)
407                  then IL.CFG.concat (body, saveStrandState (env, (state, svars), exit))                  then IR.CFG.concat (body, saveStrandState (env, (state, svars), exit))
408                  else IL.CFG{entry = IL.CFG.entry body, exit = exit}                  else IR.CFG{entry = IR.CFG.entry body, exit = exit}
409            in            in
410              IL.Method{              IR.Method{
411                  name = name,                  name = name,
412                  body = body                  body = body
413                }                }
414            end            end
415  (*DEBUG*)handle ex => (print(concat["error in cvtMethod(", StrandUtil.nameToString name, ", ...)\n"]); raise ex)  (*DEBUG*)handle ex => (print(concat["error in cvtMethod(", StrandUtil.nameToString name, ", ...)\n"]); raise ex)
416    
417    (* convert the initially code *)    (* convert the initial strand creation code *)
418      fun cvtInitially (loadGlobals, S.Initially{isArray, rangeInit, create, iters}) = let      fun cvtCreate (loadGlobals, S.Create{dim, code}) = let
419            (* load the globals into fresh variables *)
420            val (loadCFG, env) = loadGlobals VMap.empty            val (loadCFG, env) = loadGlobals VMap.empty
421            val S.C_Create{argInit, name, args} = create          (* convert the code *)
422            fun cvtIter ({param, lo, hi}, (env, iters)) = let            val (cfg, _) = cvtBlock (([], []), env, [], code)
                 val param' = newVar param  
                 val env = VMap.insert (env, param, param')  
                 val iter = (param', lookup env lo, lookup env hi)  
                 in  
                   (env, iter::iters)  
                 end  
           val (cfg, env) = cvtFragmentBlock (env, loadCFG, rangeInit)  
           val (env, iters) = List.foldl cvtIter (env, []) iters  
           val (argInitCFG, env) = cvtFragmentBlock (env, IL.CFG.empty, argInit)  
423            in            in
424              IL.Initially{              IR.Initially{
425                  isArray = isArray,                  isArray = isArray,
426                  rangeInit = cfg,                  rangeInit = cfg,
427                  iters = List.rev iters,                  iters = List.rev iters,
# Line 447  Line 432 
432    
433    (* a function for generating a block of assignments to load globals *)    (* a function for generating a block of assignments to load globals *)
434      fun loadGlobs globs env = let      fun loadGlobs globs env = let
435            fun load (env, [], stms) = (IL.CFG.mkBlock(List.rev stms), env)            fun load (env, [], stms) = (IR.CFG.mkBlock(List.rev stms), env)
436              | load (env, (x, x')::globs, stms) = let              | load (env, (x, x')::globs, stms) = let
437                  val x'' = newVar x                  val x'' = newVar x
438                  val stm = IL.ASSGN(x'', IL.GLOBAL x')                  val stm = IR.ASSGN(x'', IR.GLOBAL x')
439                  val env = VMap.insert (env, x, x'')                  val env = VMap.insert (env, x, x'')
440                  in                  in
441                    load (env, globs, stm::stms)                    load (env, globs, stm::stms)
# Line 461  Line 446 
446    
447      fun cvtInputs (inputInit, inputs) = let      fun cvtInputs (inputInit, inputs) = let
448            val (initBlk, env) = cvtBlock (([], []), VMap.empty, [], inputInit)            val (initBlk, env) = cvtBlock (([], []), VMap.empty, [], inputInit)
449              fun cvt (S.INP{var, desc, init}, (gvs, stms)) = let
450                    val name = SV.nameOf var
451                    val var' = newVar var
452                    val ty' = IR.Var.ty var'
453                    val gVar = IR.GlobalVar.new(true, name, ty')
454                    val rhs = (case init
455                           of S.NoDefault =>
456                                Op.Input(Inp.INP{ty = ty', name = name, desc = desc, init = NONE})
457                            | S.ConstExpr => ??
458                            | S.LoadSeq nrrd => ??
459                            | S.Proxy(nrrd, info) => ??
460                            | S.Image info =>
461                                Op.InputWithDefault(Inp.INP{
462                                })
463                          (* end case *))
464                    val stms = IR.ASSGN(var', rhs) :: IR.GASSGN(gVar, var') :: stms
465                    in
466                      ((var, gVar)::gvs, stms)
467                    end
468            fun cvt ((x, inp), (gvs, stms)) = let            fun cvt ((x, inp), (gvs, stms)) = let
469                  val x' = newVar x                  val x' = newVar x
470                  val gx = IL.GlobalVar.new(                  val gx = IR.GlobalVar.new(
471                          true,                          true,
472                          SimpleVar.nameOf x,                          SV.nameOf x,
473                          cvtTy(SimpleVar.typeOf x))                          cvtTy(SV.typeOf x))
474                  val rhs = (case VMap.find(env, x)                  val rhs = (case VMap.find(env, x)
475                         of SOME dflt => IL.OP(Op.InputWithDefault(Inputs.map cvtTy inp), [dflt])                         of SOME dflt => IR.OP(Op.InputWithDefault(Inputs.map cvtTy inp), [dflt])
476                          | NONE => IL.OP(Op.Input(Inputs.map cvtTy inp), [])                          | NONE => IR.OP(Op.Input(Inputs.map cvtTy inp), [])
477                        (* end case *))                        (* end case *))
478                  val stms =  IL.ASSGN(x', rhs) :: IL.GASSGN(gx, x') :: stms                  val stms =  IR.ASSGN(x', rhs) :: IR.GASSGN(gx, x') :: stms
479                  in                  in
                   IL.GlobalVar.setBinding (gx, x');  
480                    ((x, gx)::gvs, stms)                    ((x, gx)::gvs, stms)
481                  end                  end
482            val (gvs, stms) = List.foldr cvt ([], []) inputs            val (gvs, stms) = List.foldr cvt ([], []) inputs
483            val cfg = IL.CFG.appendBlock (initBlk, stms)            val cfg = IR.CFG.appendBlock (initBlk, stms)
484            val cfg = IL.CFG.prependNode (IL.Node.mkENTRY(), cfg)            val cfg = IR.CFG.prependNode (IR.Node.mkENTRY(), cfg)
485            val cfg = IL.CFG.appendNode (cfg, IL.Node.mkRETURN [])            val cfg = IR.CFG.appendNode (cfg, IR.Node.mkRETURN [])
486            in            in
487              (cfg, gvs)              (cfg, gvs)
488            end            end
489    
490    (* convert Simple globals to HighIL globals and return a function that generates    (* convert Simple globals to HighIR globals and return a function that generates
491     * an initial binding of globals to local shadow variables.     * an initial binding of globals to local shadow variables.
492     *)     *)
493      fun cvtGlobals globals = let      fun cvtGlobals globals = let
494            fun cvt x = let            fun cvt x = let
495                  val gx = IL.GlobalVar.new(                  val gx = IR.GlobalVar.new(
496                          false,                          false,
497                          SimpleVar.nameOf x,                          SV.nameOf x,
498                          cvtTy(SimpleVar.typeOf x))                          cvtTy(SV.typeOf x))
499                  in                  in
500                    (x, gx)                    (x, gx)
501                  end                  end
# Line 500  Line 503 
503              List.map cvt globals              List.map cvt globals
504            end            end
505    
506      fun translate (S.Program{props, inputDefaults, inputs, globals, globalInit, init, strands, ...}) = let      fun translate prog = let
507              val S.Program{
508                      props, consts, inputs, constInit, globals, funcs, init, strand, create, update
509                    } = prog
510            val (inputInit, inputGlobs) = cvtInputs (inputDefaults, inputs)            val (inputInit, inputGlobs) = cvtInputs (inputDefaults, inputs)
511            val globals = cvtGlobals globals            val globals = cvtGlobals globals
512          (* create the global initialization code *)          (* create the global initialization code *)
# Line 510  Line 516 
516                 *)                 *)
517                  val (cfg, env) = loadGlobs inputGlobs VMap.empty                  val (cfg, env) = loadGlobs inputGlobs VMap.empty
518                  val (globBlk, env) = cvtBlock (([], []), env, [], globalInit)                  val (globBlk, env) = cvtBlock (([], []), env, [], globalInit)
519                (* build a sequence of statements for initializing the IL globals *)                (* build a sequence of statements for initializing the IR globals *)
520                  val saveGlobsBlk = let                  val saveGlobsBlk = let
521                        fun saveGlob (x, gx) = let                        fun saveGlob (x, gx) = let
522                              val x' = lookup env x (* the local variable that holds the global *)                              val x' = lookup env x (* the local variable that holds the global *)
523                              in                              in
524                                IL.GlobalVar.setBinding (gx, x');                                IR.GASSGN(gx, x')
                               IL.GASSGN(gx, x')  
525                              end                              end
526                        in                        in
527                          IL.CFG.mkBlock (List.map saveGlob globals)                          IR.CFG.mkBlock (List.map saveGlob globals)
528                        end                        end
529                  val cfg = IL.CFG.prependNode (IL.Node.mkENTRY(), cfg)                  val cfg = IR.CFG.prependNode (IR.Node.mkENTRY(), cfg)
530                  val cfg = IL.CFG.concat(cfg, globBlk)                  val cfg = IR.CFG.concat(cfg, globBlk)
531                  val cfg = IL.CFG.concat(cfg, saveGlobsBlk)                  val cfg = IR.CFG.concat(cfg, saveGlobsBlk)
532                  val cfg = IL.CFG.appendNode (cfg, IL.Node.mkRETURN [])                  val cfg = IR.CFG.appendNode (cfg, IR.Node.mkRETURN [])
533                  in                  in
534                    cfg                    cfg
535                  end                  end
# Line 544  Line 549 
549                        end                        end
550                (* create the state variables *)                (* create the state variables *)
551                  val svars = let                  val svars = let
552                        fun newSVar x = IL.StateVar.new (                        fun newSVar x = IR.StateVar.new (
553                              SimpleVar.kindOf x = S.StrandOutputVar,                              SV.kindOf x = SV.StrandOutputVar,
554                              SimpleVar.nameOf x, cvtTy(SimpleVar.typeOf x))                              SV.nameOf x, cvtTy(SV.typeOf x))
555                        in                        in
556                          List.map newSVar state                          List.map newSVar state
557                        end                        end
# Line 555  Line 560 
560                      (* load globals into local variables *)                      (* load globals into local variables *)
561                        val (loadGlobsCFG, env) = loadGlobals env                        val (loadGlobsCFG, env) = loadGlobals env
562                        val (cfg, env) = cvtBlock (([], []), env, [], stateInit)                        val (cfg, env) = cvtBlock (([], []), env, [], stateInit)
563                        val cfg = IL.CFG.concat(loadGlobsCFG, cfg)                        val cfg = IR.CFG.concat(loadGlobsCFG, cfg)
564                        val cfg = IL.CFG.prependNode (IL.Node.mkENTRY(), cfg)                        val cfg = IR.CFG.prependNode (IR.Node.mkENTRY(), cfg)
565                        val cfg = IL.CFG.concat (cfg,                        val cfg = IR.CFG.concat (cfg,
566                              saveStrandState (env, (state, svars), IL.Node.mkSINIT()))                              saveStrandState (env, (state, svars), IR.Node.mkSINIT()))
567                        in                        in
568                          (cfg, env)                          (cfg, env)
569                        end                        end
570                  fun cvtMeth (S.Method(name, blk)) =                  fun cvtMeth (S.Method(name, blk)) =
571                        cvtMethod (loadGlobals, env, name, state, svars, blk)                        cvtMethod (loadGlobals, env, name, state, svars, blk)
572                  in                  in
573                    IL.Strand{                    IR.Strand{
574                        name = name,                        name = name,
575                        params = params,                        params = params,
576                        state = svars,                        state = svars,
# Line 573  Line 578 
578                        methods = List.map cvtMeth methods                        methods = List.map cvtMeth methods
579                      }                      }
580                  end                  end
581            val prog = IL.Program{            val prog = IR.Program{
582                    props = props,                    props = props,
583                    globals = List.map #2 (inputGlobs @ globals),                    globals = List.map #2 (inputGlobs @ globals),
584                    inputInit = inputInit,                    inputInit = inputInit,

Legend:
Removed from v.3471  
changed lines
  Added in v.3493

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