Compiler Explorer

Source code

type bigstring = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t

external bigarray_set_int64_ne : bigstring -> int -> int64 -> unit = "%caml_bigstring_set64u"

type string_ref =
  | Ref of int
  | String of string

module I64 = struct
  include Int64

let ( lsl ) = Int64.shift_left
  let ( lsr ) = Int64.shift_right_logical
  let ( lor ) = Int64.logor
  let ( + ) = Int64.add
end

let bool_into_bigstring buf ~off ~name value = match name, value with
  | true, Ref idx ->
    let open I64 in
    let hdr = (8L lsl 4) + 9L in
    let idx = (of_int idx) lsl 16 in
    let bol = 1L lsl 32 in
    bigarray_set_int64_ne buf 0 (bol lor idx lor hdr);
    8
  | true, String str ->
    let padded = ((String.length str + 7) lsr 3) lsl 3 in
    begin let open I64 in
    let hdr = (8L lsl 4) + 9L in
    let idx = ((of_int (String.length str)) lor 0x8000L) lsl 16 in
    let bol = 1L lsl 32 in
    bigarray_set_int64_ne buf 0 (bol lor idx lor hdr) end;
    8 + padded
  | _ -> assert false

let bool_to_string ~name value = match name, value with
  | true, Ref idx ->
    let buf = Bytes.create 8 in
    let open I64 in
    let hdr = (8L lsl 4) + 9L in
    let idx = (of_int idx) lsl 16 in
    let bol = 1L lsl 32 in
    Bytes.set_int64_ne buf 0 (bol lor idx lor hdr);
    buf
  | true, String str ->
    let padded = ((String.length str + 7) lsr 3) lsl 3 in
    let buf = Bytes.create 8 in
    begin let open I64 in
    let hdr = (8L lsl 4) + 9L in
    let idx = ((of_int (String.length str)) lor 0x8000L) lsl 16 in
    let bol = 1L lsl 32 in
    Bytes.set_int64_ne buf 0 (bol lor idx lor hdr) end;
    buf
  | _ -> assert false