Re: [Caml-list] ANN: unboxed-arrays-0.1: Unboxed arrays for OCaml

[Mark Shinwell <mshinwell@janestreet.com>]

On 19 January 2014 18:01, Bob Atkey <bob.atkey@gmail.com> wrote:
> The runtime representation of OCaml arrays usually stores the elements
> using a 'boxed' representation, meaning that if the value of a
> particular element cannot be stored within a single machine word
> (i.e., it is not an argument-less constructor or an `int` value), then
> the array actually contains a pointer to the representation of the
> element elsewhere in the heap. (Note that `float` arrays are special
> cased.) This boxing representation leads to an extra indirection when
> accessing elements of the array, means that memory is wasted, and
> decreases data locality, to the detriment of efficent cache usage.

Thanks for sharing your code.  I also did an experiment
with this recently (although I would argue that it isn't always
clear that flat arrays are desirable).  My flat array module
is designed to hold a sequence of values of record type.  Pointers
to the records may be retrieved and then normal mutable field
updates may be used to change them.  (In case you are wondering,
if you put some other variety of value in the array, then it's
probably safe but won't be useful---since in particular there
is no "set" method provided.)

module Flat_array : sig
  type 'a t

  val create : num_elements:int -> default:'a -> 'a t
  val element_at : 'a t -> index:int -> 'a
end

Here's a simple example of its use.  The code of the
implementation is left as an interesting exercise for the
reader ;)

type t = {
  mutable foo : int;
  mutable bar : string;
}

let default = { foo = 42; bar = "hello world"; }

let test () =
  let arr = Flat_array.create ~num_elements:10 ~default in
  let r = Flat_array.element_at arr ~index:4 in
  Printf.printf "foo=%d, bar=%s\n%!" r.foo r.bar;
  Gc.compact (); (* make sure we haven't corrupted the heap *)
  r.foo <- 10;
  r.bar <- "bar";
  Gc.compact ();
  Printf.printf "foo=%d, bar=%s\n%!" r.foo r.bar

--

module Flat_array : sig
  type 'a t

  val create : num_elements:int -> default:'a -> 'a t
  val element_at : 'a t -> index:int -> 'a
end = struct
  type _ t = Obj.t

  let create ~num_elements ~default =
    let fields_per_elt = Obj.size (Obj.repr default) in
    let size = 1 + num_elements * (1 + fields_per_elt) - 1 in
    let t = Obj.new_block Obj.closure_tag size in
    let stride = Sys.word_size/8 * (fields_per_elt + 1) in
    Obj.set_field t (size - 1) (Obj.repr stride);
    let default = Obj.repr default in
    for elt = 0 to num_elements - 1 do
      let header_index_for_elt = (1 + fields_per_elt) * elt - 1 in
      for field = 0 to fields_per_elt - 1 do
        Obj.set_field t (header_index_for_elt + 1 + field)
          (Obj.field default field)
      done;
      if elt > 0 then begin
        let infix_header =
          let infix_offset = elt * (fields_per_elt + 1) in
          let actual_value =
            (infix_offset lsl 10) lor Obj.infix_tag
          in
          assert (actual_value land 1 = 1);
          actual_value lsr 1
        in
        Obj.set_field t header_index_for_elt (Obj.repr infix_header)
      end
    done;
    t

  let element_at t ~index =
    let offset =
      if index = 0 then 0
      else
        let t = ((Obj.magic t) : int array) in
        let stride = t.(Array.length t - 1) in
        stride * index
    in
    let record_is_at = Obj.add_offset t (Int32.of_int offset) in
    Obj.obj record_is_at
end