compact_array_gadt.ml

(* adapted from https://blog.janestreet.com/why-gadts-matter-for-performance/*)
module Compact_array : sig
  type 'item t

  val of_bytes : bytes -> char t
  val of_array : 'item array -> 'item t
  val length : 'item t -> int
  val get : 'item t -> int -> 'item
end = struct
  type 'a t =
    | Array : 'a array -> 'a t
    | Bytes : bytes -> char t

  let of_bytes x = Bytes x
  let of_array x = Array x

  let length (type el) (t : el t) =
    match t with
    | Array a -> Array.length a
    | Bytes s -> Bytes.length s

  let get (type el) (t : el t) i : el =
    match t with
    | Array a -> Array.get a i
    | Bytes s -> Bytes.get s i

  let set (type el) (t : el t) i (v : el) =
    match t with
    | Array a -> Array.set a i v
    | Bytes s -> Bytes.set s i v
end

module CA = Compact_array

let () =
  let a = CA.of_array [| 1; 2 |] in
  let bytes_ = Bytes.of_string "world" in
  let s = CA.of_bytes bytes_ in
  let p = Printf.printf in
  p "CA.length a: %d\n" @@ CA.length a;
  p "CA.length s: %d\n" @@ CA.length s;
  p "CA.get a 0: %d\n" @@ CA.get a 0;
  p "CA.get s 0: %c\n" @@ CA.get s 0;

compact_array_vtable.ml

module Compact_array : sig
  type ('in_, 'out) t

  val of_bytes : bytes -> (bytes, char) t
  val of_array : 'a array -> ('a array, 'a) t
  val length : ('in_, 'out) t -> int
  val get : ('in_, 'out) t -> int -> 'out
end = struct
  type ('in_, 'out) ops =
    { len : 'in_ -> int
    ; get : 'in_ -> int -> 'out
    }

  type ('in_, 'out) t = 'in_ * ('in_, 'out) ops

  let bytes_ops = { len = Bytes.length; get = Bytes.get }
  let array_ops = { len = Array.length; get = Array.get }
  let of_bytes s = s, bytes_ops
  let of_array a = a, array_ops
  let length (t, ops) = ops.len t
  let get (t, ops) i = ops.get t i
end

module CA = Compact_array

let () =
  let a = CA.of_array [| 1; 2 |] in
  let bytes_ = Bytes.of_string "world" in
  let s = CA.of_bytes bytes_ in
  let p = Printf.printf in
  p "CA.length a: %d\n" @@ CA.length a;
  p "CA.length s: %d\n" @@ CA.length s;
  p "CA.get a 0: %d\n" @@ CA.get a 0;
  p "CA.get s 0: %c\n" @@ CA.get s 0;