Fixed bug in NextElement, improved caching

[SXSI/xpathcomp.git] / tree.ml

diff --git a/tree.ml b/tree.ml
index 730e174..0a31e83 100644 (file)
--- a/tree.ml
+++ b/tree.ml
@@ -178,24 +178,28 @@ let collect_tags tree =
       Hashtbl.replace h t 
        (pt_cup sc schild,pt_cup sbelow sb, pt_cup ssibling ss, pt_cup safter sa)
   in
-  let rec loop_right id acc_sibling acc_after= 
+  let rec loop_right id acc_after = 
     if  id == nil
-    then (acc_sibling,acc_after)
+    then Ptset.Int.empty,Ptset.Int.empty,acc_after
     else
-      let sibling2,after2 = loop_right (tree_next_sibling tree id) acc_sibling acc_after in
-      let child1,below1   = loop_left (tree_first_child tree id) after2  in
-      let tag = tree_tag_id tree id in
-       update tag child1 below1 sibling2 after2;
-       (pt_add tag sibling2, (pt_add tag (pt_cup after2 below1)))
+    let sibling2,desc2,after2 = loop_right (tree_next_sibling tree id) acc_after in
+    let child1,desc1,after1   = loop_left (tree_first_child tree id) after2  in
+    let tag = tree_tag_id tree id in
+    update tag child1 desc1 sibling2 after2;
+    ( pt_add tag sibling2, 
+      pt_add tag (pt_cup desc1 desc2),
+      pt_cup after1 (pt_cup desc1 desc2) )
   and loop_left id acc_after = 
-    if id == nil 
-    then (Ptset.Int.empty,Ptset.Int.empty)
+    if  id == nil
+    then Ptset.Int.empty,Ptset.Int.empty,acc_after
     else
-      let sibling2,after2 = loop_right (tree_next_sibling tree id) Ptset.Int.empty acc_after in
-      let child1,below1 = loop_left (tree_first_child tree id) after2 in
-      let tag = tree_tag_id tree id in
-       update tag child1 below1 sibling2 after2;
-       (pt_add tag sibling2,(pt_add tag (pt_cup after2 below1)))      
+    let sibling2,desc2,after2 = loop_right (tree_next_sibling tree id) acc_after in
+    let child1,desc1,after1   = loop_left (tree_first_child tree id) after2  in
+    let tag = tree_tag_id tree id in
+    update tag child1 desc1 sibling2 after2;
+    (pt_add tag sibling2, 
+     pt_add tag (pt_cup desc1 desc2),
+     acc_after )
   in
   let _ = loop_left (tree_root tree) Ptset.Int.empty in h
                          
@@ -288,7 +292,21 @@ let is_root t = t == root
 let node_of_t t  =
   let _ = Tag.init (Obj.magic t) in
   let table = collect_tags t 
+  in (*
+  let _ = Hashtbl.iter (fun t (c,d,ns,f) ->
+                         Printf.eprintf "Tag %s has:\n" (Tag.to_string t);
+                         Printf.eprintf "Child tags: ";
+                         Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) c;
+                         Printf.eprintf "\nDescendant tags: ";
+                         Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) d;
+                         Printf.eprintf "\nNextSibling tags: ";
+                         Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) ns;
+                         Printf.eprintf "\nFollowing tags: ";
+                         Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) f;
+                         Printf.eprintf "\n\n%!";) table
   in
+                         
+     *)                          
     { doc= t; 
       ttable = table;
     }
@@ -310,7 +328,7 @@ let parse_xml_string str =  parse parse_xml_string str
 external pool : tree -> Tag.pool = "%identity"
 
 let magic_string = "SXSI_INDEX"
-let version_string = "1"
+let version_string = "2"
 
 let pos fd =
   Unix.lseek fd 0  Unix.SEEK_CUR
@@ -358,6 +376,7 @@ let load ?(sample=64) str =
   let fd = Unix.openfile str [ Unix.O_RDONLY ] 0o644 in
   let in_c = Unix.in_channel_of_descr fd in
   let _ = set_binary_mode_in in_c true in
+  let load_table () = 
     (let ms = input_line in_c in if ms <> magic_string then failwith "Invalid index file");
     (let vs = input_line in_c in if vs <> version_string then failwith "Invalid version file");
     let table : (Tag.t,(Ptset.Int.t*Ptset.Int.t*Ptset.Int.t*Ptset.Int.t)) Hashtbl.t =
@@ -375,11 +394,15 @@ let load ?(sample=64) str =
       (* The in_channel read a chunk of fd, so we might be after
         the start of the XMLTree save file. Reset to the correct
         position *)
-      ignore(Unix.lseek fd (pos_in in_c) Unix.SEEK_SET);
-      let tree = { doc = tree_load fd;
-                  ttable = ntable;}
-      in close_in in_c;
-       tree
+      ntable
+  in
+  let _ = Printf.eprintf "\nLoading tag table : " in
+  let ntable = time (load_table) () in
+  ignore(Unix.lseek fd (pos_in in_c) Unix.SEEK_SET);
+  let tree = { doc = tree_load fd;
+              ttable = ntable;}
+  in close_in in_c;
+  tree
   
 
 
@@ -476,8 +499,6 @@ let array_find a i j =
          then 
            begin
              let tid =  tree_my_text tree.doc t in
-             let _ = Printf.eprintf "my_text %i returned %i\n%!" (inode t) (inode tid)
-             in
              output_string outc (text_get_cached_text tree.doc tid);
              if print_right
              then loop (next_sibling tree t);
@@ -520,8 +541,6 @@ let array_find a i j =
       let attname = String.sub s 3 ((String.length s) -3) in
       let fsa = first_child tree a in
       let tid =  tree_my_text tree.doc fsa in
-      let _ = Printf.eprintf "my_text %i returned %i\n%!" (inode fsa) (inode tid)
-      in
        output_char outc ' ';
        output_string outc attname;
        output_string outc "=\"";