X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftree.ml;h=fae8ebaea4dac30eea66c0b4b73db01f99acd189;hb=4309f9456521bffcab5ff79abe1ed826744c3a57;hp=bc81cf48ecffd4fa2a921c139c01d3e63510c507;hpb=83e9f9d8f219fece86afbedd1332d5ad97971d1c;p=SXSI%2Fxpathcomp.git

diff --git a/src/tree.ml b/src/tree.ml
index bc81cf4..fae8eba 100644
--- a/src/tree.ml
+++ b/src/tree.ml
@@ -96,7 +96,6 @@ struct
     close_tag b atname
 
   let start_element_handler parser_ b t tag attr_list =
-    display_count parser_;
     do_text b t;
     open_tag b tag;
     match attr_list with
@@ -108,12 +107,10 @@ struct
 
 
   let end_element_handler parser_ b t tag =
-    display_count parser_;
     do_text b t;
     close_tag b tag
 
   let character_data_handler parser_ _ t text =
-    display_count parser_;
     Buffer.add_string t text
 
   let create_parser () =
@@ -215,26 +212,25 @@ external nullt : unit -> 'a Node.t = "caml_xml_tree_nullt"
 let nil : [`Tree ] Node.t = Node.nil
 let root : [`Tree ] Node.t = Node.null
 
-type unordered_set
+type tag_list
 
-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"
+external tag_list_alloc : int -> tag_list = "caml_tag_list_alloc"
+external tag_list_set : tag_list -> int -> Tag.t -> unit = "caml_tag_list_set" "noalloc"
 
 module HPtset = Hashtbl.Make(Ptset.Int)
 
 let vector_htbl = HPtset.create MED_H_SIZE
 
-let unordered_set_of_set s =
+let tag_list_of_set s =
   try
     HPtset.find vector_htbl s
   with
-      Not_found ->
-	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
-
-let ptset_to_vector = unordered_set_of_set
+    Not_found ->
+      let v = tag_list_alloc (Ptset.Int.cardinal s + 1) in
+      let i = ref 0 in
+      let () = Ptset.Int.iter (fun e -> tag_list_set v !i e; incr i) s in
+      let () = tag_list_set v !i Tag.nullt in
+      HPtset.add vector_htbl s v; v
 
 (** tree interface *)
 
@@ -250,7 +246,7 @@ let first_element t n = tree_first_element t.doc n
 external tree_tagged_child : tree -> [`Tree] Node.t -> Tag.t -> [`Tree] Node.t = "caml_xml_tree_tagged_child" "noalloc"
 let tagged_child t n tag = tree_tagged_child t.doc n tag
 
-external tree_select_child : tree -> [`Tree ] Node.t -> unordered_set -> [`Tree] Node.t = "caml_xml_tree_select_child" "noalloc"
+external tree_select_child : tree -> [`Tree ] Node.t -> tag_list -> [`Tree] Node.t = "caml_xml_tree_select_child" "noalloc"
 let select_child t n tag_set = tree_select_child t.doc n tag_set
 
 external tree_last_child : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_last_child" "noalloc"
@@ -268,7 +264,7 @@ external tree_tagged_sibling : tree -> [`Tree] Node.t -> Tag.t -> [`Tree] Node.t
 let tagged_sibling t n tag = tree_tagged_sibling t.doc n tag
 
 
-external tree_select_sibling : tree -> [`Tree ] Node.t -> unordered_set -> [`Tree] Node.t = "caml_xml_tree_select_sibling" "noalloc"
+external tree_select_sibling : tree -> [`Tree ] Node.t -> tag_list -> [`Tree] Node.t = "caml_xml_tree_select_sibling" "noalloc"
 let select_sibling t n tag_set = tree_select_sibling t.doc n tag_set
 
 external tree_prev_sibling : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_prev_sibling" "noalloc"
@@ -282,13 +278,13 @@ let tagged_descendant t n tag = tree_tagged_descendant t.doc n tag
 external tree_tagged_next : tree -> [`Tree ] Node.t -> Tag.t -> [`Tree ] Node.t = "caml_xml_tree_tagged_next" "noalloc"
 let tagged_next t n tag = tree_tagged_next t.doc n tag
 
-external tree_select_descendant : tree -> [`Tree ] Node.t -> unordered_set -> [`Tree] Node.t = "caml_xml_tree_select_descendant" "noalloc"
+external tree_select_descendant : tree -> [`Tree ] Node.t -> tag_list -> [`Tree] Node.t = "caml_xml_tree_select_descendant" "noalloc"
 let select_descendant t n tag_set = tree_select_descendant t.doc n tag_set
 
 external tree_tagged_following_before : tree -> [`Tree ] Node.t -> Tag.t -> [`Tree ] Node.t -> [`Tree ] Node.t = "caml_xml_tree_tagged_following_before" "noalloc"
 let tagged_following_before t n tag ctx = tree_tagged_following_before t.doc n tag ctx
 
-external tree_select_following_before : tree -> [`Tree ] Node.t -> unordered_set -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_select_following_before" "noalloc"
+external tree_select_following_before : tree -> [`Tree ] Node.t -> tag_list -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_select_following_before" "noalloc"
 let select_following_before t n tag_set ctx = tree_select_following_before t.doc n tag_set ctx
 
 external tree_parent : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_parent" "noalloc"