src/bitvector.ml

   1 type t = { length : int;
   2            bits : string; }
   3
   4 let create ?(init=false) size =
   5   let i = if init then '\xff' else '\x00' in
   6   { length = size;
   7     bits = String.make (1 + size / 8) i
   8   }
   9
  10 let alloc size =
  11   { length = size;
  12     bits = String.create (1 + size / 8);
  13   }
  14
  15 let length v = v.length
  16
  17 let unsafe_get v n =
  18   let i = n / 8
  19   and j = n mod 8 in
  20   (((Char.code (String.unsafe_get v.bits i)) lsr j) land 1) == 1
  21
  22 let union v1 v2 =
  23   assert ( v1.length == v2.length );
  24   let res = alloc v1.length in
  25  (* Format.printf "size %d@." (String.length res.bits);*)
  26   for i = 0 to String.length v1.bits - 1 do
  27       res.bits.[i] <- Char.chr ((Char.code v1.bits.[i]) lor (Char.code v2.bits.[i]))
  28   done;
  29   res
  30
  31 let inter v1 v2 =
  32    assert ( v1.length == v2.length );
  33   let res = alloc v1.length in
  34   for i = 0 to String.length v1.bits - 1 do
  35     res.bits.[i] <- Char.chr ((Char.code v1.bits.[i]) land (Char.code v2.bits.[i]))
  36   done;
  37   res
  38
  39 let diff v1 v2 =
  40   assert ( v1.length == v2.length );
  41   let res = alloc v1.length in
  42   for i = 0 to String.length v1.bits - 1 do
  43     res.bits.[i] <- Char.chr ((Char.code v1.bits.[i]) land (lnot (Char.code v2.bits.[i])))
  44   done;
  45   res
  46
  47
  48
  49 let unsafe_set v n (b:bool) =
  50   let x : int = Obj.magic b in
  51   let i = n / 8
  52   and j = n mod 8 in
  53   let m = 1 lsl j in
  54   let w = Char.code (String.unsafe_get v.bits i) in
  55   let w = (w land lnot m) lor (~-x land m) in
  56   String.unsafe_set v.bits i (Char.unsafe_chr (w land 0xff))
  57 ;;
  58
  59 let get v n =
  60   if n < 0 || n >= v.length then failwith "Bitvector.get"
  61   else unsafe_get v n
  62 ;;
  63
  64 let set v n b =
  65   if n < 0 || n >= v.length then failwith "Bitvector.set"
  66   else unsafe_set v n b
  67 ;;