(******************************************************************************) (* SXSI : XPath evaluator *) (* Kim Nguyen (Kim.Nguyen@nicta.com.au) *) (* Copyright NICTA 2008 *) (* Distributed under the terms of the LGPL (see LICENCE) *) (******************************************************************************) INCLUDE "debug.ml" INCLUDE "log.ml" INCLUDE "utils.ml" external init_lib : unit -> unit = "sxsi_cpp_init" exception CPlusPlusError of string let () = Callback.register_exception "CPlusPlusError" (CPlusPlusError "") let () = init_lib () type node = [ `Tree ] Node.t 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 "" 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 external create : unit -> t = "caml_xml_tree_builder_create" external open_document : t -> 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_open_tag" external close_tag : t -> string -> unit = "caml_xml_tree_builder_close_tag" external text : t -> string -> unit = "caml_xml_tree_builder_text" external trim : string -> string = "caml_trim" let is_whitespace s = let rec loop len i = if i < len then let c = s.[i] in (c == '\n' || c == '\t' || c == ' ') && loop len (i+1) else true in loop (String.length s) 0 let display_count = let event_counter = ref 0 in (fun parser_ -> incr event_counter; if !event_counter land 0xffffff == 0 then Logger.print Format.err_formatter "Current position: %i@\n@?" (Expat.get_current_byte_index parser_)) let do_text b t = if Buffer.length t > 0 then begin let s = Buffer.contents t in if (!Config.index_empty_texts) || not (is_whitespace s) then begin open_tag b "<$>"; text b s; close_tag b "<$>"; end; 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 parser_ 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 parser_ b t tag = do_text b t; close_tag b tag let character_data_handler parser_ _ 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 ""; LOG ( __ "parsing" 2 "%s\n" "Finished parsing"); LOG ( __ "indexing" 2 "%s\n" "Starting index construction"); let r = close_document build in LOG ( __ "indexing" 2 "%s\n" "Finished index construction"); r in Expat.set_start_element_handler parser_ (start_element_handler parser_ build buf); Expat.set_end_element_handler parser_ (end_element_handler parser_ build buf); Expat.set_character_data_handler parser_ (character_data_handler parser_ build buf); LOG ( __ "parsing" 2 "%s\n" "Started parsing"); open_document build !Config.sample_factor !Config.disable_text_collection !Config.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 parse () = 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 Utils.time ~msg:"Parsing XML file" parse (); Utils.time ~msg:"Creating tree and text-collection index" finalizer () end type bit_vector = string external bool_of_int : int -> bool = "%identity" external int_of_bool : bool -> int = "%identity" let bit_vector_unsafe_get v i = bool_of_int (((Char.code (String.unsafe_get v (i lsr 3))) lsr (i land 7)) land 1) let chr (c:int) : char = Obj.magic (c land 0xff) let bit_vector_unsafe_set v i b = let j = i lsr 3 in let c = Char.code v.[j] in let bit = int_of_bool b in let mask = bit lsl (i land 7) in if b then v.[j] <- chr (c lor mask) else v.[j] <- (chr (c land (lnot mask))) let bit_vector_create n = let len = if n <= 0 then 0 else (n - 1) / 8 + 1 in String.make len '\000' type tag_list 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" type t = { doc : tree; elements: Ptset.Int.t; attributes: Ptset.Int.t; attribute_array : tag_list; children : Ptset.Int.t array; siblings : Ptset.Int.t array; descendants: Ptset.Int.t array; followings: Ptset.Int.t array; } 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_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 external tree_save : tree -> Unix.file_descr -> string -> unit = "caml_xml_tree_save" external tree_load : Unix.file_descr -> string -> bool -> int -> tree = "caml_xml_tree_load" external nullt : unit -> 'a Node.t = "caml_xml_tree_nullt" let nil : [`Tree ] Node.t = Node.nil let root : [`Tree ] Node.t = Node.null module HPtset = Hashtbl.Make(Ptset.Int) let vector_htbl = HPtset.create MED_H_SIZE let reinit () = HPtset.clear vector_htbl let tag_list_of_set s = try HPtset.find vector_htbl s with 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 *) external tree_root : tree -> [`Tree] Node.t = "caml_xml_tree_root" "noalloc" external tree_first_child : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_first_child" "noalloc" let first_child t n = tree_first_child t.doc n external tree_first_element : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_first_element" "noalloc" 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 -> 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" let last_child t n = tree_last_child t.doc n external tree_next_sibling : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_next_sibling" "noalloc" 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_tagged_sibling : tree -> [`Tree] Node.t -> Tag.t -> [`Tree] Node.t = "caml_xml_tree_tagged_sibling" "noalloc" let tagged_sibling t n tag = tree_tagged_sibling t.doc n tag 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" 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 -> 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 -> 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" let parent t n = tree_parent t.doc n external tree_tag : tree -> [`Tree] Node.t -> Tag.t = "caml_xml_tree_tag" "noalloc" let tag t n = tree_tag t.doc n external tree_is_first_child : tree -> [ `Tree ] Node.t -> bool = "caml_xml_tree_is_first_child" "noalloc" let is_first_child t n = tree_is_first_child t.doc n external tree_is_right_descendant : tree -> [ `Tree ] Node.t -> [`Tree] Node.t -> bool = "caml_xml_tree_is_right_descendant" "noalloc" let is_right_descendant t n1 n2 = tree_is_right_descendant t.doc n1 n2 ;; let node_tags t = Ptset.Int.add Tag.document_node t.descendants.(Tag.document_node) let attribute_tags t = t.attributes let element_tags t = t.elements let tags t tag = t.children.(tag), t.descendants.(tag), t.siblings.(tag), t.followings.(tag) open Format let dump_tag_table t = let tag = ref 0 in let printer ppf set = Logger.print ppf "%s: %a" (Tag.to_string !tag) TagSet.print (TagSet.inj_positive set); incr tag in let set_printer msg set = tag := 0; Logger.print err_formatter "%s :@\n" msg; Pretty.pp_print_array ~sep:pp_force_newline printer err_formatter set; Logger.print err_formatter "-----------------------------@\n"; in set_printer "Child tags" t.children; set_printer "Descendant tags" t.descendants; set_printer "Sibling tags" t.siblings; set_printer "Following tags" t.followings external tree_subtree_tags : tree -> [`Tree] Node.t -> Tag.t -> int = "caml_xml_tree_subtree_tags" "noalloc" let subtree_tags t n tag = tree_subtree_tags t.doc n tag external tree_subtree_size : tree -> [`Tree] Node.t -> int = "caml_xml_tree_subtree_size" "noalloc" let subtree_size t n = tree_subtree_size t.doc n let rec iter_array_tag i a len tree node acc = if i == len then acc else iter_array_tag (i+1) a len tree node (acc - (tree_subtree_tags tree node a.(i))) external tree_subtree_elements : tree -> [`Tree] Node.t -> int = "caml_xml_tree_subtree_elements" "noalloc" let subtree_elements t node = tree_subtree_elements t.doc node (* let subtree_elements t node = let size = tree_subtree_size t.doc node - 1 in if size <= 0 then 0 else let size = size - (tree_subtree_tags t.doc node Tag.pcdata) in if size < 3 then size else let a = t.attribute_array in iter_array_tag 0 a (Array.length a) t.doc node size *) external tree_closing : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_closing" "noalloc" let closing t n = tree_closing t.doc n external tree_num_tags : tree -> int = "caml_xml_tree_num_tags" "noalloc" let num_tags t = tree_num_tags t.doc external tree_size : tree -> int = "caml_xml_tree_size" "noalloc" let size t = tree_size t.doc module TagS = struct include Ptset.Make ( struct type t = int type data = t external hash : t -> int = "%identity" external uid : t -> Uid.t = "%identity" external equal : t -> t -> bool = "%eq" external make : t -> int = "%identity" external node : t -> int = "%identity" external stats : unit -> unit = "%identity" external init : unit -> unit = "%identity" end ) let to_ptset s = fold (Ptset.Int.add) s Ptset.Int.empty end module TSTSCache = Hashtbl.Make(struct type t = TagS.t * TagS.t let hash (x, y) = HASHINT2(Uid.to_int x.TagS.Node.id, Uid.to_int y.TagS.Node.id) let equal u v = let u1,u2 = u and v1,v2 = v in u1 == v1 && u2 == v2 end) module TagTSCache = Hashtbl.Make(struct type t = Tag.t * TagS.t let hash (x, y) = HASHINT2(x, Uid.to_int y.TagS.Node.id) let equal u v = let u1,u2 = u and v1,v2 = v in u1 == v1 && u2 == v2 end) let add_cache = TagTSCache.create 1023 let union_cache = TSTSCache.create 1023 let subset_cache = TSTSCache.create 1023 let clear_cache () = TSTSCache.clear union_cache; TSTSCache.clear subset_cache; TagTSCache.clear add_cache let _subset x y = (x == y) || (x == TagS.empty) || if y == TagS.empty then false else let key = (x, y) in try TSTSCache.find subset_cache key with | Not_found -> let z = TagS.subset x y in TSTSCache.add subset_cache key z; z let order ((x, y) as z) = if x.TagS.Node.id <= y.TagS.Node.id then z else (y, x) let _union x y = if _subset x y then y else if _subset y x then x else let key = order (x, y) in try TSTSCache.find union_cache key with | Not_found -> let z = TagS.union x y in TSTSCache.add union_cache key z; z let _add t s = let key = (t,s) in try TagTSCache.find add_cache key with | Not_found -> let z = TagS.add t s in TagTSCache.add add_cache key z;z let child_sibling_labels tree = let table_c = Array.create (tree_num_tags tree) TagS.empty in let table_n = Array.copy table_c in let rec loop node = if node == nil then TagS.empty else let children = loop (tree_first_child tree node) in let tag = tree_tag tree node in let () = let tc = table_c.(tag) in if _subset children tc then () else table_c.(tag) <- _union tc children in let siblings = loop (tree_next_sibling tree node) in let () = let tn = table_n.(tag) in if _subset siblings tn then () else table_n.(tag) <- _union tn siblings in _add tag siblings in ignore (loop root); table_c, table_n let descendant_labels tree = let table_d = Array.create (tree_num_tags tree) TagS.empty in let rec loop node = if node == nil then TagS.empty else let d1 = loop (tree_first_child tree node) in let d2 = loop (tree_next_sibling tree node) in let tag = tree_tag tree node in let () = let td = table_d.(tag) in if _subset d1 td then () else table_d.(tag) <- _union td d1; in _add tag (_union d1 d2) in ignore (loop root); table_d let collect_labels tree = let table_f = Array.create (tree_num_tags tree) TagS.empty in let table_n = Array.copy table_f in let table_c = Array.copy table_f in let table_d = Array.copy table_f in let rec loop node foll_siblings descendants followings = if node == nil then foll_siblings, descendants, followings else let tag = tree_tag tree node in let () = let tf = table_f.(tag) in if _subset followings tf then () else table_f.(tag) <- _union tf followings in let () = let tn = table_n.(tag) in if _subset foll_siblings tn then () else table_n.(tag) <- _union tn foll_siblings in let children, n_descendants, n_followings = loop (tree_last_child tree node) TagS.empty TagS.empty followings in let () = let tc = table_c.(tag) in if _subset children tc then () else table_c.(tag) <- _union tc children in let () = let td = table_d.(tag) in if _subset n_descendants td then () else table_d.(tag) <- _union td n_descendants in loop (tree_prev_sibling tree node) (_add tag foll_siblings) (_add tag (_union n_descendants descendants)) (_add tag n_followings) in ignore (loop root TagS.empty TagS.empty TagS.empty); table_f, table_n, table_c, table_d let is_nil t = t == nil let is_node t = t != nil let is_root t = t == root let node_of_t t = LOG ( __ "indexing" 2 "%s\n" "Initializing tag structure"); let _ = Tag.init (mk_tag_ops t) in LOG ( __ "indexing" 2 "%s\n" "Starting tag table construction"); let f, n, c, d = Utils.time ~msg:"Building tag relationship table" collect_labels t in let c = Array.map TagS.to_ptset c in let n = Array.map TagS.to_ptset n in let f = Array.map TagS.to_ptset f in let d = Array.map TagS.to_ptset d in let () = clear_cache () in let attributes = Ptset.Int.add Tag.attribute d.(Tag.attribute) in let elements = Ptset.Int.add Tag.document_node (Ptset.Int.remove Tag.pcdata (Ptset.Int.diff d.(Tag.document_node) attributes)) in { doc= t; attributes = attributes; attribute_array = tag_list_of_set attributes; elements = elements; children = c; siblings = n; descendants = d; followings = f } 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;; let magic_string = "SXSI_INDEX" let version_string = "4" let pos fd = Unix.lseek fd 0 Unix.SEEK_CUR let pr_pos fd = Logger.print err_formatter "At position %i@\n" (pos fd) let write fd s = let sl = String.length s in let ssl = Printf.sprintf "%020i" sl in ignore (Unix.write fd ssl 0 20); ignore (Unix.write fd s 0 (String.length s)) let rec really_read fd buffer start length = if length <= 0 then () else match Unix.read fd buffer start length with 0 -> raise End_of_file | r -> really_read fd buffer (start + r) (length - r);; let read fd = let buffer = String.create 20 in let _ = really_read fd buffer 0 20 in let size = int_of_string buffer in let buffer = String.create size in let _ = really_read fd buffer 0 size in buffer let save_tag_table channel t = let t = Array.map (fun s -> Array.of_list (Ptset.Int.elements s)) t in Marshal.to_channel channel t [] let save t str = let fd = Unix.openfile str [ Unix.O_WRONLY;Unix.O_TRUNC;Unix.O_CREAT] 0o644 in let out_c = Unix.out_channel_of_descr fd in let index_prefix = Filename.chop_suffix str ".srx" in let _ = set_binary_mode_out out_c true in output_string out_c magic_string; output_char out_c '\n'; output_string out_c version_string; output_char out_c '\n'; save_tag_table out_c t.children; save_tag_table out_c t.siblings; save_tag_table out_c t.descendants; save_tag_table out_c t.followings; (* we need to move the fd to the correct position *) flush out_c; ignore (Unix.lseek fd (pos_out out_c) Unix.SEEK_SET); tree_save t.doc fd index_prefix; close_out out_c ;; let load_tag_table channel = let table : int array array = Marshal.from_channel channel in Array.map (fun a -> Ptset.Int.from_list (Array.to_list a)) table let load ?(sample=64) ?(load_text=true) str = let fd = Unix.openfile str [ Unix.O_RDONLY ] 0o644 in let in_c = Unix.in_channel_of_descr fd in let index_prefix = Filename.chop_suffix str ".srx" in let _ = set_binary_mode_in in_c true in let load_table () = (let ms = input_line in_c in if ms <> magic_string then failwith "Invalid index file"); (let vs = input_line in_c in if vs <> version_string then failwith "Unsupported index format"); let c = load_tag_table in_c in let s = load_tag_table in_c in let d = load_tag_table in_c in let f = load_tag_table in_c in c,s,d,f in 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 index_prefix load_text sample in 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 (Ptset.Int.remove Tag.pcdata (Ptset.Int.diff d.(Tag.document_node) attributes)) in let tree = { doc = xml_tree; attributes = attributes; attribute_array = tag_list_of_set attributes; elements = elements; children = c; siblings = s; descendants = d; followings = f } in close_in in_c; tree let equal a b = a == b let nts = function -1 -> "Nil" | i -> Printf.sprintf "Node (%i)" i let dump_node t = nts (Node.to_int t) type query_result = { bv : bit_vector; pos : node array; } external tree_flush : tree -> Unix.file_descr -> unit = "caml_xml_tree_flush" let flush t fd = tree_flush t.doc fd external text_prefix : tree -> string -> bool -> query_result = "caml_text_collection_prefix_bv" let text_prefix t s b = text_prefix t.doc s b external text_suffix : tree -> string -> bool -> query_result = "caml_text_collection_suffix_bv" let text_suffix t s b = text_suffix t.doc s b external text_equals : tree -> string -> bool -> query_result = "caml_text_collection_equals_bv" let text_equals t s b = text_equals t.doc s b external text_contains : tree -> string -> bool -> query_result = "caml_text_collection_contains_bv" let text_contains t s b = text_contains t.doc s b module Predicate = Hcons.Make ( struct type _t = t type t = (_t -> node -> bool) ref let hash t = Hashtbl.hash t let equal t1 t2 = t1 == t2 end) let string_of_query query = match query with | `Prefix -> "starts-with" | `Suffix -> "ends-with" | `Equals -> "equals" | `Contains -> "contains" ;; let query_fun = function | `Prefix -> text_prefix | `Suffix -> text_suffix | `Equals -> text_equals | `Contains -> text_contains ;; let _pred_cache = Hashtbl.create 17 ;; let mk_pred query s = LOG ( __ "bottom-up" 3 "Calling mk_pred for '%s'\n" s); let f = query_fun query in let memo = ref (fun _ _ -> failwith "Undefined") in memo := begin fun tree node -> let results = try Hashtbl.find _pred_cache (query,s) with Not_found -> time ~count:1 ~msg:(Printf.sprintf "Computing text query %s(%s)" (string_of_query query) s) (f tree) s true in let bv = results.bv in memo := begin fun _ n -> let r = bit_vector_unsafe_get bv (Node.to_int n) in LOG( __ "bottom-up" 3 "Running predicate on node %i = %b@\n" (Node.to_int n) r); r end; let r = bit_vector_unsafe_get bv (Node.to_int node) in LOG( __ "bottom-up" 3 "Running predicate on node %i = %b@\n" (Node.to_int node) r); r end; Predicate.make memo let full_text_prefix t s = (text_prefix t s true).pos let full_text_suffix t s = (text_suffix t s true).pos let full_text_equals t s = (text_equals t s true).pos let full_text_contains t s = (text_contains t s true).pos let full_text_query q t s = let res = (query_fun q) t s true in Hashtbl.replace _pred_cache (q,s) res; res.pos let stats tree = let h = Hashtbl.create 1024 in let depth = ref 0 in let numleaves = ref 0 in let numtexts = ref 0 in let rec traverse tree t p d = if is_nil t then let oldc = try Hashtbl.find h p with Not_found -> 0 in Hashtbl.replace h p (oldc + 1); if d > !depth then depth := d; incr numleaves else let label = tree_tag tree t in if label == Tag.pcdata || label == Tag.attribute_data then incr numtexts; iter_siblings tree t (label::p) (d+1) and iter_siblings tree t p d = if is_nil t then () else let fs = tree_first_child tree t in traverse tree fs p d; let ns = tree_next_sibling tree t in iter_siblings tree ns p d in traverse tree.doc root [] 0; let sumdepth = Hashtbl.fold (fun p c acc -> (List.length p) * c + acc) h 0 in let alltags = Ptset.Int.union tree.elements tree.attributes in Logger.print err_formatter "Statistics :@\n\ Average depth: %f@\n\ Longest path: %i@\n\ Number of distinct paths: %i@\n\ Number of nodes: %i@\n\ Number of leaves: %i@\n\ Number of pcdata/cdata nodes: %i@\n\ Number of distinct tags: %i@\n\ Largest tag id: %i@\n@?" (float_of_int sumdepth /. float_of_int !numleaves) !depth (Hashtbl.length h) (tree_subtree_size tree.doc root) !numleaves !numtexts (Ptset.Int.cardinal alltags) (Ptset.Int.max_elt alltags) type tree_pointer = tree let get_tree_pointer x = x.doc