The unified diff between revisions [f17a7eed..] and [9efc809f..] is displayed below. It can also be downloaded as a raw diff.

#
#
# patch "database.ml"
#  from [1b9ae88030a71571e23412a593ed034cbb5fa143]
#    to [d791f5492e2d4f5e367383639fb9ec2383a0ce74]
#
============================================================
--- database.ml	1b9ae88030a71571e23412a593ed034cbb5fa143
+++ database.ml	d791f5492e2d4f5e367383639fb9ec2383a0ce74
@@ -20,7 +20,7 @@ let setup_sqlite ?busy_handler db =
   if Viz_misc.debug "sql"
   then
     Sqlite3.trace_set db
-      (fun s -> prerr_string "### sql: " ; prerr_endline s) ;
+      (fun s -> Printf.eprintf "### %2.3f sql: %s\n%!" (Sys.time ()) s) ;
   Sqlite3.exec db "PRAGMA temp_store = MEMORY" ;
   may
     (Sqlite3.busy_set db)
@@ -154,42 +154,58 @@ let ensure_node g id k =
     let n = { id = id ; kind = k ; family = [] } in
     n, { g with nodes = NodeMap.add id n g.nodes }

-let process_regular_node g s =
-  let id = Sqlite3.column_text s 0 in
-  let _, g = ensure_node g id REGULAR in
-  g
+let connect_nodes n1 n2 =
+  n1.family <- (n2.id, CHILD)  :: n1.family ;
+  n2.family <- (n1.id, PARENT) :: n2.family

-let add_edge g id1 k1 id2 k2 ek =
+let add_edge g id1 id2 ek =
+  { g with ancestry = EdgeMap.add (id1, id2) ek g.ancestry }
+
+let add_nodes_with_edge g id1 k1 id2 k2 ek =
   let n1, g = ensure_node g id1 k1 in
-  n1.family <- (id2, CHILD) :: n1.family ;
   let n2, g = ensure_node g id2 k2 in
-  n2.family <- (id1, PARENT) :: n2.family ;
-  { g with ancestry = EdgeMap.add (id1, id2) ek g.ancestry }
+  connect_nodes n1 n2 ;
+  add_edge g id1 id2 ek


+let process_regular_node g s =
+  let id = Sqlite3.column_text s 0 in
+  let _, g = ensure_node g id REGULAR in
+  g
+
 let process_neighb_in g s =
   let id    = Sqlite3.column_text s 0 in
   let child = Sqlite3.column_text s 1 in
-  add_edge g id NEIGHBOUR_IN child REGULAR BRANCHING_NEIGH
+  assert (NodeMap.mem child g.nodes) ;
+  add_nodes_with_edge g id NEIGHBOUR_IN child REGULAR BRANCHING_NEIGH

 let process_neighb_out db =
   let is_interesting = is_interesting_neighbour_out db in
   fun g s ->
     let parent = Sqlite3.column_text s 0 in
     let id     = Sqlite3.column_text s 1 in
+    assert (NodeMap.mem parent g.nodes) ;
     if is_interesting parent id
-    then add_edge g parent REGULAR id NEIGHBOUR_OUT BRANCHING_NEIGH
+    then add_nodes_with_edge g parent REGULAR id NEIGHBOUR_OUT BRANCHING_NEIGH
     else g

 let process_ancestry g s =
   let parent = Sqlite3.column_text s 0 in
   let child  = Sqlite3.column_text s 1 in
-  add_edge g parent REGULAR child REGULAR SAME_BRANCH
+  assert (NodeMap.mem parent g.nodes) ;
+  assert (NodeMap.mem child  g.nodes) ;
+  assert (not (EdgeMap.mem (parent, child) g.ancestry)) ;
+  add_nodes_with_edge g parent REGULAR child REGULAR SAME_BRANCH

 let process_branching_edge g s =
   let parent = Sqlite3.column_text s 0 in
   let child  = Sqlite3.column_text s 1 in
-  add_edge g parent REGULAR child REGULAR BRANCHING
+  let e = parent, child in
+  assert (EdgeMap.mem e g.ancestry) ;
+  if EdgeMap.find e g.ancestry = SAME_BRANCH
+  then add_edge g parent child BRANCHING
+  else g
+


 let fetch_agraph_with_view db base64 (query, query_limit) =
@@ -209,18 +225,22 @@ let fetch_agraph_with_view db base64 (qu
   (* neighbor IN *)
   let agraph =
     Sqlite3.fetch_f db
-      "SELECT parent, child \
-         FROM %s, revision_ancestry \
-        WHERE id = child AND parent != '' AND parent NOT IN %s"
+        "SELECT parent, child \
+           FROM %s AS D1 \
+           JOIN revision_ancestry ON D1.id = child \
+LEFT OUTER JOIN %s AS D2 ON D2.id = parent \
+          WHERE D2.id ISNULL"
       view_name_limit view_name_domain
       process_neighb_in agraph in

   (* neighbor OUT *)
   let agraph =
     Sqlite3.fetch_f db
-      "SELECT parent, child \
-         FROM %s, revision_ancestry \
-        WHERE id = parent AND child NOT IN %s"
+        "SELECT parent, child \
+           FROM %s AS D1 \
+           JOIN revision_ancestry ON D1.id = parent \
+LEFT OUTER JOIN %s AS D2 ON D2.id = child \
+          WHERE D2.id ISNULL"
       view_name_limit view_name_domain
       (process_neighb_out db) agraph in