persistent bit vectors, wip

backtracking · backtracking · commit 4012d2436326 · 2025-11-30T15:19:34.000+01:00
diff --git a/.gitignore b/.gitignore
@@ -22,3 +22,4 @@ sieve.opt
 
 bench.exe
 perf.data
+bench_pbv.exe
diff --git a/bench_pbv.ml b/bench_pbv.ml
@@ -0,0 +1,27 @@
+
+(* sandbox to test performance *)
+
+open Format
+
+let time f x =
+  let open Unix in
+  let u = (times()).tms_utime in
+  let y = f x in
+  let ut = (times()).tms_utime -. u in
+  printf "%2.2f@." ut;
+  y
+
+open Bitv__Pbv
+
+let () = Random.init 42
+let n = int_of_string Sys.argv.(1)
+
+module M = Small(struct let size = Sys.int_size end)
+open M
+let v = init 63 (fun i -> i < n)
+let () = printf "v = %a@." print v
+let f v =
+  let s = ref 0 in
+  iter_subsets (fun v -> s := !s + pop v) v;
+  printf "sum = %d@." !s
+let () = time f v
diff --git a/dune b/dune
@@ -30,3 +30,9 @@
  (modules bench)
  (promote (until-clean))
  (libraries unix bitv))
+
+(executable
+ (name bench_pbv)
+ (modules bench_pbv)
+ (promote (until-clean))
+ (libraries unix bitv))
diff --git a/pbv.ml b/pbv.ml
@@ -62,6 +62,7 @@ module type S = sig
   val disjoint: t -> t -> bool
   val iteri_true: (elt -> unit) -> t -> unit
   val foldi_true: (elt -> 'a -> 'a) -> t -> 'a -> 'a
+  val iter_subsets: (t -> unit) -> t -> unit
   val for_all: (elt -> bool) -> t -> bool
   val exists: (elt -> bool) -> t -> bool
   val filter: (elt -> bool) -> t -> t
@@ -273,7 +274,9 @@ let compute_nlz size x =
   let rec loop i = if x land i != 0 then size - 1 - tib i else loop (i lsr 1) in
   loop (1 lsl (size - 1))
 
-module Native = struct
+module Small(X: sig val size: int end) = struct
+
+  let () = if X.size < 0 || X.size > Sys.int_size then invalid_arg "Small"
 
   type t = int (* including the sign bit *)
 
@@ -285,18 +288,18 @@ module Native = struct
   type elt = int
 
   let max_length =
-    Sys.int_size
+    X.size
 
   let length _v =
-    Sys.int_size
+    X.size
 
   let make _n b =
-    if b then -1 else 0
+    if b then 1 lsl X.size - 1 else 0
 
   let init _n f =
     let rec build v i = if i < 0 then v else
       let v = if f i then (v lsl 1) lor 1 else v lsl 1 in build v (i-1) in
-    build 0 (Sys.int_size - 1)
+    build 0 (X.size - 1)
 
   let unsafe_get v i =
     (v lsr i) land 1 <> 0
@@ -333,7 +336,7 @@ module Native = struct
   let bw_or  = (lor)
   let bw_and = (land)
   let bw_xor = (lxor)
-  let bw_not = (lnot)
+  let bw_not v = (lnot v) land (1 lsl X.size - 1)
 
   let ntz v = compute_ntz max_length v
   let nlz v = compute_nlz max_length v
@@ -401,6 +404,12 @@ module Native = struct
     if v == 0 then acc else
     let i = v land (-v) in foldi_true_ofs f ofs (v - i) (f (ofs + tib i) acc)
 
+  let iter_subsets f v =
+    let rec iter s v =
+      if v = 0 then f s else (
+      let b = v land (-v) in let v = v - b in iter (s + b) v; iter s v) in
+    iter 0 v
+
   let rec for_all p v =
     v == 0 || let i = v land (-v) in p (tib i) && for_all p (v - i)
 
@@ -465,48 +474,7 @@ module Native = struct
 
 end
 
