Commits

Sébastien Ferré  committed 3df75ad

Stable version, used in Camelis 1.4.

  • Participants
  • Parent commits f72280a

Comments (0)

Files changed (1)

 
 module type T_BOUNDED =
   sig
-    val bound : int
     include T
+    val bound : int
+    val full : t
+    val is_full : t -> bool
+    val compl : t -> t
   end
 
 module Cis : T =
 
     let is_empty i = i = 0
 
+    let full = (-1)
+
+    let is_full i = i = (-1)
+
     let cardinal i =
       card_byte.(i land 0xFF)
 	+ card_byte.((i lsr 8) land 0xFF)
 
     let subset i1 i2 =  i1 land (lnot i2) = 0
 
+    let compl i = lnot i
+
     let union i1 i2 = i1 lor i2
 
     let inter i1 i2 = i1 land i2
     let bound = 31 * X.bound
 
     type t = Obj.t
-       (* empty set : negative integer *)
+       (* empty set : -1 *)
+       (* full set : -2 *)
        (* singleton : non-negative integer representing unique element *)
        (* other sets : blocks *)
 	  (* field 0 is bitmap of non-empty subsets *)
 	  (* each 1-bit of field 0 refers to a subset *)
 	  (* the number of 1-bits in 'e.(0) lsr (x/X.bound)' gives the field containing the bit x *)
 
-    type kind = Empty | Single of int | Other of Obj.t (* block *)
+    type kind = Empty | Full | Single of int | Other of Obj.t (* block *)
 
     let kind e =
       if Obj.is_int e
       then
 	let i = (Obj.obj e : int) in
-	if i < 0 then Empty else Single i
+	if i = -1 then Empty
+	else if i = -2 then Full
+	else Single i
       else
 	Other e
 
 
     (* intset interface *)
 
+    let fold f init e =
+      match kind e with
+      | Empty -> init
+      | Full ->
+	  let res = ref init in
+	  for x = 0 to bound - 1 do
+	    res := f !res x
+	  done;
+	  !res
+      | Single x -> f init x
+      | Other e ->
+	  let e_mask = get_mask e in
+	  let res = ref init in
+	  for x1 = 0 to 31 - 1 do
+	    if test e_mask x1 then begin
+	      let i = get_subset x1 e in
+	      let x0 = X.bound * x1 in
+	      res := X.fold (fun res2 x2 -> f res2 (x0 + x2)) !res i
+	    end
+	  done;
+	  !res
+
+    let elements e =
+      List.rev (fold (fun res x -> x::res) [] e)
+
     let empty = Obj.repr (-1)
 
     let is_empty e =
       match kind e with
       | Empty -> true
+      | Full -> false
       | Single _ -> false
       | Other e -> get_mask e = 0
 
+    let full = Obj.repr (-2)
+(*
+      let n = 31 in
+      let e = make (-1) (n + 1) in
+      for i = 1 to n-1 do
+	set_field e i X.full
+      done;
+      e
+*)
+
+    let is_full e =
+      match kind e with
+      | Empty -> false
+      | Full -> true
+      | Single _ -> false
+      | Other e ->
+	  let n = length e in
+	  let res = ref (get_mask e = (-1)) in
+	  let i = ref 1 in
+	  while !res && !i < n do
+	    res := !res && X.is_full (get_field e !i);
+	    incr i
+	  done;
+	  !res
+
     let cardinal e =
       match kind e with
       | Empty -> 0
+      | Full -> bound
       | Single _ -> 1
       | Other e ->
 	  let n = length e in
     let mem x e =
       match kind e with
       | Empty -> false
+      | Full -> x < bound
       | Single y -> x = y
       | Other e ->
 	  let i, _, x2, present = get_index x e in
       assert (x < bound);
       Obj.repr x
 
+    let simpl e =
+      let e_mask = get_mask e in
+      if e_mask = 0
+      then empty
+      else
+	let n = cardinal_word e_mask in
+	if n = 1 && X.cardinal (get_field e 1) = 1
+	then singleton (List.hd (elements e))
+	else sub e 0 (1 + n) (* for removing extra words *)
+
     let add x e =
       assert (x < bound);
       match kind e with
       | Empty -> singleton x
