X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=tree.ml;h=730e174172e7f3c5231be6c4eaa2b06a1da22dad;hb=f0557f21878be17ddc75b1bc8f4f86da68c8e604;hp=9cb5ef6f67b4bdb91c57ab65087af93a5d903b15;hpb=70ff0bfc463882ecf233f1b1a7ac4a8007fa4cc2;p=SXSI%2Fxpathcomp.git

diff --git a/tree.ml b/tree.ml
index 9cb5ef6..730e174 100644
--- a/tree.ml
+++ b/tree.ml
@@ -6,36 +6,43 @@
 (******************************************************************************)
 INCLUDE "utils.ml"
 
+
+external init_lib : unit -> unit = "caml_init_lib"
+
+exception CPlusPlusError of string
+
+let () = Callback.register_exception "CPlusPlusError" (CPlusPlusError "")
+
+let () =  init_lib ()
+
+
 type tree
-type 'a node = int
+type 'a node = private int
 type node_kind = [`Text | `Tree ]
-    
-let compare_node : 'a node -> 'a node -> int = (-)
+
+external inode : 'a node -> int = "%identity"  
+external nodei : int -> 'a node = "%identity"  
+let compare_node x y = (inode x) - (inode y)
 let equal_node : 'a node -> 'a node -> bool = (==)
-  
-(* abstract type, values are pointers to a XMLTree C++ object *)
 
-external int_of_node : 'a node -> int = "%identity"
   
 external parse_xml_uri : string -> int -> bool -> bool -> tree = "caml_call_shredder_uri"         
 external parse_xml_string :  string -> int -> bool -> bool -> tree = "caml_call_shredder_string"
   
-external save_tree : tree -> string -> unit = "caml_xml_tree_save"
-external load_tree : string ->  int -> tree = "caml_xml_tree_load"
+external tree_save : tree -> Unix.file_descr -> unit = "caml_xml_tree_save"
+external tree_load : Unix.file_descr -> tree = "caml_xml_tree_load"
   
 external nullt : unit -> 'a node = "caml_xml_tree_nullt"
 
-let nil : 'a node = -1
-let root : [`Tree ] node = 0
+let nil : [`Tree ] node = nodei ~-1
+let nulldoc : [`Text ] node = nodei ~-1
+let root : [`Tree ] node = nodei 0
 
 external text_get_tc_text : tree -> [`Text] node -> string = "caml_text_collection_get_text" 
 		
 external text_is_empty : tree -> [`Text ] node -> bool = "caml_text_collection_empty_text" 
 
-let text_is_empty t n =
-  (equal_node nil n) || text_is_empty t n
-    
-
+let text_is_empty t n = (equal_node nulldoc n) || text_is_empty t n
 
 external text_is_contains : tree -> string -> bool = "caml_text_collection_is_contains" 
 external text_count_contains : tree -> string -> int = "caml_text_collection_count_contains" 
@@ -43,67 +50,64 @@ external text_count : tree -> string -> int = "caml_text_collection_count"
 external text_contains : tree -> string -> [`Text ] node array = "caml_text_collection_contains" 
 external text_unsorted_contains : tree -> string -> unit = "caml_text_collection_unsorted_contains"
 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"
+external tree_parent_doc : tree -> [`Text ] node -> [`Tree ] node = "caml_xml_tree_parent_doc" "noalloc"
+(*external tree_prev_doc : tree -> [`Text ] node -> [`Tree ] node = "caml_xml_tree_prev_doc" "noalloc" *)
+external tree_first_child : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_first_child" "noalloc"
+external tree_first_element : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_first_element" "noalloc"
+external tree_tagged_child : tree -> [`Tree] node -> Tag.t -> [`Tree] node = "caml_xml_tree_tagged_child" "noalloc" 
+external tree_next_sibling : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_next_sibling"  "noalloc"
+external tree_next_element : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_next_element"  "noalloc"
+external tree_tagged_sibling : tree -> [`Tree] node -> Tag.t -> [`Tree] node = "caml_xml_tree_tagged_sibling" "noalloc"
 
-external tree_serialize : tree -> string -> unit = "caml_xml_tree_serialize"
-
-external tree_unserialize : string -> tree = "caml_xml_tree_unserialize"
-      
-external tree_root : tree -> [`Tree] node = "caml_xml_tree_root" 
+external tree_prev_sibling : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_prev_sibling" "noalloc"
+external tree_is_leaf : tree -> [`Tree] node -> bool = "caml_xml_tree_is_leaf" "noalloc"
+external tree_last_child : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_last_child" "noalloc"
+external tree_is_first_child : tree -> [`Tree] node -> bool = "caml_xml_tree_is_first_child" "noalloc"
 
