1 (* also taken from CDuce misc/custom.ml
2 this module should always be included not referenced with Open
7 let dump _ _ = failwith "dump not implemented"
8 let check _ = failwith "check not implemented"
9 let equal _ _ = failwith "equal not implemented"
10 let hash _ = failwith "hash not implemented"
11 let compare _ _ = failwith "compare not implemented"
12 let print _ _ = failwith "print not implemented"
15 (* Some of this borrowed from Jean-Christophe FilliĆ¢tre :
16 http://www.lri.fr/~filliatr/ftp/ocaml/ds/bitset.ml.html
19 module IntSet : Set.S with type elt = int=
21 let max = Sys.word_size - 2
27 let is_empty x = x == 0
28 let mem e s = ((1 lsl e) land s) != 0
29 let add e s = (1 lsl e) lor s
30 let singleton e = (1 lsl e)
33 let diff a b = a land (lnot b)
34 let remove e s = (lnot (1 lsl e) land s)
37 let subset a b = a land (lnot b) == 0
40 if s == 0 then n else loop (succ n) (s - (s land (-s)))
43 (* inverse of bit i = 1 lsl i i.e. tib i = log_2(i) *)
44 let log2 = Array.create 255 0
45 let () = for i = 0 to 7 do log2.(1 lsl i) <- i done
47 (* assumption: x is a power of 2 *)
49 if x land 0xFFFF == 0 then
51 if x land 0xFF == 0 then 24 + log2.(x lsr 8) else 16 + log2.(x)
53 if x land 0xFF == 0 then 8 + log2.(x lsr 8) else log2.(x)
55 let ffffffff = (0xffff lsl 16) lor 0xffff
57 if x land ffffffff == 0 then 32 + tib32 (x lsr 32) else tib32 x
60 match Sys.word_size with 32 -> tib32 | 64 -> tib64 | _ -> assert false
63 if s == 0 then raise Not_found;
70 if s == 0 then raise Not_found;
72 if s land i != 0 then tib i
73 else if i = 1 then raise Not_found else loop (i lsr 1)
78 if s == 0 then [] else let i = s land (-s) in tib i :: elements (s - i)
81 if s != 0 then let i = s land (-s) in f (tib i); iter f (s - i)
83 let rec fold f s acc =
84 if s == 0 then acc else let i = s land (-s) in fold f (s - i) (f (tib i) acc)
87 s == 0 || let i = s land (-s) in p (tib i) && for_all p (s - i)
90 s != 0 && let i = s land (-s) in p (tib i) || exists p (s - i)
96 let i = s land (-s) in
97 let s = filter p (s - i) in
98 if p (tib i) then s + i else s
100 let rec partition p s =
104 let i = s land (-s) in
105 let st,sf = partition p (s - i) in
106 if p (tib i) then st + i, sf else st, sf + i
110 s land (bi - 1), s land bi != 0, s land (-1 lsl (i+1))
116 module Make (X : Sigs.T) (Y : Sigs.T) :
117 Sigs.T with type t = X.t*Y.t =
126 let check (x,y) = X.check x; Y.check y
127 let equal (x,y) (z,t) =
128 X.equal x z && Y.equal y t
129 let hash (x,y) = (X.hash x) + 4093 * Y.hash y
130 let compare (x,y) (z,t) =
131 let r = X.compare x z in
136 let print _ _ = failwith "compare not implemented"