From 29a67211217e1e4ef05dd256de549d9eea59ffc0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= <cedric.pasteur@ens.fr>
Date: Wed, 7 Sep 2011 17:27:58 +0200
Subject: [PATCH] Fix for dep when using linear types and automata

---
 compiler/utilities/global/dep.ml | 27 +++++++++++++++------------
 compiler/utilities/misc.ml       | 11 +++++++++++
 compiler/utilities/misc.mli      |  5 +++++
 3 files changed, 31 insertions(+), 12 deletions(-)

diff --git a/compiler/utilities/global/dep.ml b/compiler/utilities/global/dep.ml
index 0a36cf8..0b3715f 100644
--- a/compiler/utilities/global/dep.ml
+++ b/compiler/utilities/global/dep.ml
@@ -37,19 +37,19 @@ struct
     let rec nametograph_env g var_list node_env =
       List.fold_left (fun env x -> Env.add x g env) node_env var_list in
 
-    let rec init_graph eqs g_list n_to_graph node_env =
+    let rec init_graph eqs g_list n_to_graph lin_map node_env =
       match eqs with
-        | [] -> g_list, n_to_graph, node_env
+        | [] -> g_list, n_to_graph, lin_map, node_env
         | eq :: eqs ->
             let g = make eq in
             let node_env = nametograph_env g (Read.def [] eq) node_env in
             let n_to_graph = nametograph g (Read.def [] eq)
               (Read.antidep eq) n_to_graph in
-            let n_to_graph = nametograph g (Read.linear_read eq) true n_to_graph in
-            init_graph eqs (g :: g_list) n_to_graph node_env
+            let lin_map = nametograph g (Read.linear_read eq) true lin_map in
+            init_graph eqs (g :: g_list) n_to_graph lin_map node_env
     in
 
-    let rec make_graph g_list names_to_graph =
+    let rec make_graph g_list names_to_graph lin_map =
       let attach_one node (g, is_antidep) =
         if is_antidep then
           add_depends g node
@@ -57,9 +57,9 @@ struct
           add_depends node g
       in
 
-      let attach node n =
+      let attach env node n =
         try
-          let l = Env.find n names_to_graph in
+          let l = Env.find n env in
           List.iter (attach_one node) l
         with
           | Not_found -> () in
@@ -68,12 +68,15 @@ struct
         | [] -> ()
         | node :: g_list ->
             let names = Read.read (containt node) in
-            List.iter (attach node) names;
-            make_graph g_list names_to_graph in
+            List.iter (attach names_to_graph node) names;
+            let reads = Misc.list_diff names (Read.linear_read (containt node)) in
+            List.iter (attach lin_map node) names;
+            make_graph g_list names_to_graph lin_map
+    in
 
-    let g_list, names_to_graph, node_env =
-      init_graph eqs [] Env.empty Env.empty in
-    make_graph g_list names_to_graph;
+    let g_list, names_to_graph, lin_map, node_env =
+      init_graph eqs [] Env.empty Env.empty Env.empty in
+    make_graph g_list names_to_graph lin_map;
     g_list, node_env
 end
 
diff --git a/compiler/utilities/misc.ml b/compiler/utilities/misc.ml
index dc56977..e65f971 100644
--- a/compiler/utilities/misc.ml
+++ b/compiler/utilities/misc.ml
@@ -154,6 +154,12 @@ let rec assocd value = function
       else
         assocd value l
 
+(** [list_diff l dl] returns [l] without the elements belonging to [dl].*)
+let rec list_diff l dl = match l with
+    | [] -> []
+    | x::l ->
+      let l = list_diff l dl in
+      if List.mem x dl then l else x::l
 
 (** { 3 Compiler iterators } *)
 
@@ -224,6 +230,11 @@ let fold_righti f l acc =
     | h :: l -> f i h (aux (i + 1) l acc) in
   aux 0 l acc
 
+let rec map3 f l1 l2 l3 = match l1, l2, l3 with
+  | [], [], [] -> []
+  | v1::l1, v2::l2, v3::l3 -> (f v1 v2 v3)::(map3 f l1 l2 l3)
+  | _ -> invalid_arg "Misc.map3"
+
 exception Assert_false
 let internal_error passe =
   Format.eprintf "@.---------@\n
diff --git a/compiler/utilities/misc.mli b/compiler/utilities/misc.mli
index 186d6d5..95e3263 100644
--- a/compiler/utilities/misc.mli
+++ b/compiler/utilities/misc.mli
@@ -74,6 +74,9 @@ val list_compare : ('a -> 'a -> int) -> 'a list -> 'a list -> int
 
 val option_compare : ('a -> 'a -> int) -> 'a option -> 'a option -> int
 
+(** [list_diff l dl] returns [l] without the elements belonging to [dl].*)
+val list_diff : 'a list -> 'a list -> 'a list
+
 (** Mapfold *)
 val mapfold: ('acc -> 'b -> 'c * 'acc) -> 'acc -> 'b list -> 'c list * 'acc
 val mapfold2: ('acc -> 'b -> 'd -> 'c * 'acc) -> 'acc -> 'b list -> 'd list -> 'c list * 'acc
@@ -97,6 +100,8 @@ val fold_left4 :
   ('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a
 
 (** Mapi *)
+val map3: ('a -> 'b -> 'c -> 'd) ->
+  'a list -> 'b list -> 'c list -> 'd list
 val mapi: (int -> 'a -> 'b) -> 'a list -> 'b list
 val mapi2: (int -> 'a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
 val mapi3: (int -> 'a -> 'b -> 'c -> 'd) ->