+      | Full -> e
       | Single y ->
 	  let x1, x2 = x / X.bound, x mod X.bound in
 	  let y1, y2 = y / X.bound, y mod X.bound in
 	    then e
 	    else begin
 	      let e' = copy e in (* unsafe not to make a copy *)
-	      set_field e' i (X.add x2 (get_field e' i));
-	      e'
+	      let e'_x1 = X.add x2 (get_field e' i) in
+	      set_field e' i e'_x1;
+	      if X.is_full e'_x1 && is_full e'
+	      then full
+	      else e'
 	    end
 	  else begin
 	    let n = length e in
     let remove x e =
       match kind e with
       | Empty -> e
+      | Full ->
+	  if x < bound
+	  then begin
+	    let x1, x2 = x / X.bound, x mod X.bound in
+	    let i = x1 + 1 in
+	    let n = 31 in
+	    let e' = make (-1) (n+1) in
+	    for k = 1 to i-1 do
+	      set_field e' k X.full
+	    done;
+	    set_field e' i (X.remove x2 X.full);
+	    for k = i+1 to n-1 do
+	      set_field e' k X.full
+	    done;
+	    e' end
+	  else e
       | Single y ->
 	  if x = y
 	  then empty
 	      let e'_i = X.remove x2 (get_field e i) in
 	      if X.is_empty e'_i
 	      then begin
