Commits

Sébastien Ferré committed 9e124f6

Initial revision

  • Participants
  • Parent commits 2c2c01f

Comments (0)

Files changed (1)

+
+module type T =
+  sig (* set operations refer to the keys of the map *)
+    type 'a t
+    val cardinal : 'a t -> int
+    val empty : 'a t
+    val is_empty : 'a t -> bool
+    val singleton : int -> unit t
+    val mem : int -> 'a t -> bool
+    val choose : 'a t -> int
+    val get : int -> 'a t -> 'a (* raise Not_found *)
+    val add : int -> unit t -> unit t
+    val set : int -> 'a -> 'a t -> 'a t
+    val remove : int -> 'a t -> 'a t
+
+    val fold : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b
+    val iter : (int -> 'a -> unit) -> 'a t -> unit
+    val domain : ?filter:(int -> 'a -> bool) -> 'a t -> unit t
+    val map : (int -> 'a -> 'b option) -> 'a t -> 'b t
+(*    val equal : ?filter:(int -> 'a -> 'b -> bool) -> 'a t -> 'b t -> bool *)
+    val subset : ?filter:(int -> 'a -> 'b -> bool) -> 'a t -> 'b t -> bool
+    val fold_inter : ('c -> int -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c
+    val domain_inter : ?filter:(int -> 'a -> 'b -> bool) -> 'a t -> 'b t -> unit t
+    val map_inter : (int -> 'a -> 'b -> 'c option) -> 'a t -> 'b t -> 'c t
+    val domain_union : ?filter:(int -> 'a option -> 'b option -> bool) -> 'a t -> 'b t -> unit t
+    val map_union : (int -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    val domain_diff : ?filter:(int -> 'a -> 'b option -> bool) -> 'a t -> 'b t -> unit t
+    val map_diff : (int -> 'a -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    val memory_size : ?f:('a -> int) -> 'a t -> int (* in words, the argument function gives the memory size of a value *)
+  end
+
+let unit = (Obj.magic () : 'a)
+
+(* implementation based on Map for testing *)
+
+module Std : T =
+  struct
+    module Map = Map.Make (struct type t = int let compare = Pervasives.compare end)
+
+    type 'a t = 'a Map.t
+
+    let cardinal m = Map.fold (fun _ _ res -> 1 + res) m 0
+    let empty = Map.empty
+    let is_empty = Map.is_empty
+    let choose m =
+      if Map.is_empty m
+      then raise Not_found
+      else Map.fold (fun x _ _ -> x) m 0
+    let singleton x = Map.add x unit Map.empty
+    let mem = Map.mem
+    let get = Map.find
+    let add x m = Map.add x unit m
+    let set = Map.add
+    let remove = Map.remove
+    let fold f init m = Map.fold (fun x v res -> f res x v) m init
+    let iter = Map.iter
+
+    let domain ?(filter = fun _ _ -> true) m =
+      Map.fold
+	(fun x v res -> if filter x v then Map.add x unit res else res)
+	m Map.empty
+
+    let map f m =
+      Map.fold
+	(fun x v res -> match f x v with None -> res | Some v' -> Map.add x v' res)
+	m Map.empty
+
+    let subset ?(filter = fun _ _ _ -> true) m1 m2 =
+      Map.fold
+	(fun x v1 res -> res && try filter x v1 (Map.find x m2) with Not_found -> false)
+	m1 true
+
+    let fold_inter f init m1 m2 =
+      Map.fold
+	(fun x v1 res -> try f res x v1 (Map.find x m2) with Not_found -> res)
+	m1 init
+
+    let domain_inter ?(filter = fun _ _ _ -> true) m1 m2 =
+      Map.fold
+	(fun x v1 res -> try if filter x v1 (Map.find x m2) then Map.add x unit res else res with Not_found -> res)
+	m1 Map.empty
+
+    let map_inter f m1 m2 =
+      Map.fold
+	(fun x v1 res -> try match f x v1 (Map.find x m2) with None -> res | Some v -> Map.add x v res with Not_found -> res)
+	m1 Map.empty
+
+    let domain_union ?(filter = fun _ _ _ -> true) m1 m2 =
+      let m0 =
+	Map.fold
+	  (fun x v1 res ->
+	    if filter x (Some v1) (try Some (Map.find x m2) with Not_found -> None)
+	    then Map.add x unit res
+	    else res)
+	  m1 Map.empty in
+      Map.fold
+	(fun x v2 res ->
+	  if Map.mem x m1
+	  then res
+	  else
+	    if filter x (Some unit) (Some v2)
+	    then Map.add x unit res
+	    else res)
+	m2 m0
+      
+    let map_union f m1 m2 =
+      let m0 =
+	Map.fold
+	  (fun x v1 res ->
+	    match f x (Some v1) (try Some (Map.find x m2) with Not_found -> None) with
+	    | None -> res
+	    | Some v -> Map.add x v res)
+	  m1 Map.empty in
+      Map.fold
+	(fun x v2 res ->
+	  if Map.mem x m1
+	  then res
+	  else
+	    match f x (Some unit) (Some v2) with
+	    | None -> res
+	    | Some v -> Map.add x v res)
+	m2 m0
+      
+    let domain_diff ?(filter = fun _ _ v2_opt -> v2_opt = None) m1 m2 =
+      Map.fold
+	(fun x v1 res ->
+	  let v2_opt = try Some (Map.find x m2) with Not_found -> None in
+	  if filter x v1 v2_opt
+	  then Map.add x unit res
+	  else res)
+	m1 Map.empty
+
+    let map_diff f m1 m2 =
+      Map.fold
+	(fun x v1 res ->
+	  let v2_opt = try Some (Map.find x m2) with Not_found -> None in
+	  match f x v1 v2_opt with
+	  | None -> res
+	  | Some v -> Map.add x v res)
+	m1 Map.empty
+
+    let memory_size ?(f = fun _ -> 0) m = Map.fold (fun x v res -> 5 + f v + res) m 0
+  end
+
+
+(* table giving powers of 31 *)
+
+let exp31 =
+  let res = Array.make 7 1 in
+  for i = 1 to 6 do
+    res.(i) <- 31 * res.(i-1)
+  done;
+  res
+
+let log31 x =
+  let res = ref 6 in
+  while !res > 0 && x < exp31.(!res) do
+    decr res
+  done;
+  !res
+
+let split x l =
+  let bound = exp31.(l) in
+  x / bound, x mod bound
+
+module Bitmap31 =
+  struct
+    let empty = 0
+
+    let is_empty bmp = (bmp = empty)
+
+    let full = 0x7FFFFFFF
+
+    let is_full bmp = (bmp = full)
+
+    (* computing efficiently number of 1-bits in bytes and words *)
+
+    let card_byte =
+      let t = Array.make 256 0 in
+      for i = 0 to 255 do
+	for j = 0 to 7 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 singleton x = 1 lsl x
+
+    let mem x bmp = (bmp lsr x) land 1 <> 0
+
+    let choose bmp =
+      if bmp = empty
+      then raise Not_found
+      else begin
+	let x = ref 0 in
+	while not (mem !x bmp) do
+	  incr x
+	done;
+	!x end
+
+    let add x bmp = bmp lor (1 lsl x)
+
+    let remove x bmp = bmp land (lnot (1 lsl x))
+
+    let subset bmp1 bmp2 = bmp1 land (lnot bmp2) = 0
+
+    let compl bmp = full land (lnot bmp)
+
+    let union bmp1 bmp2 = bmp1 lor bmp2
+
+    let inter bmp1 bmp2 = bmp1 land bmp2
+
+    let diff bmp1 bmp2 = bmp1 land (lnot bmp2)
+
+    let fold f init bmp =
+      let res = ref init in
+      for x1 = 0 to 31 - 1 do
+	if mem x1 bmp
+	then res := f !res x1
+      done;
+      !res
+
+    let iter f bmp =
+      for x1 = 0 to 31 - 1 do
+	if mem x1 bmp
+	then f x1
+      done
+
+    let filter f bmp = fold (fun res x -> if f x then res else remove x res) bmp bmp
+  end
+
+(* --------------------------------- *)
+
+module M : T =
+  struct
+type 'a t = Obj.t
+      (* 'a = unit for sets *)
+
+type 'a repr =
+  | Empty (* empty map, empty set *)
+  | Full of int (* full set at some level *)
+  | Single of int (* singleton set *)
+  | Bitmap31 of int (* 31-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,
+	   and values for level = 0 *)
+
+let obj level0 (m : 'a t) : 'a repr =
+  if Obj.is_int m
+  then
+    let i = (Obj.obj m : int) in
+    if level0
+    then Bitmap31 i
+    else
+      if i = -1 then Empty
+      else if i < -1 then Full (-i - 1)
+      else Single i (* the value has type unit *)
+  else
+    Block m
+
+let rec repr level0 (m : 'a repr) : 'a t =
+  match m with
+  | Empty ->
+      if level0
+      then Obj.repr Bitmap31.empty
+      else Obj.repr (-1)
+  | Full l ->
+      if level0
+      then Obj.repr Bitmap31.full
+      else Obj.repr (-l - 1)
+  | Single x ->
+      if level0
+      then Obj.repr (Bitmap31.singleton x)
+      else Obj.repr x
+  | Bitmap31 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))
+	else begin
+	  let block = Obj.new_block 1 2 in
+	  Obj.set_field block 0 (Obj.repr (Bitmap31.singleton 0));
+	  Obj.set_field block 1 (Obj.repr bmp);
+	  block
+	end
+  | Block b ->
+      let n = Obj.size b in
+      let l = Obj.tag 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 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 res = ref true in
+  for i = 1 to 31 do
+    res := !res && Obj.field b i = full_l
+  done;
+  !res
+
+
+let is_empty_repr = function (* low-level 'is_empty' test *)
+  | Empty -> true
+  | Full _ -> false
+  | Single _ -> false
+  | Bitmap31 bmp -> Bitmap31.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
+  | Block b -> block_is_full b (Obj.tag b)
+
+module Block =
+  struct
+    let level block = Obj.tag block
+
+    let mask block = (Obj.obj (Obj.field block 0) : int)
+
+    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
+
+    let get_field block x1 =
+      assert (x1 < 31);
+      let level = level block in
+      assert (level > 0);
+      let present, i = locate block x1 in
+      if present
+      then obj (level>0) (Obj.field block i)
+      else Empty
+
+    let get_value block x =
+      assert (x < 31);
+      assert (level block = 0);
+      let present, i = locate block x in
+      if present
+      then (Obj.obj (Obj.field block i) : 'a)
+      else raise Not_found
+
+    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);
+      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 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 ix (repr (level>0) m);
+      Obj.set_field block iy (repr (level>0) 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 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
+	Obj.set_field block i (repr (level>0) (Full level))
+      done;
+      block
+
+    let remove_field block x1 =
+      let present, i = locate block x1 in
+      if not present
+      then block
+      else begin
+	let n = Obj.size block in
+	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)));
+	for k = 1 to i-1 do
+	  Obj.set_field block' k (Obj.field block k)
+	done;
+	for k = i to n-2 do
+	  Obj.set_field block' k (Obj.field block (k+1))
+	done;
+	block' end
+
+    let remove_value block x1 =
+      let present, i = locate block x1 in
+      if not present
+      then block
+      else begin
+	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)));
+	for k = 1 to i-1 do
+	  Obj.set_field block' k (Obj.field block k)
+	done;
+	for k = i to n-2 do
+	  Obj.set_field block' k (Obj.field block (k+1))
+	done;
+	block' end
+
+    let replace_field block x1 f =
+      let level = level block in
+      assert (level > 0);
+      let present, i = locate block x1 in
+      if not present
+      then
+	let m' = f Empty in
+	if is_empty_repr m'
+	then block
+	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)));
+	  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');
+	  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 *)
+	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');
+	  block'
+	end
+
+    let replace_value block x1 f =
+      assert (level block = 0);
+      let present, i = locate block x1 in
+      if not present
+      then begin
+	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)));
+	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');
+	for k = i-1 downto 1 do
+	  Obj.set_field block' k (Obj.field block k)
+	done;
+	block' end
+      else begin
+	let v' = f (Obj.obj (Obj.field block i) : 'a) in
+	let block' = Obj.dup block in
+	Obj.set_field block' i (Obj.repr v');
+	block' end
+
+    let fields_from_mask level bmp f =
+      let bmp, l =
+	Bitmap31.fold
+	  (fun (bmp,l) x1 ->
+	    match f x1 with
+	    | None -> (Bitmap31.remove x1 bmp), l
+	    | Some m ->
+		if is_empty_repr m
+		then (Bitmap31.remove x1 bmp), l
+		else bmp, (repr (level>0) m :: l))
+	  (bmp, [])
+	  bmp in
+      let block = Obj.new_block level (1 + List.length l) 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
+
+    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 bmp, l =
+	Bitmap31.fold
+	  (fun (bmp,l) x -> match f x with None -> (Bitmap31.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
+
+    let mapfilter_values f block =
+      values_from_mask (mask block)
+	(fun x -> f x (get_value block x))
+
+    let fold_fields f init block =
+      let level = level block in
+      assert (level > 0);
+      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))
+      done;
+      !res
+
+    let fold_values f init block =
+      assert (level block = 0);
+      let n = Obj.size block in
+      let res = ref init in
+      for i = 1 to n-1 do
+	res := f !res (Obj.obj (Obj.field block i) : 'a)
+      done;
+      !res
+  end
+
+
+(* --------------------- *)
+
+let empty : 'a t = repr false Empty
+
+let rec is_empty (m : 'a t) : bool =
+  is_empty_repr (obj false m)
+
+let singleton (x : int) : unit t = repr false (Single x)
+
+let rec cardinal (m : 'a t) : int =
+  cardinal_repr (obj false m)
+and cardinal_repr = function
+  | Empty -> 0
+  | Full level -> exp31.(level)
+  | Single _ -> 1
+  | Bitmap31 bmp -> Bitmap31.cardinal bmp
+  | Block b ->
+      let level = Block.level b in
+      if level = 0
+      then Bitmap31.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)
+and mem_repr x = function
+  | Empty -> false
+  | Full l -> x < exp31.(l)
+  | Single y -> x = y
+  | Bitmap31 bmp -> x < 31 && Bitmap31.mem x bmp
+  | Block b ->
+      let level = Block.level b in
+      let x1, x2 = split x level in
+      x1 < 31 &&
+      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)
+and choose_repr pos = function
+  | Empty -> raise Not_found
+  | Full l -> pos + 0
+  | Single y -> pos + y
+  | Bitmap31 bmp -> pos + Bitmap31.choose bmp
+  | Block b ->
+      let level = Block.level b in
+      let x1 = Bitmap31.choose (Block.mask b) in
+      if level = 0
+      then pos + x1
+      else
+	let bound = exp31.(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)
+and get_repr x = function
+  | Empty ->
+      raise Not_found
+  | Full l ->
+      if x < exp31.(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
+      then unit
+      else raise Not_found
+  | Block b ->
+      let level = Block.level b in
+      let x1, x2 = split x level in
+      if x1 < 31
+      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))
+and add_repr x = function
+  | Empty -> Single x
+  | Full l as m ->
+      let l_x = log31 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
+      if level = 0
+      then Bitmap31 (Bitmap31.add x (Bitmap31.singleton y))
+      else
+	let bound = exp31.(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)
+      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
+      if l_x <= level
+      then
+	let x1, x2 = split x level in
+	Block (Block.replace_field b x1 (fun m_x1 -> add_repr x2 m_x1))
+      else
+	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))
+and set_repr x v = function
+  | Empty ->
+      let l_x = log31 x in
+      if l_x = 0 (* x < 31 *)
+      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
+      if l_x <= level
+      then
+	let x1, x2 = split x level in
+	if level = 0
+	then Block (Block.replace_value b x1 (fun _ -> v))
+	else Block (Block.replace_field b x1 (set_repr x2 v))
+      else
+	let x1, x2 = split x l_x 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))
+and remove_repr x = function
+  | Empty -> Empty
+  | Full l ->
+      if x >= exp31.(l)
+      then Full l
+      else
+	let m_full =
+	  if l = 1
+	  then Bitmap31 Bitmap31.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)
+      else m
+  | Block b as m ->
+      let level = Block.level b in
+      let l_x = log31 x in
+      if l_x > level
+      then m
+      else
+	let x1, x2 = split x level in
+	if level = 0
+	then Block (Block.remove_value b x1)
+	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)
+    and fold_repr f acc pos = function
+      | Empty -> acc
+      | Full l ->
+	  let res = ref acc in
+	  for x = 0 to exp31.(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
+      | Block b ->
+	  let level = Block.level b in
+	  if level = 0
+	  then
+	    Bitmap31.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
+	      (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 rec iter_repr pos = function
+	| Empty -> ()
+	| Full l ->
+	    for x = 0 to exp31.(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
+	| Block b ->
+	    let level = Block.level b in
+	    if level = 0
+	    then
+	      Bitmap31.iter
+		(fun x -> f (pos+x) (Block.get_value b x))
+		(Block.mask b)
+	    else
+	      let bound = exp31.(level) in
+	      Bitmap31.iter
+		(fun x1 -> iter_repr (pos + x1 * bound) (Block.get_field b x1))
+		(Block.mask b)
+      in
+      iter_repr 0 (obj false m)
+
+    let rec domain ?filter m =
+      repr false (domain_repr ?filter 0 (obj false m))
+    and domain_repr ?filter pos m =
+      match m with
+      | Empty -> m
+      | Full l ->
+	  begin match filter with
+	  | None -> m
+	  | Some f ->
+	      let res = ref Empty in
+	      for x = 0 to exp31.(l) - 1 do
+		if f (pos+x) unit
+		then res := add_repr x !res
+	      done;
+	      !res
+	  end
+      | Single y ->
+	  begin match filter with
+	  | None -> m
+	  | Some f ->
+	      if f (pos+y) unit
+	      then m
+	      else Empty
+	  end
+      | Bitmap31 bmp ->
+	  begin match filter with
+	  | None -> m
+	  | Some f ->
+	      Bitmap31 (Bitmap31.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)
+	    | Some f ->
+		Bitmap31 (Bitmap31.filter (fun x -> f (pos+x) (Block.get_value b x)) (Block.mask b))
+	  else
+	    let bound = exp31.(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))
+    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
+	    match f (pos+x) unit with
+	    | None -> ()
+	    | Some v' -> res := set_repr x v' !res
+	  done;
+	  !res
+      | Single y ->
+	  begin match f (pos+y) unit with
+	  | None -> Empty
+	  | Some v' -> set_repr y v' Empty
+	  end
+      | Bitmap31 bmp ->
+	  Block (Block.values_from_mask bmp
+		   (fun x -> f (pos+x) unit))
+      | Block b ->
+	  let level = Block.level b in
+	  if level = 0
+	  then
+	    Block (Block.mapfilter_values (fun x v -> f (pos+x) v) b)
+	  else
+	    let bound = exp31.(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 all1 pos m1 =
+	match filter with
+	| None -> true
+	| Some f -> fold_repr (fun res x v1 -> res && f x v1 unit) true pos m1 in
+      let all12 pos m1 m2 =
+	match filter with
+	| None -> true
+	| Some f -> fold_repr (fun res x v1 -> res && try f x v1 (get_repr x m2) with Not_found -> false) true pos m1 in
+      let rec subset_repr pos m1 m2 =
+	match m1, m2 with
+	| Empty, _ -> 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, 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
+	| 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, Block b2 -> mem_repr y1 m2 && all12 pos m1 m2
+	| Bitmap31 bmp1, Single y2 -> y2 < 31 && bmp1 = Bitmap31.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 ->
+	    let l2 = Block.level b2 in
+	    if l2 = 0
+	    then
+	      Bitmap31.subset bmp1 (Block.mask b2) &&
+	      all12 pos m1 m2
+	    else subset_repr pos m1 (Block.get_field b2 0)
+	| Block b1, Bitmap31 bmp2 ->
+	    let l1 = Block.level b1 in
+	    if l1 = 0
+	    then
+	      Bitmap31.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 ->
+	    let l1, l2 = Block.level b1, Block.level b2 in
+	    if l1 < l2 then subset_repr pos m1 (Block.get_field b2 0)
+	    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) &&
+	      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
+      in
+      subset_repr 0 (obj false m1) (obj false m2)
+
+    let fold_inter f init (m1 : 'a t) (m2 : 'b t) =
+      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 =
+	match m1, m2 with
+	| Empty, _ -> acc
+	| _, Empty -> acc
+	| Full l1, Full l2 ->
+	    fold1 acc pos (Full (min l1 l2))
+	| Full l1, Single y2 ->
+	    if y2 < exp31.(l1)
+	    then fold2 acc pos m2
+	    else acc
+	| Single y1, Full l2 ->
+	    if y1 < exp31.(l2)
+	    then fold1 acc pos m1
+	    else acc
+	| Full l1, Bitmap31 bmp2 ->
+	    fold2 acc pos m2
+	| Bitmap31 bmp1, Full l2  ->
+	    fold1 acc pos m1
+	| Full l1, Block b2 ->
+	    let l2 = Block.level b2 in
+	    if l1 > l2
+	    then fold2 acc pos m2
+	    else fold_inter_repr acc pos m1 (Block.get_field b2 0)
+	| Block b1, Full l2 ->
+	    let l1 = Block.level b1 in
+	    if l1 < l2
+	    then fold1 acc pos m1
+	    else fold_inter_repr acc pos (Block.get_field b1 0) m2
+	| Single y1, Single y2 ->
+	    if y1 = y2
+	    then fold1 acc pos m1
+	    else acc
+	| Single y1, Bitmap31 bmp2 ->
+	    if y1 < 31 && Bitmap31.mem y1 bmp2
+	    then fold1 acc pos m1
+	    else acc
+	| Bitmap31 bmp1, Single y2 ->
+	    if y2 < 31 && Bitmap31.mem y2 bmp1
+	    then fold2 acc pos m2
+	    else acc
+	| Single y1, Block b2  ->
+	    (try f acc (pos+y1) unit (get_repr y1 m2)
+	    with Not_found -> acc)
+	| 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 ->
+	    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
+	    else fold_inter_repr acc pos m1 (Block.get_field b2 0)
+	| Block b1, Bitmap31 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
+	    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
+	      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
+	      else
+		let bound = exp31.(l1) in
+		Bitmap31.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)
+
+
+    let domain_inter ?filter (m1 : 'a t) (m2 : 'b t) =
+      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 =
+	match m1, m2 with
+	| Empty, _ -> Empty
+	| _, Empty -> Empty
+	| Full l1, Full l2 ->
+	    filter1 pos (Full (min l1 l2))
+	| Full l1, Single y2 ->
+	    if y2 < exp31.(l1)
+	    then filter2 pos m2
+	    else Empty
+	| Single y1, Full l2 ->
+	    if y1 < exp31.(l2)
+	    then filter1 pos m1
+	    else Empty
+	| Full l1, Bitmap31 bmp2 ->
+	    filter2 pos m2
+	| Bitmap31 bmp1, Full l2  ->
+	    filter1 pos m1
+	| Full l1, Block b2 ->
+	    let l2 = Block.level b2 in
+	    if l1 > l2
+	    then filter2 pos m2
+	    else domain_inter_repr pos m1 (Block.get_field b2 0)
+	| Block b1, Full l2 ->
+	    let l1 = Block.level b1 in
+	    if l1 < l2
+	    then filter1 pos m1
+	    else domain_inter_repr pos (Block.get_field b1 0) m2
+	| Single y1, Single y2 ->
+	    if y1 = y2
+	    then filter1 pos m1
+	    else Empty
+	| Single y1, Bitmap31 bmp2 ->
+	    if y1 < 31 && Bitmap31.mem y1 bmp2
+	    then filter1 pos m1
+	    else Empty
+	| Bitmap31 bmp1, Single y2 ->
+	    if y2 < 31 && Bitmap31.mem y2 bmp1
+	    then filter2 pos m2
+	    else Empty
+	| Single y1, Block b2  ->
+	    (try
+	      let v2 = get_repr y1 m2 in
+	      match filter with
+	      | None -> m1
+	      | Some f -> if f (pos+y1) unit v2 then m1 else Empty
+	    with Not_found -> Empty)
+	| Block b1, Single y2 ->
+	    (try
+	      let v1 = get_repr y2 m1 in
+	      match filter with
+	      | 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 ->
+	    let l2 = Block.level b2 in
+	    if l2 = 0
+	    then
+	      let mask = Bitmap31.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)
+	    else domain_inter_repr pos m1 (Block.get_field b2 0)
+	| Block b1, Bitmap31 bmp2 ->
+	    let l1 = Block.level b1 in
+	    if l1 = 0
+	    then
+	      let mask = Bitmap31.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)
+	    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
+	      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)
+	      else
+		let bound = exp31.(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))
+
+    let map_inter f (m1 : 'a t) (m2 : 'b t) =
+      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 =
+	match m1, m2 with
+	| Empty, _ -> Empty
+	| _, Empty -> Empty
+	| Full l1, Full l2 ->
+	    map1 pos (Full (min l1 l2))
+	| Full l1, Single y2 ->
+	    if y2 < exp31.(l1)
+	    then map2 pos m2
+	    else Empty
+	| Single y1, Full l2 ->
+	    if y1 < exp31.(l2)
+	    then map1 pos m1
+	    else Empty
+	| Full l1, Bitmap31 bmp2 ->
+	    map2 pos m2
+	| Bitmap31 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
+	      then Empty
+	      else
+		Block (Block.values_from_mask mask
+		  (fun x -> f (pos+x) unit (Block.get_value b2 x)))
+	    else
+	      if l1 > l2
+	      then map2 pos m2
+	      else map_inter_repr pos m1 (Block.get_field b2 0)
+	| Block b1, Full l2 ->
+	    let l1 = Block.level b1 in
+	    if l1 = 0
+	    then
+	      let mask = Block.mask b1 in
+	      if Bitmap31.is_empty mask
+	      then Empty
+	      else
+		Block (Block.values_from_mask mask
+		  (fun x -> f (pos+x) (Block.get_value b1 x) unit))
+	    else
+	      if l1 < l2
+	      then map1 pos m1
+	      else map_inter_repr pos (Block.get_field b1 0) m2
+	| Single y1, Single y2 ->
+	    if y1 = y2
+	    then map1 pos m1
+	    else Empty
+	| Single y1, Bitmap31 bmp2 ->
+	    if y1 < 31 && Bitmap31.mem y1 bmp2
+	    then map1 pos m1
+	    else Empty
+	| Bitmap31 bmp1, Single y2 ->
+	    if y2 < 31 && Bitmap31.mem y2 bmp1
+	    then map2 pos m2
+	    else Empty
+	| Single y1, Block b2  ->
+	    (try
+	      let v2 = get_repr y1 m2 in
+	      match f (pos+y1) unit v2 with
+	      | None -> Empty
+	      | Some v -> set_repr y1 v Empty
+	    with Not_found -> Empty)
+	| Block b1, Single y2 ->
+	    (try
+	      let v1 = get_repr y2 m1 in
+	      match f (pos+y2) v1 unit with
+	      | 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 ->
+	    let l2 = Block.level b2 in
+	    if l2 = 0
+	    then
+	      let mask = Bitmap31.inter bmp1 (Block.mask b2) in
+	      if Bitmap31.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 ->
+	    let l1 = Block.level b1 in
+	    if l1 = 0
+	    then
+	      let mask = Bitmap31.inter (Block.mask b1) bmp2 in
+	      if Bitmap31.is_empty mask
+	      then Empty
+	      else
+		Block (Block.values_from_mask mask
+		  (fun x -> f (pos+x) (Block.get_value b1 x) unit))
+	    else map_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 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
+	      if l1 = 0
+	      then
+		if Bitmap31.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
+		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))
+
+    let domain_union ?filter (m1 : 'a t) (m2 : 'b t) =
+      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
+	Block (Block.fields_from_mask l1 mask
+		 (fun x1 ->
+		   if x1 = 0
+		   then
+		     Some (domain_union_repr pos (Block.get_field b1 0) m2)
+		   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
+	Block (Block.fields_from_mask l2 mask
+		 (fun x2 ->
+		   if x2 = 0
+		   then
+		     Some (domain_union_repr pos m1 (Block.get_field b2 0))
+		   else
+		     Some (filter2 (pos + x2 * bound) (Block.get_field b2 x2) (fun x -> None))))
+      and domain_union_repr pos m1 m2 =
+	match m1, m2 with
+	| Empty, Empty -> Empty
+	| Empty, _ -> filter2 pos m2 (fun x -> None)
+	| _, Empty -> filter1 pos m1 (fun x -> None)
+	| Full l1, Full l2 ->
+	    if l1 < l2
+	    then
+	      let n1 = exp31.(l1) in
+	      filter2 pos m2 (fun x -> if x < n1 then Some unit else None)
+	    else
+	      let n2 = exp31.(l2) in
+	      filter1 pos m1 (fun x -> if x < n2 then Some unit else None)
+	| _, Single y2 ->
+	    if mem_repr y2 m1
+	    then filter1 pos m1 (fun x -> if x = y2 then Some unit else None)
+	    else
+	      let m1' = filter1 pos m1 (fun x -> None) in
+	      ( match filter with
+	      | None -> add_repr y2 m1'
+	      | Some f ->
+		  if f y2 None (Some unit)
+		  then add_repr y2 m1'
+		  else m1')
+	| Single y1, _ ->
+	    if mem_repr y1 m2
+	    then filter2 pos m2 (fun x -> if x = y1 then Some unit else None)
+	    else
+	      let m2' = filter2 pos m2 (fun x -> None) in
+	      ( match filter with
+	      | None -> add_repr y1 m2'
+	      | Some f ->
+		  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, Block b2 ->
+	    let l2 = Block.level b2 in
+	    if l1 > l2
+	    then filter1 pos m1 (fun x -> try Some (get_repr x m2) with Not_found -> None)
+	    else filter_block2 pos b2 l2 m1
+	| Block b1, Full l2 ->
+	    let l1 = Block.level b1 in
+	    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 ->
+	    let l2 = Block.level b2 in
+	    if l2 = 0
+	    then
+	      let mask = Bitmap31.union bmp1 (Block.mask b2) in
+	      match filter with
+	      | None -> Bitmap31 mask
+	      | Some f -> Bitmap31 (Bitmap31.filter
+				      (fun x -> f (pos+x)
+					  (if Bitmap31.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 ->
+	    let l1 = Block.level b1 in
+	    if l1 = 0
+	    then
+	      let mask = Bitmap31.union (Block.mask b1) bmp2 in
+	      match filter with
+	      | None -> Bitmap31 mask
+	      | Some f -> Bitmap31 (Bitmap31.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))
+				      mask)
+	    else filter_block1 pos b1 l1 m2
+	| Block b1, Block b2 ->
+	    let l1, l2 = Block.level b1, Block.level b2 in
+	    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
+	      if l1 = 0
+	      then
+		match filter with
+		| None -> Bitmap31 mask
+		| Some f ->
+		    Bitmap31 (Bitmap31.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
+		Block (Block.fields_from_mask l1 mask
+			 (fun x1 ->
+			   let f1_opt = try Some (Block.get_field b1 x1) with Not_found -> None in
+			   let f2_opt = try Some (Block.get_field b2 x1) with Not_found -> None in
+			   match f1_opt, f2_opt with
+			   | None, None -> None
+			   | Some f1, None -> Some (filter1 (pos + x1 * bound) f1 (fun x -> None))
+			   | None, Some f2 -> Some (filter2 (pos + x1 * bound) f2 (fun x -> None))
+			   | 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))
+
+    let map_union f (m1 : 'a t) (m2 : 'b t) =
+      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
+	Block (Block.fields_from_mask l1 mask
+		 (fun x1 ->
+		   if x1 = 0
+		   then
+		     Some (map_union_repr pos (Block.get_field b1 0) m2)
+		   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
+	Block (Block.fields_from_mask l2 mask
+		 (fun x2 ->
+		   if x2 = 0
+		   then
+		     Some (map_union_repr pos m1 (Block.get_field b2 0))
+		   else
+		     Some (map2 (pos + x2 * bound) (Block.get_field b2 x2) (fun x -> None))))
+      and map_union_repr pos m1 m2 =
+	match m1, m2 with
+	| Empty, Empty -> Empty
+	| Empty, _ -> map2 pos m2 (fun x -> None)
+	| _, Empty -> map1 pos m1 (fun x -> None)
+	| Full l1, Full l2 ->
+	    if l1 < l2
+	    then
+	      let n1 = exp31.(l1) in
+	      map2 pos m2 (fun x -> if x < n1 then Some unit else None)
+	    else
+	      let n2 = exp31.(l2) in
+	      map1 pos m1 (fun x -> if x < n2 then Some unit else None)
+	| _, Single y2 ->
+	    if mem_repr y2 m1
+	    then map1 pos m1 (fun x -> if x = y2 then Some unit else None)
+	    else
+	      let m1' = map1 pos m1 (fun x -> None) in
+	      ( match f y2 None (Some unit) with
+	      | None -> m1'
+	      | Some v -> set_repr y2 v m1')
+	| Single y1, _ ->
+	    if mem_repr y1 m2
+	    then map2 pos m2 (fun x -> if x = y1 then Some unit else None)
+	    else
+	      let m2' = map2 pos m2 (fun x -> None) in
+	      ( 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, Block b2 ->
+	    let l2 = Block.level b2 in
+	    if l1 > l2
+	    then map1 pos m1 (fun x -> try Some (get_repr x m2) with Not_found -> None)
+	    else map_block2 pos b2 l2 m1
+	| Block b1, Full l2 ->
+	    let l1 = Block.level b1 in
+	    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 ->
+	    let l2 = Block.level b2 in
+	    if l2 = 0
+	    then
+	      let mask = Bitmap31.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)
+			   (try Some (Block.get_value b2 x) with _ -> None)))
+	    else map_block2 pos b2 l2 m1
+	| Block b1, Bitmap31 bmp2 ->
+	    let l1 = Block.level b1 in
+	    if l1 = 0
+	    then
+	      let mask = Bitmap31.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)))
+	    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
+	      if l1 = 0
+	      then
+		Block (Block.values_from_mask mask
+			 (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)))
+	      else
+		let bound = exp31.(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
+			   let f2_opt = try Some (Block.get_field b2 x1) with Not_found -> None in
+			   match f1_opt, f2_opt with
+			   | None, None -> None
+			   | Some f1, None -> Some (map1 (pos + x1 * bound) f1 (fun x -> None))
+			   | None, Some f2 -> Some (map2 (pos + x1 * bound) f2 (fun x -> None))
+			   | 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))
+
+    let domain_diff ?filter (m1 : 'a t) (m2 : 'b t) =
+      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 mask = Block.mask b1 in
+	Block (Block.fields_from_mask l1 mask
+		 (fun x1 ->
+		   if x1 = 0
+		   then
+		     Some (domain_diff_repr pos (Block.get_field b1 0) m2)
+		   else
+		     Some (filter1 (pos + x1 * bound) (Block.get_field b1 x1) (fun x -> None))))
+      and domain_diff_repr pos m1 m2 =
+	match m1, m2 with
+	| Empty, _ -> Empty
+	| _, Empty -> filter1 pos m1 (fun x -> None)
+	| Full l1, Full l2 ->
+	    if l1 < l2
+	    then
+	      filter1 pos m1 (fun x -> Some unit)
+	    else
+	      let n2 = exp31.(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  ->
+	    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 -> try Some (get_repr x m2) with Not_found -> None)
+	    else domain_diff_repr pos m1 (Block.get_field b2 0)
+	| Block b1, Full l2 ->
+	    let l1 = Block.level b1 in
+	    if l1 < l2
+	    then filter1 pos m1 (fun x -> Some unit)
+	    else filter_block1 pos b1 l1 m2
+	| Bitmap31 bmp1, Bitmap31 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 ->
+	    let l2 = Block.level b2 in
+	    if l2 = 0
+	    then
+	      match filter with
+	      | None -> Bitmap31 (Bitmap31.diff bmp1 (Block.mask b2))
+	      | Some f ->
+		  Bitmap31 (Bitmap31.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 ->
+	    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)
+	      | Some f ->
+		  Bitmap31 (Bitmap31.filter
+			      (fun x -> f (pos+x)
+				  (Block.get_value b1 x)
+				  (if Bitmap31.mem x bmp2 then Some unit else None))
+			      mask)
+	    else filter_block1 pos b1 l1 m2
+	| Block b1, Block b2 ->
+	    let l1, l2 = Block.level b1, Block.level b2 in
+	    if l1 < l2 then domain_diff_repr pos m1 (Block.get_field b2 0)
+	    else if l1 > l2 then filter_block1 pos b1 l1 m2
+	    else (* l1 = l2 *)
+	      let mask = Block.mask b1 in
+	      if l1 = 0
+	      then
+		match filter with
+		| None -> Bitmap31 (Bitmap31.diff mask (Block.mask b2))
+		| Some f ->
+		    Bitmap31 (Bitmap31.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
+		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))
+
+
+    let map_diff f (m1 : 'a t) (m2 : 'b t) =
+      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 mask = Block.mask b1 in
+	Block (Block.fields_from_mask l1 mask
+		 (fun x1 ->
+		   if x1 = 0
+		   then
+		     Some (map_diff_repr pos (Block.get_field b1 0) m2)
+		   else
+		     Some (map1 (pos + x1 * bound) (Block.get_field b1 x1) (fun x -> None))))
+      and map_diff_repr pos m1 m2 =
+	match m1, m2 with
+	| Empty, _ -> Empty
+	| _, Empty -> map1 pos m1 (fun x -> None)
+	| Full l1, Full l2 ->
+	    if l1 < l2
+	    then
+	      map1 pos m1 (fun x -> Some unit)
+	    else
+	      let n2 = exp31.(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  ->
+	    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 -> try Some (get_repr x m2) with Not_found -> None)
+	    else map_diff_repr pos m1 (Block.get_field b2 0)
+	| Block b1, Full l2 ->
+	    let l1 = Block.level b1 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 ->
+	    let l2 = Block.level b2 in
+	    if l2 = 0
+	    then
+	      let mask = bmp1 in
+	      Block (Block.values_from_mask mask
+		       (fun x -> f (pos+x)
+			   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 ->
+	    let l1 = Block.level b1 in
+	    if l1 = 0
+	    then
+	      let mask = Block.mask b1 in
+	      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)))
+	    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_diff_repr pos m1 (Block.get_field b2 0)
+	    else if l1 > l2 then map_block1 pos b1 l1 m2
+	    else (* l1 = l2 *)
+	      let mask = Block.mask b1 in
+	      if l1 = 0
+	      then
+		Block (Block.values_from_mask mask
+			 (fun x -> f (pos+x)
+			     (Block.get_value b1 x)
+			     (try Some (Block.get_value b2 x) with Not_found -> None)))
+	      else
+		let bound = exp31.(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))
+
+    let memory_size ?(f = fun _ -> 0) m =
+      let rec memory_size_repr = function
+	| Empty -> 1
+	| Full _ -> 1
+	| Single _ -> 1
+	| Bitmap31 _ -> 1
+	| Block b ->
+	    let level = Block.level b in
+	    if level = 0
+	    then 
+	      Block.fold_values
+		(fun res v -> res + f v)
+		3 (* reference + tag + mask *)
+		b
+	    else
+	      Block.fold_fields
+		(fun res m_i -> res + memory_size_repr m_i)
+		3 (* reference + tag + mask *)
+		b
+      in
+      memory_size_repr (obj false m)
+
+
+  end
+
+(* automatic testing by comparison *)
+
+module Comparator (A : T) (B : T) =
+  struct
+    exception Fail of string * string
+
+    module Wrapper (X : T) =
+      struct
+	let list m = List.sort Pervasives.compare (X.fold (fun res x v -> (x,v)::res) [] m)
+
+	let string l = "{" ^ String.concat "," (List.map (fun (x,_) -> string_of_int x) l) ^ "}"
+
+	let list_string m = let l = list m in l, string l
+
+	let int_random () = Random.int 1000
+
+	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
+	  try
+	    for i = 1 to 500 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
+	      else begin
+		Buffer.add_char tr '-'; Buffer.add_string tr (string_of_int i);
+		m := X.remove i !m end
+	    done;
+	    Buffer.contents tr, !m
+	  with e -> raise (Fail (Buffer.contents tr, Printexc.to_string e))
+	
+	let apply name f seed =
+	  Random.init seed;
+	  let tr, m = random () in
+(*	  let tr' = name ^ "(" ^ tr ^ ")" in *)
+	  let tr' = name ^ "(" ^ string (list m) ^ ")" in
+	  try
+	    let res, s_res = f m in
+	    tr' ^ " = " ^ s_res, res
+	  with e -> raise (Fail (tr', Printexc.to_string e))
+
+	let apply2 name f seed =
+	  Random.init seed;
+	  let tr1, m1 = random () in
+	  let tr2, m2 = random () in
+(*	  let tr = name ^ "(" ^ tr1 ^ "," ^ tr2 ^ ")" in *)
+	  let tr = name ^ "(\n" ^ string (list m1) ^ ",\n" ^ string (list m2) ^ ")" in
+	  try
+	    let res, s_res = f m1 m2 in
+	    tr ^ " =\n" ^ s_res, res
+	  with e -> raise (Fail (tr, Printexc.to_string e))
+
+	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 create = apply "list" list_string
+	let cardinal = apply "cardinal" (fun m -> let n = X.cardinal m in n, string_of_int n)
+	let is_empty = apply "is_empty" (fun m -> let b = X.is_empty m in b, string_of_bool b)
+	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 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
+	      (* 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 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 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))
+      end
+
+    module AX = Wrapper (A)
+    module BX = Wrapper (B)
+
+    let main duration =
+      let comp opA opB =
+	let seed = Random.int max_int 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
+	then begin print_string "-"; flush stdout end (* print_endline "OK" *)
+	else begin print_string "\nError: "; print_endline trA; print_endline trB end
+      in
+      while Sys.time () < duration do
+	match Random.int 14 with
+	| 0 -> comp AX.create BX.create
+	| 1 -> comp AX.cardinal BX.cardinal
+	| 2 -> comp AX.is_empty BX.is_empty
+	| 3 -> comp AX.mem BX.mem
+	| 4 -> comp AX.get BX.get
+	| 5 -> comp AX.domain BX.domain
+	| 6 -> comp AX.map BX.map
+	| 7 -> comp AX.subset BX.subset
+	| 8 -> comp AX.domain_inter BX.domain_inter
+	| 9 -> comp AX.map_inter BX.map_inter
+	| 10 -> comp AX.domain_union BX.domain_union
+	| 11 -> comp AX.map_union BX.map_union
+	| 12 -> comp AX.domain_diff BX.domain_diff
+	| 13 -> comp AX.map_diff BX.map_diff
+	| _ -> ()
+      done;
+      print_newline ()
+
+  end
+
+module Comp = Comparator (Std) (M)
+
+(* let _ = Comp.main (float_of_string Sys.argv.(1)) *)
+
+(* for testing *)
+(*
+open M
+
+(*
+let x = ref empty
+
+let ask f = f !x
+
+let tell f = x := f !x
+*)
+
+let rec range_aux acc a b =
+  if a = b
+  then acc
+  else range_aux (add a acc) (a+1) b
+let range = range_aux empty
+
+let rec id_aux acc a b =
+  if a = b
+  then acc
+  else id_aux (set a a acc) (a+1) b
+let id = id_aux empty
+
+let rec range2_aux acc a b =
+  if a = b
+  then acc
+  else range2_aux (set a (range a b) acc) (a+1) b
+let range2 = range2_aux empty
+
+let list m = fold (fun res x v -> (x,v)::res) [] m
+*)