Source file typed_variants_lib.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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
open Base
include Typed_variants_lib_intf
module Nothing = struct
type nonrec derived_on = |
type _ t = |
let unreachable_code = function
| (_ : _ t) -> .
;;
let names = []
let name : type a. a t -> string = unreachable_code
let path : type a. a t -> string list = unreachable_code
let __ord : type a. a t -> int list = unreachable_code
let get : type a. a t -> derived_on -> a option = unreachable_code
let create : type a. a t -> a -> derived_on = unreachable_code
module Type_ids = struct
let type_id : type a. a t -> a Type_equal.Id.t = unreachable_code
end
module Packed = struct
type 'a field = 'a t
type t' = T : 'a field -> t'
type t = { f : t' } [@@unboxed]
let all = []
let pack : type a. a field -> t = unreachable_code
let compare { f = T x1 } { f = T x2 } = List.compare Int.compare (__ord x1) (__ord x2)
let equal t1 t2 = compare t1 t2 = 0
let sexp_of_t packed =
match packed with
| (_ : t) -> .
;;
let t_of_sexp sexp =
raise_s
(Sexp.List
[ Sexp.Atom "Nothing has no constructors, so cannot convert to variant."
; sexp
])
;;
end
let which : derived_on -> Packed.t = function
| (_ : derived_on) -> .
;;
end
module Singleton (T : T) = struct
include Typed_fields_lib.Singleton (T)
let get (type a) (T : a t) (t : derived_on) : a option = Some t
let create (type a) (T : a t) (t : a) : derived_on = t
let which _ = { Packed.f = Packed.T T }
end
module Singleton1 (T1 : T1) = struct
include Typed_fields_lib.Singleton1 (T1)
let get (type a r) (T : (a, r) t) (t : a derived_on) : r option = Some t
let create (type a r) (T : (a, r) t) (t : r) : a derived_on = t
let which _ = { Packed.f = Packed.T T }
end
module Singleton2 (T2 : T2) = struct
include Typed_fields_lib.Singleton2 (T2)
let get (type a b r) (T : (a, b, r) t) (t : (a, b) derived_on) : r option = Some t
let create (type a b r) (T : (a, b, r) t) (t : r) : (a, b) derived_on = t
let which _ = { Packed.f = Packed.T T }
end
module Singleton3 (T3 : T3) = struct
include Typed_fields_lib.Singleton3 (T3)
let get (type a b c r) (T : (a, b, c, r) t) (t : (a, b, c) derived_on) : r option =
Some t
;;
let create (type a b c r) (T : (a, b, c, r) t) (t : r) : (a, b, c) derived_on = t
let which _ = { Packed.f = Packed.T T }
end
module Singleton4 (T4 : sig
type ('a, 'b, 'c, 'd) t
end) =
struct
include Typed_fields_lib.Singleton4 (T4)
let get (type a b c d r) (T : (a, b, c, d, r) t) (t : (a, b, c, d) derived_on)
: r option
=
Some t
;;
let create (type a b c d r) (T : (a, b, c, d, r) t) (t : r) : (a, b, c, d) derived_on =
t
;;
let which _ = { Packed.f = Packed.T T }
end
module Singleton5 (T5 : sig
type ('a, 'b, 'c, 'd, 'e) t
end) =
struct
include Typed_fields_lib.Singleton5 (T5)
let get (type a b c d e r) (T : (a, b, c, d, e, r) t) (t : (a, b, c, d, e) derived_on)
: r option
=
Some t
;;
let create (type a b c d e r) (T : (a, b, c, d, e, r) t) (t : r)
: (a, b, c, d, e) derived_on
=
t
;;
let which _ = { Packed.f = Packed.T T }
end