# Commits

committed c3ffb89

Bug fix ??

• Participants
• Parent commits fb3942c

# intmap.ml

done;
res

-let log31 x =
+let log31 x = Common.prof "Intmap.log31" (fun () ->
let res = ref 6 in
while !res > 0 && x < exp31.(!res) do
decr res
done;
-  !res
+  !res)

let split x l =
let bound = exp31.(l) in
and values for level = 0 *)

let obj level0 (m : 'a t) : 'a repr =
+  (* [level0] is true if [m] is the field of a block whose level is 1. *)
+  (* hence [m] is a set/map at level0, and hence the multiples tests (level=1) *)
if Obj.is_int m
then
let i = (Obj.obj m : int) in
block
end
| Block b ->
-      let n = Obj.size b in
let l = Obj.tag b in
+      let n = Obj.size b in
if n = 1 (* no fields *) then repr level0 Empty
else if block_is_full b l then repr level0 (Full (1 + l))
-      else if l >= 2 && Obj.field b 0 = Obj.repr 1 then Obj.field b 1
+      else if l > 0 && Obj.field b 0 = Obj.repr 1 then repr level0 (obj (l=1) (Obj.field b 1))
else b
and block_is_full b l = (* l must be the level of b *)
l > 0 &&
Obj.size b = 32 &&
-  let full_l = repr (l>0) (Full l) in
+  let full_l = repr (l=1) (Full l) in
let res = ref true in
for i = 1 to 31 do
res := !res && Obj.field b i = full_l
assert (level > 0);
let present, i = locate block x1 in
if present
-      then obj (level>0) (Obj.field block i)
+      then obj (level=1) (Obj.field block i)
else Empty

let get_value block x =
let one_field level x1 m =
let block = Obj.new_block level 2 in
Obj.set_field block 0 (Obj.repr (Bitmap31.singleton x1));
-      Obj.set_field block 1 (repr (level>0) m);
+      Obj.set_field block 1 (repr (level=1) m);
block

let one_value x v =
let ix, iy = if x1 < y1 then 2, 1 else 1, 2 in
let block = Obj.new_block level 3 in
Obj.set_field block 0 (Obj.repr (Bitmap31.add x1 (Bitmap31.singleton y1)));
-      Obj.set_field block ix (repr (level>0) m);
-      Obj.set_field block iy (repr (level>0) n);
+      Obj.set_field block ix (repr (level=1) m);
+      Obj.set_field block iy (repr (level=1) n);
block

let two_values (x,v) (y,w) =
let block = Obj.new_block level (31+1) in
Obj.set_field block 0 (Obj.repr Bitmap31.full);
for i = 1 to 31 do
-	Obj.set_field block i (repr (level>0) (Full level))
+	Obj.set_field block i (repr (level=1) (Full level))
done;
block

for k = n downto i+1 do
Obj.set_field block' k (Obj.field block (k-1))
done;
-	  Obj.set_field block' i (repr (level>0) m');
+	  Obj.set_field block' i (repr (level=1) m');
for k = i-1 downto 1 do
Obj.set_field block' k (Obj.field block k)
done;
block' end
else
-	let m' = f (obj (level>0) (Obj.field block i)) in (* new field *)
+	let m' = f (obj (level=1) (Obj.field block i)) in (* new field *)
if is_empty_repr m'
then remove_field block x1
else begin
let block' = Obj.dup block in
-	  Obj.set_field block' i (repr (level>0) m');
+	  Obj.set_field block' i (repr (level=1) m');
block'
end

| Some m ->
if is_empty_repr m
then (Bitmap31.remove x1 bmp), l
-		else bmp, (repr (level>0) m :: l))
+		else bmp, (repr (level=1) m :: l))
(bmp, [])
bmp in
let block = Obj.new_block level (1 + List.length l) in
let n = Obj.size block in
let res = ref init in
for i = 1 to n-1 do
-	res := f !res (obj (level>0) (Obj.field block i))
+	res := f !res (obj (level=1) (Obj.field block i))
done;
!res

else Block (Block.replace_field b x1 (fun m_x1 -> remove_repr x2 m_x1))

