# 
# patch "database.ml"
#  from [d684e0564eaf8ace401d77b61906873c706f73f9]
#    to [f78fcb72f043c24d31f4f02e169633d4bbae37b1]
# 
# patch "viz_misc.ml"
#  from [1462c7cfe31639613d5cbef63e79a72f3c0cceb3]
#    to [c0f7e882e80792536f5ec1e63695211c306a66e6]
# 
# patch "viz_misc.mli"
#  from [998703433822eb6ea3f7c74e30b3403d288cbe0b]
#    to [0d137b9883d1ce144629f5b0aa5872752f9e1b6b]
# 
--- database.ml
+++ database.ml
@@ -83,28 +83,30 @@
   Str.regexp "\\(\\(explicit_\\)?merge of\\|propagate \\(of\\|from\\)\\) ", MERGE ;
   Str.regexp "disapproval of ", DISAPPROVE
 ]
-let re_match re s = Str.string_match re s 0
+let re_match s (re, _) = Str.string_match re s 0
 
 let process_changelog_row g = function
   | [| id; cl |] ->
       let cl = monot_decode cl in
-      if not (List.exists (fun (re, _) -> re_match re cl) auto_cl_re)
+      if not (List.exists (re_match cl) auto_cl_re)
       then g else begin
-	let (_, kind) = 
-	  try List.find (fun (re, k) -> re_match re cl) auto_cl_re
-	  with Not_found -> assert false (* means I f*cked up the regexps *) in
+	let (_, kind) = List.find (re_match cl) auto_cl_re in
 	let node = 
 	  try NodeMap.find id g.nodes
 	  with Not_found -> assert false (* monotone db is inconsistent *) in
 	let updated_edges =
 	  if kind = DISAPPROVE
 	  then begin
-	    match node.family with
-	    | [ pid, PARENT ] ->
-		EdgeMap.add (pid, id) DISAPPROVED g.ancestry
-	    | _ -> 
-		g.ancestry 
-	  end 
+	    let pid =
+	      try list_rassoc PARENT node.family
+	      with Not_found -> assert false in
+	    let a = EdgeMap.add (pid, id) DISAPPROVED g.ancestry in
+	    try
+	      let pnode = NodeMap.find pid g.nodes in
+	      let gpid = list_rassoc PARENT pnode.family in
+	      EdgeMap.add (gpid, pid) DISAPPROVED a
+	    with Not_found -> a
+	  end
 	  else g.ancestry in
 	let updated_nodes = 
 	  if kind <> node.kind 
@@ -117,11 +119,7 @@
 
 let process_branching_edge_row g = function
   | [| parent; child |] ->
-      { g with ancestry =
-	begin
-	  assert (NodeMap.mem parent g.nodes && NodeMap.mem child g.nodes) ;
-	  EdgeMap.add (parent, child) BRANCHING g.ancestry
-	end }
+      { g with ancestry = EdgeMap.add (parent, child) BRANCHING g.ancestry }
   | _ -> g
 
 
--- viz_misc.ml
+++ viz_misc.ml
@@ -46,6 +46,11 @@
   | _ :: tl -> list_assoc_all k tl
   | [] -> []
 
+let rec list_rassoc v = function
+  | (a, b) :: _ when b = v -> a
+  | _ :: tl -> list_rassoc v tl
+  | [] -> raise Not_found
+
 let array_index a v =
   let rec loop i =
     if i >= Array.length a 
--- viz_misc.mli
+++ viz_misc.mli
@@ -6,6 +6,7 @@
 val option_of_list : 'a list -> 'a option
 val list_uniq : 'a list -> 'a list
 val list_assoc_all : 'a -> ('a * 'b) list -> 'b list
+val list_rassoc : 'b -> ('a * 'b) list -> 'a (** @raise Not_found *)
 val array_index : 'a array -> 'a -> int (** @raise Not_found *)
 
 val some : 'a option -> 'a