+type t = { doc : tree;
+ node : descr;
+ ttable : (Tag.t,(Ptset.Int.t*Ptset.Int.t)) Hashtbl.t;
+ }
+
+let text_size t = text_size t.doc
+module MemUnion = Hashtbl.Make (struct
+ type t = Ptset.Int.t*Ptset.Int.t
+ let equal (x,y) (z,t) = (Ptset.Int.equal x z)&&(Ptset.Int.equal y t)
+ let equal a b = equal a b || equal b a
+ let hash (x,y) = (* commutative hash *)
+ let x = Ptset.Int.hash x
+ and y = Ptset.Int.hash y
+ in
+ if x < y then HASHINT2(x,y) else HASHINT2(y,x)
+ end)
+
+let collect_tags tree =
+ let h_union = MemUnion.create BIG_H_SIZE in
+ let pt_cup s1 s2 =
+ try
+ MemUnion.find h_union (s1,s2)
+ with
+ | Not_found -> let s = Ptset.Int.union s1 s2
+ in
+ MemUnion.add h_union (s1,s2) s;s
+ in
+ let h_add = Hashtbl.create BIG_H_SIZE in
+ let pt_add t s =
+ let k = HASHINT2(Tag.hash t,Ptset.Int.hash s) in
+ try
+ Hashtbl.find h_add k
+ with
+ | Not_found -> let r = Ptset.Int.add t s in
+ Hashtbl.add h_add k r;r
+ in
+ let h = Hashtbl.create BIG_H_SIZE in
+ let sing = Ptset.Int.singleton Tag.pcdata in
+ let update t sb sa =
+ let sbelow,safter =
+ try
+ Hashtbl.find h t
+ with
+ | Not_found ->
+ (sing,sing)
+ in
+ Hashtbl.replace h t (pt_cup sbelow sb, pt_cup safter sa)
+ in
+ let rec loop id acc =
+ if equal_node id nil
+ then (Ptset.Int.empty,acc)
+ else
+ let below2,after2 = loop (tree_next_sibling tree id) acc in
+ let below1,after1 = loop (tree_first_child tree id) after2 in
+ let tag = tree_tag_id tree id in
+ update tag below1 after2;
+ pt_add tag (pt_cup below1 below2), (pt_add tag after1)
+ in
+ let b,a = loop (tree_root tree) Ptset.Int.empty in
+ update Tag.pcdata b a;
+ h
+
+
+
+
+
+let contains_array = ref [| |]
+let contains_index = Hashtbl.create 4096
+let in_array _ i =
+ try
+ Hashtbl.find contains_index i
+ with
+ Not_found -> false
+
+let init_contains t s =
+ let a = text_contains t.doc s
+ in
+ Array.fast_sort (compare) a;
+ contains_array := a;
+ Array.iter (fun x -> Hashtbl.add contains_index x true) !contains_array
+
+let count_contains t s = text_count_contains t.doc s
+let unsorted_contains t s = text_unsorted_contains t.doc s
+
+let init_naive_contains t s =
+ let i,j = tree_doc_ids t.doc (tree_root t.doc)
+ in
+ let regexp = Str.regexp_string s in
+ let matching arg =
+ try
+ let _ = Str.search_forward regexp arg 0;
+ in true
+ with _ -> false
+ in
+ let rec loop n acc l =
+ if n >= j then acc,l
+ else
+ let s = get_cached_text t.doc n
+ in
+ if matching s
+ then loop (n+1) (n::acc) (l+1)
+ else loop (n+1) acc l
+ in
+ let acc,l = loop i [] 0 in
+ let a = Array.create l nil in
+ let _ = List.fold_left (fun cpt e -> a.(cpt) <- e; (cpt-1)) (l-1) acc
+ in
+ contains_array := a
+