From 35b9abd60699383b0cebf25e905049d3d7027271 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= Date: Fri, 20 Apr 2012 16:54:22 +0200 Subject: [PATCH] Add hooks to re-initialize hconsed modules. --- src/hcons.ml | 86 ++++++++------ src/hcons.mli | 12 +- src/hlist.ml | 6 +- src/hlist.mli | 2 + src/nodeSet.ml | 15 ++- src/ptset.ml | 35 +++--- src/ptset.mli | 1 + src/stateSet.ml | 1 + src/transition.mli | 1 + src/tree.ml | 290 +++++++++++++++++++++++---------------------- src/tree.mli | 2 + 11 files changed, 244 insertions(+), 207 deletions(-) diff --git a/src/hcons.ml b/src/hcons.ml index 5a7ad14..daa62a0 100644 --- a/src/hcons.ml +++ b/src/hcons.ml @@ -1,30 +1,32 @@ INCLUDE "utils.ml" module type SA = - sig - type data - type t - val make : data -> t - val node : t -> data - val hash : t -> int - val uid : t -> Uid.t - val equal : t -> t -> bool - val stats : unit -> unit - end +sig + type data + type t + val make : data -> t + val node : t -> data + val hash : t -> int + val uid : t -> Uid.t + val equal : t -> t -> bool + val stats : unit -> unit + val init : unit -> unit +end module type S = - sig +sig - type data - type t = private { id : Uid.t; - key : int; - node : data } - val make : data -> t - val node : t -> data - val hash : t -> int - val uid : t -> Uid.t - val equal : t -> t -> bool - val stats : unit -> unit - end + type data + type t = private { id : Uid.t; + key : int; + node : data } + val make : data -> t + val node : t -> data + val hash : t -> int + val uid : t -> Uid.t + val equal : t -> t -> bool + val stats : unit -> unit + val init : unit -> unit +end module Make (H : Hashtbl.HashedType) : S with type data = H.t = struct @@ -38,30 +40,42 @@ struct let hash t = t.key let equal t1 t2 = t1 == t2 module WH = Weak.Make( struct - type _t = t - type t = _t - let hash = hash - let equal a b = a == b || H.equal a.node b.node - end) + type _t = t + type t = _t + let hash = hash + let equal a b = a == b || H.equal a.node b.node + end) let pool = WH.create MED_H_SIZE exception Found of Uid.t + let total_count = ref 0 + let miss_count = ref 0 + let init () = + total_count := 0; + miss_count := 0 let make x = + incr total_count; let cell = { id = Uid.dummy; key = H.hash x; node = x } in - try - WH.find pool cell - with - | Not_found -> - let cell = { cell with id = uid_make(); } in - WH.add pool cell;cell + try + WH.find pool cell + with + | Not_found -> + let cell = { cell with id = uid_make(); } in + incr miss_count; + WH.add pool cell; + cell exception Found of t let stats () = - let l = WH.fold (fun cell acc -> (Uid.to_int cell.id)::acc) pool [] in + Logger.print Format.err_formatter "Hconsing statistics: %i/%i = %f@\n" + !miss_count + !total_count + ((float_of_int !miss_count) /. (float_of_int !total_count)) +(* let l = WH.fold (fun cell acc -> (Uid.to_int cell.id)::acc) pool [] in let l = List.sort compare l in Logger.print Format.err_formatter "Hconsing statistics:@\n%a" - (fun ppf l -> - Pretty.pp_print_list ~sep:Format.pp_force_newline Format.pp_print_int ppf l) l + (fun ppf l -> + Pretty.pp_print_list ~sep:Format.pp_force_newline Format.pp_print_int ppf l) l *) end diff --git a/src/hcons.mli b/src/hcons.mli index 2e18f82..efef8d4 100644 --- a/src/hcons.mli +++ b/src/hcons.mli @@ -8,20 +8,22 @@ module type SA = val uid : t -> Uid.t val equal : t -> t -> bool val stats : unit -> unit + val init : unit -> unit end -module type S = - sig +module type S = sig type data type t = private { id : Uid.t; - key : int; - node : data } + key : int; + node : data } val make : data -> t val node : t -> data val hash : t -> int val uid : t -> Uid.t val equal : t -> t -> bool val stats : unit -> unit - end + val init : unit -> unit + +end module Make (H : Hashtbl.HashedType) : S with type data = H.t diff --git a/src/hlist.ml b/src/hlist.ml index 4434e1e..aa3781f 100644 --- a/src/hlist.ml +++ b/src/hlist.ml @@ -28,7 +28,8 @@ module type S = sig val rev_map : (elt -> elt) -> t -> t val length : t -> int val mem : elt -> t -> bool - + val stats : unit -> unit + val init : unit -> unit end module Make (H : Hcons.SA) : S with type elt = H.t = @@ -56,7 +57,8 @@ struct let equal = Node.equal let uid x= x.Node.id let nil = Node.make Nil - + let stats = Node.stats + let init = Node.init (* doing sorted insertion allows to make better use of hash consing *) let rec sorted_cons e l = match l.Node.node with diff --git a/src/hlist.mli b/src/hlist.mli index 3173c2c..903868c 100644 --- a/src/hlist.mli +++ b/src/hlist.mli @@ -27,6 +27,8 @@ module type S = sig val rev_map : (elt -> elt) -> t -> t val length : t -> int val mem : elt -> t -> bool + val stats : unit -> unit + val init : unit -> unit end module Make (H : Hcons.SA) : S with type elt = H.t diff --git a/src/nodeSet.ml b/src/nodeSet.ml index 142476b..944f85c 100644 --- a/src/nodeSet.ml +++ b/src/nodeSet.ml @@ -100,11 +100,18 @@ module Mat : S with type t = Tree.node mat = let conscat4 e l1 l2 l3 l4 = conscat e l1 (concat l2 (concat l3 l4)) let subtree_tags tree node tag = - { clist = SubtreeTags(tree, node, tag); - length = Tree.subtree_tags tree node tag } + let len = Tree.subtree_tags tree node tag in + if len == 0 then empty + else + { clist = SubtreeTags(tree, node, tag); + length = len } + let subtree_elements tree node = - { clist = SubtreeElts(tree, node); - length = Tree.subtree_elements tree node } + let len = Tree.subtree_elements tree node in + if len == 0 then empty + else + { clist = SubtreeElts(tree, node); + length = len } let fst_tagged tree t tag = if Tree.tag tree t == tag then t diff --git a/src/ptset.ml b/src/ptset.ml index bb58049..9f9185c 100644 --- a/src/ptset.ml +++ b/src/ptset.ml @@ -57,6 +57,7 @@ sig val make : data -> t val node : t -> data val stats : unit -> unit + val init : unit -> unit end module Make ( H : Hcons.SA ) : S with type elt = H.t = @@ -89,6 +90,7 @@ struct type data = Data.t type t = Node.t let stats = Node.stats + let init = Node.init let hash = Node.hash let uid = Node.uid let make = Node.make @@ -313,22 +315,22 @@ struct then empty else match (Node.node s1,Node.node s2) with - | Empty, _ -> empty - | _, Empty -> s1 - | Leaf k1, _ -> if mem k1 s2 then empty else s1 - | _, Leaf k2 -> remove k2 s1 - | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) -> - if m1 == m2 && p1 == p2 then - merge (diff l1 l2) (diff r1 r2) - else if m1 > m2 && match_prefix p2 p1 m1 then - if zero_bit p2 m1 then - merge (diff l1 s2) r1 - else - merge l1 (diff r1 s2) - else if m1 < m2 && match_prefix p1 p2 m2 then - if zero_bit p1 m2 then diff s1 l2 else diff s1 r2 - else - s1 + | Empty, _ -> empty + | _, Empty -> s1 + | Leaf k1, _ -> if mem k1 s2 then empty else s1 + | _, Leaf k2 -> remove k2 s1 + | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) -> + if m1 == m2 && p1 == p2 then + merge (diff l1 l2) (diff r1 r2) + else if m1 > m2 && match_prefix p2 p1 m1 then + if zero_bit p2 m1 then + merge (diff l1 s2) r1 + else + merge l1 (diff r1 s2) + else if m1 < m2 && match_prefix p1 p2 m2 then + if zero_bit p1 m2 then diff s1 l2 else diff s1 r2 + else + s1 (*s All the following operations ([cardinal], [iter], [fold], [for_all], @@ -432,6 +434,7 @@ struct external make : t -> int = "%identity" external node : t -> int = "%identity" external stats : unit -> unit = "%identity" + external init : unit -> unit = "%identity" end ) let print ppf s = diff --git a/src/ptset.mli b/src/ptset.mli index 5c63873..f75a85d 100644 --- a/src/ptset.mli +++ b/src/ptset.mli @@ -79,6 +79,7 @@ val from_list : elt list -> t val make : data -> t val node : t -> data val stats : unit -> unit +val init : unit -> unit end diff --git a/src/stateSet.ml b/src/stateSet.ml index c202d4d..551d638 100644 --- a/src/stateSet.ml +++ b/src/stateSet.ml @@ -9,6 +9,7 @@ include Ptset.Make ( external make : t -> int = "%identity" external node : t -> int = "%identity" external stats : unit -> unit = "%identity" + external init : unit -> unit = "%identity" end ) diff --git a/src/transition.mli b/src/transition.mli index d785904..e64531b 100644 --- a/src/transition.mli +++ b/src/transition.mli @@ -8,6 +8,7 @@ val uid : t -> Uid.t val equal : t -> t -> bool val stats : unit -> unit val compare : t -> t -> int +val init : unit -> unit module Infix : sig val ( ?< ) : State.t -> State.t diff --git a/src/tree.ml b/src/tree.ml index fae8eba..df72de7 100644 --- a/src/tree.ml +++ b/src/tree.ml @@ -5,7 +5,7 @@ (* Distributed under the terms of the LGPL (see LICENCE) *) (******************************************************************************) INCLUDE "debug.ml" -INCLUDE "utils.ml" + INCLUDE "utils.ml" external init_lib : unit -> unit = "sxsi_cpp_init" @@ -72,8 +72,8 @@ struct 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_)) + 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 = @@ -99,11 +99,11 @@ struct 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 "<@>" + [] -> () + | 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 = @@ -149,13 +149,13 @@ struct 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 + done with - | End_of_file -> close_in in_chan - | e -> raise e + | End_of_file -> close_in in_chan + | e -> raise e in - finalizer () + finalizer () end @@ -196,8 +196,8 @@ 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 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 = @@ -220,6 +220,7 @@ external tag_list_set : tag_list -> int -> Tag.t -> unit = "caml_tag_list_set" " 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 @@ -338,14 +339,14 @@ let subtree_size t n = tree_subtree_size t.doc n 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 < 2 then size else - let acc = ref size in - for i = 0 to Array.length t.attribute_array - 1 do - acc := !acc - tree_subtree_tags t.doc node t.attribute_array.(i) - done; - !acc + if size == 0 then 0 + else let size = size - (tree_subtree_tags t.doc node Tag.pcdata) in + if size < 2 then size else + let acc = ref size in + for i = 0 to Array.length t.attribute_array - 1 do + acc := !acc - tree_subtree_tags t.doc node t.attribute_array.(i) + done; + !acc external tree_closing : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_closing" "noalloc" let closing t n = tree_closing t.doc n @@ -361,10 +362,10 @@ let stats t = let tree = t.doc in let rec loop left node acc_d total_d num_leaves = if node == nil then - (acc_d+total_d,if left then num_leaves+1 else num_leaves) + (acc_d+total_d,if left then num_leaves+1 else num_leaves) else - let d,td = loop true (tree_first_child tree node) (acc_d+1) total_d num_leaves in - loop false (tree_next_sibling tree node) (acc_d) d td + let d,td = loop true (tree_first_child tree node) (acc_d+1) total_d num_leaves in + loop false (tree_next_sibling tree node) (acc_d) d td in let a,b = loop true root 0 0 0 in @@ -372,20 +373,21 @@ let stats t = ;; 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" - end - ) - let to_ptset s = fold (Ptset.Int.add) s Ptset.Int.empty - end +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 @@ -395,8 +397,8 @@ module TSTSCache = let equal u v = let u1,u2 = u and v1,v2 = v in - u1 == v1 && u2 == v2 - end) + u1 == v1 && u2 == v2 + end) module TagTSCache = Hashtbl.Make(struct type t = Tag.t * TagS.t let hash (x, y) = @@ -404,8 +406,8 @@ module TagTSCache = let equal u v = let u1,u2 = u and v1,v2 = v in - u1 == v1 && u2 == v2 - end) + u1 == v1 && u2 == v2 + end) let add_cache = TagTSCache.create 1023 let union_cache = TSTSCache.create 1023 @@ -421,12 +423,12 @@ let _subset x y = 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 + 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 @@ -436,22 +438,22 @@ 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 + 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 + | 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 + 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 @@ -469,13 +471,13 @@ let child_sibling_labels tree = 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 + if _subset siblings tn then () + else table_n.(tag) <- _union tn siblings in - _add tag siblings + _add tag siblings in - ignore (loop root); - table_c, table_n + ignore (loop root); + table_c, table_n let descendant_labels tree = let table_d = Array.create (tree_num_tags tree) TagS.empty in @@ -486,13 +488,13 @@ let descendant_labels tree = 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; + if _subset d1 td then () + else table_d.(tag) <- _union td d1; in - _add tag (_union d1 d2) + _add tag (_union d1 d2) in - ignore (loop root); - table_d + ignore (loop root); + table_d let collect_labels tree = let table_f = Array.create (tree_num_tags tree) TagS.empty in @@ -504,32 +506,32 @@ let collect_labels tree = 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 + 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 + 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 + 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 + 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) + 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 + ignore (loop root TagS.empty TagS.empty TagS.empty); + table_f, table_n, table_c, table_d let is_nil t = t == nil @@ -551,16 +553,16 @@ let node_of_t t = (Ptset.Int.remove Tag.pcdata (Ptset.Int.diff d.(Tag.document_node) attributes)) in - { doc= t; - attributes = attributes; - attribute_array = Array.of_list (Ptset.Int.elements attributes); - elements = elements; - children = c; - siblings = n; - descendants = d; - followings = f + { doc= t; + attributes = attributes; + attribute_array = Array.of_list (Ptset.Int.elements attributes); + elements = elements; + children = c; + siblings = n; + descendants = d; + followings = f - } + } let parse_xml_uri str = node_of_t (TreeBuilder.parse_file str) @@ -579,14 +581,14 @@ 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)) + 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);; + 0 -> raise End_of_file + | r -> really_read fd buffer (start + r) (length - r);; let read fd = let buffer = String.create 20 in @@ -594,34 +596,34 @@ let read fd = let size = int_of_string buffer in let buffer = String.create size in let _ = really_read fd buffer 0 size in - buffer + 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 [] + 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; + 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 + 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 + 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 @@ -635,25 +637,25 @@ let load ?(sample=64) ?(load_text=true) str = 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 + 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 = Array.of_list (Ptset.Int.elements attributes); - elements = elements; - children = c; - siblings = s; - descendants = d; - followings = f + 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 = Array.of_list (Ptset.Int.elements attributes); + elements = elements; + children = c; + siblings = s; + descendants = d; + followings = f } in close_in in_c; tree @@ -664,7 +666,7 @@ let load ?(sample=64) ?(load_text=true) str = let equal a b = a == b let nts = function - -1 -> "Nil" +-1 -> "Nil" | i -> Printf.sprintf "Node (%i)" i let dump_node t = nts (Node.to_int t) @@ -697,21 +699,21 @@ module Predicate = Hcons.Make ( type t = (_t -> node -> bool) ref let hash t = Hashtbl.hash t let equal t1 t2 = t1 == t2 -end) + end) let string_of_query query = - match query with - | `Prefix -> "starts-with" - | `Suffix -> "ends-with" - | `Equals -> "equals" - | `Contains -> "contains" + 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 + | `Prefix -> text_prefix + | `Suffix -> text_suffix + | `Equals -> text_equals + | `Contains -> text_contains ;; let _pred_cache = Hashtbl.create 17 @@ -722,10 +724,10 @@ let mk_pred query s = 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 + 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 -> diff --git a/src/tree.mli b/src/tree.mli index 6640b27..e24add3 100644 --- a/src/tree.mli +++ b/src/tree.mli @@ -89,3 +89,5 @@ type bit_vector val bit_vector_create : int -> bit_vector val bit_vector_unsafe_set : bit_vector -> int -> bool -> unit val bit_vector_unsafe_get : bit_vector -> int -> bool + +val reinit : unit -> unit -- 2.17.1