.

[SXSI/xpathcomp.git] / tree.ml

diff --git a/tree.ml b/tree.ml
index 9e80e6d..730e174 100644 (file)
--- a/tree.ml
+++ b/tree.ml
@@ -52,7 +52,8 @@ external text_unsorted_contains : tree -> string -> unit = "caml_text_collection
 external text_get_cached_text : tree -> [`Text] node -> string = "caml_text_collection_get_cached_text"
     
 external tree_root : tree -> [`Tree] node = "caml_xml_tree_root" 
-
+external tree_subtree_size : tree -> [`Tree] node -> int = "caml_xml_tree_subtree_size"
+ 
 let tree_is_nil x = equal_node x nil
 
 external tree_parent : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_parent" "noalloc"
@@ -127,7 +128,7 @@ type t = {
   doc : tree;            
   ttable : (Tag.t,(Ptset.Int.t*Ptset.Int.t*Ptset.Int.t*Ptset.Int.t)) Hashtbl.t;
 }
-
+let subtree_size t i = tree_subtree_size t.doc i
 let text_size t = text_size t.doc
 
 module MemUnion = Hashtbl.Make (struct 
@@ -243,7 +244,35 @@ let init_naive_contains t s =
   let _ = List.fold_left (fun cpt e -> a.(cpt) <- e; (cpt-1)) (l-1) acc
   in
     contains_array := a
+
+let last_idx = ref 0
+
+let array_find a i j =
+  let l = Array.length a in
+  let rec loop idx x y =
+    if x > y || idx >= l then nulldoc
+       else
+         if a.(idx) >= x then if a.(idx) > y then nulldoc else (last_idx := idx;a.(idx))
+         else loop (idx+1) x y
+  in
+    if a.(0) > j || a.(l-1) < i then nulldoc
+    else loop !last_idx i j 
          
+let text_below tree t = 
+  let l = Array.length !contains_array in
+  let i,j = tree_doc_ids tree.doc t in
+  let id = if l == 0 then i else (array_find !contains_array i j) in
+  tree_parent_doc tree.doc id
+    
+let text_next tree t root =
+  let l = Array.length !contains_array in
+  let inf = nodei((inode(snd(tree_doc_ids tree.doc t)))+1) in    
+  let _,j = tree_doc_ids tree.doc root in      
+  let id = if l == 0 then if inf > j then nulldoc else  inf
+  else array_find !contains_array inf j
+  in 
+  tree_parent_doc tree.doc id
+
 
 
 module DocIdSet = struct
@@ -367,11 +396,12 @@ let nts = function
       
 let dump_node t = nts (inode t)
 
-      
 let is_left t n = tree_is_first_child t.doc n
 
-let is_below_right t n1 n2 = tree_is_ancestor t.doc (tree_parent t.doc n1) n2
-
+let is_below_right t n1 n2 = 
+  tree_is_ancestor t.doc (tree_parent t.doc n1) n2 
+  && not (tree_is_ancestor t.doc n1 n2)
+    
 let parent t n = tree_parent t.doc n
 
 let first_child t = (); fun n -> tree_first_child t.doc n
@@ -520,10 +550,14 @@ let tags_after t tag =
 let tags t tag = Hashtbl.find t.ttable tag
 
 
-let binary_parent t n = 
+let rec binary_parent t n = 
+  let r = 
   if tree_is_first_child t.doc n
   then tree_parent t.doc n
   else tree_prev_sibling t.doc n
+  in if tree_tag_id t.doc r = Tag.pcdata then
+  binary_parent t r
+  else r
 
 let doc_ids t n = tree_doc_ids t.doc n