Commits

Sébastien Ferré committed c3ffb89

Bug fix ??

Comments (0)

Files changed (1)

   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
 		Buffer.add_char tr '+'; Buffer.add_string tr (string_of_int i);
-		m := X.set i i !m end
+		m := X.set i () !m
+	        (* m := X.add i !m *) end
 	      else begin
 		Buffer.add_char tr '-'; Buffer.add_string tr (string_of_int i);
 		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 *)