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

SCM Repository

[diderot] Diff of /branches/pure-cfg/src/compiler/translate/translate.sml
ViewVC logotype

Diff of /branches/pure-cfg/src/compiler/translate/translate.sml

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

revision 493, Thu Jan 27 16:40:50 2011 UTC revision 494, Fri Jan 28 18:15:25 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 19  Line 24 
24      structure IL = HighIL      structure IL = HighIL
25      structure DstTy = HighILTypes      structure DstTy = HighILTypes
26    
27        type env = IL.var VMap.map
28    
29      fun lookup env x = (case VMap.find (env, x)      fun lookup env x = (case VMap.find (env, x)
30             of SOME x' => x'             of SOME x' => x'
31              | NONE => raise Fail(concat[              | NONE => raise Fail(concat[
# Line 45  Line 52 
52    (* create a new instance of a variable *)    (* create a new instance of a variable *)
53      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))
54    
55      (* a pending-join node tracks the phi nodes needed to join the assignments that flow into
56       * the join node.
57       *)
58        datatype join = JOIN of {
59            arity : int,                    (* number of predecessors *)
60            nd : IL.node,                   (* the CFG node for this pending join *)
61            phiMap : IL.phi VMap.map ref    (* a mapping from Simple AST variables that are assigned *)
62                                            (* to their phi nodes. *)
63          }
64    
65      (* create a new pending-join node *)
66        fun newJoin arity = JOIN{arity = arity, nd = IL.Node.mkJOIN [], phiMap = ref VMap.empty}
67    
68      (* record an assignment to the IL variable dstVar (corresponding to the Simple AST variable
69       * srcVar) in the current pending-join node.  The predIndex specifies which path into the
70       * JOIN node this assignment occurs on.
71       *)
72        fun recordAssign (env, JOIN{arity, phiMap, ...}, srcVar, dstVar, predIndex) = let
73              val m = !phiMap
74              val m'= (case VMap.find (m, srcVar)
75                     of NONE => let
76                          val dstVar' = newVar srcVar
77                          val dfltVar = lookup env srcVar
78                          val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dfltVar)
79                          in
80                            VMap.insert (m, srcVar, (dstVar', rhs))
81                          end
82                      | SOME(lhs, rhs) => let
83                          fun update (i, l as x::r) = if (i = predIndex)
84                                then dstVar::r
85                                else x::update(i+1, r)
86                            | update _ = raise Fail "invalid predecessor index"
87                          in
88                            VMap.insert (m, srcVar, (lhs, update(0, rhs)))
89                          end
90                    (* end case *))
91              in
92                phiMap := m'
93              end
94    
95      (* complete a pending join operation by filling in the phi nodes from the phi map and
96       * updating the environment.
97       *)
98        fun completeJoin (env, JOIN{nd, phiMap, ...}) = let
99              val IL.ND{kind=IL.JOIN{phis, ...}, ...} = nd
100              fun doVar (srcVar, phi as (dstVar, _), (env, phis)) =
101                    (VMap.insert (env, srcVar, dstVar), phi::phis)
102              val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)
103              in
104                phis := phis';
105                env
106              end
107    
108    (* expression translation *)    (* expression translation *)
109      fun cvtExp (env, lhs, exp) = (case exp      fun cvtExp (env, lhs, exp) = (case exp
110             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
# Line 75  Line 135 
135              | S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]              | S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]
136            (* end case *))            (* end case *))
137    
138        fun cvtBlock (env, blk, k : (env * IL.node * IL.node) -> IL.cfg) = raise Fail "cvtBlock"
139    
140    (*
141    (* convert a Simple AST block to an IL statement.  We return the statement that represents the    (* convert a Simple AST block to an IL statement.  We return the statement that represents the
142     * block, plus the environment mapping Simple AST variables to their current SSA representations     * block, plus the environment mapping Simple AST variables to their current SSA representations
143     * and the set of Simple AST variables that were assigned to in the block.     * and the set of Simple AST variables that were assigned to in the block.
# Line 186  Line 249 
249            in            in
250              toStmt (env, VSet.empty, stms)              toStmt (env, VSet.empty, stms)
251            end            end
252    *)
253    
254      fun cvtTopLevelBlock (env, blk) = let      fun cvtTopLevelBlock (env, blk) = let
255            val exit = IL.Stmt.mkEXIT ()            fun finish (env, firstNd, lastNd) = let
256            val (stm, last, env, assigned) = cvtBlock (env, blk, SOME exit)                  val entry = IL.Node.mkENTRY ()
257            val entry = IL.Stmt.mkENTRY (SOME stm)                  val exit = IL.Node.mkEXIT ()
258            in                  in
259              IL.Node.addEdge (IL.Stmt.tail entry, IL.Stmt.entry stm);                    IL.Node.addEdge (entry, firstNd);
260            (* NOTE: this could fail if all control paths end in DIE or STABILIZE, so we                  (* NOTE: this addEdge could fail if all control paths end in DIE or STABILIZE,
261             * wrap it in a handler                   * so we wrap it in a handler
262             *)             *)
263              IL.Node.addEdge (last, IL.Stmt.entry exit) handle _ => ();                    IL.Node.addEdge (lastNd, exit) handle _ => ();
264              (entry, env)                    IL.CFG{entry = ref entry, exit = ref exit}
265                    end
266              in
267                cvtBlock (env, blk, finish)
268            end            end
269    
270    (* generate fresh SSA variables and add them to the environment *)    (* generate fresh SSA variables and add them to the environment *)

Legend:
Removed from v.493  
changed lines
  Added in v.494

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