X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftree.ml;h=6bda2925e4e2c8e0859c95c5fc2f06e24be32b21;hb=7166a99542af5ad2f5b53fe9fa9e5164dff7cfe5;hp=27ceed6492ad3ba103dac086d7b68115dcfa22c3;hpb=4b52da1a20a4fe031930bb96d2ca46bec06dc529;p=SXSI%2Fxpathcomp.git diff --git a/src/tree.ml b/src/tree.ml index 27ceed6..6bda292 100644 --- a/src/tree.ml +++ b/src/tree.ml @@ -8,7 +8,7 @@ INCLUDE "debug.ml" INCLUDE "utils.ml" -external init_lib : unit -> unit = "caml_init_lib" +external init_lib : unit -> unit = "sxsi_cpp_init" exception CPlusPlusError of string @@ -20,6 +20,99 @@ type node = [ `Tree ] Node.t type tree + +module TreeBuilder = +struct + type t + external create : unit -> t = "caml_xml_tree_builder_create" + external open_document : t -> bool -> int -> bool -> int -> unit = "caml_xml_tree_builder_open_document" + external close_document : t -> tree = "caml_xml_tree_builder_close_document" + external open_tag : t -> string -> unit = "caml_xml_tree_builder_new_open_tag" + external close_tag : t -> string -> unit = "caml_xml_tree_builder_new_closing_tag" + external text : t -> string -> unit = "caml_xml_tree_builder_new_text" + + + let do_text b t = + if Buffer.length t > 0 then begin + open_tag b "<$>"; + text b (Buffer.contents t); + close_tag b "<$>"; + Buffer.clear t + end + + let output_attr b name value = + let atname = "<@>" ^ name in + open_tag b atname; + open_tag b "<@$>"; + text b value; + close_tag b "<@$>"; + close_tag b atname + + let start_element_handler b t tag attr_list = + do_text b t; + open_tag b tag; + match attr_list with + [] -> () + | l -> + open_tag b "<@>"; + List.iter (fun (name, value) -> output_attr b name value) l; + close_tag b "<@>" + + + let end_element_handler b t tag = + do_text b t; + close_tag b tag + + let character_data_handler _b t text = + Buffer.add_string t text + + let create_parser () = + let buf = Buffer.create 512 in + let build = create () in + let parser_ = Expat.parser_create ~encoding:None in + let finalize () = + do_text build buf; + close_tag build ""; + close_document build + in + Expat.set_start_element_handler parser_ (start_element_handler build buf); + Expat.set_end_element_handler parser_ (end_element_handler build buf); + Expat.set_character_data_handler parser_ (character_data_handler build buf); + open_document build !Options.index_empty_texts !Options.sample_factor + !Options.disable_text_collection !Options.text_index_type; + open_tag build ""; + parser_, finalize + + let parse_string s = + let parser_, finalizer = create_parser () in + Expat.parse parser_ s; + finalizer () + + let parse_file file = + let in_chan = open_in file in + let buffer = String.create 4096 in + let parser_, finalizer = create_parser () in + let () = + try + while true do + let read = input in_chan buffer 0 4096 in + if read == 0 then raise End_of_file else + Expat.parse_sub parser_ buffer 0 read; + done + + with + | End_of_file -> close_in in_chan + | e -> raise e + in + finalizer () + + + +end + + + + type bit_vector = string external bool_of_int : int -> bool = "%identity" @@ -41,8 +134,10 @@ type t = { +(* 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_print_xml_fast3 : tree -> [`Tree ] Node.t -> Unix.file_descr -> unit = "caml_xml_tree_print" let print_xml t n fd = tree_print_xml_fast3 t.doc n fd @@ -105,6 +200,9 @@ let next_sibling t n = tree_next_sibling t.doc n 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 @@ -119,6 +217,9 @@ let prev_sibling t n = tree_prev_sibling t.doc n external tree_tagged_descendant : tree -> [`Tree ] Node.t -> Tag.t -> [`Tree ] Node.t = "caml_xml_tree_tagged_descendant" "noalloc" 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" let select_descendant t n tag_set = tree_select_descendant t.doc n tag_set @@ -415,16 +516,9 @@ let node_of_t t = } -let parse f str = - node_of_t - (f str !Options.sample_factor - !Options.index_empty_texts - !Options.disable_text_collection - !Options.text_index_type - ) -let parse_xml_uri str = parse parse_xml_uri str -let parse_xml_string str = parse parse_xml_string str +let parse_xml_uri str = node_of_t (TreeBuilder.parse_file str) +let parse_xml_string str = node_of_t (TreeBuilder.parse_string str) let size t = tree_size t.doc;;