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

SCM Repository

[diderot] Diff of /branches/pure-cfg/src/compiler/codegen/low-to-tree.sml
ViewVC logotype

Diff of /branches/pure-cfg/src/compiler/codegen/low-to-tree.sml

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

revision 541, Wed Feb 16 05:30:57 2011 UTC revision 542, Wed Feb 16 14:12:56 2011 UTC
# Line 192  Line 192 
192              (* end case *)              (* end case *)
193            end            end
194    
195        datatype open_if
196        (* working on the "then" branch.  The fields are statments that preceed the if, the condition,
197         * and the else-branch node.
198         *)
199          = THEN_BR of T.stm list * T.exp * IL.node
200        (* working on the "else" branch.  The fields are statments that preceed the if, the condition,
201         * the "then" branch statements, and the node that terminated the "then" branch (will be
202         * a JOIN, DIE, or STABILIZE).
203         *)
204          | ELSE_BR of T.stm list * T.exp * T.stm list * IL.node_kind
205    
206      fun trCFG (env, prefix, finish, cfg) = let      fun trCFG (env, prefix, finish, cfg) = let
207            fun doNode (env, ifCont : T.stm list * IL.node_kind -> T.block, stms, nd) = (            fun join (env, [], _, IL.JOIN _) = raise Fail "JOIN with no open if"
208  print(concat["doNode (_, _, ", Nd.toString nd, ")\n"]);              | join (env, [], _, _) = raise Fail "no path to exit unimplemented" (* FIXME *)
209                  case Nd.kind nd              | join (env, THEN_BR(stms1, cond, elseBr)::stk, stms, k) =
210                   of IL.NULL => raise Fail "unexpected NULL"                  doNode (env, ELSE_BR(stms1, cond, stms, k)::stk, [], elseBr)
211                    | IL.ENTRY{succ} => doNode (env, ifCont, stms, !succ)              | join (env, ELSE_BR(stms, cond, stms1, k1)::stk, stms2, k2) = let
212                    | IL.JOIN{phis, succ, ...} => ifCont (stms, Nd.kind nd)                  val (env, thenBlk) = endBlock (env, stms1)
213                    | IL.COND{cond, trueBranch, falseBranch, ...} => let                  val (env, elseBlk) = endBlock (env, stms2)
214                        val cond = useVar env cond                  in
215                        fun kThen (stms', _) = let                    case (k1, k2)
216                              val (env, thenBlk) = endBlock (env, stms')                     of (IL.JOIN{phis, succ, ...}, IL.JOIN _) => let
                             fun kElse (stms', IL.JOIN{phis, succ, ...}) = let  
                                   val (env, elseBlk) = endBlock (env, stms')  
217                                    val (env, [thenBlk, elseBlk]) =                                    val (env, [thenBlk, elseBlk]) =
218                                          List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)                                          List.foldl doPhi (env, [thenBlk, elseBlk]) (!phis)
219                                    val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)                                    val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
220                                    in                                    in
221                                      doNode (env, ifCont, stm::stms, !succ)                            doNode (env, stk, stm::stms, !succ)
222                                    end                                    end
223                        | (IL.JOIN{phis, succ, ...}, _) => let
224                            val (env, [thenBlk]) = List.foldl doPhi (env, [thenBlk]) (!phis)
225                            val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
226                              in                              in
227                                doNode (env, kElse, [], !falseBranch)                            doNode (env, stk, stm::stms, !succ)
228                              end                              end
229                        | (_, IL.JOIN{phis, succ, ...}) => let
230                            val (env, [elseBlk]) = List.foldl doPhi (env, [elseBlk]) (!phis)
231                            val stm = mkIf(cond, List.rev thenBlk, List.rev elseBlk)
232                        in                        in
233                          doNode (env, kThen, [], !trueBranch)                            doNode (env, stk, stm::stms, !succ)
234                            end
235                        | (_, _) => raise Fail "no path to exit unimplemented" (* FIXME *)
236                      (* end case *)
237                        end                        end
238              and doNode (env, ifStk : open_if list, stms, nd) = (
239                    case Nd.kind nd
240                     of IL.NULL => raise Fail "unexpected NULL"
241                      | IL.ENTRY{succ} => doNode (env, ifStk, stms, !succ)
242                      | k as IL.JOIN{phis, succ, ...} => join (env, ifStk, stms, k)
243                      | IL.COND{cond, trueBranch, falseBranch, ...} =>
244                          doNode (env, THEN_BR(stms, useVar env cond, !falseBranch)::ifStk, [], !trueBranch)
245                    | IL.COM {text, succ, ...} =>                    | IL.COM {text, succ, ...} =>
246                        doNode (env, ifCont, T.S_Comment text :: stms, !succ)                        doNode (env, ifStk, T.S_Comment text :: stms, !succ)
247                    | IL.ASSIGN{stm, succ, ...} => let                    | IL.ASSIGN{stm, succ, ...} => let
248                        val (env, stms') = doAssign (env, stm)                        val (env, stms') = doAssign (env, stm)
249                        in                        in
250                          doNode (env, ifCont, stms' @ stms, !succ)                          doNode (env, ifStk, stms' @ stms, !succ)
251                        end                        end
252                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
253  (* FIXME: this code is broken when we have one arm of a if-then-else that is a die or stabilize *)                    | k as IL.DIE _ => join (env, ifStk, T.S_Die :: stms, k)
254                    | IL.DIE _ =>                    | k as IL.STABILIZE _ => join (env, ifStk, T.S_Stabilize :: stms, k)
                       mkBlock (List.rev (T.S_Die :: stms))  
                   | IL.STABILIZE _ =>  
                       mkBlock (List.rev stms)  
255                    | IL.EXIT _ => let                    | IL.EXIT _ => let
256                        val suffix = finish env                        val suffix = finish env
257                        in                        in
# Line 237  Line 259 
259                        end                        end
260                  (* end case *))                  (* end case *))
261            in            in
262              doNode (env, fn _ => raise Fail "bogus ifCont at JOIN node", [], CFG.entry cfg)              doNode (env, [], [], CFG.entry cfg)
263            end            end
264    
265      fun trMethod (env, stateVars) (IL.Method{name, stateIn, stateOut, body}) = let      fun trMethod (env, stateVars) (IL.Method{name, stateIn, stateOut, body}) = let

Legend:
Removed from v.541  
changed lines
  Added in v.542

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