- let equal : [`Tree ] node -> [`Tree] node -> bool = equal
- external serialize : t -> string -> unit = "caml_xml_tree_serialize"
- external unserialize : string -> t = "caml_xml_tree_unserialize"
-
- external root : t -> [`Tree] node = "caml_xml_tree_root"
- external nullt : unit -> [`Tree ] node = "caml_xml_tree_nullt"
-
- let nil = nullt ()
- let is_nil x = equal x nil
-
- external parent : t -> [`Tree] node -> [`Tree] node = "caml_xml_tree_parent"
- external parent_doc : t -> [`Text ] node -> [`Tree ] node = "caml_xml_tree_parent_doc"
- external prev_doc : t -> [`Text ] node -> [`Tree ] node = "caml_xml_tree_prev_doc"
- external first_child : t -> [`Tree] node -> [`Tree] node = "caml_xml_tree_first_child"
-
-
-
- external next_sibling : t -> [`Tree] node -> [`Tree] node = "caml_xml_tree_next_sibling"
- external prev_sibling : t -> [`Tree] node -> [`Tree] node = "caml_xml_tree_prev_sibling"
- external is_leaf : t -> [`Tree] node -> bool = "caml_xml_tree_is_leaf"
-
-(* external tag : t -> [`Tree ] node -> T = "caml_xml_tree_tag"*)
- external tag_id : t -> [`Tree ] node -> Tag.t = "caml_xml_tree_tag_id"
-
-(*
- let tag_hash = Array.make 6_000_000 (Tag.nullt)
-
- let tag_id t id =
- let tag = tag_hash.(int_of_node id)
- in
- if tag != Tag.nullt then tag
- else
- let tag = tag_id t id in
- (tag_hash.(int_of_node id) <- tag; tag)
-*)
- let is_last t n = equal nil (next_sibling t n)
-
- external prev_text : t -> [`Tree] node -> [`Text ] node = "caml_xml_tree_prev_text"
-
-
- external my_text : t -> [`Tree] node -> [`Text ] node = "caml_xml_tree_my_text"
- external next_text : t -> [`Tree] node -> [`Text ] node = "caml_xml_tree_next_text"
- external doc_ids : t -> [`Tree ] node -> [`Text ] node * [`Text ] node = "caml_xml_tree_doc_ids"
- external text_xml_id : t -> [`Text ] node -> int = "caml_xml_tree_text_xml_id"
- external node_xml_id : t -> [`Tree ] node -> int = "caml_xml_tree_node_xml_id"
- external is_ancestor : t -> [`Tree ] node -> [`Tree ] node -> bool = "caml_xml_tree_is_ancestor"
- external tagged_desc : t -> [`Tree ] node -> Tag.t -> [`Tree ] node = "caml_xml_tree_tagged_desc"
- external tagged_foll : t -> [`Tree ] node -> Tag.t -> [`Tree ] node = "caml_xml_tree_tagged_foll"
- external subtree_tags : t -> [`Tree ] node -> Tag.t -> int = "caml_xml_tree_subtree_tags"
- external tagged_below : t -> [`Tree ] node -> Ptset.int_vector -> Ptset.int_vector -> [`Tree ] node = "caml_xml_tree_tagged_below"
- external tagged_desc_only : t -> [`Tree ] node -> Ptset.int_vector -> [`Tree ] node = "caml_xml_tree_tagged_desc_only"
- external tagged_next : t -> [`Tree ] node -> Ptset.int_vector -> Ptset.int_vector -> [`Tree ] node -> [`Tree ] node = "caml_xml_tree_tagged_next"
- external tagged_foll_only : t -> [`Tree ] node -> Ptset.int_vector -> [`Tree ] node -> [`Tree ] node = "caml_xml_tree_tagged_foll_only"
- external tagged_desc_or_foll_only : t -> [`Tree ] node -> Ptset.int_vector -> [`Tree ] node -> [`Tree ] node = "caml_xml_tree_tagged_foll_only"
- external tagged_foll_below : t -> [`Tree ] node -> Tag.t -> [`Tree ] node -> [`Tree ] node = "caml_xml_tree_tagged_foll_below"
-
- let test_jump tree tag =
- let rec loop id ctx =
- if id != nil
- then
- let first = tagged_desc tree id tag
- and next = tagged_desc tree id tag
- in
- loop first id;
- loop next ctx
- in
- loop (root tree) (root tree)
-
-
- let test_xml_tree ppf tags v =
- let pr x = Format.fprintf ppf x in
- let rec aux id =
- if (is_nil id)
- then ()
- else
- begin
- pr "Node %i, (Tag) %i='%s' (GetTagName), NodeXMLId (Preorder)=%i\n%!"
- (int_of_node id)
- (tag_id v id)
- (Tag.to_string (tag_id v id))
- (node_xml_id v id);
- pr "DocID of PrevText,MyText,NextText : (%i = %s,%i = %s,%i = %s) ParentDoc(my_text)=%i PrevDoc(next_text)=%i\n%!"
- (int_of_node (prev_text v id))
- (Text.get_text v (prev_text v id))
- (int_of_node (my_text v id))
- (Text.get_text v (my_text v id))
- (int_of_node (next_text v id))
- (Text.get_text v (next_text v id))
- (int_of_node(parent_doc v (my_text v id)))
- (int_of_node(prev_doc v (next_text v id)));
- let i1,i2 = doc_ids v id in
- pr "Testing DocIds below (%i,%i)*\n%!"
- (int_of_node i1) (int_of_node i2);
- pr "Testing Tagged*\n%!";
- Ptset.iter (fun t ->
- let str = Tag.to_string t in
- if Tag.pcdata <> t
- then begin
- pr "Tag: %s : \n%!" str;
- pr "TaggedDesc = %i%!, " (tagged_desc v id t);
- pr "TaggedFoll = %i\n%!" (tagged_foll v id t);
- pr "SubtreeTags = %i\n%!" (subtree_tags v id t);
- end) tags;
- pr "----------------------------\n";
- aux(first_child v id);
- aux(next_sibling v id);
- end
- in
- aux (root v)
-
- let rrrr = ref 0
-
- let time_xml_tree v tag =
-
- let rec aux id acc =
- incr rrrr;
- if (is_nil id)
- then acc
- else begin
- let acc =
- if tag == (tag_id v id)
- then
- id::acc
- else acc
- in
- aux (next_sibling v id) (aux (first_child v id) acc);
- end
- in
- let r = aux (root v) [] in
- Printf.eprintf "%i\n%!" !rrrr;r
-
- let rrrr2 = ref 0
- let time_xml_tree2 v tag =
- let rec aux id acc ctx=
- incr rrrr2;
- if (is_nil id)
- then acc
- else begin
- let acc =
- if tag == (tag_id v id)
- then
- id::acc
- else acc
- in
- aux (tagged_foll_below v id tag ctx) (aux (tagged_desc v id tag) acc id) ctx;
- end
- in
- let r = aux (root v) [] (root v) in
- Printf.eprintf "%i\n%!" !rrrr2; r
-
-
-
-
-
-
- let print_skel t =
- let rec aux id =
- if (is_nil id)
- then Printf.eprintf "#\n"
- else
- begin
- Printf.eprintf "Node %i has tag '%i=%s' DocOrder=%i, DocID of PrevText,MyText,NextText : (%i = %s,%i = %s,%i = %s) parent_doc(my_text)=%i\n%!"
- (int_of_node id)
- (tag_id t id)
- (Tag.to_string (tag_id t id))
- (node_xml_id t id)
- (int_of_node (prev_text t id))
- (Text.get_text t (prev_text t id))
- (int_of_node (my_text t id))
- (Text.get_text t (my_text t id))
- (int_of_node (next_text t id))
- (Text.get_text t (next_text t id))
- (int_of_node(parent_doc t (my_text t id)));
-
- aux(first_child t id);
- aux(next_sibling t id);
- end
- in
- aux (root t)