Commits

Anonymous committed ea009bd

+ BitArray

Comments (0)

Files changed (6)

 Library cadastr
   Path:       src
   BuildDepends: num
-  Modules:    Cadastr, Monoid, Cd_All, Cd_Int, Cd_List, Cd_Ops, Cd_Byte, Cd_Bytes, Cd_Chars, Cd_Strings, Cd_Array, Cd_Typeinfo, Cdt, Cd_Types, Cd_Option, Cd_Num, Cd_Tuples, Cd_Bool, Cd_Ref, Cd_Partapp, Cd_Int64, Cd_Ser, Cd_SortedArray, Cd_SortedArraySet, Cd_Utf8, Cd_Buffer, Cd_StringsCommon, Cd_Exn, Cd_Queue, Cd_Stream, Cd_Sys, Cd_Memo
+  Modules:    Cadastr, Monoid, Cd_All, Cd_Int, Cd_List, Cd_Ops, Cd_Byte, Cd_Bytes, Cd_Chars, Cd_Strings, Cd_Array, Cd_Typeinfo, Cdt, Cd_Types, Cd_Option, Cd_Num, Cd_Tuples, Cd_Bool, Cd_Ref, Cd_Partapp, Cd_Int64, Cd_Ser, Cd_SortedArray, Cd_SortedArraySet, Cd_Utf8, Cd_Buffer, Cd_StringsCommon, Cd_Exn, Cd_Queue, Cd_Stream, Cd_Sys, Cd_Memo, Cd_BitArray
   NativeOpt:       -w A
   ByteOpt:         -w A
 
 (* setup.ml generated for the first time by OASIS v0.2.1~alpha1 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 7fb71cf5fd77f92a242c07a7c4db2d97) *)
+(* DO NOT EDIT (digest: 50bc00f8df6a8cd29f8c3228b1a0cf2f) *)
 (*
    Regenerated by OASIS v0.4.1
    Visit http://oasis.forge.ocamlcore.org for more information and
                            "Cd_Queue";
                            "Cd_Stream";
                            "Cd_Sys";
-                           "Cd_Memo"
+                           "Cd_Memo";
+                           "Cd_BitArray"
                         ];
                       lib_pack = false;
                       lib_internal_modules = [];
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.1";
-     oasis_digest = Some "\228f\148\182\235\158;\140sc\143\004\219\208 +";
+     oasis_digest = Some "\205\132p\196\157s\223A\153\253\233\238k.u\218";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 6999 "setup.ml"
+# 7000 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

src/cadastr.mllib

 # OASIS_START
-# DO NOT EDIT (digest: 10e4044b5117f18366b06f58dacd80b1)
+# DO NOT EDIT (digest: 1b9c93c16baf0dc9537dc7028921e5da)
 Cadastr
 Monoid
 Cd_All
 Cd_Stream
 Cd_Sys
 Cd_Memo
+Cd_BitArray
 # OASIS_STOP
 module SortedArraySet = Cd_SortedArraySet.SortedArraySet;
 module Exn = Cd_Exn.Exn;
 module Memo = Cd_Memo.Memo;
+module BitArray = Cd_BitArray.BitArray;
 include Cd_Tuples;
 
 include Cd_Ops;

src/cd_BitArray.ml

+module BitArray
+ :
+  sig
+
+    type t;
+
+    value make : int -> bool -> t;
+    value length : t -> int;
+    value get : t -> int -> bool;
+    value set : t -> int -> bool -> unit;
+
+    (* todo: unsafe get/set *)
+
+  end
+ =
+  struct
+
+    (* layout: ['bits0..7' .. 'bitsN..N+(1..7)' len_sub]
+       where length of bitarray = 8 * (String.length string) - len_sub.
+     *)
+
+    type t = string
+    ;
+
+    value make len init =
+      if len < 0
+      then invalid_arg "BitArray.make: len < 0"
+      else
+        let strlen = 1 + ((-((-len) land (-8))) lsr 3)
+          (* the real wtf.
+             round up bits to 8*n, get n, add 1 byte for len_sub.
+           *)
+        in
+        let len_sub = (strlen lsl 3) - len in
+        let r = String.make strlen (if init then '\xFF' else '\x00') in
+        ( assert (len_sub >= 8 && len_sub <= 15)
+        ; r.[strlen - 1] := Char.chr len_sub
+        ; r
+        )
+    ;
+
+    value length str =
+      let strlen = String.length str in
+      let len_sub = Char.code str.[strlen - 1] in
+      (strlen lsl 3) - len_sub
+    ;
+
+    value unsafe_get str i =
+     (     (Char.code str.[ i lsr 3 ])
+         land
+           (1 lsl (i land 7))
+       <>
+         0
+     )
+    ;
+
+    value get str i =
+      if i < 0 || i >= length str
+      then invalid_arg "BitArray.get"
+      else unsafe_get str i
+    ;
+
+    value unsafe_set str i b =
+      str.[ i lsr 3 ] :=
+        Char.chr
+          (let c = Char.code str.[ i lsr 3 ] in
+           if b
+           then c lor        (1 lsl (i land 7))
+           else c land (lnot (1 lsl (i land 7)))
+          )
+    ;
+
+    value set str i b =
+      if i < 0 || i >= length str
+      then invalid_arg "BitArray.set"
+      else unsafe_set str i b
+    ;
+
+  end
+;
+
 end;
 *)
 
+
+value test_bitarray () =
+  let () = Random.self_init () in
+  let cmp a b =
+    let len = Array.length a in
+    ( assert_equal len (BitArray.length b)
+    ; loop 0
+    )
+    where rec loop i =
+      if i = len
+      then ()
+      else
+        ( assert_equal a.(i) (BitArray.get b i)
+        ; loop (i + 1)
+        )
+  and proper_oob b i =
+    let got_exn =
+      try
+        ( ignore (BitArray.get b i)
+        ; False
+        )
+      with
+      [ Invalid_argument _ -> True ]
+    in
+      assert_equal True got_exn
+  in
+  let midcheck len a b =
+    let () = cmp a b in
+    let () =
+      (* oob check *)
+      for i = 0 to 20 do
+        ( proper_oob b (len + i)
+        ; proper_oob b ( -1 - i)
+        )
+      done
+    in
+      ()
+  in
+  List.iter
+    (fun init ->
+       for len = 0 to 25 do
+         (let a = Array.make len init
+          and b = BitArray.make len init in
+          let () = midcheck len a b in
+          if len = 0
+          then
+            ()
+          else
+            for j = 0 to len * len do
+              (let k = Random.int len
+               and v = Random.bool () in
+               ( a.(k) := v
+               ; BitArray.set b k v
+               ; assert_equal v (BitArray.get b k)
+               ; midcheck len a b
+               )
+              )
+            done
+         )
+       done
+    )
+    [True; False]
+;
+
+value bitarray =
+  [ "bitarray" >:: test_bitarray
+  ]
+;
+
+
 (****************************************************************)
 
 value suite =
     @ typedefs
 
     @ utf8
+
+    @ bitarray
     )
 ;