-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 = MemAdd.create BIG_H_SIZE in
- let pt_add t s =
- try MemAdd.find h_add (t,s)
- with
- | Not_found -> let r = Ptset.Int.add t s in
- MemAdd.add h_add (t,s) r;r
- in
- let h = Hashtbl.create BIG_H_SIZE in
- let update t sc sb ss sa =
- let schild,sbelow,ssibling,safter =
- try
- Hashtbl.find h t
- with
- | Not_found ->
- (Ptset.Int.empty,Ptset.Int.empty,Ptset.Int.empty,Ptset.Int.empty)
- in
- Hashtbl.replace h t
- (pt_cup sc schild,pt_cup sbelow sb, pt_cup ssibling ss, pt_cup safter sa)
+let rec fold_siblings tree f node acc =
+ if node == nil then acc else fold_siblings tree f (tree_next_sibling tree node) (f node acc)
+module TS =
+ struct
+ type t = bool array
+ let create n = Array.create n false
+ let add e a = a.(e) <- true; a
+ let merge a b =
+ for i = 0 to Array.length a - 1 do
+ a.(i) <- a.(i) || b.(i)
+ done
+ let clear a =
+ for i = 0 to Array.length a - 1 do
+ a.(i) <- false;
+ done
+
+ let to_ptset a =
+ let r = ref Ptset.Int.empty in
+ for i = 0 to Array.length a - 1 do
+ r := Ptset.Int.add i !r;
+ done;
+ !r
+ end
+
+
+let collect_children_siblings tree =
+ let ntags = (tree_num_tags tree) in
+ let () = Printf.eprintf ">>>length: %i\n%!" ntags in
+ let table_c = Array.init (tree_num_tags tree) (fun _ -> TS.create ntags) in
+ let table_n = Array.init (tree_num_tags tree) (fun _ -> TS.create ntags) in
+ let acc_tag n s = TS.add (tree_tag tree n) s in
+ let count = ref 0 in
+ let size = tree_subtree_size tree root in
+ let tmp = TS.create ntags in
+ let rec loop node =
+ if node == nil then ()
+ else
+ let () = if !count mod 10000 == 0 then
+ Printf.eprintf "Node %i / %i\n%!" !count size;
+ in
+ let () = if !count mod 1000000 == 0 then Gc.compact() in
+ let () = count := !count + 1 in
+ let tag = tree_tag tree node in
+ let () = TS.clear tmp in
+ let children =
+ fold_siblings tree
+ acc_tag
+ (tree_first_child tree node) tmp
+ in
+ let () = TS.merge table_c.(tag) children in
+ let () = TS.clear tmp in
+ let siblings =
+ fold_siblings tree
+ acc_tag
+ (tree_next_sibling tree node) tmp
+ in
+ TS.merge table_n.(tag) siblings;
+ loop (tree_first_child tree node);
+ loop (tree_next_sibling tree node)