From e9316bbf1b710b05e18f70959aec5ae99cd81fb0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= <cedric.pasteur@ens.fr>
Date: Tue, 19 Apr 2011 15:36:00 +0200
Subject: [PATCH] Interference graph ported to OCamlGraph

---
 compiler/myocamlbuild.ml                      |   3 +
 compiler/utilities/_tags                      |   2 +-
 .../utilities/minils/interference_graph.ml    | 133 ++++++++++++++++++
 3 files changed, 137 insertions(+), 1 deletion(-)
 create mode 100644 compiler/utilities/minils/interference_graph.ml

diff --git a/compiler/myocamlbuild.ml b/compiler/myocamlbuild.ml
index 0953dcd..e8c34d2 100644
--- a/compiler/myocamlbuild.ml
+++ b/compiler/myocamlbuild.ml
@@ -9,6 +9,9 @@ let df = function
       (* Tell ocamlbuild about Menhir library (needed by --table). *)
       ocaml_lib ~extern:true ~dir:"+menhirLib" "menhirLib";
 
+      (* Tell ocamlbuild about the ocamlgraph library. *)
+      ocaml_lib ~extern:true ~dir:"+ocamlgraph" "ocamlgraph";
+
       (* Menhir does not come with menhirLib.cmxa so we have to manually by-pass
          OCamlbuild's built-in logic and add the needed menhirLib.cmxa. *)
       flag ["link"; "native"; "link_menhirLib"] (S [A "-I"; A "+menhirLib";
diff --git a/compiler/utilities/_tags b/compiler/utilities/_tags
index d04f1bc..6ba28ef 100644
--- a/compiler/utilities/_tags
+++ b/compiler/utilities/_tags
@@ -1 +1 @@
-<global>:include
+<global> or <minils>:include
diff --git a/compiler/utilities/minils/interference_graph.ml b/compiler/utilities/minils/interference_graph.ml
new file mode 100644
index 0000000..a51d99f
--- /dev/null
+++ b/compiler/utilities/minils/interference_graph.ml
@@ -0,0 +1,133 @@
+open Graph
+
+type ilink =
+  | Iinterference
+  | Iaffinity
+  | Isame_value
+
+type ivar = Minils.extvalue_desc
+
+module VertexValue = struct
+  type t = ivar list ref
+  let compare = compare
+  let hash = Hashtbl.hash
+  let equal = (=)
+  let default = []
+end
+
+module EdgeValue = struct
+  type t = ilink
+  let default = Iinterference
+  let compare = compare
+end
+
+module G =
+struct
+  include Imperative.Graph.ConcreteLabeled(VertexValue)(EdgeValue)
+
+  let add_edge_v g n1 v n2 =
+    add_edge_e g (E.create n1 v n2)
+
+  let mem_edge_v g n1 n2 v =
+    try
+      (E.label (find_edge g n1 n2)) = v
+    with
+        Not_found -> false
+
+  let filter_succ g v n =
+    fold_succ_e (fun e acc -> if (E.label e) = v then (E.dst e)::acc else acc) g n []
+
+  let coalesce g n1 n2 =
+    if n1 <> n2 then (
+      iter_succ_e (fun e -> add_edge_e g (E.create n1 (E.label e) (E.dst e))) g n2;
+      let r = V.label n1 in
+        r := !(V.label n2) @ !r;
+        remove_vertex g n2
+    )
+
+end
+
+type interference_graph = {
+  g_type : Types.ty;
+  g_graph : G.t;
+  g_hash : (ivar, G.V.t) Hashtbl.t
+}
+
+(** Functions to create graphs and nodes *)
+
+let mk_node x =
+  G.V.create (ref [x])
+
+let add_node g n =
+  G.add_vertex g.g_graph n;
+  List.iter (fun x -> Hashtbl.add g.g_hash x n) !(G.V.label n)
+  (* Hashtbl.add g.g_tag_hash n.g_tag n;
+  n.g_graph <- Some g*)
+
+let node_for_value g x =
+  Hashtbl.find g.g_hash x
+
+let mk_graph nodes ty =
+  let g = { g_graph = G.create ();
+            g_type = ty;
+            g_hash = Hashtbl.create 100 } in
+    List.iter (add_node g) nodes;
+    g
+
+(** Functions to read the graph *)
+let interfere g n1 n2 =
+  G.mem_edge_v g.g_graph n1 n2 Iinterference
+
+let affinity g n1 n2 =
+  G.mem_edge_v g.g_graph n1 n2 Iaffinity
+
+let have_same_value g n1 n2 =
+  G.mem_edge_v g.g_graph n1 n2 Isame_value
+
+let interfere_with g n =
+  G.filter_succ g.g_graph Iinterference n
+
+let affinity_with g n =
+  G.filter_succ g.g_graph Iaffinity n
+
+let has_same_value_as g n =
+  G.filter_succ g.g_graph Isame_value n
+
+
+(** Functions to modify the graph *)
+
+let add_interference_link g n1 n2 =
+  if n1 <> n2 then (
+    G.remove_edge g.g_graph n1 n2;
+    G.add_edge_v g.g_graph n1 Iinterference n2
+  )
+
+let add_affinity_link g n1 n2 =
+  if n1 <> n2 && not (G.mem_edge g.g_graph n1 n2) then (
+    G.remove_edge g.g_graph n1 n2;
+    G.add_edge_v g.g_graph n1 Iaffinity n2
+  )
+
+let add_same_value_link g n1 n2 =
+  if n1 <> n2 && not (interfere g n1 n2) then (
+    G.remove_edge g.g_graph n1 n2;
+    G.add_edge_v g.g_graph n1 Isame_value n2
+  )
+
+let coalesce g n1 n2 =
+  let find_wrong_same_value () =
+    let filter_same_value e acc =
+      if (G.E.label e) = Isame_value && not(have_same_value g n2 (G.E.dst e)) then
+        (G.E.dst e)::acc
+      else
+        acc
+    in
+      G.fold_succ_e filter_same_value g.g_graph n1 []
+  in
+    (* remove same value links no longer true *)
+    List.iter (fun n -> G.remove_edge g.g_graph n n1) (find_wrong_same_value ());
+    (* update the hash table*)
+    List.iter (fun x -> Hashtbl.replace g.g_hash x n1) !(G.V.label n2);
+    (* coalesce nodes in the graph*)
+    G.coalesce g.g_graph n1 n2
+