-    let rec fold f init (m : 'a t) =
-      fold_repr f init 0 (obj false m)
+    let rec fold f init (m : 'a t) = Common.prof "Intmap.fold" (fun () ->
+      fold_repr f init 0 (obj false m))
and fold_repr f acc pos = function
| Empty -> acc
| Full l ->

let list_string m = let l = list m in l, string l

-	let int_random () = Random.int 1000
+	let bound = 5000
+
+	let int_random () = Random.int bound

let random () =
let m = ref X.empty (* if Random.bool () then X.empty else X.singleton (int_random ())*) in
-	  let tr = Buffer.create 1000 in
+	  let tr = Buffer.create bound in
try
-	    for i = 1 to 500 do
+	    for i = 1 to bound do
let i = int_random () in
if Random.bool ()
then begin
-		m := X.set i i !m end
+		m := X.set i () !m
+	        (* m := X.add i !m *) end
else begin
m := X.remove i !m end
let is_even = fun i _ -> i mod 2 = 0
let is_even2 = fun i _ _ -> i mod 2 = 0
let is_even2_diff = fun i _ v2 -> v2 = None || i mod 2 = 0
-	let double_if_even = fun i v -> if i mod 2 = 0 then Some (2*v) else None
-	let double_if_even2 = fun i _ _ -> if i mod 2 = 0 then Some (2*i) else None
-	let double_if_even2_diff = fun i _ v2 -> if v2 = None || i mod 2 = 0 then Some (2*i) else None
+	let if_even = fun i v -> if i mod 2 = 0 then Some v else None
+	let if_even2 = fun i _ _ -> if i mod 2 = 0 then Some () else None
+	let if_even2_diff = fun i _ v2 -> if v2 = None || i mod 2 = 0 then Some () else None

let create = apply "list" list_string
let cardinal = apply "cardinal" (fun m -> let n = X.cardinal m in n, string_of_int n)
let mem = apply "mem" (fun m -> let b = X.mem (int_random ()) m in b, string_of_bool b)
let get = apply "get" (fun m -> (try Some (X.get (int_random ()) m) with Not_found -> None), "?")
let domain = apply "domain" (fun m -> list_string (X.domain ~filter:is_even m))
-	let map = apply "map" (fun m -> list_string (X.map double_if_even m))
+	let map = apply "map" (fun m -> list_string (X.map if_even m))
let subset = apply2 "subset"
(fun m1 m2 ->
-	      let m1' = if Random.bool () then m1 else X.map_inter (fun i v1 v2 -> Some i) m1 m2 in
+	      let m1' = if Random.bool () then m1 else X.map_inter (fun i v1 v2 -> Some ()) m1 m2 in
(* to have a chance that subset returns true *)
let b = X.subset ~filter:is_even2 m1' m2 in
b, string_of_bool b)
let domain_inter = apply2 "domain_inter" (fun m1 m2 -> list_string (X.domain_inter ~filter:is_even2 m1 m2))
-	let map_inter = apply2 "map_inter" (fun m1 m2 -> list_string (X.map_inter double_if_even2 m1 m2))
+	let map_inter = apply2 "map_inter" (fun m1 m2 -> list_string (X.map_inter if_even2 m1 m2))
let domain_union = apply2 "domain_union" (fun m1 m2 -> list_string (X.domain_union ~filter:is_even2 m1 m2))
-	let map_union = apply2 "map_union" (fun m1 m2 -> list_string (X.map_union double_if_even2 m1 m2))
+	let map_union = apply2 "map_union" (fun m1 m2 -> list_string (X.map_union if_even2 m1 m2))
let domain_diff = apply2 "domain_diff" (fun m1 m2 -> list_string (X.domain_diff ~filter:is_even2_diff m1 m2))
-	let map_diff = apply2 "map_diff" (fun m1 m2 -> list_string (X.map_diff double_if_even2_diff m1 m2))
+	let map_diff = apply2 "map_diff" (fun m1 m2 -> list_string (X.map_diff if_even2_diff m1 m2))
end

module AX = Wrapper (A)

let main duration =
let comp opA opB =
-	let seed = Random.int max_int in
+	let seed = Random.int 1000000000 in
let trA, resA = try opA seed with Fail (tr, e) -> raise (Fail ("A." ^ tr, e)) in
let trB, resB = try opB seed with Fail (tr, e) -> raise (Fail ("B." ^ tr, e)) in
if resA = resB
else begin print_string "\nError: "; print_endline trA; print_endline trB end
in
while Sys.time () < duration do
-	match Random.int 14 with
+	match Random.int 2 with
| 0 -> comp AX.create BX.create
| 1 -> comp AX.cardinal BX.cardinal
| 2 -> comp AX.is_empty BX.is_empty

module Comp = Comparator (Std) (M)

+(* uncomment for automatic testing *)
(* let _ = Comp.main (float_of_string Sys.argv.(1)) *)

(* for testing *)