-		let n = length e in
-		let e' = make (reset (get_mask e) x1) (n-1) in
+		let n' = length e - 1 in
+		let e' = make (reset (get_mask e) x1) n' in
 		for k = 1 to i-1 do
 		  Obj.set_field e' k (Obj.field e k)
 		  (* set_field e' k (get_field e k) *)
 		done;
-		for k = i to n-2 do
+		for k = i to n'-1 do
 		  Obj.set_field e' k (Obj.field e (k+1))
 		  (* set_field e' k (get_field e (k+1)) *)
 		done;
-		e' end
+		if n' = 1
+		then empty
+		else
+		  if n' = 2 && X.cardinal (get_field e' 1) = 1
+		  then singleton (List.hd (elements e'))
+		  else e' end
 	      else begin
 		let e' = copy e in
 		set_field e' i e'_i;
 	    else e
 	  else e
 
+
     let subset e1 e2 =
       let subset_word i1 i2 = i1 land (lnot i2) = 0 in
       match kind e1, kind e2 with
       | Empty, _ -> true
-      | _, Empty -> false
+      | _, Full -> true
+      | _, Empty -> is_empty e1
+      | Full, _ -> is_full e2
       | Single x1, _ -> mem x1 e2
       | Other e1, Single y ->
 	  let y1, y2 = y / X.bound, y mod X.bound in
 	    let res = ref true in
 	    let x1 = ref 0 in
 	    while !res && !x1 < 31 do
-	      res := test (get_mask e1) !x1 && X.subset (get_subset !x1 e1) (get_subset !x1 e2);
+	      res := not (test (get_mask e1) !x1) || X.subset (get_subset !x1 e1) (get_subset !x1 e2);
 	      incr x1
 	    done;
 	    !res
 	  end
 
+    let compl e1 =
+      match kind e1 with
+      | Empty -> full
+      | Full -> empty
+      | Single x -> remove x full
+      | Other e1 ->
+	  let e1_mask = get_mask e1 in
+	  if e1_mask = 0
+	  then full
+	  else begin
+	    let e = make (-1) (31+1) in
+	    for x1 = 31 - 1 downto 0 do
+	      if test e1_mask x1
+	      then
+		let e_x1 = X.compl (get_subset x1 e1) in
+		if X.is_empty e_x1
+		then set_mask e (reset (get_mask e) x1)
+		else set_field e (get_i x1 e) e_x1
+	      else set_field e (get_i x1 e) X.full
+	    done;
+	    simpl e
+	  end
+
     let union e1 e2 =
       let union_word i1 i2 = i1 lor i2 in
       match kind e1, kind e2 with
       | Empty, _ -> e2
       | _, Empty -> e1
+      | Full, _
+      | _, Full -> full
       | Single x, _ -> add x e2
       | _, Single y -> add y e1
       | Other e1, Other e2 ->
     let inter e1 e2 =
       let inter_word i1 i2 = i1 land i2 in
       match kind e1, kind e2 with
-      | Empty, _ -> e1
-      | _, Empty -> e2
+      | Empty, _
+      | _, Empty -> empty
+      | Full, _ -> e2
+      | _, Full -> e1
       | Single x, _ -> if mem x e2 then e1 else empty
       | _, Single y -> if mem y e1 then e2 else empty
       | Other e1, Other e2 ->
 	  let e_mask = inter_word (get_mask e1) (get_mask e2) in
-	  let n = cardinal_word e_mask in
-	  let e = make e_mask (n+1) in
-	  for x1 = 31 - 1 downto 0 do
-	    if test (get_mask e) x1
-	    then
-	      let e_x1 = X.inter (get_subset x1 e1) (get_subset x1 e2) in
-	      if X.is_empty e_x1
-	      then set_mask e (reset (get_mask e) x1)
-	      else set_field e (get_i x1 e) e_x1
-	  done;
-	  sub e 0 (1 + cardinal_word (get_mask e)) (* for removing extra words *)
+	  if e_mask = 0
+	  then empty
+	  else begin
+	    let n = cardinal_word e_mask in
+	    let e = make e_mask (n+1) in
+	    for x1 = 31 - 1 downto 0 do
+	      if test (get_mask e) x1
+	      then
+		let e_x1 = X.inter (get_subset x1 e1) (get_subset x1 e2) in
+		if X.is_empty e_x1
+		then set_mask e (reset (get_mask e) x1)
+		else set_field e (get_i x1 e) e_x1
+	    done;
+	    simpl e
+	  end
 
     let diff e1 e2 =
 (*      let diff_word i1 i2 = i1 land (lnot i2) in *)
       match kind e1, kind e2 with
-      | Empty, _ -> e1
+      | Empty, _ -> empty
       | _, Empty -> e1
+      | Full, _ -> compl e2
+      | _, Full -> empty
       | Single x, _ -> if mem x e2 then empty else e1
       | _, Single y -> remove y e1
       | Other e1, Other e2 ->
 	      then set_mask e (reset (get_mask e) x1)
 	      else set_field e (get_i x1 e) e_x1
 	  done;
-	  sub e 0 (1 + cardinal_word (get_mask e)) (* for removing extra words *)
+	  simpl e
 
     let union_r l = List.fold_left (fun res set -> union res set) empty l
 
       | [] -> raise (Invalid_argument "Intset.Bitmap961.inter_r : empty list of sets")
       | set::sets -> List.fold_right (fun set res -> inter set res) sets set
 
+    let iter f e =
+      match kind e with
+      | Empty -> ()
+      | Full ->
+	  for x = 0 to bound - 1 do
+	    f x
+	  done
+      | Single x -> f x
+      | Other e ->
+	  let e_mask = get_mask e in
+	  for x1 = 0 to 31 - 1 do
+	    if test e_mask x1 then begin
+	      let i = get_subset x1 e in
+	      let x0 = X.bound * x1 in
+	      X.iter (fun x2 -> f (x0 + x2)) i
+	    end
+	  done
+
+    let map f e = fold (fun res x -> f x::res) [] e
+
+    let filter p e1 =
+      match kind e1 with
+      | Empty -> e1
+      | Full ->
+	  let e_mask = (-1) in
+	  let n = 31 in
+	  let e = make e_mask (n+1) in
+	  for x1 = 31 - 1 downto 0 do
+	    let x0 = X.bound * x1 in
+	    let e_x1 = X.filter (fun x2 -> p (x0 + x2)) X.full in
+	    if X.is_empty e_x1
+	    then set_mask e (reset (get_mask e) x1)
+	    else set_field e (get_i x1 e) e_x1
+	  done;
+	  simpl e
+      | Single x -> if p x then e1 else empty
+      | Other e1 ->
+	  let e_mask = get_mask e1 in
+	  let n = cardinal_word e_mask in
+	  let e = make e_mask (n+1) in
+	  for x1 = 31 - 1 downto 0 do
+	    if test (get_mask e) x1
+	    then
+	      let x0 = X.bound * x1 in
+	      let e_x1 = X.filter (fun x2 -> p (x0 + x2)) (get_subset x1 e1) in
+	      if X.is_empty e_x1
+	      then set_mask e (reset (get_mask e) x1)
+	      else set_field e (get_i x1 e) e_x1
+	  done;
+	  simpl e
+
+    let memory_size e =
+      match kind e with
+      | Empty -> 1
+      | Full -> 1
+      | Single _ -> 1
+      | Other e ->
+	  let n = length e in
+	  let res = ref (1 + n) in
+	  for i = 1 to n-1 do
+	    res := !res + X.memory_size (get_field e i)
+	  done;
+	  !res
+  end
+
+(* for test *)
+(*
+module M = Bitmap (Bitmap (Bitmap31))
+
+let make l = List.fold_right M.add l M.empty
+*)
+
+(*
+module Bitmaprec (X : T_BOUNDED) : T_BOUNDED =
+  struct
+    let bound = 31 * X.bound
+
+    type t = Obj.t
+       (* empty set : -1 *)
+       (* full set : -2 *)
+       (* singleton : non-negative integer representing unique element *)
+       (* other sets : blocks *)
+	  (* tag indicates level *)
+	  (* field 0 is bitmap of non-empty subsets *)
+	  (* each 1-bit of field 0 refers to a subset *)
+	  (* the number of 1-bits in 'e.(0) lsr (x/X.bound)' gives the field containing the bit x *)
+
+    type kind = Empty | Full | Single of int | Other of Obj.t (* block *)
+
+    let kind e =
+      if Obj.is_int e
+      then
+	let i = (Obj.obj e : int) in
+	if i = -1 then Empty
+	else if i = -2 then Full
+	else Single i
+      else
+	Other e
+
+    (* 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_word i =
+      card_byte.(i land 0xFF)
+	+ card_byte.((i lsr 8) land 0xFF)
+	+ card_byte.((i lsr 16) land 0xFF)
+	+ card_byte.((i lsr 24) land 0xFF)
+
+    (* low level access to representations as arrays *)
+	
+    let make m n = (* m is the initial mask, and n the number of fields, comprising the mask *)
+      assert (n > 0);
+      let e = Obj.new_block 0 n in
+      Obj.set_field e 0 (Obj.repr m);
+      e
+
+    let copy e = Obj.dup e
+
+    let sub e pos len =
+      let e' = Obj.new_block 0 len in
+      for i = 0 to len - 1 do
+	Obj.set_field e' i (Obj.field e (pos + i))
+      done;
+      e'
+
+    let length e = Obj.size e
+
+    let get_mask e = (Obj.obj (Obj.field e 0) : int)
+
+    let set_mask e m = Obj.set_field e 0 (Obj.repr m)
+
+    let get_field e i = (Obj.obj (Obj.field e i) : X.t)
+
+    let set_field e i s = Obj.set_field e i (Obj.repr s)
+
+
+    let get_i x1 e =
+      let b = (get_mask e) lsr x1 in
+      assert (b land 1 <> 0);
+      cardinal_word b
+
+    let get_subset x1 e =
+      let b = (get_mask e) lsr x1 in
+      if b land 1 = 0
+      then X.empty
+      else get_field e (cardinal_word b)
+
+    let get_index x e = (* returns coordinates of bit x in e *)
+      let x1, x2 = x / X.bound, x mod X.bound in
+      let b = (get_mask e) lsr x1 in
+      if b land 1 = 0
+      then (cardinal_word b + 1, x1, x2, false)
+      else (cardinal_word b, x1, x2, true)
+      
+    (* bitwise operations *)
+
+    let test i x2 =
+      (i lsr x2) land 1 <> 0
+
+    let set i x2 =
+      i lor (1 lsl x2)
+
+    let reset i x2 =
+      i land ((-1) - (1 lsl x2))
+
+    (* intset interface *)
+
     let fold f init e =
       match kind e with
       | Empty -> init
+      | Full ->
+	  let res = ref init in
+	  for x = 0 to bound - 1 do
+	    res := f !res x
+	  done;
+	  !res
       | Single x -> f init x
       | Other e ->
 	  let e_mask = get_mask e in
 	    end
 	  done;
 	  !res
-	
+
+    let elements e =
+      List.rev (fold (fun res x -> x::res) [] e)
+
+    let empty = Obj.repr (-1)
+
+    let is_empty e =
+      match kind e with
+      | Empty -> true
+      | Full -> false
+      | Single _ -> false
+      | Other e -> get_mask e = 0
+
+    let full = Obj.repr (-2)
+(*
+      let n = 31 in
+      let e = make (-1) (n + 1) in
+      for i = 1 to n-1 do
+	set_field e i X.full
+      done;
+      e
+*)
+
+    let is_full e =
+      match kind e with
+      | Empty -> false
+      | Full -> true
+      | Single _ -> false
+      | Other e ->
+	  let n = length e in
+	  let res = ref (get_mask e = (-1)) in
+	  let i = ref 1 in
+	  while !res && !i < n do
+	    res := !res && X.is_full (get_field e !i);
+	    incr i
+	  done;
+	  !res
+
+    let cardinal e =
+      match kind e with
+      | Empty -> 0
+      | Full -> bound
+      | Single _ -> 1
+      | Other e ->
+	  let n = length e in
+	  let res = ref 0 in
+	  for i = 1 to n-1 do
+	    res := !res + X.cardinal (get_field e i)
+	  done;
+	  !res
+
+    let mem x e =
+      match kind e with
+      | Empty -> false
+      | Full -> x < bound
+      | Single y -> x = y
+      | Other e ->
+	  let i, _, x2, present = get_index x e in
+	  present && X.mem x2 (get_field e i)
+
+    let singleton x =
+      assert (x < bound);
+      Obj.repr x
+
+    let simpl e =
+      let e_mask = get_mask e in
+      if e_mask = 0
+      then empty
+      else
+	let n = cardinal_word e_mask in
+	if n = 1 && X.cardinal (get_field e 1) = 1
+	then singleton (List.hd (elements e))
+	else sub e 0 (1 + n) (* for removing extra words *)
+
+    let add x e =
+      assert (x < bound);
+      match kind e with
+      | Empty -> singleton x
+      | Full -> e
+      | Single y ->
+	  let x1, x2 = x / X.bound, x mod X.bound in
+	  let y1, y2 = y / X.bound, y mod X.bound in
+	  if x1 = y1
+	  then begin
+	    let e = make (1 lsl x1) 2 in
+	    set_field e 1 (X.add x2 (X.singleton y2));
+	    e end
+	  else begin
+	    let e = make ((1 lsl x1) lor (1 lsl y1)) 3 in
+	    let ix, iy = if x1 < y1 then 2, 1 else 1, 2 in
+	    set_field e ix (X.singleton x2);
+	    set_field e iy (X.singleton y2);
+	    e
+	  end
+      | Other e ->
+	  let i, x1, x2, present = get_index x e in
+	  if present
+	  then
+	    if X.mem x2 (get_field e i)
+	    then e
+	    else begin
+	      let e' = copy e in (* unsafe not to make a copy *)
+	      let e'_x1 = X.add x2 (get_field e' i) in
+	      set_field e' i e'_x1;
+	      if X.is_full e'_x1 && is_full e'
+	      then full
+	      else e'
+	    end
+	  else begin
+	    let n = length e in
+	    let e' = make (set (get_mask e) x1) (n+1) in
+	    for k = 1 to i-1 do
+	      Obj.set_field e' k (Obj.field e k)
+	      (* set_field e' k (get_field e k) *)
+	    done;
+	    for k = n downto i+1 do
+	      Obj.set_field e' k (Obj.field e (k-1))
+	      (* set_field e' k (get_field e (k-1)) *)
+	    done;
+	    set_field e' i (X.singleton x2);
+	    e' end
+
+    let remove x e =
+      match kind e with
+      | Empty -> e
+      | Full ->
+	  if x < bound
+	  then begin
+	    let x1, x2 = x / X.bound, x mod X.bound in
+	    let i = x1 + 1 in
+	    let n = 31 in
+	    let e' = make (-1) (n+1) in
+	    for k = 1 to i-1 do
+	      set_field e' k X.full
+	    done;
+	    set_field e' i (X.remove x2 X.full);
+	    for k = i+1 to n-1 do
+	      set_field e' k X.full
+	    done;
+	    e' end
+	  else e
+      | Single y ->
+	  if x = y
+	  then empty
+	  else e
+      | Other e ->
+	  let i, x1, x2, present = get_index x e in
+	  if present
+	  then
+	    if X.mem x2 (get_field e i)
+	    then
+	      let e'_i = X.remove x2 (get_field e i) in
+	      if X.is_empty e'_i
+	      then begin
+		let n' = length e - 1 in
+		let e' = make (reset (get_mask e) x1) n' in
+		for k = 1 to i-1 do
+		  Obj.set_field e' k (Obj.field e k)
+		  (* set_field e' k (get_field e k) *)
+		done;
+		for k = i to n'-1 do
+		  Obj.set_field e' k (Obj.field e (k+1))
+		  (* set_field e' k (get_field e (k+1)) *)
+		done;
+		if n' = 1
+		then empty
+		else
+		  if n' = 2 && X.cardinal (get_field e' 1) = 1
+		  then singleton (List.hd (elements e'))
+		  else e' end
+	      else begin
+		let e' = copy e in
+		set_field e' i e'_i;
+		e'
+	      end
+	    else e
+	  else e
+
+
+    let subset e1 e2 =
+      let subset_word i1 i2 = i1 land (lnot i2) = 0 in
+      match kind e1, kind e2 with
+      | Empty, _ -> true
+      | _, Full -> true
+      | _, Empty -> is_empty e1
+      | Full, _ -> is_full e2
+      | Single x1, _ -> mem x1 e2
+      | Other e1, Single y ->
+	  let y1, y2 = y / X.bound, y mod X.bound in
+	  if subset_word (get_mask e1) (1 lsl y1)
+	  then X.subset (get_subset y1 e1) (X.singleton y2)
+	  else false
+      | Other e1, Other e2 ->
+	  if not (subset_word (get_mask e1) (get_mask e2))
+	  then false
+	  else begin
+	    let res = ref true in
+	    let x1 = ref 0 in
+	    while !res && !x1 < 31 do
+	      res := not (test (get_mask e1) !x1) || X.subset (get_subset !x1 e1) (get_subset !x1 e2);
+	      incr x1
+	    done;
+	    !res
+	  end
+
+    let compl e1 =
+      match kind e1 with
+      | Empty -> full
+      | Full -> empty
+      | Single x -> remove x full
+      | Other e1 ->
+	  let e1_mask = get_mask e1 in
+	  if e1_mask = 0
+	  then full
+	  else begin
+	    let e = make (-1) (31+1) in
+	    for x1 = 31 - 1 downto 0 do
+	      if test e1_mask x1
+	      then
+		let e_x1 = X.compl (get_subset x1 e1) in
+		if X.is_empty e_x1
+		then set_mask e (reset (get_mask e) x1)
+		else set_field e (get_i x1 e) e_x1
+	      else set_field e (get_i x1 e) X.full
+	    done;
+	    simpl e
+	  end
+
+    let union e1 e2 =
+      let union_word i1 i2 = i1 lor i2 in
+      match kind e1, kind e2 with
+      | Empty, _ -> e2
+      | _, Empty -> e1
+      | Full, _
+      | _, Full -> full
+      | Single x, _ -> add x e2
+      | _, Single y -> add y e1
+      | Other e1, Other e2 ->
+	  let e_mask = union_word (get_mask e1) (get_mask e2) in
+	  let n = cardinal_word e_mask in
+	  let e = make e_mask (n+1) in
+	  for x1 = 0 to 31 - 1 do
+	    if test (get_mask e) x1
+	    then set_field e (get_i x1 e) (X.union (get_subset x1 e1) (get_subset x1 e2))
+	  done;
+	  e
+
+    let inter e1 e2 =
+      let inter_word i1 i2 = i1 land i2 in
+      match kind e1, kind e2 with
+      | Empty, _
+      | _, Empty -> empty
+      | Full, _ -> e2
+      | _, Full -> e1
+      | Single x, _ -> if mem x e2 then e1 else empty
+      | _, Single y -> if mem y e1 then e2 else empty
+      | Other e1, Other e2 ->
+	  let e_mask = inter_word (get_mask e1) (get_mask e2) in
+	  if e_mask = 0
+	  then empty
+	  else begin
+	    let n = cardinal_word e_mask in
+	    let e = make e_mask (n+1) in
+	    for x1 = 31 - 1 downto 0 do
+	      if test (get_mask e) x1
+	      then
+		let e_x1 = X.inter (get_subset x1 e1) (get_subset x1 e2) in
+		if X.is_empty e_x1
+		then set_mask e (reset (get_mask e) x1)
+		else set_field e (get_i x1 e) e_x1
+	    done;
+	    simpl e
+	  end
+
+    let diff e1 e2 =
+(*      let diff_word i1 i2 = i1 land (lnot i2) in *)
+      match kind e1, kind e2 with
+      | Empty, _ -> empty
+      | _, Empty -> e1
+      | Full, _ -> compl e2
+      | _, Full -> empty
+      | Single x, _ -> if mem x e2 then empty else e1
+      | _, Single y -> remove y e1
+      | Other e1, Other e2 ->
+	  let e_mask = get_mask e1 in
+	  let n = cardinal_word e_mask in
+	  let e = make e_mask (n+1) in
+	  for x1 = 31 - 1 downto 0 do
+	    if test (get_mask e) x1
+	    then
+	      let e_x1 = X.diff (get_subset x1 e1) (get_subset x1 e2) in
+	      if X.is_empty e_x1
+	      then set_mask e (reset (get_mask e) x1)
+	      else set_field e (get_i x1 e) e_x1
+	  done;
+	  simpl e
+
+    let union_r l = List.fold_left (fun res set -> union res set) empty l
+
+    let inter_r = function
+      | [] -> raise (Invalid_argument "Intset.Bitmap961.inter_r : empty list of sets")
+      | set::sets -> List.fold_right (fun set res -> inter set res) sets set
+
     let iter f e =
       match kind e with
       | Empty -> ()
+      | Full ->
+	  for x = 0 to bound - 1 do
+	    f x
+	  done
       | Single x -> f x
       | Other e ->
 	  let e_mask = get_mask e in
     let filter p e1 =
       match kind e1 with
       | Empty -> e1
+      | Full ->
+	  let e_mask = (-1) in
+	  let n = 31 in
+	  let e = make e_mask (n+1) in
+	  for x1 = 31 - 1 downto 0 do
+	    let x0 = X.bound * x1 in
+	    let e_x1 = X.filter (fun x2 -> p (x0 + x2)) X.full in
+	    if X.is_empty e_x1
+	    then set_mask e (reset (get_mask e) x1)
+	    else set_field e (get_i x1 e) e_x1
+	  done;
+	  simpl e
       | Single x -> if p x then e1 else empty
       | Other e1 ->
 	  let e_mask = get_mask e1 in
 	      then set_mask e (reset (get_mask e) x1)
 	      else set_field e (get_i x1 e) e_x1
 	  done;
-	  sub e 0 (1 + cardinal_word (get_mask e)) (* for removing extra words *)
-
-    let elements e =
-      List.rev (fold (fun res x -> x::res) [] e)
+	  simpl e
 
     let memory_size e =
       match kind e with
       | Empty -> 1
+      | Full -> 1
       | Single _ -> 1
       | Other e ->
 	  let n = length e in
 	  done;
 	  !res
   end
-
+*)