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

SCM Repository

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

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

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

revision 492, Wed Jan 26 17:42:05 2011 UTC revision 493, Thu Jan 27 16:40:50 2011 UTC
# Line 16  Line 16 
16      type var_env = DstIL.var SrcIL.Var.Tbl.hash_table      type var_env = DstIL.var SrcIL.Var.Tbl.hash_table
17    
18      val rename : (var_env * SrcIL.var) -> DstIL.var      val rename : (var_env * SrcIL.var) -> DstIL.var
19      val expand : (var_env * SrcIL.assign) -> DstIL.assign list      val expand : (var_env * SrcIL.assign) -> DstIL.cfg
20    
21    end    end
22    
# Line 27  Line 27 
27    
28      type var_env = DstIL.var SrcIL.Var.Tbl.hash_table      type var_env = DstIL.var SrcIL.Var.Tbl.hash_table
29    
30      val translate : var_env * SrcIL.stmt -> DstIL.stmt      val translate : var_env * SrcIL.cfg -> DstIL.cfg
31    
32    end = struct    end = struct
33    
34      structure SrcIL : SSA = Params.SrcIL      structure SrcIL = Params.SrcIL
35      structure SrcNd = SrcIL.Node      structure SrcNd = SrcIL.Node
36      structure DstIL : SSA = Params.DstIL      structure DstIL = Params.DstIL
37      structure DstNd = DstIL.Node      structure DstNd = DstIL.Node
38      structure DstStm = DstIL.Stmt      structure DstCFG = DstIL.CFG
39    
40      type var_env = Params.var_env      type var_env = Params.var_env
41    
# Line 46  Line 46 
46    
47      fun rename (E{vMap, ...}) x = Params.rename(vMap, x)      fun rename (E{vMap, ...}) x = Params.rename(vMap, x)
48    
49      fun expand (E{vMap, ...}) (assign, assigns') =      fun expand (E{vMap, ...}, assign) = Params.expand (vMap, assign)
           Params.expand (vMap, assign) @ assigns'  
50    
51      fun insertNd (E{ndMap, ...}, id, nd) = Stamp.Tbl.insert ndMap (id, nd)      fun insertNd (E{ndMap, ...}, id, nd) = Stamp.Tbl.insert ndMap (id, nd)
52    
53        fun findNd (E{ndMap, ...}) = Stamp.Tbl.find ndMap
54    
55      fun renameNd (E{ndMap, ...}) (nd as SrcIL.ND{id, ...}) = (      fun renameNd (E{ndMap, ...}) (nd as SrcIL.ND{id, ...}) = (
56            case Stamp.Tbl.find ndMap id            case Stamp.Tbl.find ndMap id
57             of SOME nd' => nd'             of SOME nd' => nd'
58              | NONE => raise Fail("unable to find " ^ SrcNd.toString nd)              | NONE => raise Fail("unable to find " ^ SrcNd.toString nd)
59            (* end case *))            (* end case *))
60    
61    (* the first pass creates the nodes of the DstIL CFG and defines      fun translateCFG (env, SrcIL.CFG{entry, exit}) = let
62     * the environment that maps from SrcIL nodes and variables to            val findNd = findNd env
    * DstIL nodes and variables.  
    *)  
     fun translateNodes (env, stm) = let  
63            fun trans (SrcIL.ND{id, kind, ...}) = let            fun trans (SrcIL.ND{id, kind, ...}) = let
64                  val newNd = (case kind                  fun newNd nd = (insertNd (env, id, nd); nd)
65                    in
66                      case findNd id
67                       of SOME nd => nd
68                        | NONE => (case kind
69                       of SrcIL.NULL => raise Fail "unexpected NULL node"                       of SrcIL.NULL => raise Fail "unexpected NULL node"
70                        | SrcIL.ENTRY _ => DstNd.mkENTRY()                            | SrcIL.ENTRY{succ} => let
71                        | SrcIL.JOIN{phis, ...} => let                                val nd = newNd (DstNd.mkENTRY())
72                                  in
73                                    DstNd.addEdge (nd, trans (!succ));
74                                    nd
75                                  end
76                              | SrcIL.JOIN{phis, succ, ...} => let
77                            fun cvtPhi (x, xs) =                            fun cvtPhi (x, xs) =
78                                  (rename env x, List.map (rename env) xs)                                  (rename env x, List.map (rename env) xs)
79                                  val nd = newNd (DstNd.mkJOIN(List.map cvtPhi (!phis)))
80                            in                            in
81                              DstNd.mkJOIN(List.map cvtPhi (!phis))                                  DstNd.addEdge (nd, trans (!succ));
82                                    nd
83                            end                            end
84                        | SrcIL.COND{cond, ...} => DstNd.mkCOND{                            | SrcIL.COND{cond, trueBranch, falseBranch, ...} => let
85                                  val nd = newNd (DstNd.mkCOND{
86                              cond = rename env cond,                              cond = rename env cond,
87                              trueBranch = DstNd.dummy,                              trueBranch = DstNd.dummy,
88                              falseBranch = DstNd.dummy                              falseBranch = DstNd.dummy
89                            }                                      })
90                        | SrcIL.BLOCK{body, ...} => let                                val trueB = trans (!trueBranch)
91                            val body' = List.foldr (expand env) [] (!body)                                val _ = (DstNd.setTrueBranch (nd, trueB); DstNd.setPred(trueB, nd))
92                                  val falseB = trans (!falseBranch)
93                                  val _ = (DstNd.setTrueBranch (nd, falseB); DstNd.setPred(falseB, nd))
94                            in                            in
95                              DstNd.mkBLOCK body'                                  nd
96                            end                            end
97                        | SrcIL.NEW{actor, args, ...} => DstNd.mkNEW{                            | SrcIL.COM{text, succ, ...} => let
98                              actor = actor,                                val nd = newNd (DstNd.mkCOM text)
                             args = List.map (rename env) args  
                           }  
                       | SrcIL.DIE _ => DstNd.mkDIE()  
                       | SrcIL.STABILIZE _ => DstNd.mkSTABILIZE()  
                       | SrcIL.EXIT _ => DstNd.mkEXIT()  
                    (* end case *))  
99                  in                  in
100                    insertNd (env, id, newNd)                                  DstNd.addEdge (nd, trans (!succ));
101                                    nd
102                  end                  end
103                              | SrcIL.ASSIGN{stm, succ, ...} => let
104                                  val DstIL.CFG{entry, exit} = expand (env, stm)
105            in            in
106              SrcIL.applyToNodes trans stm                                  DstNd.addEdge (!exit, trans (!succ));
107                                    !entry
108            end            end
109                              | SrcIL.NEW{actor, args, succ, ...} => let
110    (* the second pass copys the statement tree and sets the CFG edges; it                                val nd = newNd (DstNd.mkNEW{
111     * returns the new statement tree.                                        actor = actor,
112     *)                                        args = List.map (rename env) args
113      fun translateStmts (env, stm) = let                                      })
           val renameNd = renameNd env  
         (* set the CFG edges of the node corresponding to the source node *)  
           fun setEdges (srcNd as SrcIL.ND{kind, ...}) = let  
                 val dstNd as DstIL.ND{kind=dstKind, ...} = renameNd srcNd  
114                  in                  in
115                    case kind                                  DstNd.addEdge (nd, trans (!succ));
116                     of SrcIL.NULL => raise Fail "unexpected NULL node"                                  nd
                     | SrcIL.ENTRY{succ} => DstNd.setSucc(dstNd, renameNd(!succ))  
                     | SrcIL.JOIN{preds, succ, ...} => let  
                         val DstIL.JOIN{preds=dstPreds, ...} = dstKind  
                         in  
                           dstPreds := List.map renameNd (!preds);  
                           DstNd.setSucc (dstNd, renameNd(!succ))  
                         end  
                     | SrcIL.COND{pred, trueBranch, falseBranch, ...} => (  
                         DstNd.setPred (dstNd, renameNd(!pred));  
                         DstNd.setTrueBranch (dstNd, renameNd(!trueBranch));  
                         DstNd.setFalseBranch (dstNd, renameNd(!falseBranch)))  
                     | SrcIL.BLOCK{pred, succ, ...} => (  
                         DstNd.setPred (dstNd, renameNd(!pred));  
                         DstNd.setSucc (dstNd, renameNd(!succ)))  
                     | SrcIL.NEW{pred, succ, ...} => (  
                         DstNd.setPred (dstNd, renameNd(!pred));  
                         DstNd.setSucc (dstNd, renameNd(!succ)))  
                     | SrcIL.DIE{pred} => DstNd.setPred (dstNd, renameNd(!pred))  
                     | SrcIL.STABILIZE{pred} => DstNd.setPred (dstNd, renameNd(!pred))  
                     | SrcIL.EXIT{pred} => DstNd.setPred (dstNd, renameNd(!pred))  
                   (* end case *)  
117                  end                  end
118          (* translate statements *)                            | SrcIL.DIE _ => newNd (DstNd.mkDIE())
119            fun trans (SrcIL.STM{kind, next, ...}) = let                            | SrcIL.STABILIZE _ => newNd (DstNd.mkSTABILIZE())
120                  fun new kind' = DstStm.new(kind', Option.map trans next)                            | SrcIL.EXIT _ => newNd (DstNd.mkEXIT())
121                  in                         (* end case *))
                   case kind  
                    of SrcIL.S_SIMPLE nd => new (DstIL.S_SIMPLE(renameNd nd))  
                     | SrcIL.S_IF{cond, thenBranch, elseBranch} => new (DstIL.S_IF{  
                           cond = renameNd cond,  
                           thenBranch = trans thenBranch,  
                           elseBranch = trans elseBranch  
                         })  
                     | SrcIL.S_LOOP{hdr, cond, body} => new (DstIL.S_LOOP{  
                           hdr = trans hdr,  
                           cond = renameNd cond,  
                           body = trans body  
                         })  
122                    (* end case *)                    (* end case *)
123                  end                  end
124              val entry = trans (!entry)
125            in            in
126              SrcIL.applyToNodes setEdges stm;              DstIL.CFG{entry = ref entry, exit = ref (renameNd env (!exit))}
             trans stm  
127            end            end
128    
129      fun translate (vMap, stm) = let      fun translate (vMap, cfg) = let
130            val env = E{            val env = E{
131                    ndMap = Stamp.Tbl.mkTable (256, Fail "ndMap"),                    ndMap = Stamp.Tbl.mkTable (256, Fail "ndMap"),
132                    vMap = vMap                    vMap = vMap
133                  }                  }
           val _ = translateNodes (env, stm)  
134            in            in
135              translateStmts (env, stm)              translateCFG (env, cfg)
136            end            end
137    
138    end    end

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

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