-module Small(X: sig val size: int end) : S = struct
-  include Native
-
-  let max_length =
-    X.size
-
-  let length _v =
-    X.size
-
-  let make n b =
-    if n <> X.size then invalid_arg "make";
-    if b then 1 lsl X.size - 1 else 0
-
-  let init _n f =
-    let rec build v i = if i < 0 then v else
-      let v = if f i then (v lsl 1) lor 1 else v lsl 1 in build v (i-1) in
-    build 0 (X.size - 1)
-
-  let bw_not v = (lnot v) land (1 lsl X.size - 1)
-
-  let ntz v = compute_ntz max_length v
-  let nlz v = compute_nlz max_length v
-
-  include SetOps(struct
-    type t_ = t type t = t_
-    let make = make
-    let length = length
-    let is_empty = is_empty
-    let pop = pop
-    let ntz = ntz
-    let nlz = nlz
-    let get = get
-    let unsafe_get = unsafe_get
-    let set = set
-    let unsafe_set = unsafe_set
-    let bw_or = bw_or
-    let bw_and = bw_and
-    let bw_xor = bw_xor
-    let bw_not = bw_not
-    let elements = elements
-  end)
-end
+module Native = Small(struct let size = Sys.int_size end)
 
 module Large : S = struct
 
@@ -757,8 +725,13 @@ module Large : S = struct
     in
     fold 0 acc v
 
+  let iter_subsets _f _v =
+    assert false (*TODO*)
+
 end
 
+(* TODO: module FixedSize for large bit vectors with a fixed size *)
+
 let fixed_size n : (module S) =
   if n = Sys.int_size then
     (module Native)
diff --git a/pbv.mli b/pbv.mli
@@ -34,7 +34,7 @@ module type S = sig
   val set: t -> int -> bool -> t
   val iteri: (int -> bool -> unit) -> t -> unit
   val foldi: (int -> bool -> 'a -> 'a) -> t -> 'a -> 'a
-  (* TODO: fill, blit, sub, append *)
+  (* TODO: fill, blit, sub, append, random *)
 
   (** Bit vector interface *)
 
@@ -87,6 +87,7 @@ module type S = sig
   val disjoint: t -> t -> bool
   val iteri_true: (elt -> unit) -> t -> unit
   val foldi_true: (elt -> 'a -> 'a) -> t -> 'a -> 'a
+  val iter_subsets: (t -> unit) -> t -> unit
   val for_all: (elt -> bool) -> t -> bool
   val exists: (elt -> bool) -> t -> bool
   val filter: (elt -> bool) -> t -> t
@@ -110,17 +111,18 @@ module type S = sig
   val of_seq: elt Seq.t -> t
   val print_set: Format.formatter -> t -> unit
     (** prints a bit vector as a set, using notation [{x1,x2,...,xn}]. *)
-  (* TODO iter_subsets *)
 end
 
-module Native : S
-  (** Bit vectors of size [Sys.int_size], implemented using a machine integer.
-      Note: The size parameter of [empty] and [full] is ignored,
-      and operations [sub] and [append] are not supported. *)
-
 module Small(X: sig val size: int end) : S
-  (** Bit vectors of size at most [Sys.int_size], implemented using a
-      machine integer. *)
+  (** Bit vectors of fixed size not exceeding [Sys.int_size],
+      implemented using a machine integer.
+
+      Note: The size parameter of [empty] and [full] is ignored, and
+      operations [sub] and [append] are not supported. *)
+
+module Native : S
+  (** Bit vectors of size [Sys.int_size], implemented using a machine
+      integer. *)
 
 module Large : S
   (** Bit vectors of arbitrary size, up to [2**31 - 1]. *)

Original file line number	Diff line number	Diff line change
`@@ -22,3 +22,4 @@ sieve.opt`
`22`	`22`
`23`	`23`	`bench.exe`
`24`	`24`	`perf.data`
	`25`	`+bench_pbv.exe`