export more functions in CCBitField including any-width fields

src/data/CCBitField.ml

@@ -25,12 +25,35 @@ module type BITFIELD = sig
   (** Number of bits of the field *)
 
   val bool : unit -> bool field
-  (** New field of type bool *)
+  (** New field of type boo
+      @raise TooManyFields if there is no room *)
 
   val int2 : unit -> int field
-  (** New field of type 2-bits int *)
+  (** New field of type 2-bits int
+      @raise TooManyFields if there is no room *)
+
+  val int3 : unit -> int field
+  (** New field for 3-bits int
+      @raise TooManyFields if there is no room *)
+
+  val int : width:int -> int field
+  (** New field for [width] bits.
+      @raise TooManyFields if there is no room *)
 end
 
+let rec all_bits_ acc w =
+  if w=0 then acc
+  else
+    let acc = acc lor (1 lsl w-1) in
+    all_bits_ acc (w-1)
+
+(*$T
+  all_bits_ 0 1 = 1
+  all_bits_ 0 2 = 3
+  all_bits_ 0 3 = 7
+  all_bits_ 0 4 = 15
+  *)
+
 module Make(X : EMPTY) : BITFIELD = struct
   type t = int
 
@@ -78,4 +101,37 @@ module Make(X : EMPTY) : BITFIELD = struct
         x lor (v lsl n)
       )
     }
+
+  let int3 () =
+    let n = !width_ in
+    width_ := n+3;
+    if !width_ > max_width then raise TooManyFields;
+    let mask = 7 lsl n in
+    {
+      start=n;
+      width=3;
+      get=(fun x -> (x land mask) lsr n);
+      set=(fun v x ->
+        assert (x >= 0 && x < 8);
+        let x = x land (lnot mask) in
+        x lor (v lsl n)
+      )
+    }
+
+  let int ~width:w =
+    let n = !width_ in
+    width_ := n+w;
+    if !width_ > max_width then raise TooManyFields;
+    let mask_unshifted = all_bits_ 0 w in
+    let mask = mask_unshifted lsl n in
+    {
+      start=n;
+      width=w;
+      get=(fun x -> (x land mask) lsr n);
+      set=(fun v x ->
+        assert (x >= 0 && x <= mask_unshifted);
+        let x = x land (lnot mask) in
+        x lor (v lsl n)
+      )
+    }
 end

src/data/CCBitField.mli

@@ -9,6 +9,9 @@
   {b status: experimental}
   @since NEXT_RELEASE *)
 
+exception TooManyFields
+(** Raised when too many fields are packed into one bitfield *)
+
 module type EMPTY = sig end
 
 (** {2 Bitfield Signature} *)
@@ -29,10 +32,20 @@ module type BITFIELD = sig
   (** Number of bits of the field *)
 
   val bool : unit -> bool field
-  (** New field of type bool *)
+  (** New field of type boo
+      @raise TooManyFields if there is no room *)
 
   val int2 : unit -> int field
-  (** New field of type 2-bits int *)
+  (** New field of type 2-bits int
+      @raise TooManyFields if there is no room *)
+
+  val int3 : unit -> int field
+  (** New field for 3-bits int
+      @raise TooManyFields if there is no room *)
+
+  val int : width:int -> int field
+  (** New field for [width] bits.
+      @raise TooManyFields if there is no room *)
 end
 
 (** Create a new bitfield type *)
@@ -44,8 +57,10 @@ module Make(X : EMPTY) : BITFIELD
   let x = B.bool () in
   let y = B.int2 () in
   let z = B.bool () in
+  let u = B.int 4 in
 
   assert_equal 2 (B.width y) ;
+  assert_equal 4 (B.width u) ;
 
   let f = B.empty
   |> B.set y 3
@@ -56,8 +71,22 @@ module Make(X : EMPTY) : BITFIELD
 
   assert_equal false (B.get x f) ;
   assert_equal 3 (B.get y f) ;
-  assert_equal (B.get z f);
+  assert_equal true (B.get z f);
+
+  let f' = B.set u 13 f in
+
+  assert_equal false (B.get x f') ;
+  assert_equal 3 (B.get y f') ;
+  assert_equal true (B.get z f');
+  assert_equal 13 (B.get u f');
 
   ()
 *)
 
+
+(**/**)
+
+val all_bits_ : int -> int -> int
+(** Undocumented, do not use. Exposed for testing purpose *)
+
+(**/**)