Source file bitsvect.ml

# 1 "Camomile/internal/bitsvect.ml"
(** bits vector *)
(* Copyright (C) 2002 Yamagata Yoriyuki. *)

(* This library is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2 of *)
(* the License, or (at your option) any later version. *)

(* As a special exception to the GNU Library General Public License, you *)
(* may link, statically or dynamically, a "work that uses this library" *)
(* with a publicly distributed version of this library to produce an *)
(* executable file containing portions of this library, and distribute *)
(* that executable file under terms of your choice, without any of the *)
(* additional requirements listed in clause 6 of the GNU Library General *)
(* Public License. By "a publicly distributed version of this library", *)
(* we mean either the unmodified Library as distributed by the authors, *)
(* or a modified version of this library that is distributed under the *)
(* conditions defined in clause 3 of the GNU Library General Public *)
(* License. This exception does not however invalidate any other reasons *)
(* why the executable file might be covered by the GNU Library General *)
(* Public License . *)

(* This library is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU *)
(* Lesser General Public License for more details. *)

(* You should have received a copy of the GNU Lesser General Public *)
(* License along with this library; if not, write to the Free Software *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
(* USA *)

(* You can contact the authour by sending email to *)
(* yoriyuki.y@gmail.com *)


let rec bits n = if n = 0 then 0 else 1 + bits (n lsr 1)

type t = 
  {len : int; 
   mutable bits : int; 
   mutable contents : Bytes.t;
   mutable id : int}

(* get v i : read the i-th element of v *)
(* b < 8 *)
let get vect i =
  let b = vect.bits in
  let v = vect.contents in
  let k = b * i in
  let m0 = ((Char.code (Bytes.get v (k lsr 3))) lsr (k land 0b111)) in
  let m =
    ((Char.code (Bytes.get v ((k lsr 3) + 1))) lsl (8 - (k land 0b111))) lor m0
  in m land ((1 lsl b) - 1)

let unsafe_get vect i =
  let b = vect.bits in
  let v = vect.contents in
  let k = b * i in
  let j = k lsr 3 in
  let v1 = Char.code (Bytes.unsafe_get v j) in
  let v2 = Char.code (Bytes.unsafe_get v (j + 1)) in
  let j' = k land 0b111 in
  (v2 lsl (8 - j')) lor (v1 lsr j') land ((1 lsl b) - 1)

let set_raw vect i n =
  let b = vect.bits in
  let v = vect.contents in
  let i0 = (i * b) lsr 3 in
  let i1 = (i * b) land 7 in
  let masq1 = (1 lsl b - 1) in
  let c0 = (Char.code (Bytes.get v i0)) land (lnot (masq1 lsl i1)) in
  let c0' = c0 lor ((n lsl i1) land 255) in
  Bytes.set v i0 (Char.chr c0');
  if b + i1 <= 8 then () else
    let masq2 = (1 lsl (b + i1 - 8)) - 1 in
    let c1 = (Char.code (Bytes.get v (i0 + 1))) land (lnot masq2) in
    let c1' = c1 lor (n lsr (8 - i1)) in
    Bytes.set v (i0 + 1) (Char.chr c1')

let bits_to_bytes b = b / 8 + 2

let set vect i n =
  let b = bits n in
  if vect.bits < b then
    let save = 
      {len = vect.len; 
       bits = vect.bits; 
       contents = vect.contents;
       id = 0} 
    in
    let len = vect.len in
    vect.contents <- Bytes.make (bits_to_bytes (b * len)) (Char.chr 0);
    vect.bits <- b;
    for i = 0 to len - 1 do set_raw vect i (get save i) done;
  else ();
  set_raw vect i n

let make i0 df = 
  let b = max (bits df) 1 in
  let v = 
    {len = i0;
     bits = b; 
     contents = Bytes.make (bits_to_bytes (b * i0)) (Char.chr 0);
     id = 0} 
  in
  for i = 0 to i0 - 1 do set v i df done; v

let copy v =
  {len = v.len;
   bits = v.bits;
   contents = Bytes.copy v.contents;
   id = 0}

let iteri proc v =
  for i = 0 to v.len - 1 do
    proc i (get v i)
  done

let length v = v.len

let set_id v id = v.id <- id
let id v = v.id