Added:
authorRichard W.M. Jones <rich@annexia.org>
Wed, 27 Aug 2008 11:26:45 +0000 (11:26 +0000)
committerRichard W.M. Jones <rich@annexia.org>
Wed, 27 Aug 2008 11:26:45 +0000 (11:26 +0000)
 - Bitstring.compare, Bitstring.equals
 - Bitstring.t as a synonym for Bitstring.bitstring type
 - get and set functions for mutating individual bits (rarely used)
 - Bitstring.concat

bitstring.ml
bitstring.mli

index 7ed7a58..156dec1 100644 (file)
@@ -38,6 +38,8 @@ exception Construct_failure of string * string * int * int
  *)
 type bitstring = string * int * int
 
+type t = bitstring
+
 (* Functions to create and load bitstrings. *)
 let empty_bitstring = "", 0, 0
 
@@ -1009,9 +1011,14 @@ let construct_bitstring buf (data, off, len) =
 
   Buffer.add_bits buf data len
 
+(* Concatenate bitstrings. *)
+let concat bs =
+  let buf = Buffer.create () in
+  List.iter (construct_bitstring buf) bs;
+  Buffer.contents buf
+
 (*----------------------------------------------------------------------*)
 (* Extract a string from a bitstring. *)
-
 let string_of_bitstring (data, off, len) =
   if off land 7 = 0 && len land 7 = 0 then
     (* Easy case: everything is byte-aligned. *)
@@ -1060,6 +1067,74 @@ let bitstring_to_file bits filename =
     raise exn
 
 (*----------------------------------------------------------------------*)
+(* Comparison. *)
+let compare ((data1, off1, len1) as bs1) ((data2, off2, len2) as bs2) =
+  (* In the fully-aligned case, this is reduced to string comparison ... *)
+  if off1 land 7 = 0 && len1 land 7 = 0 && off2 land 7 = 0 && len2 land 7 = 0
+  then (
+    (* ... but we have to do that by hand because the bits may
+     * not extend to the full length of the underlying string.
+     *)
+    let off1 = off1 lsr 3 and off2 = off2 lsr 3
+    and len1 = len1 lsr 3 and len2 = len2 lsr 3 in
+    let rec loop i =
+      if i < len1 && i < len2 then (
+       let c1 = String.unsafe_get data1 (off1 + i)
+       and c2 = String.unsafe_get data2 (off2 + i) in
+       let r = compare c1 c2 in
+       if r <> 0 then r
+       else loop (i+1)
+      )
+      else len1 - len2
+    in
+    loop 0
+  )
+  else (
+    (* Slow/unaligned. *)
+    let str1 = string_of_bitstring bs1
+    and str2 = string_of_bitstring bs2 in
+    let r = String.compare str1 str2 in
+    if r <> 0 then r else len1 - len2
+  )
+
+let equals ((_, _, len1) as bs1) ((_, _, len2) as bs2) =
+  if len1 <> len2 then false
+  else if bs1 = bs2 then true
+  else 0 = compare bs1 bs2
+
+(*----------------------------------------------------------------------*)
+(* Bit get/set functions. *)
+
+let index_out_of_bounds () = invalid_arg "index out of bounds"
+
+let put (data, off, len) n v =
+  if n < 0 || off+n >= len then index_out_of_bounds ()
+  else (
+    let i = off+n in
+    let si = i lsr 3 and mask = 0x80 lsr (i land 7) in
+    let c = Char.code data.[si] in
+    let c = if v <> 0 then c lor mask else c land (lnot mask) in
+    data.[si] <- Char.unsafe_chr c
+  )
+
+let set bits n = put bits n 1
+
+let clear bits n = put bits n 0
+
+let get (data, off, len) n =
+  if n < 0 || off+n >= len then index_out_of_bounds ()
+  else (
+    let i = off+n in
+    let si = i lsr 3 and mask = 0x80 lsr (i land 7) in
+    let c = Char.code data.[si] in
+    c land mask
+  )
+
+let is_set bits n = get bits n <> 0
+
+let is_clear bits n = get bits n = 0
+
+(*----------------------------------------------------------------------*)
 (* Display functions. *)
 
 let isprint c =
index 1e271f5..a29cb03 100644 (file)
@@ -667,6 +667,12 @@ type bitstring = string * int * int
     {!hexdump_bitstring}, {!bitstring_length}.
 *)
 
+type t = bitstring
+(** [t] is a synonym for the {!bitstring} type.
+
+    This allows you to use this module with functors like
+    [Set] and [Map] from the stdlib. *)
+
 (** {3 Exceptions} *)
 
 exception Construct_failure of string * string * int * int
@@ -683,6 +689,24 @@ exception Construct_failure of string * string * int * int
     location of the [BITSTRING] constructor that failed.
 *)
 
+(** {3 Bitstring comparison} *)
+
+val compare : bitstring -> bitstring -> int
+(** [compare bs1 bs2] compares two bitstrings and returns zero
+    if they are equal, a negative number if [bs1 < bs2], or a
+    positive number if [bs1 > bs2].
+
+    This tests "semantic equality" which is not affected by
+    the offset or alignment of the underlying representation
+    (see {!bitstring}).
+
+    The ordering is total and lexicographic. *)
+
+val equals : bitstring -> bitstring -> bool
+(** [equals] returns true if and only if the two bitstrings are
+    semantically equal.  It is the same as calling [compare] and
+    testing if the result is [0], but usually more efficient. *)
+
 (** {3 Bitstring manipulation} *)
 
 val bitstring_length : bitstring -> int
@@ -722,6 +746,10 @@ val takebits : int -> bitstring -> bitstring
     Note that this function just changes the offset and length
     fields of the {!bitstring} tuple, so is very efficient. *)
 
+val concat : bitstring list -> bitstring
+(** Concatenate a list of bitstrings together into a single
+    bitstring. *)
+
 (** {3 Constructing bitstrings} *)
 
 val empty_bitstring : bitstring
@@ -850,6 +878,36 @@ end
     may also be useful for end users.  They work much like the
     standard library [Buffer] module. *)
 
+(** {3 Get/set bits}
+
+    These functions let you manipulate individual bits in the
+    bitstring.  However they are not particularly efficient and you
+    should generally use the [bitmatch] and [BITSTRING] operators when
+    building and parsing bitstrings.
+
+    These functions all raise [Invalid_argument "index out of bounds"]
+    if the index is out of range of the bitstring.
+*)
+
+val set : bitstring -> int -> unit
+  (** [set bits n] sets the [n]th bit in the bitstring to 1. *)
+
+val clear : bitstring -> int -> unit
+  (** [clear bits n] sets the [n]th bit in the bitstring to 0. *)
+
+val is_set : bitstring -> int -> bool
+  (** [is_set bits n] is true if the [n]th bit is set to 1. *)
+
+val is_clear : bitstring -> int -> bool
+  (** [is_clear bits n] is true if the [n]th bit is set to 0. *)
+
+val put : bitstring -> int -> int -> unit
+  (** [put bits n v] sets the [n]th bit in the bitstring to 1
+      if [v] is not zero, or to 0 if [v] is zero. *)
+
+val get : bitstring -> int -> int
+  (** [get bits n] returns the [n]th bit (returns non-zero or 0). *)
+
 (** {3 Miscellaneous} *)
 
 val package : string