Commits

Sébastien Ferré committed ceebc47

Generalization to different word sizes, and different chunk sizes for computing cardinals.

Comments (0)

Files changed (1)

   end
 
 
-(* table giving powers of 31 *)
+(* table giving powers of [base] *)
 
-let exp31 =
-  let res = Array.make 7 1 in
-  for i = 1 to 6 do
-    res.(i) <- 31 * res.(i-1)
+let base = Sys.word_size - 1
+let max_pow = if base = 31 then 6 else 10
+
+let exp_base =
+  let res = Array.make (max_pow+1) 1 in
+  for i = 1 to max_pow do
+    res.(i) <- base * res.(i-1)
   done;
   res
 
-let log31 x = Common.prof "Intmap.log31" (fun () ->
-  let res = ref 6 in
-  while !res > 0 && x < exp31.(!res) do
+(*
+let log_base x = Common.prof "Intmap.log_base" (fun () ->
+  let res = ref max_pow in
+  while !res > 0 && x < exp_base.(!res) do
     decr res
   done;
   !res)
+*)
+let log_base x = Common.prof "Intmap.log_base" (fun () ->
+  let res = ref 1 in
+  while !res <= max_pow && x >= exp_base.(!res) do
+    incr res
+  done;
+  !res - 1)
 
 let split x l =
-  let bound = exp31.(l) in
+  let bound = exp_base.(l) in
   x / bound, x mod bound
 
-module Bitmap31 =
+module Bitmap_base =
   struct
-    let empty = 0
+    let empty = 0 (* only 0s *)
 
     let is_empty bmp = (bmp = empty)
 
-    let full = 0x7FFFFFFF
+    let full = -1 (* only 1s *)
 
     let is_full bmp = (bmp = full)
 
     (* computing efficiently number of 1-bits in bytes and words *)
 
+    let chunk_size = 8
+    let chunk_nb = 1 lsl chunk_size
+    let chunk_filter = chunk_nb - 1
+
     let card_byte =
-      let t = Array.make 256 0 in
-      for i = 0 to 255 do
-	for j = 0 to 7 do
+      let t = Array.make chunk_nb 0 in
+      for i = 0 to chunk_nb - 1 do
+	for j = 0 to chunk_size - 1 do
 	  if (i lsr j) land 1 <> 0
 	  then t.(i) <- t.(i) + 1
 	done
       done;
       t
 
+(*
     let cardinal bmp =
       card_byte.(bmp land 0xFF)
 	+ card_byte.((bmp lsr 8) land 0xFF)
 	+ card_byte.((bmp lsr 16) land 0xFF)
 	+ card_byte.((bmp lsr 24) land 0xFF)
+*)
+
+    let cardinal bmp =
+      let rec aux bmp acc =
+	if bmp = 0
+	then acc
+	else aux (bmp lsr chunk_size) (acc + card_byte.(bmp land chunk_filter))
+      in
+      aux bmp 0
 
     let singleton x = 1 lsl x
 
 
     let diff bmp1 bmp2 = bmp1 land (lnot bmp2)
 
-    let fold f init bmp =
+(*
+    let fold f init bmp = Common.prof "Intmap.Bitmap_base.fold" (fun () ->
       let res = ref init in
-      for x1 = 0 to 31 - 1 do
+      for x1 = 0 to base - 1 do
 	if mem x1 bmp
 	then res := f !res x1
       done;
-      !res
+      !res)
+*)
+    let fold f init bmp = Common.prof "Intmap.Bitmap_base.fold" (fun () ->
+      let res = ref init in
+      let bmp1 = ref bmp in
+      let x1 = ref 0 in
+      while !bmp1 <> 0 do
+	if !bmp1 land 1 <> 0 then res := f !res !x1;
+	bmp1 := !bmp1 lsr 1;
+	incr x1
+      done;
+      !res)
 
     let iter f bmp =
-      for x1 = 0 to 31 - 1 do
+      for x1 = 0 to base - 1 do
 	if mem x1 bmp
 	then f x1
       done
   | Empty (* empty map, empty set *)
   | Full of int (* full set at some level *)
   | Single of int (* singleton set *)
-  | Bitmap31 of int (* 31-bounded set *)
+  | Bitmap_base of int (* base-bounded set *)
   | Block of 'a t
 	(* other cases, i.e. blocks whose tag is level,
 	   field 0 is mask, and other fields contain lower-level maps/sets for level > 0,
   then
     let i = (Obj.obj m : int) in
     if level0
-    then Bitmap31 i
+    then Bitmap_base i
     else
       if i = -1 then Empty
       else if i < -1 then Full (-i - 1)
   match m with
   | Empty ->
       if level0
-      then Obj.repr Bitmap31.empty
+      then Obj.repr Bitmap_base.empty
       else Obj.repr (-1)
   | Full l ->
       if level0
-      then Obj.repr Bitmap31.full
+      then Obj.repr Bitmap_base.full
       else Obj.repr (-l - 1)
   | Single x ->
       if level0
-      then Obj.repr (Bitmap31.singleton x)
+      then Obj.repr (Bitmap_base.singleton x)
       else Obj.repr x
-  | Bitmap31 bmp ->
+  | Bitmap_base bmp ->
       if level0
       then Obj.repr bmp
       else
-	if Bitmap31.is_empty bmp then repr level0 Empty
-	else if Bitmap31.is_full bmp then repr level0 (Full 1)
-	else if Bitmap31.cardinal bmp = 1 then repr level0 (Single (Bitmap31.fold (fun res x -> x) 0 bmp))
+	if Bitmap_base.is_empty bmp then repr level0 Empty
+	else if Bitmap_base.is_full bmp then repr level0 (Full 1)
+	else if Bitmap_base.cardinal bmp = 1 then repr level0 (Single (Bitmap_base.fold (fun res x -> x) 0 bmp))
 	else begin
 	  let block = Obj.new_block 1 2 in
-	  Obj.set_field block 0 (Obj.repr (Bitmap31.singleton 0));
+	  Obj.set_field block 0 (Obj.repr (Bitmap_base.singleton 0));
 	  Obj.set_field block 1 (Obj.repr bmp);
 	  block
 	end
   Obj.size b = 32 &&
   let full_l = repr (l=1) (Full l) in
   let res = ref true in
-  for i = 1 to 31 do
+  for i = 1 to base do
     res := !res && Obj.field b i = full_l
   done;
   !res
   | Empty -> true
   | Full _ -> false
   | Single _ -> false
-  | Bitmap31 bmp -> Bitmap31.is_empty bmp
+  | Bitmap_base bmp -> Bitmap_base.is_empty bmp
   | Block b -> Obj.size b = 1
 
 let rec is_full_repr = function
   | Empty -> false
   | Full _ -> true
   | Single _ -> false
-  | Bitmap31 bmp -> Bitmap31.is_full bmp
+  | Bitmap_base bmp -> Bitmap_base.is_full bmp
   | Block b -> block_is_full b (Obj.tag b)
 
 module Block =
     let locate block x1 =
       let b = (mask block) lsr x1 in
       if b land 1 = 0 (* not present *)
-      then false, Bitmap31.cardinal b + 1
-      else true, Bitmap31.cardinal b
+      then false, Bitmap_base.cardinal b + 1
+      else true, Bitmap_base.cardinal b
 
     let get_field block x1 =
-      assert (x1 < 31);
+      assert (x1 < base);
       let level = level block in
       assert (level > 0);
       let present, i = locate block x1 in
       else Empty
 
     let get_value block x =
-      assert (x < 31);
+      assert (x < base);
       assert (level block = 0);
       let present, i = locate block x in
       if present
 
     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 0 (Obj.repr (Bitmap_base.singleton x1));
       Obj.set_field block 1 (repr (level=1) m);
       block
 
     let one_value x v =
       let block = Obj.new_block 0 2 in
-      Obj.set_field block 0 (Obj.repr (Bitmap31.singleton x));
+      Obj.set_field block 0 (Obj.repr (Bitmap_base.singleton x));
       Obj.set_field block 1 (Obj.repr v);
       block
 
     let two_fields level (x1,m) (y1,n) =
       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 0 (Obj.repr (Bitmap_base.add x1 (Bitmap_base.singleton y1)));
       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 ix, iy = if x < y then 2, 1 else 1, 2 in
       let block = Obj.new_block 0 3 in
-      Obj.set_field block 0 (Obj.repr (Bitmap31.add x (Bitmap31.singleton y)));
+      Obj.set_field block 0 (Obj.repr (Bitmap_base.add x (Bitmap_base.singleton y)));
       Obj.set_field block ix (Obj.repr v);
       Obj.set_field block iy (Obj.repr w);
       block
 
     let full level =
-      let block = Obj.new_block level (31+1) in
-      Obj.set_field block 0 (Obj.repr Bitmap31.full);
-      for i = 1 to 31 do
+      let block = Obj.new_block level (base+1) in
+      Obj.set_field block 0 (Obj.repr Bitmap_base.full);
+      for i = 1 to base do
 	Obj.set_field block i (repr (level=1) (Full level))
       done;
       block
 	let level = level block in
 	assert (level > 0);
 	let block' = Obj.new_block level (n-1) in
-	Obj.set_field block' 0 (Obj.repr (Bitmap31.remove x1 (mask block)));
+	Obj.set_field block' 0 (Obj.repr (Bitmap_base.remove x1 (mask block)));
 	for k = 1 to i-1 do
 	  Obj.set_field block' k (Obj.field block k)
 	done;
 	let n = Obj.size block in
 	assert (level block = 0);
 	let block' = Obj.new_block 0 (n-1) in
-	Obj.set_field block' 0 (Obj.repr (Bitmap31.remove x1 (mask block)));
+	Obj.set_field block' 0 (Obj.repr (Bitmap_base.remove x1 (mask block)));
 	for k = 1 to i-1 do
 	  Obj.set_field block' k (Obj.field block k)
 	done;
 	else begin
 	  let n = Obj.size block in
 	  let block' = Obj.new_block level (n+1) in
-	  Obj.set_field block' 0 (Obj.repr (Bitmap31.add x1 (mask block)));
+	  Obj.set_field block' 0 (Obj.repr (Bitmap_base.add x1 (mask block)));
 	  for k = n downto i+1 do
 	    Obj.set_field block' k (Obj.field block (k-1))
 	  done;
 	let v' = f unit in
 	let n = Obj.size block in
 	let block' = Obj.new_block 0 (n+1) in
-	Obj.set_field block' 0 (Obj.repr (Bitmap31.add x1 (mask block)));
+	Obj.set_field block' 0 (Obj.repr (Bitmap_base.add x1 (mask block)));
 	for k = n downto i+1 do
 	  Obj.set_field block' k (Obj.field block (k-1))
 	done;
 	Obj.set_field block' i (Obj.repr v');
 	block' end
 
-    let fields_from_mask level bmp f =
+    let fields_from_mask level bmp f = Common.prof "Bitmap.Block.fields_from_mask" (fun () ->
       let bmp, l =
-	Bitmap31.fold
+	Bitmap_base.fold
 	  (fun (bmp,l) x1 ->
 	    match f x1 with
-	    | None -> (Bitmap31.remove x1 bmp), l
+	    | None -> (Bitmap_base.remove x1 bmp), l
 	    | Some m ->
 		if is_empty_repr m
-		then (Bitmap31.remove x1 bmp), l
+		then (Bitmap_base.remove x1 bmp), l
 		else bmp, (repr (level=1) m :: l))
 	  (bmp, [])
 	  bmp in
       Obj.set_field block 0 (Obj.repr bmp);
       let i = ref 1 in
       List.iter (fun m -> Obj.set_field block !i m; incr i) l;
-      block
+      block)
 
     let mapfilter_fields f block =
       fields_from_mask (level block) (mask block)
 	(fun x1 -> f x1 (get_field block x1))
 
-    let values_from_mask bmp f =
+    let values_from_mask bmp f = Common.prof "Bitmap.Block.values_from_mask" (fun () ->
       let bmp, l =
-	Bitmap31.fold
-	  (fun (bmp,l) x -> match f x with None -> (Bitmap31.remove x bmp), l | Some v -> bmp, (v :: l))
+	Bitmap_base.fold
+	  (fun (bmp,l) x -> match f x with None -> (Bitmap_base.remove x bmp), l | Some v -> bmp, (v :: l))
 	  (bmp,[])
 	  bmp in
       let block = Obj.new_block 0 (1 + List.length l) in
       Obj.set_field block 0 (Obj.repr bmp);
       let i = ref 1 in
       List.iter (fun v -> Obj.set_field block !i (Obj.repr v); incr i) l;
-      block
+      block)
 
     let mapfilter_values f block =
       values_from_mask (mask block)
 
 let singleton (x : int) : unit t = repr false (Single x)
 
-let rec cardinal (m : 'a t) : int =
-  cardinal_repr (obj false m)
+let rec cardinal (m : 'a t) : int = Common.prof "Intmap.cardinal" (fun () ->
+  cardinal_repr (obj false m))
 and cardinal_repr = function
   | Empty -> 0
-  | Full level -> exp31.(level)
+  | Full level -> exp_base.(level)
   | Single _ -> 1
-  | Bitmap31 bmp -> Bitmap31.cardinal bmp
+  | Bitmap_base bmp -> Bitmap_base.cardinal bmp
   | Block b ->
       let level = Block.level b in
       if level = 0
-      then Bitmap31.cardinal (Block.mask b)
+      then Bitmap_base.cardinal (Block.mask b)
       else Block.fold_fields (fun res m -> res + cardinal_repr m) 0 b
 
-let rec mem (x : int) (m : 'a t) : bool =
-  mem_repr x (obj false m)
+let rec mem (x : int) (m : 'a t) : bool = Common.prof "Intmap.mem" (fun () ->
+  mem_repr x (obj false m))
 and mem_repr x = function
   | Empty -> false
-  | Full l -> x < exp31.(l)
+  | Full l -> x < exp_base.(l)
   | Single y -> x = y
-  | Bitmap31 bmp -> x < 31 && Bitmap31.mem x bmp
+  | Bitmap_base bmp -> x < base && Bitmap_base.mem x bmp
   | Block b ->
       let level = Block.level b in
       let x1, x2 = split x level in
-      x1 < 31 &&
+      x1 < base &&
       try
 	if level = 0
 	then begin ignore (Block.get_value b x1); true end
 	else mem_repr x2 (Block.get_field b x1)
       with Not_found -> false
 
-let rec choose (m : 'a t) : int =
-  choose_repr 0 (obj false m)
+let rec choose (m : 'a t) : int = Common.prof "Intmap.choose" (fun () ->
+  choose_repr 0 (obj false m))
 and choose_repr pos = function
   | Empty -> raise Not_found
   | Full l -> pos + 0
   | Single y -> pos + y
-  | Bitmap31 bmp -> pos + Bitmap31.choose bmp
+  | Bitmap_base bmp -> pos + Bitmap_base.choose bmp
   | Block b ->
       let level = Block.level b in
-      let x1 = Bitmap31.choose (Block.mask b) in
+      let x1 = Bitmap_base.choose (Block.mask b) in
       if level = 0
       then pos + x1
       else
-	let bound = exp31.(level) in
+	let bound = exp_base.(level) in
 	choose_repr (pos + x1*bound) (Block.get_field b x1)
 
-let rec get (x : int) (m : 'a t) : 'a =
-  get_repr x (obj false m)
+let rec get (x : int) (m : 'a t) : 'a = Common.prof "Intmap.get" (fun () ->
+  get_repr x (obj false m))
 and get_repr x = function
   | Empty ->
       raise Not_found
   | Full l ->
-      if x < exp31.(l)
+      if x < exp_base.(l)
       then unit
       else raise Not_found
   | Single y ->
       if x = y
       then unit
       else raise Not_found
-  | Bitmap31 bmp ->
-      if x < 31 && Bitmap31.mem x bmp
+  | Bitmap_base bmp ->
+      if x < base && Bitmap_base.mem x bmp
       then unit
       else raise Not_found
   | Block b ->
       let level = Block.level b in
       let x1, x2 = split x level in
-      if x1 < 31
+      if x1 < base
       then
 	if level = 0
 	then Block.get_value b x1
 	else get_repr x2 (Block.get_field b x1)
       else raise Not_found
       
-let rec add x m =
-  repr false (add_repr x (obj false m))
+let rec add x m = Common.prof "Intmap.add" (fun () ->
+  repr false (add_repr x (obj false m)))
 and add_repr x = function
   | Empty -> Single x
   | Full l as m ->
-      let l_x = log31 x in
+      let l_x = log_base x in
       if l <= l_x (* x is out of Full l range *)
       then
 	let x1, x2 = split x l_x in
 	Block (Block.two_fields l_x (0,m) (x1,Single x2))
       else m
   | Single y ->
-      let level = log31 (max x y) in
+      let level = log_base (max x y) in
       if level = 0
-      then Bitmap31 (Bitmap31.add x (Bitmap31.singleton y))
+      then Bitmap_base (Bitmap_base.add x (Bitmap_base.singleton y))
       else
-	let bound = exp31.(level) in
+	let bound = exp_base.(level) in
 	let x1, x2 = x / bound, x mod bound in
 	let y1, y2 = y / bound, y mod bound in
 	if x1 = y1
 	then Block (Block.one_field level x1 (add_repr x2 (Single y2)))
 	else Block (Block.two_fields level (x1, Single x2) (y1, Single y2))
-  | Bitmap31 bmp as m ->
-      let l_x = log31 x in
-      if l_x = 0 (* x < 31 *)
-      then Bitmap31 (Bitmap31.add x bmp)
+  | Bitmap_base bmp as m ->
+      let l_x = log_base x in
+      if l_x = 0 (* x < base *)
+      then Bitmap_base (Bitmap_base.add x bmp)
       else
 	let x1, x2 = split x l_x in
 	Block (Block.two_fields l_x (0,m) (x1,Single x2))
   | Block b ->
       let level = Block.level b in
-      let l_x = log31 x in
+      let l_x = log_base x in
       if l_x <= level
       then
 	let x1, x2 = split x level in
 	let x1, x2 = split x l_x in
 	Block (Block.two_fields l_x (0,Block b) (x1,Single x2))
 	
-let rec set x v m =
-  repr false (set_repr x v (obj false m))
+let rec set x v m = Common.prof "Intmap.set" (fun () ->
+  repr false (set_repr x v (obj false m)))
 and set_repr x v = function
   | Empty ->
-      let l_x = log31 x in
-      if l_x = 0 (* x < 31 *)
+      let l_x = log_base x in
+      if l_x = 0 (* x < base *)
       then Block (Block.one_value x v)
       else
 	let x1, x2 = split x l_x in
 	Block (Block.one_field l_x x1 (set_repr x2 v Empty))
   | Block b ->
       let level = Block.level b in
-      let l_x = log31 x in
+      let l_x = log_base x in
       if l_x <= level
       then
 	let x1, x2 = split x level in
 	Block (Block.two_fields l_x (0,Block b) (x1, set_repr x2 v Empty))
   | m -> add_repr x m
 
-let rec remove (x : int) (m : 'a t) : 'a t =
-  repr false (remove_repr x (obj false m))
+let rec remove (x : int) (m : 'a t) : 'a t = Common.prof "Intmap.remove" (fun () ->
+  repr false (remove_repr x (obj false m)))
 and remove_repr x = function
   | Empty -> Empty
   | Full l ->
-      if x >= exp31.(l)
+      if x >= exp_base.(l)
       then Full l
       else
 	let m_full =
 	  if l = 1
-	  then Bitmap31 Bitmap31.full
+	  then Bitmap_base Bitmap_base.full
 	  else Block (Block.full (l-1)) in
 	remove_repr x m_full
   | Single y as m ->
       if x = y
       then Empty
       else m
-  | Bitmap31 bmp as m ->
-      if x < 31
-      then Bitmap31 (Bitmap31.remove x bmp)
+  | Bitmap_base bmp as m ->
+      if x < base
+      then Bitmap_base (Bitmap_base.remove x bmp)
       else m
   | Block b as m ->
       let level = Block.level b in
-      let l_x = log31 x in
+      let l_x = log_base x in
       if l_x > level
       then m
       else
       | Empty -> acc
       | Full l ->
 	  let res = ref acc in
-	  for x = 0 to exp31.(l) - 1 do
+	  for x = 0 to exp_base.(l) - 1 do
 	    res := f !res (pos+x) unit
 	  done;
 	  !res
       | Single y ->
 	  f acc (pos+y) unit
-      | Bitmap31 bmp ->
-	  Bitmap31.fold (fun res x -> f res (pos+x) unit) acc bmp
+      | Bitmap_base bmp ->
+	  Bitmap_base.fold (fun res x -> f res (pos+x) unit) acc bmp
       | Block b ->
 	  let level = Block.level b in
 	  if level = 0
 	  then
-	    Bitmap31.fold
+	    Bitmap_base.fold
 	      (fun res x -> f res (pos+x) (Block.get_value b x))
 	      acc
 	      (Block.mask b)
 	  else
-	    let bound = exp31.(level) in
-	    Bitmap31.fold
+	    let bound = exp_base.(level) in
+	    Bitmap_base.fold
 	      (fun res x1 -> fold_repr f res (pos + x1 * bound) (Block.get_field b x1))
 	      acc
 	      (Block.mask b)
 
-    let iter f (m : 'a t) =
+    let iter f (m : 'a t) = Common.prof "Intmap.iter" (fun () ->
       let rec iter_repr pos = function
 	| Empty -> ()
 	| Full l ->
-	    for x = 0 to exp31.(l) - 1 do
+	    for x = 0 to exp_base.(l) - 1 do
 	      f (pos+x) unit
 	    done
 	| Single y ->
 	    f (pos+y) unit
-	| Bitmap31 bmp ->
-	    Bitmap31.iter (fun x -> f (pos+x) unit) bmp
+	| Bitmap_base bmp ->
+	    Bitmap_base.iter (fun x -> f (pos+x) unit) bmp
 	| Block b ->
 	    let level = Block.level b in
 	    if level = 0
 	    then
-	      Bitmap31.iter
+	      Bitmap_base.iter
 		(fun x -> f (pos+x) (Block.get_value b x))
 		(Block.mask b)
 	    else
-	      let bound = exp31.(level) in
-	      Bitmap31.iter
+	      let bound = exp_base.(level) in
+	      Bitmap_base.iter
 		(fun x1 -> iter_repr (pos + x1 * bound) (Block.get_field b x1))
 		(Block.mask b)
       in
-      iter_repr 0 (obj false m)
+      iter_repr 0 (obj false m))
 
-    let rec domain ?filter m =
-      repr false (domain_repr ?filter 0 (obj false m))
+    let rec domain ?filter m = Common.prof "Intmap.domain" (fun () ->
+      repr false (domain_repr ?filter 0 (obj false m)))
     and domain_repr ?filter pos m =
       match m with
       | Empty -> m
 	  | None -> m
 	  | Some f ->
 	      let res = ref Empty in
-	      for x = 0 to exp31.(l) - 1 do
+	      for x = 0 to exp_base.(l) - 1 do
 		if f (pos+x) unit
 		then res := add_repr x !res
 	      done;
 	      then m
 	      else Empty
 	  end
-      | Bitmap31 bmp ->
+      | Bitmap_base bmp ->
 	  begin match filter with
 	  | None -> m
 	  | Some f ->
-	      Bitmap31 (Bitmap31.filter (fun x -> f (pos+x) unit) bmp)
+	      Bitmap_base (Bitmap_base.filter (fun x -> f (pos+x) unit) bmp)
 	  end
       | Block b ->
 	  let level = Block.level b in
 	  if level = 0
 	  then
 	    match filter with
-	    | None -> Bitmap31 (Block.mask b)
+	    | None -> Bitmap_base (Block.mask b)
 	    | Some f ->
-		Bitmap31 (Bitmap31.filter (fun x -> f (pos+x) (Block.get_value b x)) (Block.mask b))
+		Bitmap_base (Bitmap_base.filter (fun x -> f (pos+x) (Block.get_value b x)) (Block.mask b))
 	  else
-	    let bound = exp31.(level) in
+	    let bound = exp_base.(level) in
 	    Block (Block.mapfilter_fields
 		     (fun x1 m_x1 -> Some (domain_repr ?filter (pos + x1 * bound) m_x1))
 		     b)
 
-    let rec map f m =
-      repr false (map_repr f 0 (obj false m))
+    let rec map f m = Common.prof "Intmap.map" (fun () ->
+      repr false (map_repr f 0 (obj false m)))
     and map_repr f pos m =
       match m with
       | Empty -> Empty
       | Full l ->
 	  let res = ref Empty in
-	  for x = 0 to exp31.(l) - 1 do
+	  for x = 0 to exp_base.(l) - 1 do
 	    match f (pos+x) unit with
 	    | None -> ()
 	    | Some v' -> res := set_repr x v' !res
 	  | None -> Empty
 	  | Some v' -> set_repr y v' Empty
 	  end
-      | Bitmap31 bmp ->
+      | Bitmap_base bmp ->
 	  Block (Block.values_from_mask bmp
 		   (fun x -> f (pos+x) unit))
       | Block b ->
 	  then
 	    Block (Block.mapfilter_values (fun x v -> f (pos+x) v) b)
 	  else
-	    let bound = exp31.(level) in
+	    let bound = exp_base.(level) in
 	    Block (Block.mapfilter_fields
 		     (fun x1 m_x1 -> Some (map_repr f (pos + x1 * bound) m_x1))
 		     b)
 
-    let subset ?filter m1 m2 =
+    let subset ?filter m1 m2 = Common.prof "Intmap.subset" (fun () ->
       let all1 pos m1 =
 	match filter with
 	| None -> true
 	| _, Empty -> is_empty_repr m1
 	| Full l1, Full l2 -> l1 <= l2 && all1 pos m1
 	| Full l1, Single y2 -> false
-	| Full l1, Bitmap31 bmp2 -> l1 = 1 && Bitmap31.is_full bmp2 && all1 pos m1
+	| Full l1, Bitmap_base bmp2 -> l1 = 1 && Bitmap_base.is_full bmp2 && all1 pos m1
 	| Full l1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l2 >= l1 then subset_repr pos m1 (Block.get_field b2 0)
 	    else if l2 = l1-1 then block_is_full b2 l2 && all12 pos m1 m2
 	    else false
-	| Single y1, Full l2 -> y1 < exp31.(l2) && all1 pos m1
-	| Bitmap31 bmp1, Full l2 -> all1 pos m1
+	| Single y1, Full l2 -> y1 < exp_base.(l2) && all1 pos m1
+	| Bitmap_base bmp1, Full l2 -> all1 pos m1
 	| Block b1, Full l2 ->
 	    let l1 = Block.level b1 in
 	    l1 < l2 && all1 pos m1
 	| Single y1, Single y2 -> y1 = y2 && all1 pos m1
-	| Single y1, Bitmap31 bmp2 -> y1 < 31 && Bitmap31.mem y1 bmp2 && all1 pos m1
+	| Single y1, Bitmap_base bmp2 -> y1 < base && Bitmap_base.mem y1 bmp2 && all1 pos m1
 	| Single y1, Block b2 -> mem_repr y1 m2 && all12 pos m1 m2
-	| Bitmap31 bmp1, Single y2 -> y2 < 31 && bmp1 = Bitmap31.singleton y2 && all1 pos m1
+	| Bitmap_base bmp1, Single y2 -> y2 < base && bmp1 = Bitmap_base.singleton y2 && all1 pos m1
 	| Block b1, Single y2 -> cardinal_repr m1 = 1 && mem_repr y2 m1 && all1 pos m1
-	| Bitmap31 bmp1, Bitmap31 bmp2 -> Bitmap31.subset bmp1 bmp2 && all1 pos m1
-	| Bitmap31 bmp1, Block b2 ->
+	| Bitmap_base bmp1, Bitmap_base bmp2 -> Bitmap_base.subset bmp1 bmp2 && all1 pos m1
+	| Bitmap_base bmp1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l2 = 0
 	    then
-	      Bitmap31.subset bmp1 (Block.mask b2) &&
+	      Bitmap_base.subset bmp1 (Block.mask b2) &&
 	      all12 pos m1 m2
 	    else subset_repr pos m1 (Block.get_field b2 0)
-	| Block b1, Bitmap31 bmp2 ->
+	| Block b1, Bitmap_base bmp2 ->
 	    let l1 = Block.level b1 in
 	    if l1 = 0
 	    then
-	      Bitmap31.subset (Block.mask b1) bmp2 &&
+	      Bitmap_base.subset (Block.mask b1) bmp2 &&
 	      all1 pos m1
 	    else Block.mask b1 = 1 && subset_repr pos (Block.get_field b1 0) m2
 	| Block b1, Block b2 ->
 	    else if l1 > l2 then Block.mask b1 = 1 && subset_repr pos (Block.get_field b1 0) m2
 	    else (* l1 = l2 *)
 	      let mask1 = Block.mask b1 in
-	      Bitmap31.subset mask1 (Block.mask b2) &&
+	      Bitmap_base.subset mask1 (Block.mask b2) &&
 	      if l1 = 0
 	      then all12 pos m1 m2
 	      else
-		let bound = exp31.(l1) in
-		Bitmap31.fold (fun res x1 -> res && subset_repr (pos + x1 * bound) (Block.get_field b1 x1) (Block.get_field b2 x1)) true mask1
+		let bound = exp_base.(l1) in
+		Bitmap_base.fold (fun res x1 -> res && subset_repr (pos + x1 * bound) (Block.get_field b1 x1) (Block.get_field b2 x1)) true mask1
       in
-      subset_repr 0 (obj false m1) (obj false m2)
+      subset_repr 0 (obj false m1) (obj false m2))
 
-    let fold_inter f init (m1 : 'a t) (m2 : 'b t) =
+    let fold_inter f init (m1 : 'a t) (m2 : 'b t) = Common.prof "Intmap.fold_inter" (fun () ->
       let fold1 acc pos m1 = fold_repr (fun res x v1 -> f res x v1 unit) acc pos m1 in
       let fold2 acc pos m2 = fold_repr (fun res x v2 -> f res x unit v2) acc pos m2 in
       let rec fold_inter_repr acc pos m1 m2 =
 	| Full l1, Full l2 ->
 	    fold1 acc pos (Full (min l1 l2))
 	| Full l1, Single y2 ->
-	    if y2 < exp31.(l1)
+	    if y2 < exp_base.(l1)
 	    then fold2 acc pos m2
 	    else acc
 	| Single y1, Full l2 ->
-	    if y1 < exp31.(l2)
+	    if y1 < exp_base.(l2)
 	    then fold1 acc pos m1
 	    else acc
-	| Full l1, Bitmap31 bmp2 ->
+	| Full l1, Bitmap_base bmp2 ->
 	    fold2 acc pos m2
-	| Bitmap31 bmp1, Full l2  ->
+	| Bitmap_base bmp1, Full l2  ->
 	    fold1 acc pos m1
 	| Full l1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if y1 = y2
 	    then fold1 acc pos m1
 	    else acc
-	| Single y1, Bitmap31 bmp2 ->
-	    if y1 < 31 && Bitmap31.mem y1 bmp2
+	| Single y1, Bitmap_base bmp2 ->
+	    if y1 < base && Bitmap_base.mem y1 bmp2
 	    then fold1 acc pos m1
 	    else acc
-	| Bitmap31 bmp1, Single y2 ->
-	    if y2 < 31 && Bitmap31.mem y2 bmp1
+	| Bitmap_base bmp1, Single y2 ->
+	    if y2 < base && Bitmap_base.mem y2 bmp1
 	    then fold2 acc pos m2
 	    else acc
 	| Single y1, Block b2  ->
 	| Block b1, Single y2 ->
 	    (try f acc (pos+y2) (get_repr y2 m1) unit
 	    with Not_found -> acc)
-	| Bitmap31 bmp1, Bitmap31 bmp2 ->
-	    fold1 acc pos (Bitmap31 (Bitmap31.inter bmp1 bmp2))
-	| Bitmap31 bmp1, Block b2 ->
+	| Bitmap_base bmp1, Bitmap_base bmp2 ->
+	    fold1 acc pos (Bitmap_base (Bitmap_base.inter bmp1 bmp2))
+	| Bitmap_base bmp1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l2 = 0
 	    then
-	      let mask = Bitmap31.inter bmp1 (Block.mask b2) in
-	      Bitmap31.fold (fun res x -> f res (pos+x) unit (Block.get_value b2 x)) acc mask
+	      let mask = Bitmap_base.inter bmp1 (Block.mask b2) in
+	      Bitmap_base.fold (fun res x -> f res (pos+x) unit (Block.get_value b2 x)) acc mask
 	    else fold_inter_repr acc pos m1 (Block.get_field b2 0)
-	| Block b1, Bitmap31 bmp2 ->
+	| Block b1, Bitmap_base bmp2 ->
 	    let l1 = Block.level b1 in
 	    if l1 = 0
 	    then
-	      let mask = Bitmap31.inter (Block.mask b1) bmp2 in
-	      Bitmap31.fold (fun res x -> f res (pos+x) (Block.get_value b1 x) unit) acc mask
+	      let mask = Bitmap_base.inter (Block.mask b1) bmp2 in
+	      Bitmap_base.fold (fun res x -> f res (pos+x) (Block.get_value b1 x) unit) acc mask
 	    else fold_inter_repr acc pos (Block.get_field b1 0) m2
 	| Block b1, Block b2 ->
 	    let l1, l2 = Block.level b1, Block.level b2 in
 	    if l1 < l2 then fold_inter_repr acc pos m1 (Block.get_field b2 0)
 	    else if l1 > l2 then fold_inter_repr acc pos (Block.get_field b1 0) m2
 	    else (* l1 = l2 *)
-	      let mask = Bitmap31.inter (Block.mask b1) (Block.mask b2) in
+	      let mask = Bitmap_base.inter (Block.mask b1) (Block.mask b2) in
 	      if l1 = 0
 	      then
-		Bitmap31.fold (fun res x -> f res (pos+x) (Block.get_value b1 x) (Block.get_value b2 x)) acc mask
+		Bitmap_base.fold (fun res x -> f res (pos+x) (Block.get_value b1 x) (Block.get_value b2 x)) acc mask
 	      else
-		let bound = exp31.(l1) in
-		Bitmap31.fold
+		let bound = exp_base.(l1) in
+		Bitmap_base.fold
 		  (fun res x1 -> fold_inter_repr res (pos + x1 * bound) (Block.get_field b1 x1) (Block.get_field b2 x1))
 		  acc mask
       in
-      fold_inter_repr init 0 (obj false m1) (obj false m2)
+      fold_inter_repr init 0 (obj false m1) (obj false m2))
 
 
-    let domain_inter ?filter (m1 : 'a t) (m2 : 'b t) =
+    let domain_inter ?filter (m1 : 'a t) (m2 : 'b t) = Common.prof "Intmap.domain_inter" (fun () ->
       let filter1 pos m1 = match filter with None -> m1 | Some f -> domain_repr ~filter:(fun x v -> f x v unit) pos m1 in
       let filter2 pos m2 = match filter with None -> m2 | Some f -> domain_repr ~filter:(fun x v -> f x unit v) pos m2 in
       let rec domain_inter_repr pos m1 m2 =
 	| Full l1, Full l2 ->
 	    filter1 pos (Full (min l1 l2))
 	| Full l1, Single y2 ->
-	    if y2 < exp31.(l1)
+	    if y2 < exp_base.(l1)
 	    then filter2 pos m2
 	    else Empty
 	| Single y1, Full l2 ->
-	    if y1 < exp31.(l2)
+	    if y1 < exp_base.(l2)
 	    then filter1 pos m1
 	    else Empty
-	| Full l1, Bitmap31 bmp2 ->
+	| Full l1, Bitmap_base bmp2 ->
 	    filter2 pos m2
-	| Bitmap31 bmp1, Full l2  ->
+	| Bitmap_base bmp1, Full l2  ->
 	    filter1 pos m1
 	| Full l1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if y1 = y2
 	    then filter1 pos m1
 	    else Empty
-	| Single y1, Bitmap31 bmp2 ->
-	    if y1 < 31 && Bitmap31.mem y1 bmp2
+	| Single y1, Bitmap_base bmp2 ->
+	    if y1 < base && Bitmap_base.mem y1 bmp2
 	    then filter1 pos m1
 	    else Empty
-	| Bitmap31 bmp1, Single y2 ->
-	    if y2 < 31 && Bitmap31.mem y2 bmp1
+	| Bitmap_base bmp1, Single y2 ->
+	    if y2 < base && Bitmap_base.mem y2 bmp1
 	    then filter2 pos m2
 	    else Empty
 	| Single y1, Block b2  ->
 	      | None -> m2
 	      | Some f -> if f (pos+y2) v1 unit then m2 else Empty
 	    with Not_found -> Empty)
-	| Bitmap31 bmp1, Bitmap31 bmp2 ->
-	    filter1 pos (Bitmap31 (Bitmap31.inter bmp1 bmp2))
-	| Bitmap31 bmp1, Block b2 ->
+	| Bitmap_base bmp1, Bitmap_base bmp2 ->
+	    filter1 pos (Bitmap_base (Bitmap_base.inter bmp1 bmp2))
+	| Bitmap_base bmp1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l2 = 0
 	    then
-	      let mask = Bitmap31.inter bmp1 (Block.mask b2) in
+	      let mask = Bitmap_base.inter bmp1 (Block.mask b2) in
 	      match filter with
-	      | None -> Bitmap31 mask
-	      | Some f -> Bitmap31 (Bitmap31.filter (fun x -> f (pos+x) unit (Block.get_value b2 x)) mask)
+	      | None -> Bitmap_base mask
+	      | Some f -> Bitmap_base (Bitmap_base.filter (fun x -> f (pos+x) unit (Block.get_value b2 x)) mask)
 	    else domain_inter_repr pos m1 (Block.get_field b2 0)
-	| Block b1, Bitmap31 bmp2 ->
+	| Block b1, Bitmap_base bmp2 ->
 	    let l1 = Block.level b1 in
 	    if l1 = 0
 	    then
-	      let mask = Bitmap31.inter (Block.mask b1) bmp2 in
+	      let mask = Bitmap_base.inter (Block.mask b1) bmp2 in
 	      match filter with
-	      | None -> Bitmap31 mask
-	      | Some f -> Bitmap31 (Bitmap31.filter (fun x -> f (pos+x) (Block.get_value b1 x) unit) mask)
+	      | None -> Bitmap_base mask
+	      | Some f -> Bitmap_base (Bitmap_base.filter (fun x -> f (pos+x) (Block.get_value b1 x) unit) mask)
 	    else domain_inter_repr pos (Block.get_field b1 0) m2
 	| Block b1, Block b2 ->
 	    let l1, l2 = Block.level b1, Block.level b2 in
 	    if l1 < l2 then domain_inter_repr pos m1 (Block.get_field b2 0)
 	    else if l1 > l2 then domain_inter_repr pos (Block.get_field b1 0) m2
 	    else (* l1 = l2 *)
-	      let mask = Bitmap31.inter (Block.mask b1) (Block.mask b2) in
+	      let mask = Bitmap_base.inter (Block.mask b1) (Block.mask b2) in
 	      if l1 = 0
 	      then
 		match filter with
-		| None -> Bitmap31 mask
-		| Some f -> Bitmap31 (Bitmap31.filter (fun x -> f (pos+x) (Block.get_value b1 x) (Block.get_value b2 x)) mask)
+		| None -> Bitmap_base mask
+		| Some f -> Bitmap_base (Bitmap_base.filter (fun x -> f (pos+x) (Block.get_value b1 x) (Block.get_value b2 x)) mask)
 	      else
-		let bound = exp31.(l1) in
+		let bound = exp_base.(l1) in
 		Block (Block.fields_from_mask l1 mask
 			 (fun x1 -> Some (domain_inter_repr (pos + x1 * bound) (Block.get_field b1 x1) (Block.get_field b2 x1))))
       in
-      repr false (domain_inter_repr 0 (obj false m1) (obj false m2))
+      repr false (domain_inter_repr 0 (obj false m1) (obj false m2)))
 
-    let map_inter f (m1 : 'a t) (m2 : 'b t) =
+    let map_inter f (m1 : 'a t) (m2 : 'b t) = Common.prof "Intmap.map_inter" (fun () ->
       let map1 pos m1 = map_repr (fun x v -> f x v unit) pos m1 in
       let map2 pos m2 = map_repr (fun x v -> f x unit v) pos m2 in
       let rec map_inter_repr pos m1 m2 =
 	| Full l1, Full l2 ->
 	    map1 pos (Full (min l1 l2))
 	| Full l1, Single y2 ->
-	    if y2 < exp31.(l1)
+	    if y2 < exp_base.(l1)
 	    then map2 pos m2
 	    else Empty
 	| Single y1, Full l2 ->
-	    if y1 < exp31.(l2)
+	    if y1 < exp_base.(l2)
 	    then map1 pos m1
 	    else Empty
-	| Full l1, Bitmap31 bmp2 ->
+	| Full l1, Bitmap_base bmp2 ->
 	    map2 pos m2
-	| Bitmap31 bmp1, Full l2  ->
+	| Bitmap_base bmp1, Full l2  ->
 	    map1 pos m1
 	| Full l1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l2 = 0
 	    then
 	      let mask = Block.mask b2 in
-	      if Bitmap31.is_empty mask
+	      if Bitmap_base.is_empty mask
 	      then Empty
 	      else
 		Block (Block.values_from_mask mask
 	    if l1 = 0
 	    then
 	      let mask = Block.mask b1 in
-	      if Bitmap31.is_empty mask
+	      if Bitmap_base.is_empty mask
 	      then Empty
 	      else
 		Block (Block.values_from_mask mask
 	    if y1 = y2
 	    then map1 pos m1
 	    else Empty
-	| Single y1, Bitmap31 bmp2 ->
-	    if y1 < 31 && Bitmap31.mem y1 bmp2
+	| Single y1, Bitmap_base bmp2 ->
+	    if y1 < base && Bitmap_base.mem y1 bmp2
 	    then map1 pos m1
 	    else Empty
-	| Bitmap31 bmp1, Single y2 ->
-	    if y2 < 31 && Bitmap31.mem y2 bmp1
+	| Bitmap_base bmp1, Single y2 ->
+	    if y2 < base && Bitmap_base.mem y2 bmp1
 	    then map2 pos m2
 	    else Empty
 	| Single y1, Block b2  ->
 	      | None -> Empty
 	      | Some v -> set_repr y2 v Empty
 	    with Not_found -> Empty)
-	| Bitmap31 bmp1, Bitmap31 bmp2 ->
-	    map1 pos (Bitmap31 (Bitmap31.inter bmp1 bmp2))
-	| Bitmap31 bmp1, Block b2 ->
+	| Bitmap_base bmp1, Bitmap_base bmp2 ->
+	    map1 pos (Bitmap_base (Bitmap_base.inter bmp1 bmp2))
+	| Bitmap_base bmp1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l2 = 0
 	    then
-	      let mask = Bitmap31.inter bmp1 (Block.mask b2) in
-	      if Bitmap31.is_empty mask
+	      let mask = Bitmap_base.inter bmp1 (Block.mask b2) in
+	      if Bitmap_base.is_empty mask
 	      then Empty
 	      else
 		Block (Block.values_from_mask mask
 		  (fun x -> f (pos+x) unit (Block.get_value b2 x)))
 	    else map_inter_repr pos m1 (Block.get_field b2 0)
-	| Block b1, Bitmap31 bmp2 ->
+	| Block b1, Bitmap_base bmp2 ->
 	    let l1 = Block.level b1 in
 	    if l1 = 0
 	    then
-	      let mask = Bitmap31.inter (Block.mask b1) bmp2 in
-	      if Bitmap31.is_empty mask
+	      let mask = Bitmap_base.inter (Block.mask b1) bmp2 in
+	      if Bitmap_base.is_empty mask
 	      then Empty
 	      else
 		Block (Block.values_from_mask mask
 	    if l1 < l2 then map_inter_repr pos m1 (Block.get_field b2 0)
 	    else if l1 > l2 then map_inter_repr pos (Block.get_field b1 0) m2
 	    else (* l1 = l2 *)
-	      let mask = Bitmap31.inter (Block.mask b1) (Block.mask b2) in
+	      let mask = Bitmap_base.inter (Block.mask b1) (Block.mask b2) in
 	      if l1 = 0
 	      then
-		if Bitmap31.is_empty mask
+		if Bitmap_base.is_empty mask
 		then Empty
 		else
 		  Block (Block.values_from_mask mask
 			   (fun x -> f (pos+x) (Block.get_value b1 x) (Block.get_value b2 x)))
 	      else
-		let bound = exp31.(l1) in
+		let bound = exp_base.(l1) in
 		Block (Block.fields_from_mask l1 mask
 			 (fun x1 -> Some (map_inter_repr (pos + x1 * bound) (Block.get_field b1 x1) (Block.get_field b2 x1))))
       in
-      repr false (map_inter_repr 0 (obj false m1) (obj false m2))
+      repr false (map_inter_repr 0 (obj false m1) (obj false m2)))
 
-    let domain_union ?filter (m1 : 'a t) (m2 : 'b t) =
+    let domain_union ?filter (m1 : 'a t) (m2 : 'b t) = Common.prof "Intmap.domain_union" (fun () ->
       let filter1 pos m1 v2 = match filter with None -> m1 | Some f -> domain_repr ~filter:(fun x v -> f x (Some v) (v2 (x-pos))) pos m1 in
       let filter2 pos m2 v1 = match filter with None -> m2 | Some f -> domain_repr ~filter:(fun x v -> f x (v1 (x-pos)) (Some v)) pos m2 in
       let filter12 pos m v1 v2 = match filter with None -> m | Some f -> domain_repr ~filter:(fun x v -> f x (v1 (x-pos)) (v2 (x-pos))) pos m in
       let rec filter_block1 pos b1 l1 m2 =
-	let bound = exp31.(l1) in
-	let mask = Bitmap31.add 0 (Block.mask b1) in
+	let bound = exp_base.(l1) in
+	let mask = Bitmap_base.add 0 (Block.mask b1) in
 	Block (Block.fields_from_mask l1 mask
 		 (fun x1 ->
 		   if x1 = 0
 		   else
 		     Some (filter1 (pos + x1 * bound) (Block.get_field b1 x1) (fun x -> None))))
       and filter_block2 pos b2 l2 m1 =
-	let bound = exp31.(l2) in
-	let mask = Bitmap31.add 0 (Block.mask b2) in
+	let bound = exp_base.(l2) in
+	let mask = Bitmap_base.add 0 (Block.mask b2) in
 	Block (Block.fields_from_mask l2 mask
 		 (fun x2 ->
 		   if x2 = 0
 	| Full l1, Full l2 ->
 	    if l1 < l2
 	    then
-	      let n1 = exp31.(l1) in
+	      let n1 = exp_base.(l1) in
 	      filter2 pos m2 (fun x -> if x < n1 then Some unit else None)
 	    else
-	      let n2 = exp31.(l2) in
+	      let n2 = exp_base.(l2) in
 	      filter1 pos m1 (fun x -> if x < n2 then Some unit else None)
 	| _, Single y2 ->
 	    if mem_repr y2 m1
 		  if f y1 (Some unit) None
 		  then add_repr y1 m2'
 		  else m2')
-	| Full l1, Bitmap31 bmp2 ->
-	    filter1 pos m1 (fun x -> if Bitmap31.mem x bmp2 then Some unit else None)
-	| Bitmap31 bmp1, Full l2  ->
-	    filter2 pos m2 (fun x -> if Bitmap31.mem x bmp1 then Some unit else None)
+	| Full l1, Bitmap_base bmp2 ->
+	    filter1 pos m1 (fun x -> if Bitmap_base.mem x bmp2 then Some unit else None)
+	| Bitmap_base bmp1, Full l2  ->
+	    filter2 pos m2 (fun x -> if Bitmap_base.mem x bmp1 then Some unit else None)
 	| Full l1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l1 > l2
 	    if l1 < l2
 	    then filter2 pos m2 (fun x -> try Some (get_repr x m1) with Not_found -> None)
 	    else filter_block1 pos b1 l1 m2
-	| Bitmap31 bmp1, Bitmap31 bmp2 ->
-	    filter12 pos (Bitmap31 (Bitmap31.union bmp1 bmp2))
-	      (fun x -> if Bitmap31.mem x bmp1 then Some unit else None)
-	      (fun x -> if Bitmap31.mem x bmp2 then Some unit else None)
-	| Bitmap31 bmp1, Block b2 ->
+	| Bitmap_base bmp1, Bitmap_base bmp2 ->
+	    filter12 pos (Bitmap_base (Bitmap_base.union bmp1 bmp2))
+	      (fun x -> if Bitmap_base.mem x bmp1 then Some unit else None)
+	      (fun x -> if Bitmap_base.mem x bmp2 then Some unit else None)
+	| Bitmap_base bmp1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l2 = 0
 	    then
-	      let mask = Bitmap31.union bmp1 (Block.mask b2) in
+	      let mask = Bitmap_base.union bmp1 (Block.mask b2) in
 	      match filter with
-	      | None -> Bitmap31 mask
-	      | Some f -> Bitmap31 (Bitmap31.filter
+	      | None -> Bitmap_base mask
+	      | Some f -> Bitmap_base (Bitmap_base.filter
 				      (fun x -> f (pos+x)
-					  (if Bitmap31.mem x bmp1 then Some unit else None)
+					  (if Bitmap_base.mem x bmp1 then Some unit else None)
 					  (try Some (Block.get_value b2 x) with Not_found -> None))
 				      mask)
 	    else filter_block2 pos b2 l2 m1
-	| Block b1, Bitmap31 bmp2 ->
+	| Block b1, Bitmap_base bmp2 ->
 	    let l1 = Block.level b1 in
 	    if l1 = 0
 	    then
-	      let mask = Bitmap31.union (Block.mask b1) bmp2 in
+	      let mask = Bitmap_base.union (Block.mask b1) bmp2 in
 	      match filter with
-	      | None -> Bitmap31 mask
-	      | Some f -> Bitmap31 (Bitmap31.filter
+	      | None -> Bitmap_base mask
+	      | Some f -> Bitmap_base (Bitmap_base.filter
 				      (fun x -> f (pos+x)
 					  (try Some (Block.get_value b1 x) with Not_found -> None)
-					  (if Bitmap31.mem x bmp2 then Some unit else None))
+					  (if Bitmap_base.mem x bmp2 then Some unit else None))
 				      mask)
 	    else filter_block1 pos b1 l1 m2
 	| Block b1, Block b2 ->
 	    if l1 < l2 then filter_block2 pos b2 l2 m1
 	    else if l1 > l2 then filter_block1 pos b1 l1 m2
 	    else (* l1 = l2 *)
-	      let mask = Bitmap31.union (Block.mask b1) (Block.mask b2) in
+	      let mask = Bitmap_base.union (Block.mask b1) (Block.mask b2) in
 	      if l1 = 0
 	      then
 		match filter with
-		| None -> Bitmap31 mask
+		| None -> Bitmap_base mask
 		| Some f ->
-		    Bitmap31 (Bitmap31.filter
+		    Bitmap_base (Bitmap_base.filter
 				(fun x -> f (pos+x)
 				    (try Some (Block.get_value b1 x) with Not_found -> None)
 				    (try Some (Block.get_value b2 x) with Not_found -> None))
 				mask)
 	      else
-		let bound = exp31.(l1) in
+		let bound = exp_base.(l1) in
 		Block (Block.fields_from_mask l1 mask
 			 (fun x1 ->
 			   let f1_opt = try Some (Block.get_field b1 x1) with Not_found -> None in
 			   | Some f1, Some f2 ->
 			       Some (domain_union_repr (pos + x1 * bound) f1 f2)))
       in
-      repr false (domain_union_repr 0 (obj false m1) (obj false m2))
+      repr false (domain_union_repr 0 (obj false m1) (obj false m2)))
 
-    let map_union f (m1 : 'a t) (m2 : 'b t) =
+    let map_union f (m1 : 'a t) (m2 : 'b t) = Common.prof "Intmap.map_union" (fun () ->
       let map1 pos m1 v2 = map_repr (fun x v -> f x (Some v) (v2 (x-pos))) pos m1 in
       let map2 pos m2 v1 = map_repr (fun x v -> f x (v1 (x-pos)) (Some v)) pos m2 in
       let map12 pos m v1 v2 = map_repr (fun x v -> f x (v1 (x-pos)) (v2 (x-pos))) pos m in
       let rec map_block1 pos b1 l1 m2 =
-	let bound = exp31.(l1) in
-	let mask = Bitmap31.add 0 (Block.mask b1) in
+	let bound = exp_base.(l1) in
+	let mask = Bitmap_base.add 0 (Block.mask b1) in
 	Block (Block.fields_from_mask l1 mask
 		 (fun x1 ->
 		   if x1 = 0
 		   else
 		     Some (map1 (pos + x1 * bound) (Block.get_field b1 x1) (fun x -> None))))
       and map_block2 pos b2 l2 m1 =
-	let bound = exp31.(l2) in
-	let mask = Bitmap31.add 0 (Block.mask b2) in
+	let bound = exp_base.(l2) in
+	let mask = Bitmap_base.add 0 (Block.mask b2) in
 	Block (Block.fields_from_mask l2 mask
 		 (fun x2 ->
 		   if x2 = 0
 	| Full l1, Full l2 ->
 	    if l1 < l2
 	    then
-	      let n1 = exp31.(l1) in
+	      let n1 = exp_base.(l1) in
 	      map2 pos m2 (fun x -> if x < n1 then Some unit else None)
 	    else
-	      let n2 = exp31.(l2) in
+	      let n2 = exp_base.(l2) in
 	      map1 pos m1 (fun x -> if x < n2 then Some unit else None)
 	| _, Single y2 ->
 	    if mem_repr y2 m1
 	      ( match f y1 (Some unit) None with
 	      | None -> m2'
 	      | Some v -> set_repr y1 v m2')
-	| Full l1, Bitmap31 bmp2 ->
-	    map1 pos m1 (fun x -> if Bitmap31.mem x bmp2 then Some unit else None)
-	| Bitmap31 bmp1, Full l2  ->
-	    map2 pos m2 (fun x -> if Bitmap31.mem x bmp1 then Some unit else None)
+	| Full l1, Bitmap_base bmp2 ->
+	    map1 pos m1 (fun x -> if Bitmap_base.mem x bmp2 then Some unit else None)
+	| Bitmap_base bmp1, Full l2  ->
+	    map2 pos m2 (fun x -> if Bitmap_base.mem x bmp1 then Some unit else None)
 	| Full l1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l1 > l2
 	    if l1 < l2
 	    then map2 pos m2 (fun x -> try Some (get_repr x m1) with Not_found -> None)
 	    else map_block1 pos b1 l1 m2
-	| Bitmap31 bmp1, Bitmap31 bmp2 ->
-	    map12 pos (Bitmap31 (Bitmap31.union bmp1 bmp2))
-	      (fun x -> if Bitmap31.mem x bmp1 then Some unit else None)
-	      (fun x -> if Bitmap31.mem x bmp2 then Some unit else None)
-	| Bitmap31 bmp1, Block b2 ->
+	| Bitmap_base bmp1, Bitmap_base bmp2 ->
+	    map12 pos (Bitmap_base (Bitmap_base.union bmp1 bmp2))
+	      (fun x -> if Bitmap_base.mem x bmp1 then Some unit else None)
+	      (fun x -> if Bitmap_base.mem x bmp2 then Some unit else None)
+	| Bitmap_base bmp1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l2 = 0
 	    then
-	      let mask = Bitmap31.union bmp1 (Block.mask b2) in
+	      let mask = Bitmap_base.union bmp1 (Block.mask b2) in
 	      Block (Block.values_from_mask mask
 		       (fun x -> f (pos+x)
-			   (if Bitmap31.mem x bmp1 then Some unit else None)
+			   (if Bitmap_base.mem x bmp1 then Some unit else None)
 			   (try Some (Block.get_value b2 x) with _ -> None)))
 	    else map_block2 pos b2 l2 m1
-	| Block b1, Bitmap31 bmp2 ->
+	| Block b1, Bitmap_base bmp2 ->
 	    let l1 = Block.level b1 in
 	    if l1 = 0
 	    then
-	      let mask = Bitmap31.union (Block.mask b1) bmp2 in
+	      let mask = Bitmap_base.union (Block.mask b1) bmp2 in
 	      Block (Block.values_from_mask mask
 		       (fun x -> f (pos+x)
 			   (try Some (Block.get_value b1 x) with _ -> None)
-			   (if Bitmap31.mem x bmp2 then Some unit else None)))
+			   (if Bitmap_base.mem x bmp2 then Some unit else None)))
 	    else map_block1 pos b1 l1 m2
 	| Block b1, Block b2 ->
 	    let l1, l2 = Block.level b1, Block.level b2 in
 	    if l1 < l2 then map_block2 pos b2 l2 m1
 	    else if l1 > l2 then map_block1 pos b1 l1 m2
 	    else (* l1 = l2 *)
-	      let mask = Bitmap31.union (Block.mask b1) (Block.mask b2) in
+	      let mask = Bitmap_base.union (Block.mask b1) (Block.mask b2) in
 	      if l1 = 0
 	      then
 		Block (Block.values_from_mask mask
 			     (try Some (Block.get_value b1 x) with Not_found -> None)
 			     (try Some (Block.get_value b2 x) with Not_found -> None)))
 	      else
-		let bound = exp31.(l1) in
+		let bound = exp_base.(l1) in
 		Block (Block.fields_from_mask l1 mask
 			 (fun x1 ->
 			   let f1_opt = try Some (Block.get_field b1 x1) with Not_found -> None in
 			   | Some f1, Some f2 ->
 			       Some (map_union_repr (pos + x1 * bound) f1 f2)))
       in
-      repr false (map_union_repr 0 (obj false m1) (obj false m2))
+      repr false (map_union_repr 0 (obj false m1) (obj false m2)))
 
-    let domain_diff ?filter (m1 : 'a t) (m2 : 'b t) =
+    let domain_diff ?filter (m1 : 'a t) (m2 : 'b t) = Common.prof "Intmap.domain_diff" (fun () ->
       let filter1 pos m1 v2 =
 	match filter with
 	| None -> domain_repr ~filter:(fun x v -> (v2 (x-pos)) = None) pos m1
 	| Some f -> domain_repr ~filter:(fun x v -> f x v (v2 (x-pos))) pos m1 in
       let rec filter_block1 pos b1 l1 m2 =
-	let bound = exp31.(l1) in
+	let bound = exp_base.(l1) in
 	let mask = Block.mask b1 in
 	Block (Block.fields_from_mask l1 mask
 		 (fun x1 ->
 	    then
 	      filter1 pos m1 (fun x -> Some unit)
 	    else
-	      let n2 = exp31.(l2) in
+	      let n2 = exp_base.(l2) in
 	      filter1 pos m1 (fun x -> if x < n2 then Some unit else None)
 	| _, Single y2 ->
 	    filter1 pos m1 (fun x -> if x = y2 then Some unit else None)
 	| Single y1, _ ->
 	    filter1 pos m1 (fun x -> try Some (get_repr y1 m2) with Not_found -> None)
-	| Full l1, Bitmap31 bmp2 ->
-	    filter1 pos m1 (fun x -> if Bitmap31.mem x bmp2 then Some unit else None)
-	| Bitmap31 bmp1, Full l2  ->
+	| Full l1, Bitmap_base bmp2 ->
+	    filter1 pos m1 (fun x -> if Bitmap_base.mem x bmp2 then Some unit else None)
+	| Bitmap_base bmp1, Full l2  ->
 	    filter1 pos m1 (fun x -> Some unit)
 	| Full l1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l1 < l2
 	    then filter1 pos m1 (fun x -> Some unit)
 	    else filter_block1 pos b1 l1 m2
-	| Bitmap31 bmp1, Bitmap31 bmp2 ->
+	| Bitmap_base bmp1, Bitmap_base bmp2 ->
 	    ( match filter with
-	    | None -> Bitmap31 (Bitmap31.diff bmp1 bmp2)
-	    | Some _ -> filter1 pos m1 (fun x -> if Bitmap31.mem x bmp2 then Some unit else None))
-	| Bitmap31 bmp1, Block b2 ->
+	    | None -> Bitmap_base (Bitmap_base.diff bmp1 bmp2)
+	    | Some _ -> filter1 pos m1 (fun x -> if Bitmap_base.mem x bmp2 then Some unit else None))
+	| Bitmap_base bmp1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l2 = 0
 	    then
 	      match filter with
-	      | None -> Bitmap31 (Bitmap31.diff bmp1 (Block.mask b2))
+	      | None -> Bitmap_base (Bitmap_base.diff bmp1 (Block.mask b2))
 	      | Some f ->
-		  Bitmap31 (Bitmap31.filter
+		  Bitmap_base (Bitmap_base.filter
 			      (fun x -> f (pos+x)
 				  unit
 				  (try Some (Block.get_value b2 x) with Not_found -> None))
 			      bmp1)
 	    else domain_diff_repr pos m1 (Block.get_field b2 0)
-	| Block b1, Bitmap31 bmp2 ->
+	| Block b1, Bitmap_base bmp2 ->
 	    let l1 = Block.level b1 in
 	    if l1 = 0
 	    then
 	      let mask = Block.mask b1 in
 	      match filter with
-	      | None -> Bitmap31 (Bitmap31.diff mask bmp2)
+	      | None -> Bitmap_base (Bitmap_base.diff mask bmp2)
 	      | Some f ->
-		  Bitmap31 (Bitmap31.filter
+		  Bitmap_base (Bitmap_base.filter
 			      (fun x -> f (pos+x)
 				  (Block.get_value b1 x)
-				  (if Bitmap31.mem x bmp2 then Some unit else None))
+				  (if Bitmap_base.mem x bmp2 then Some unit else None))
 			      mask)
 	    else filter_block1 pos b1 l1 m2
 	| Block b1, Block b2 ->
 	      if l1 = 0
 	      then
 		match filter with
-		| None -> Bitmap31 (Bitmap31.diff mask (Block.mask b2))
+		| None -> Bitmap_base (Bitmap_base.diff mask (Block.mask b2))
 		| Some f ->
-		    Bitmap31 (Bitmap31.filter
+		    Bitmap_base (Bitmap_base.filter
 				(fun x -> f (pos+x)
 				    (Block.get_value b1 x)
 				    (try Some (Block.get_value b2 x) with Not_found -> None))
 				mask)
 	      else
-		let bound = exp31.(l1) in
+		let bound = exp_base.(l1) in
 		Block (Block.fields_from_mask l1 mask
 			 (fun x1 ->
 			   let f1 = Block.get_field b1 x1 in
 			   let f2 = Block.get_field b2 x1 in
 			   Some (domain_diff_repr (pos + x1 * bound) f1 f2)))
       in
-      repr false (domain_diff_repr 0 (obj false m1) (obj false m2))
+      repr false (domain_diff_repr 0 (obj false m1) (obj false m2)))
 
 
-    let map_diff f (m1 : 'a t) (m2 : 'b t) =
+    let map_diff f (m1 : 'a t) (m2 : 'b t) = Common.prof "Intmap.map_diff" (fun () ->
       let map1 pos m1 v2 = map_repr (fun x v -> f x v (v2 (x-pos))) pos m1 in
       let rec map_block1 pos b1 l1 m2 =
-	let bound = exp31.(l1) in
+	let bound = exp_base.(l1) in
 	let mask = Block.mask b1 in
 	Block (Block.fields_from_mask l1 mask
 		 (fun x1 ->
 	    then
 	      map1 pos m1 (fun x -> Some unit)
 	    else
-	      let n2 = exp31.(l2) in
+	      let n2 = exp_base.(l2) in
 	      map1 pos m1 (fun x -> if x < n2 then Some unit else None)
 	| _, Single y2 ->
 	    map1 pos m1 (fun x -> if x = y2 then Some unit else None)
 	| Single y1, _ ->
 	    map1 pos m1 (fun x -> try Some (get_repr y1 m2) with Not_found -> None)
-	| Full l1, Bitmap31 bmp2 ->
-	    map1 pos m1 (fun x -> if Bitmap31.mem x bmp2 then Some unit else None)
-	| Bitmap31 bmp1, Full l2  ->
+	| Full l1, Bitmap_base bmp2 ->
+	    map1 pos m1 (fun x -> if Bitmap_base.mem x bmp2 then Some unit else None)
+	| Bitmap_base bmp1, Full l2  ->
 	    map1 pos m1 (fun x -> Some unit)
 	| Full l1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l1 < l2
 	    then map1 pos m1 (fun x -> Some unit)
 	    else map_block1 pos b1 l1 m2
-	| Bitmap31 bmp1, Bitmap31 bmp2 ->
-	    map1 pos m1 (fun x -> if Bitmap31.mem x bmp2 then Some unit else None)
-	| Bitmap31 bmp1, Block b2 ->
+	| Bitmap_base bmp1, Bitmap_base bmp2 ->
+	    map1 pos m1 (fun x -> if Bitmap_base.mem x bmp2 then Some unit else None)
+	| Bitmap_base bmp1, Block b2 ->
 	    let l2 = Block.level b2 in
 	    if l2 = 0
 	    then
 			   unit
 			   (try Some (Block.get_value b2 x) with Not_found -> None)))
 	    else map_diff_repr pos m1 (Block.get_field b2 0)
-	| Block b1, Bitmap31 bmp2 ->
+	| Block b1, Bitmap_base bmp2 ->
 	    let l1 = Block.level b1 in
 	    if l1 = 0
 	    then
 	      Block (Block.values_from_mask mask
 		       (fun x -> f (pos+x)
 			   (Block.get_value b1 x)
-			   (if Bitmap31.mem x bmp2 then Some unit else None)))
+			   (if Bitmap_base.mem x bmp2 then Some unit else None)))
 	    else map_block1 pos b1 l1 m2
 	| Block b1, Block b2 ->
 	    let l1, l2 = Block.level b1, Block.level b2 in
 			     (Block.get_value b1 x)
 			     (try Some (Block.get_value b2 x) with Not_found -> None)))
 	      else
-		let bound = exp31.(l1) in
+		let bound = exp_base.(l1) in
 		Block (Block.fields_from_mask l1 mask
 			 (fun x1 ->
 			   let f1 = Block.get_field b1 x1 in
 			   let f2 = Block.get_field b2 x1 in
 			   Some (map_diff_repr (pos + x1 * bound) f1 f2)))
       in
-      repr false (map_diff_repr 0 (obj false m1) (obj false m2))
+      repr false (map_diff_repr 0 (obj false m1) (obj false m2)))
 
     let memory_size ?(f = fun _ -> 0) m =
       let rec memory_size_repr = function
 	| Empty -> 1
 	| Full _ -> 1
 	| Single _ -> 1
-	| Bitmap31 _ -> 1
+	| Bitmap_base _ -> 1
 	| Block b ->
 	    let level = Block.level b in
 	    if level = 0
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.