package ooh

  1. Overview
  2. Docs

Source file multi_valued.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
(* SPDX-FileCopyrightText: Copyright (C) 2025 Stefan Muenzel
 * SPDX-License-Identifier: MPL-2.0
 *)

module Raw : sig
  type ('vs, 'v) t [@@immediate]

  val kind : ('vs, 'v) t -> ('vs, 'v) Witness.t

  val create
    :  'v Encoded.t
    -> ('vs, 'v) Witness.t
    -> ('vs, 'v) t

  val get : ('vs, 'v) t -> 'v
end = struct
  type ('vs, 'v) t = int

  let kind
      (type vs v)
      (t : (vs, v) t)
    : (vs, v) Witness.t
    =
    Obj.magic (t land 0b11)

  let create
      (type vs v)
      (encoded : v Encoded.t)
      (witness : (vs, v) Witness.t)
    : (vs, v) t
    =
    (Witness.as_int witness) lor (Encoded.Raw.to_int encoded)

  let get 
      (type vs v)
      (t : (vs, v) t)
    : v
    =
    Obj.magic (t land (lnot 0b11))
end

type 'vs t =
  | T : ('vs, 'v) Raw.t -> 'vs t
[@@unboxed] [@@immediate]

let create
    (type vs v)
    (encoded : v Encoded.t)
    (witness : (vs, v) Witness.t)
  : vs t
  =
  T (Raw.create encoded witness)

module Option0 = struct
  type nonrec 'value t = < v00 : 'value; v01 : unit > t

  module Optional_syntax = struct
    module Optional_syntax = struct
      let is_none (type value) (T t : value t) : bool =
        match Raw.kind t with
        | V00 -> true
        | V01 -> false

      let unsafe_value (type value) (T t : value t) : value =
        Raw.get ((Obj.magic t) : (< v00 : value; .. >, value) Raw.t)
    end
  end
end