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/ssa-fn.sml
[diderot] / branches / pure-cfg / src / compiler / IL / ssa-fn.sml  
ViewVC logotype

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

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

revision 654, Mon Mar 21 17:10:54 2011 UTC revision 655, Mon Mar 21 17:37:10 2011 UTC
# Line 173  Line 173 
173          val setTrueBranch : node * node -> unit  (* set trueBranch successor for COND node *)          val setTrueBranch : node * node -> unit  (* set trueBranch successor for COND node *)
174          val setFalseBranch : node * node -> unit (* set falseBranch successor for COND node *)          val setFalseBranch : node * node -> unit (* set falseBranch successor for COND node *)
175          val addEdge : node * node -> unit          val addEdge : node * node -> unit
176          (* replace in-going and out-going edges *)
177            val replaceInEdge : {src : node, oldDst : node, dst : node} -> unit
178            val replaceOutEdge : {oldSrc : node, src : node, dst : node} -> unit
179        (* constructors *)        (* constructors *)
180          val mkENTRY : unit -> node          val mkENTRY : unit -> node
181          val mkJOIN : (var * var list) list -> node          val mkJOIN : (var * var list) list -> node
# Line 519  Line 522 
522  (*DEBUG*)handle ex => (  (*DEBUG*)handle ex => (
523  print(concat["error in addEdge(", toString nd1, ",", toString nd2, ")\n"]);  print(concat["error in addEdge(", toString nd1, ",", toString nd2, ")\n"]);
524  raise ex)  raise ex)
525            fun replaceInEdge {src, oldDst, dst} = (
526                (* first set the successor of src *)
527                  case kind src
528                   of COND{trueBranch, falseBranch, ...} =>
529                        if same(!trueBranch, oldDst)
530                          then trueBranch := dst
531                          else falseBranch := dst
532                    | _ => setSucc (src, dst)
533                  (* end case *);
534                (* then set the predecessor of dst *)
535                  setPred (dst, src))
536    (*DEBUG*)handle ex => (
537    print(concat["error in replaceInEdge(", toString src, ",", toString oldDst, ",", toString dst, ")\n"]);
538    raise ex)
539            fun replaceOutEdge {oldSrc, src, dst} = (
540                (* first set the successor of src *)
541                  setSucc (src, dst);
542                (* then set the predecessor of dst *)
543                  case kind dst
544                   of JOIN{preds, ...} => let
545                        fun edit [] = raise Fail "replaceOutEdge: cannot find predecessor"
546                          | edit (nd::nds) = if same(nd, oldSrc) then src::nds else nd::edit nds
547                        in
548                          preds := edit (!preds)
549                        end
550                    | _ => setPred (dst, src)
551                  (* end case *))
552    (*DEBUG*)handle ex => (
553    print(concat["error in replaceOutEdge(", toString oldSrc, ",", toString src, ",", toString dst, ")\n"]);
554    raise ex)
555        (* properties *)        (* properties *)
556          fun newProp initFn =          fun newProp initFn =
557                PropList.newProp (fn (ND{props, ...}) => props, initFn)                PropList.newProp (fn (ND{props, ...}) => props, initFn)
# Line 605  Line 638 
638                (* end case *))                (* end case *))
639    
640        (* replace a simple node in a cfg with a subgraph *)        (* replace a simple node in a cfg with a subgraph *)
641          fun replaceNode (ND{kind, ...}, node) = (case kind          fun replaceNode (oldNd as ND{kind, ...}, node) = (case kind
642                 of ASSIGN{pred, succ, ...} => (                 of ASSIGN{pred, succ, ...} => (
643                      Node.addEdge (!pred, node);                      Node.replaceInEdge {src = !pred, oldDst = oldNd, dst = node};
644                      Node.addEdge (node, !succ))                      Node.replaceOutEdge {oldSrc = oldNd, src = node, dst = !succ})
645                  | _ => raise Fail "unsupported splice"                  | _ => raise Fail "unsupported replaceNode"
646                (* end case *))                (* end case *))
647    
648        (* replace a simple node in a cfg with a subgraph *)        (* replace a simple node in a cfg with a subgraph *)
# Line 618  Line 651 
651                  then deleteNode nd                  then deleteNode nd
652                  else (case kind                  else (case kind
653                     of ASSIGN{pred, succ, ...} => (                     of ASSIGN{pred, succ, ...} => (
654                          Node.addEdge (!pred, entry);                          Node.replaceInEdge {src = !pred, oldDst = nd, dst = entry};
655                          Node.addEdge (exit, !succ))                          Node.replaceOutEdge {oldSrc = nd, src = exit, dst = !succ})
656                      | _ => raise Fail "unsupported replaceNode"                      | _ => raise Fail "unsupported splice"
657                    (* end case *))                    (* end case *))
658    
659        (* concatenate two CFGs *)        (* concatenate two CFGs *)
Legend:
Removed from v.654  
changed lines
  Added in v.655
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge