let benchmark_jump t s = benchmark_jump t.doc s
-external benchmark_fsns : tree -> unit = "caml_benchmark_fsns" "noalloc"
+external benchmark_fcns : tree -> unit = "caml_benchmark_fcns" "noalloc"
-let benchmark_fsns t = benchmark_fsns t.doc
+let benchmark_fcns t = benchmark_fcns t.doc
+
+external benchmark_lcps : tree -> unit = "caml_benchmark_lcps" "noalloc"
+
+let benchmark_lcps t = benchmark_lcps t.doc
let hash (x,y) = HASHINT2(x,Ptset.Int.uid y)
end)
+module MemUpdate = struct
+include Hashtbl.Make (
+ struct
+ type t = Tag.t*Ptset.Int.t*Ptset.Int.t*Ptset.Int.t*Ptset.Int.t
+ let equal (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) = a1==a2 &&
+ b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2
+ let hash (a,b,c,d,e) = HASHINT4(HASHINT2(a,Ptset.Int.uid b),Ptset.Int.uid c,Ptset.Int.uid d,Ptset.Int.uid e)
+ end)
+
+end
+
let collect_tags tree =
let _ = Printf.eprintf "Collecting Tags\n%!" in
-(* let h_union = MemUnion.create BIG_H_SIZE in
+ 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 r = Ptset.Int.add t s in
MemAdd.add h_add (t,s) r;r
- in *)
- let pt_cup = Ptset.Int.union in
- let pt_add = Ptset.Int.add in
+ in
let h = Hashtbl.create BIG_H_SIZE in
let update t sc sb ss sa =
let schild,sbelow,ssibling,safter =
let _ = loop false (tree_root tree) Ptset.Int.empty in
let _ = Printf.eprintf "Finished\n%!" in
h
-
-
-
+
+
+
let contains_array = ref [| |]
let contains_index = Hashtbl.create 4096
let parent t n = tree_parent t.doc n
-let first_child t = (); fun n -> tree_first_child t.doc n
-let first_element t = (); fun n -> tree_first_element t.doc n
+let first_child t = let doc = t.doc in ();fun n -> tree_first_child doc n
+let first_element t = let doc = t.doc in (); fun n -> tree_first_element doc n
(* these function will be called in two times: first partial application
on the tag, then application of the tag and the tree, then application of
let v = ptset_to_vector ts in ();
fun n -> tree_select_child t.doc n v
-let next_sibling t = (); fun n -> tree_next_sibling t.doc n
-let next_element t = (); fun n -> tree_next_element t.doc n
+let next_sibling t = let doc = t.doc in (); fun n -> tree_next_sibling doc n
+let next_element t = let doc = t.doc in (); fun n -> tree_next_element doc n
let tagged_following_sibling t tag = (); fun n -> tree_tagged_following_sibling t.doc n tag
-
+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)
+ 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
+ in
+ let a,b = loop true root 0 0 0
+ in
+ Printf.eprintf "Average depth: %f, number of leaves %i\n%!" ((float_of_int a)/. (float_of_int b)) b
+;;