Refactoring, 1st tier:

[SXSI/xpathcomp.git] / src / tree.ml

diff --git a/src/tree.ml b/src/tree.ml
index 97a850c..a8a3a96 100644 (file)
--- 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
@@ -418,16 +513,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;;
 
@@ -503,6 +591,7 @@ let load ?(sample=64) ?(load_text=true) str =
   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