-let tree_is_nil x = equal_node x nil
 
-external tree_parent : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_parent" 
-external tree_parent_doc : tree -> [`Text ] node -> [`Tree ] node = "caml_xml_tree_parent_doc" 
-external tree_prev_doc : tree -> [`Text ] node -> [`Tree ] node = "caml_xml_tree_prev_doc" 
-external tree_first_child : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_first_child" 
-external tree_tagged_child : tree -> [`Tree] node -> Tag.t -> [`Tree] node = "caml_xml_tree_tagged_child" 
-external tree_next_sibling : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_next_sibling" 
-external tree_tagged_sibling : tree -> [`Tree] node -> Tag.t -> [`Tree] node = "caml_xml_tree_tagged_sibling" 
-
-external tree_prev_sibling : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_prev_sibling" 
-external tree_is_leaf : tree -> [`Tree] node -> bool = "caml_xml_tree_is_leaf" 
-external tree_last_child : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_last_child"
-external tree_is_first_child : tree -> [`Tree] node -> bool = "caml_xml_tree_is_first_child"
-
-(*    external tag : tree -> [`Tree ] node -> T = "caml_xml_tree_tag"*)
-external tree_tag_id : tree -> [`Tree ] node -> Tag.t = "caml_xml_tree_tag_id" 
+external tree_tag_id : tree -> [`Tree ] node -> Tag.t = "caml_xml_tree_tag_id"  "noalloc"
     
 
 let tree_is_last t n = equal_node nil (tree_next_sibling t n)
     
-external tree_prev_text : tree -> [`Tree] node -> [`Text ] node = "caml_xml_tree_prev_text" 
+(*external tree_prev_text : tree -> [`Tree] node -> [`Text ] node = "caml_xml_tree_prev_text" "noalloc" *)
 
-external tree_my_text : tree -> [`Tree] node -> [`Text ] node = "caml_xml_tree_my_text" 
-external tree_next_text : tree -> [`Tree] node -> [`Text ] node = "caml_xml_tree_next_text" 
+external tree_my_text : tree -> [`Tree] node -> [`Text ] node = "caml_xml_tree_my_text" "noalloc"
+(*external tree_next_text : tree -> [`Tree] node -> [`Text ] node = "caml_xml_tree_next_text" "noalloc" *)
 external tree_doc_ids : tree -> [`Tree ] node -> [`Text ] node * [`Text ] node = "caml_xml_tree_doc_ids" 
 
-let text_size tree = int_of_node (snd ( tree_doc_ids tree (Obj.magic 0) ))
+let text_size tree = inode (snd ( tree_doc_ids tree root ))
 
-let text_get_cached_text t x =
-  if x == -1 then ""
+let text_get_cached_text t (x:[`Text] node) =
+  if x == nulldoc then ""
   else 
      text_get_cached_text t x
 
 
-external tree_text_xml_id : tree -> [`Text ] node -> int = "caml_xml_tree_text_xml_id" 
-external tree_node_xml_id : tree -> [`Tree ] node -> int = "caml_xml_tree_node_xml_id" 
-external tree_is_ancestor : tree -> [`Tree ] node -> [`Tree ] node -> bool = "caml_xml_tree_is_ancestor" 
-external tree_tagged_desc : tree -> [`Tree ] node -> Tag.t -> [`Tree ] node = "caml_xml_tree_tagged_desc" 
-external tree_tagged_foll_below : tree -> [`Tree ] node -> Tag.t -> [`Tree ] node -> [`Tree ] node = "caml_xml_tree_tagged_foll_below" 
-external tree_subtree_tags : tree -> [`Tree ] node -> Tag.t -> int = "caml_xml_tree_subtree_tags" 
+external tree_text_xml_id : tree -> [`Text ] node -> int = "caml_xml_tree_text_xml_id" "noalloc"
+external tree_node_xml_id : tree -> [`Tree ] node -> int = "caml_xml_tree_node_xml_id" "noalloc"
+external tree_is_ancestor : tree -> [`Tree ] node -> [`Tree ] node -> bool = "caml_xml_tree_is_ancestor" "noalloc" 
+external tree_tagged_desc : tree -> [`Tree ] node -> Tag.t -> [`Tree ] node = "caml_xml_tree_tagged_desc" "noalloc"
+external tree_tagged_foll_below : tree -> [`Tree ] node -> Tag.t -> [`Tree ] node -> [`Tree ] node = "caml_xml_tree_tagged_foll_below" "noalloc"
+external tree_subtree_tags : tree -> [`Tree ] node -> Tag.t -> int = "caml_xml_tree_subtree_tags" "noalloc"
 
 
+type unordered_set
+external unordered_set_alloc : int -> unordered_set = "caml_unordered_set_alloc"
+external unordered_set_length : unordered_set -> int = "caml_unordered_set_length"
+external unordered_set_insert : unordered_set -> int -> unit = "caml_unordered_set_set" "noalloc"
 
-type int_vector
-external int_vector_alloc : int -> int_vector = "caml_int_vector_alloc"
-external int_vector_length : int_vector -> int = "caml_int_vector_length"
-external int_vector_set : int_vector -> int -> int -> unit = "caml_int_vector_set"
-
-external tree_select_child : tree -> [`Tree ] node -> int_vector -> [`Tree] node = "caml_xml_tree_select_child"
-external tree_select_foll_sibling : tree -> [`Tree ] node -> int_vector -> [`Tree] node = "caml_xml_tree_select_foll_sibling"
-external tree_select_desc : tree -> [`Tree ] node -> int_vector -> [`Tree] node = "caml_xml_tree_select_desc"
-external tree_select_foll_below : tree -> [`Tree ] node -> int_vector -> [`Tree] node -> [`Tree] node = "caml_xml_tree_select_foll_below"
+external tree_select_child : tree -> [`Tree ] node -> unordered_set -> [`Tree] node = "caml_xml_tree_select_child" "noalloc"
+external tree_select_foll_sibling : tree -> [`Tree ] node -> unordered_set -> [`Tree] node = "caml_xml_tree_select_foll_sibling" "noalloc"
+external tree_select_desc : tree -> [`Tree ] node -> unordered_set -> [`Tree] node = "caml_xml_tree_select_desc" "noalloc"
+external tree_select_foll_below : tree -> [`Tree ] node -> unordered_set -> [`Tree] node -> [`Tree] node = "caml_xml_tree_select_foll_below" "noalloc"
 
 
 module HPtset = Hashtbl.Make(Ptset.Int)
@@ -115,16 +119,16 @@ let ptset_to_vector s =
     HPtset.find vector_htbl s
   with
       Not_found ->
-	let v = int_vector_alloc (Ptset.Int.cardinal s) in
-	let _ = Ptset.Int.fold (fun e i -> int_vector_set v i e;i+1) s 0 in
+	let v = unordered_set_alloc (Ptset.Int.cardinal s) in
+	let _ = Ptset.Int.iter (fun e -> unordered_set_insert v e) s in
 	  HPtset.add vector_htbl s v; v
 
       
 type t = { 
   doc : tree;	          
-  ttable : (Tag.t,(Ptset.Int.t*Ptset.Int.t)) Hashtbl.t;
+  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 
@@ -138,6 +142,13 @@ module MemUnion = Hashtbl.Make (struct
 	  if x < y then HASHINT2(x,y) else HASHINT2(y,x)
     end)
 
+module MemAdd = Hashtbl.Make (
+  struct 
+    type t = Tag.t*Ptset.Int.t
+    let equal (x,y) (z,t) = (x == z)&&(Ptset.Int.equal y t)
+    let hash (x,y) =  HASHINT2(x,Ptset.Int.hash y)
+  end)
+
 let collect_tags tree =
   let h_union = MemUnion.create BIG_H_SIZE in
   let pt_cup s1 s2 =
@@ -148,41 +159,48 @@ let collect_tags tree =
 	  in
 	    MemUnion.add h_union (s1,s2) s;s
   in    
-  let h_add = Hashtbl.create BIG_H_SIZE in
-  let pt_add t s = 
-    let k = HASHINT2(Tag.hash t,Ptset.Int.hash s) in
-      try
-	Hashtbl.find h_add k
-      with
+  let h_add = MemAdd.create BIG_H_SIZE in
+  let pt_add t s =  
+    try MemAdd.find h_add (t,s)
+    with
       | Not_found -> let r = Ptset.Int.add t s in
-	  Hashtbl.add h_add k r;r
+	  MemAdd.add h_add (t,s) r;r
   in
   let h = Hashtbl.create BIG_H_SIZE in
-  let update t sb sa =
-    let sbelow,safter = 
+  let update t sc sb ss sa =
+    let schild,sbelow,ssibling,safter =  
       try
 	Hashtbl.find h t 
       with
 	| Not_found -> 
-	    (Ptset.Int.empty,Ptset.Int.empty)
+	    (Ptset.Int.empty,Ptset.Int.empty,Ptset.Int.empty,Ptset.Int.empty)
     in
-      Hashtbl.replace h t (pt_cup sbelow sb, pt_cup safter sa)
+      Hashtbl.replace h t 
+	(pt_cup sc schild,pt_cup sbelow sb, pt_cup ssibling ss, pt_cup safter sa)
   in
-  let rec loop id acc = 
-    if equal_node id nil
-    then (Ptset.Int.empty,acc)
+  let rec loop_right id acc_sibling acc_after= 
+    if  id == nil
+    then (acc_sibling,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)))
+  and loop_left id acc_after = 
+    if id == nil 
+    then (Ptset.Int.empty,Ptset.Int.empty)
     else
-      let below2,after2 = loop (tree_next_sibling tree id) acc in
-      let below1,after1 = loop (tree_first_child tree id) after2 in
+      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 below1 after2;
-	pt_add tag (pt_cup below1 below2), (pt_add tag after1)
+	update tag child1 below1 sibling2 after2;
+	(pt_add tag sibling2,(pt_add tag (pt_cup after2 below1)))      
   in
-    let _ = loop (tree_root tree) Ptset.Int.empty in h
-
-
-
-
+  let _ = loop_left (tree_root tree) Ptset.Int.empty in h
+			  
+			  
+    
 
 let contains_array = ref [| |]
 let contains_index = Hashtbl.create 4096 
@@ -218,15 +236,43 @@ let init_naive_contains t s =
       let s = text_get_cached_text t.doc n
       in
 	if matching s 
-	then loop (n+1) (n::acc) (l+1) 
-	else loop (n+1) acc l
+	then loop (nodei ((inode n)+1)) (n::acc) (l+1) 
+	else loop (nodei ((inode n)+1)) acc l
   in
   let acc,l = loop i [] 0 in
-  let a = Array.create l nil in
+  let a = Array.create l nulldoc in
   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
@@ -263,18 +309,84 @@ let parse_xml_string str =  parse parse_xml_string str
      
 external pool : tree -> Tag.pool = "%identity"
 
-let save t str = (save_tree t.doc str)
+let magic_string = "SXSI_INDEX"
+let version_string = "1"
+
+let pos fd =
+  Unix.lseek fd 0  Unix.SEEK_CUR
+
+let pr_pos fd = Printf.eprintf "At position %i\n%!" (pos fd)
+
+let write fd s = 
+  let sl = String.length s in
+  let ssl = Printf.sprintf "%020i" sl in
+    ignore (Unix.write fd ssl 0 20);
+    ignore (Unix.write fd s 0 (String.length s))
+
+let rec really_read fd buffer start length =
+  if length <= 0 then () else
+    match Unix.read fd buffer start length with
+	0 -> raise End_of_file
+      | r -> really_read fd buffer (start + r) (length - r);;
+
+let read fd =
+  let buffer = String.create 20 in
+  let _ =  really_read fd buffer 0 20 in
+  let size = int_of_string buffer in
+  let buffer = String.create size in
+  let _ =  really_read fd buffer 0 size in
+    buffer
+    
+
+let save t str =
+  let fd = Unix.openfile str [ Unix.O_WRONLY;Unix.O_TRUNC;Unix.O_CREAT] 0o644 in
+  let out_c = Unix.out_channel_of_descr fd in
+  let _ = set_binary_mode_out out_c true in
+    output_string out_c magic_string;
+    output_char out_c '\n';
+    output_string out_c version_string;
+    output_char out_c '\n';
+    Marshal.to_channel out_c t.ttable [ ];
+    (* we need to move the fd to the correct position *)
+    flush out_c;
+    ignore (Unix.lseek fd (pos_out out_c) Unix.SEEK_SET);
+    tree_save t.doc fd;
+    close_out out_c
 ;;
 
 let load ?(sample=64) str = 
-  node_of_t (load_tree str sample)
-    
+  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 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 =
+      Marshal.from_channel in_c 
+    in
+    let ntable = Hashtbl.create (Hashtbl.length table) in
+      Hashtbl.iter (fun k (s1,s2,s3,s4) -> 
+		      let ss1 = Ptset.Int.fold (Ptset.Int.add) s1 Ptset.Int.empty
+		      and ss2 = Ptset.Int.fold (Ptset.Int.add) s2 Ptset.Int.empty
+		      and ss3 = Ptset.Int.fold (Ptset.Int.add) s3 Ptset.Int.empty
+		      and ss4 = Ptset.Int.fold (Ptset.Int.add) s4 Ptset.Int.empty
+		      in Hashtbl.add ntable k (ss1,ss2,ss3,ss4)
+		   ) table;
+      Hashtbl.clear table;
+      (* 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
+  
 
 
 
 let tag_pool t = pool t.doc
   
-let compare a b = a - b
+let compare = compare_node
 
 let equal a b = a == b
    
@@ -282,16 +394,18 @@ let nts = function
     -1 -> "Nil"
   | i -> Printf.sprintf "Node (%i)"  i
       
-let dump_node t = nts t
+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
+let first_element t = (); fun n -> tree_first_element t.doc n
 
 (* these function will be called in two times: first partial application
    on the tag, then application of the tag and the tree, then application of
@@ -305,6 +419,8 @@ let select_child t = fun ts ->
     fun n -> tree_select_child t.doc n v
 
 let next_sibling t = (); fun n ->  tree_next_sibling t.doc n
+let next_element t = (); fun n ->  tree_next_element t.doc n
+
 let tagged_sibling t tag = (); fun n -> tree_tagged_sibling t.doc n tag
 
 let select_sibling t = fun ts ->
@@ -312,6 +428,7 @@ let select_sibling t = fun ts ->
     fun n -> tree_select_foll_sibling t.doc n v
 
 let next_sibling_ctx t = (); fun n _ -> tree_next_sibling t.doc n
+let next_element_ctx t = (); fun n _ ->  tree_next_element t.doc n
 let tagged_sibling_ctx t tag = (); fun n  _ -> tree_tagged_sibling t.doc n tag
 
 let select_sibling_ctx t = fun ts -> 
@@ -328,7 +445,7 @@ let select_desc t = fun ts ->
   let v = (ptset_to_vector ts) in ();
     fun n -> tree_select_desc t.doc n v
 
-let tagged_foll_ctx t tag = (); fun n ctx -> tree_tagged_foll_below t.doc n tag ctx
+let tagged_foll_ctx  t tag = (); fun n ctx -> tree_tagged_foll_below t.doc n tag ctx
 
 let select_foll_ctx t = fun ts ->
   let v = (ptset_to_vector ts) in ();
@@ -356,10 +473,15 @@ let array_find a i j =
       then 
 	let tagid = tree_tag_id tree.doc t in
 	  if tagid==Tag.pcdata
-	  then output_string outc (text_get_cached_text tree.doc t);
-	  if print_right
-	  then loop (next_sibling tree t)
-	    
+	  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);
+	    end
 	  else
 	    let tagstr = Tag.to_string tagid in
 	    let l = first_child tree t 
@@ -391,14 +513,19 @@ let array_find a i j =
 		    output_char outc '>';
 		  end;
 	      if print_right then loop r
-    and loop_attributes a =    
+    and loop_attributes a = 
+      if a != nil
+      then
       let s = (Tag.to_string (tag tree a)) in
       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 "=\"";
-	output_string outc (text_get_cached_text tree.doc
-			      (tree_my_text tree.doc (first_child tree a)));
+	output_string outc (text_get_cached_text tree.doc tid);
 	output_char outc '"';
 	loop_attributes (next_sibling tree a)
     in
@@ -410,19 +537,27 @@ let array_find a i j =
 	print_xml_fast outc tree (first_child tree t)
       else print_xml_fast outc tree t 
 	
+let tags_children t tag = 
+  let a,_,_,_ = Hashtbl.find t.ttable tag in a
 let tags_below t tag = 
-  fst(Hashtbl.find t.ttable tag)
-
+  let _,a,_,_ = Hashtbl.find t.ttable tag in a
+let tags_siblings t tag = 
+  let _,_,a,_ = Hashtbl.find t.ttable tag in a
 let tags_after t tag = 
-  snd(Hashtbl.find t.ttable tag)
+  let _,_,_,a = Hashtbl.find t.ttable tag in a
+
 
 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
 
@@ -432,7 +567,7 @@ let subtree_tags t tag = ();
 
 let get_text t n =
   let tid = tree_my_text t.doc n in
-    if tid == nil then "" else 
+    if tid == nulldoc then "" else 
       text_get_cached_text t.doc tid