type tree
+external register_tag : tree -> string -> Tag.t = "caml_xml_tree_register_tag"
+
+external tag_name : tree -> Tag.t -> string = "caml_xml_tree_get_tag_name"
+
+let tag t = (); fun s ->
+ match s with
+ | "<$>" -> Tag.pcdata
+ | "<@>" -> Tag.attribute
+ | "" -> Tag.document_node
+ | "<@$>" -> Tag.attribute_data
+ | _ -> register_tag t s
+
+let to_string d = ();
+ fun t ->
+ if t == Tag.pcdata then "<$>"
+ else if t == Tag.attribute_data then "<@$>"
+ else if t == Tag.attribute then "<@>"
+ else if t == Tag.nullt then "<!NIL!>"
+ else tag_name d t
+
+let translate x = x
+
+let mk_tag_ops t = {
+ Tag.tag = tag t;
+ Tag.to_string = to_string t;
+ Tag.translate = translate
+}
+
module TreeBuilder =
struct
type t
}
-
+let tag_operations t = mk_tag_ops t.doc
(*
external parse_xml_uri : string -> int -> bool -> bool -> int -> tree = "caml_call_shredder_uri"
external parse_xml_string : string -> int -> bool -> bool -> int -> tree = "caml_call_shredder_string"
external tree_next_element : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_next_element" "noalloc"
let next_element t n = tree_next_element t.doc n
+external tree_next_node_before : tree -> [`Tree] Node.t -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_next_node_before" "noalloc"
+let next_node_before t n ctx = tree_next_node_before t.doc n ctx
+
external tree_tagged_following_sibling : tree -> [`Tree] Node.t -> Tag.t -> [`Tree] Node.t = "caml_xml_tree_tagged_following_sibling" "noalloc"
let tagged_following_sibling t n tag = tree_tagged_following_sibling t.doc n tag
let is_root t = t == root
let node_of_t t =
- let _ = Tag.init (Obj.magic t) in
+ let _ = Tag.init (mk_tag_ops t) in
let f, n, c, d = time collect_labels t ~msg:"Building tag relationship table" in
let c = Array.map TagS.to_ptset c in
let n = Array.map TagS.to_ptset n in
let size t = tree_size t.doc;;
-external pool : tree -> Tag.pool = "%identity"
-
let magic_string = "SXSI_INDEX"
let version_string = "3"
let c, s, d, f = time ~msg:"Loading tag table"(load_table) () in
ignore(Unix.lseek fd (pos_in in_c) Unix.SEEK_SET);
let xml_tree = tree_load fd str load_text sample in
- Printf.eprintf "Root is: %i\n" (Obj.magic (tree_root xml_tree));
let () = Tag.init (Obj.magic xml_tree) in
let attributes = Ptset.Int.add Tag.attribute d.(Tag.attribute) in
let elements = Ptset.Int.add Tag.document_node
-let tag_pool t = pool t.doc
-
let equal a b = a == b
let nts = function