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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
(** This file tests the consistency of [Container] and [Indexed_container] module types.
We compare each module type S to the most generic version G that exports the same set
of values. We create a module type I by instantiating G to mimic S, such as by
dropping a type parameter. We then test that S = I by writing two identity functors,
one from S to I and one from I to S. *)
open! Base
module _ : module type of Container = struct
(* The most generic interface that everything else implements. *)
module type Generic = Container.Generic
(* The generic interface with creator functions. Ensure it implements Generic. *)
module type Generic_with_creators = Container.Generic_with_creators
module _ (M : Container.Generic_with_creators) : Container.Generic = M
(* Ensure that S0 is Generic with no type arguments. *)
module type S0 = Container.S0
open struct
module type Generic0 = sig
type elt
type t
include Generic with type _ elt := elt and type (_, _, _) t := t
val mem : t -> elt -> bool
end
end
module _ (M : S0) : Generic0 = M
module _ (M : Generic0) : S0 = M
(* Ensure that S0_phantom is Generic with a fixed element type. *)
module type S0_phantom = Container.S0_phantom
open struct
module type Generic0_phantom = sig
type elt
type _ t
include Container.Generic with type _ elt := elt and type (_, 'p, _) t := 'p t
val mem : _ t -> elt -> bool
end
end
module _ (M : S0_phantom) : Generic0_phantom = M
module _ (M : Generic0_phantom) : S0_phantom = M
(* Ensure that S0_with_creators is Generic_with_creators with no type arguments. *)
module type S0_with_creators = Container.S0_with_creators
open struct
module type Generic0_with_creators = sig
type elt
type t
include
Generic_with_creators
with type _ elt := elt
and type (_, _, _) t := t
and type ('a, _, _) concat := 'a list
val mem : t -> elt -> bool
end
end
module _ (M : S0_with_creators) : Generic0_with_creators = M
module _ (M : Generic0_with_creators) : S0_with_creators = M
(* Ensure that S1 is Generic with no phantom type. *)
module type S1 = Container.S1
open struct
module type Generic1 = sig
type _ t
include Container.Generic with type 'a elt := 'a and type ('a, _, _) t := 'a t
end
end
module _ (M : S1) : Generic1 = M
module _ (M : Generic1) : S1 = M
(* Ensure that S1_phantom is Generic with a covariant phantom type. *)
module type S1_phantom = Container.S1_phantom
open struct
module type Generic1_phantom = sig
type (_, _) t
include Generic with type 'a elt := 'a and type ('a, 'p, _) t := ('a, 'p) t
end
end
module _ (M : S1_phantom) : Generic1_phantom = M
module _ (M : Generic1_phantom) : S1_phantom = M
(* Ensure that S1_with_creators is Generic_with_creators with no phantom type. *)
module type S1_with_creators = Container.S1_with_creators
open struct
module type Generic1_with_creators = sig
type 'a t
include
Generic_with_creators
with type 'a elt := 'a
and type ('a, _, _) t := 'a t
and type ('a, _, _) concat := 'a t
end
end
module _ (M : S1_with_creators) : Generic1_with_creators = M
module _ (M : Generic1_with_creators) : S1_with_creators = M
(* Other definitions that we are not testing: *)
module Continue_or_stop = Container.Continue_or_stop
module Make = Container.Make
module Make0 = Container.Make0
module Make_gen = Container.Make_gen
module Make_with_creators = Container.Make_with_creators
module Make0_with_creators = Container.Make0_with_creators
module Make_gen_with_creators = Container.Make_gen_with_creators
module type Derived = Container.Derived
module type Summable = Container.Summable
include (Container : Derived)
end
module _ : module type of Indexed_container = struct
(* The generic interface everything else implements. *)
module type Generic = Indexed_container.Generic
(* Ensure that S0 is Generic without type parameters. *)
module type S0 = Indexed_container.S0
open struct
module type Generic0 = sig
type elt
type t
include Generic with type _ elt := elt and type (_, _, _) t := t
val mem : t -> elt -> bool
end
end
module _ (M : S0) : Generic0 = M
module _ (M : Generic0) : S0 = M
(* Ensure that S1 is Generic without an abstract element type. *)
module type S1 = Indexed_container.S1
open struct
module type Generic1 = sig
type 'a t
include Generic with type 'a elt := 'a and type ('a, _, _) t := 'a t
end
end
module _ (M : S1) : Generic1 = M
module _ (M : Generic1) : S1 = M
(* Ensure that Generic_with_creators includes Generic. *)
module type Generic_with_creators = Indexed_container.Generic_with_creators
module _ (M : Indexed_container.Generic_with_creators) : Indexed_container.Generic = M
(* Ensure that S0_with_creators is Generic_with_creators with no type arguments. *)
module type S0_with_creators = Indexed_container.S0_with_creators
open struct
module type Generic0_with_creators = sig
type elt
type t
include
Generic_with_creators
with type _ elt := elt
and type (_, _, _) t := t
and type ('a, _, _) concat := 'a list
val mem : t -> elt -> bool
end
end
module _ (M : S0_with_creators) : Generic0_with_creators = M
module _ (M : Generic0_with_creators) : S0_with_creators = M
(* Ensure that S1_with_creators is Generic_with_creators with no phantom type. *)
module type S1_with_creators = Indexed_container.S1_with_creators
open struct
module type Generic1_with_creators = sig
type 'a t
include
Generic_with_creators
with type 'a elt := 'a
and type ('a, _, _) t := 'a t
and type ('a, _, _) concat := 'a t
end
end
module _ (M : S1_with_creators) : Generic1_with_creators = M
module _ (M : Generic1_with_creators) : S1_with_creators = M
(* Other definitions that we are not testing: *)
module Make = Indexed_container.Make
module Make0 = Indexed_container.Make0
module Make_gen = Indexed_container.Make_gen
module Make_with_creators = Indexed_container.Make_with_creators
module Make0_with_creators = Indexed_container.Make0_with_creators
module Make_gen_with_creators = Indexed_container.Make_gen_with_creators
module type Derived = Indexed_container.Derived
include (Indexed_container : Derived)
end
|
