bundles/menhirLib/menhir-20120123/src/packedIntArray.ml

   1 (**************************************************************************)
   2 (*                                                                        *)
   3 (*  Menhir                                                                *)
   4 (*                                                                        *)
   5 (*  François Pottier, INRIA Rocquencourt                                  *)
   6 (*  Yann Régis-Gianas, PPS, Université Paris Diderot                      *)
   7 (*                                                                        *)
   8 (*  Copyright 2005-2008 Institut National de Recherche en Informatique    *)
   9 (*  et en Automatique. All rights reserved. This file is distributed      *)
  10 (*  under the terms of the GNU Library General Public License, with the   *)
  11 (*  special exception on linking described in file LICENSE.               *)
  12 (*                                                                        *)
  13 (**************************************************************************)
  14
  15 (* A packed integer array is represented as a pair of an integer [k] and
  16    a string [s]. The integer [k] is the number of bits per integer that we
  17    use. The string [s] is just an array of bits, which is read in 8-bit
  18    chunks. *)
  19
  20 (* The ocaml programming language treats string literals and array literals
  21    in slightly different ways: the former are statically allocated, while
  22    the latter are dynamically allocated. (This is rather arbitrary.) In the
  23    context of Menhir's table-based back-end, where compact, immutable
  24    integer arrays are needed, ocaml strings are preferable to ocaml arrays. *)
  25
  26 type t =
  27   int * string
  28
  29 (* The magnitude [k] of an integer [v] is the number of bits required
  30    to represent [v]. It is rounded up to the nearest power of two, so
  31    that [k] divides [Sys.word_size]. *)
  32
  33 let magnitude (v : int) =
  34   if v < 0 then
  35     Sys.word_size
  36   else
  37     let rec check k max = (* [max] equals [2^k] *)
  38       if (max <= 0) || (v < max) then
  39         k
  40           (* if [max] just overflew, then [v] requires a full ocaml
  41              integer, and [k] is the number of bits in an ocaml integer
  42              plus one, that is, [Sys.word_size]. *)
  43       else
  44         check (2 * k) (max * max)
  45     in
  46     check 1 2
  47
  48 (* [pack a] turns an array of integers into a packed integer array. *)
  49
  50 (* Because the sign bit is the most significant bit, the magnitude of
  51    any negative number is the word size. In other words, [pack] does
  52    not achieve any space savings as soon as [a] contains any negative
  53    numbers, even if they are ``small''. *)
  54
  55 let pack (a : int array) : t =
  56
  57   let m = Array.length a in
  58
  59   (* Compute the maximum magnitude of the array elements. This tells
  60      us how many bits per element we are going to use. *)
  61
  62   let k =
  63     Array.fold_left (fun k v ->
  64       max k (magnitude v)
  65     ) 1 a
  66   in
  67
  68   (* Because access to ocaml strings is performed on an 8-bit basis,
  69      two cases arise. If [k] is less than 8, then we can pack multiple
  70      array entries into a single character. If [k] is greater than 8,
  71      then we must use multiple characters to represent a single array
  72      entry. *)
  73
  74   if k <= 8 then begin
  75
  76     (* [w] is the number of array entries that we pack in a character. *)
  77
  78     assert (8 mod k = 0);
  79     let w = 8 / k in
  80
  81     (* [n] is the length of the string that we allocate. *)
  82
  83     let n =
  84       if m mod w = 0 then
  85         m / w
  86       else
  87         m / w + 1
  88     in
  89
  90     let s =
  91       String.create n
  92     in
  93
  94     (* Define a reader for the source array. The reader might run off
  95        the end if [w] does not divide [m]. *)
  96
  97     let i = ref 0 in
  98     let next () =
  99       let ii = !i in
 100       if ii = m then
 101         0 (* ran off the end, pad with zeroes *)
 102       else
 103         let v = a.(ii) in
 104         i := ii + 1;
 105         v
 106     in
 107
 108     (* Fill up the string. *)
 109
 110     for j = 0 to n - 1 do
 111       let c = ref 0 in
 112       for x = 1 to w do
 113         c := (!c lsl k) lor next()
 114       done;
 115       s.[j] <- Char.chr !c
 116     done;
 117
 118     (* Done. *)
 119
 120     k, s
 121
 122   end
 123   else begin (* k > 8 *)
 124
 125     (* [w] is the number of characters that we use to encode an array entry. *)
 126
 127     assert (k mod 8 = 0);
 128     let w = k / 8 in
 129
 130     (* [n] is the length of the string that we allocate. *)
 131
 132     let n =
 133       m * w
 134     in
 135
 136     let s =
 137       String.create n
 138     in
 139
 140     (* Fill up the string. *)
 141
 142     for i = 0 to m - 1 do
 143       let v = ref a.(i) in
 144       for x = 1 to w do
 145         s.[(i + 1) * w - x] <- Char.chr (!v land 255);
 146         v := !v lsr 8
 147       done
 148     done;
 149
 150     (* Done. *)
 151
 152     k, s
 153
 154   end
 155
 156 (* Access to a string. *)
 157
 158 let read (s : string) (i : int) : int =
 159   Char.code (String.unsafe_get s i)
 160
 161 (* [get1 t i] returns the integer stored in the packed array [t] at index [i].
 162    It assumes (and does not check) that the array's bit width is [1]. The
 163    parameter [t] is just a string. *)
 164
 165 let get1 (s : string) (i : int) : int =
 166   let c = read s (i lsr 3) in
 167   let c = c lsr ((lnot i) land 0b111) in
 168   let c = c land 0b1 in
 169   c
 170
 171 (* [get t i] returns the integer stored in the packed array [t] at index [i]. *)
 172
 173 (* Together, [pack] and [get] satisfy the following property: if the index [i]
 174    is within bounds, then [get (pack a) i] equals [a.(i)]. *)
 175
 176 let get ((k, s) : t) (i : int) : int =
 177   match k with
 178   | 1 ->
 179       get1 s i
 180   | 2 ->
 181       let c = read s (i lsr 2) in
 182       let c = c lsr (2 * ((lnot i) land 0b11)) in
 183       let c = c land 0b11 in
 184       c
 185   | 4 ->
 186       let c = read s (i lsr 1) in
 187       let c = c lsr (4 * ((lnot i) land 0b1)) in
 188       let c = c land 0b1111 in
 189       c
 190   | 8 ->
 191       read s i
 192   | 16 ->
 193       let j = 2 * i in
 194       (read s j) lsl 8 + read s (j + 1)
 195   | _ ->
 196       assert (k = 32); (* 64 bits unlikely, not supported *)
 197       let j = 4 * i in
 198       (((read s j lsl 8) + read s (j + 1)) lsl 8 + read s (j + 2)) lsl 8 + read s (j + 3)
 199