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
type ('a, 'id) hash = 'a -> int
type ('a, 'id) eq = 'a -> 'a -> bool
type ('a, 'id) cmp = 'a -> 'a -> int
let getHashInternal : ('a, 'id) hash -> 'a -> int = Obj.magic
let getEqInternal : ('a, 'id) eq -> 'a -> 'a -> bool = Obj.magic
let getCmpInternal : ('a, 'id) cmp -> 'a -> 'a -> int = Obj.magic
module type Comparable = sig
type identity
type t
val cmp : (t, identity) cmp
end
type ('key, 'id) comparable =
(module Comparable with type t = 'key and type identity = 'id)
module MakeComparableU (M : sig
type t
val cmp : t -> t -> int
end) =
struct
type identity
type t = M.t
let cmp = M.cmp
end
module MakeComparable (M : sig
type t
val cmp : t -> t -> int
end) =
struct
type identity
type t = M.t
let cmp =
let cmp = M.cmp in
fun a b -> cmp a b
end
let comparableU (type key) ~cmp =
let module N = MakeComparableU (struct
type t = key
let cmp = cmp
end) in
(module N : Comparable with type t = key)
let comparable (type key) ~cmp =
let module N = MakeComparable (struct
type t = key
let cmp = cmp
end) in
(module N : Comparable with type t = key)
module type Hashable = sig
type identity
type t
val hash : (t, identity) hash
val eq : (t, identity) eq
end
type ('key, 'id) hashable =
(module Hashable with type t = 'key and type identity = 'id)
module MakeHashableU (M : sig
type t
val hash : t -> int
val eq : t -> t -> bool
end) =
struct
type identity
type t = M.t
let hash = M.hash
let eq = M.eq
end
module MakeHashable (M : sig
type t
val hash : t -> int
val eq : t -> t -> bool
end) =
struct
type identity
type t = M.t
let hash =
let hash = M.hash in
fun a -> hash a
let eq =
let eq = M.eq in
fun a b -> eq a b
end
let hashableU (type key) ~hash ~eq =
let module N = MakeHashableU (struct
type t = key
let hash = hash
let eq = eq
end) in
(module N : Hashable with type t = key)
let hashable (type key) ~hash ~eq =
let module N = MakeHashable (struct
type t = key
let hash = hash
let eq = eq
end) in
(module N : Hashable with type t = key)