1
module Name_of = struct
3
let module M = Typename.Make0(struct type t = int let name = "int" end) in
6
let typename_of_int32 =
7
let module M = Typename.Make0(struct type t = int32 let name = "int32" end) in
10
let typename_of_int64 =
11
let module M = Typename.Make0(struct type t = int64 let name = "int64" end) in
14
let typename_of_nativeint =
15
let module M = Typename.Make0(struct
17
let name = "nativeint"
21
let typename_of_char =
22
let module M = Typename.Make0(struct type t = char let name = "char" end) in
25
let typename_of_float =
26
let module M = Typename.Make0(struct type t = float let name = "float" end) in
29
let typename_of_string =
30
let module M = Typename.Make0(struct type t = string let name = "string" end) in
33
let typename_of_bool =
34
let module M = Typename.Make0(struct type t = bool let name = "bool" end) in
37
let typename_of_unit =
38
let module M = Typename.Make0(struct type t = unit let name = "unit" end) in
41
module M_option = Typename.Make1(struct type 'a t = 'a option let name = "option" end)
42
let typename_of_option = M_option.typename_of_t
44
module M_list = Typename.Make1(struct type 'a t = 'a list let name = "list" end)
45
let typename_of_list = M_list.typename_of_t
47
module M_array = Typename.Make1(struct type 'a t = 'a array let name = "array" end)
48
let typename_of_array = M_array.typename_of_t
50
module M_lazy_t = Typename.Make1(struct type 'a t = 'a lazy_t let name = "lazy_t" end)
51
let typename_of_lazy_t = M_lazy_t.typename_of_t
53
module M_ref = Typename.Make1(struct type 'a t = 'a ref let name = "ref" end)
54
let typename_of_ref = M_ref.typename_of_t
56
module M_function = Typename.Make2(struct
57
type ('a, 'b) t = 'a -> 'b
60
let typename_of_function = M_function.typename_of_t
63
module M_tuple0 = Typename.Make0(struct type t = tuple0 let name = "tuple0" end)
64
let typename_of_tuple0 = M_tuple0.typename_of_t
66
module M_tuple2 = Typename.Make2(struct
67
type ('a, 'b) t = 'a * 'b
70
let typename_of_tuple2 = M_tuple2.typename_of_t
72
module M_tuple3 = Typename.Make3(struct
73
type ('a, 'b, 'c) t = 'a * 'b * 'c
76
let typename_of_tuple3 = M_tuple3.typename_of_t
78
module M_tuple4 = Typename.Make4(struct
79
type ('a, 'b, 'c, 'd) t = 'a * 'b * 'c * 'd
82
let typename_of_tuple4 = M_tuple4.typename_of_t
84
module M_tuple5 = Typename.Make5(struct
85
type ('a, 'b, 'c, 'd, 'e) t = 'a * 'b * 'c *'d * 'e
88
let typename_of_tuple5 = M_tuple5.typename_of_t
91
module rec Typerep : sig
97
| Nativeint : nativeint t
103
| Option : 'a t -> 'a option t
104
| List : 'a t -> 'a list t
105
| Array : 'a t -> 'a array t
106
| Lazy : 'a t -> 'a Lazy.t t
107
| Ref : 'a t -> 'a ref t
108
| Function : ('dom t * 'rng t) -> ('dom -> 'rng) t
109
| Tuple : 'a Typerep.Tuple.t -> 'a t
110
| Record : 'a Typerep.Record.t -> 'a t
111
| Variant : 'a Typerep.Variant.t -> 'a t
112
| Named : ('a Typerep.Named.t * 'a t Lazy.t option) -> 'a t
114
type packed = T : 'a t -> packed
120
val typename_of_named : named Typename.t
121
val typename_of_t : t Typename.t
122
val witness : (t, named) Type_equal.t
126
type a val a : a Typerep.t
128
val typename_of_named : 'a Typename.t -> 'a named Typename.t
129
val typename_of_t : t Typename.t
130
val witness : (t, a named) Type_equal.t
134
type a val a : a Typerep.t
135
type b val b : b Typerep.t
137
val typename_of_named :
140
-> ('a, 'b) named Typename.t
141
val typename_of_t : t Typename.t
142
val witness : (t, (a, b) named) Type_equal.t
145
type ('a, 'b, 'c) named
146
type a val a : a Typerep.t
147
type b val b : b Typerep.t
148
type c val c : c Typerep.t
150
val typename_of_named :
154
-> ('a, 'b, 'c) named Typename.t
155
val typename_of_t : t Typename.t
156
val witness : (t, (a, b, c) named) Type_equal.t
159
type ('a, 'b, 'c, 'd) named
160
type a val a : a Typerep.t
161
type b val b : b Typerep.t
162
type c val c : c Typerep.t
163
type d val d : d Typerep.t
165
val typename_of_named :
170
-> ('a, 'b, 'c, 'd) named Typename.t
171
val typename_of_t : t Typename.t
172
val witness : (t, (a, b, c, d) named) Type_equal.t
175
type ('a, 'b, 'c, 'd, 'e) named
176
type a val a : a Typerep.t
177
type b val b : b Typerep.t
178
type c val c : c Typerep.t
179
type d val d : d Typerep.t
180
type e val e : e Typerep.t
182
val typename_of_named :
188
-> ('a, 'b, 'c, 'd, 'e) named Typename.t
189
val typename_of_t : t Typename.t
190
val witness : (t, (a, b, c, d, e) named) Type_equal.t
192
(* there the module is necessary because we need to deal with a type [t] with
193
parameters whose kind is not representable as a type variable: ['a 't], even with
196
| T0 of (module T0 with type t = 'a)
197
| T1 of (module T1 with type t = 'a)
198
| T2 of (module T2 with type t = 'a)
199
| T3 of (module T3 with type t = 'a)
200
| T4 of (module T4 with type t = 'a)
201
| T5 of (module T5 with type t = 'a)
203
val arity : _ t -> int
204
val typename_of_t : 'a t -> 'a Typename.t
205
val name : _ t -> string
209
(* these constructors could be plunged at toplevel of Typerep.t, however it is less
212
| T2 : ('a Typerep.t * 'b Typerep.t)
214
| T3 : ('a Typerep.t * 'b Typerep.t * 'c Typerep.t)
216
| T4 : ('a Typerep.t * 'b Typerep.t * 'c Typerep.t * 'd Typerep.t)
217
-> ('a * 'b * 'c * 'd) t
218
| T5 : ('a Typerep.t * 'b Typerep.t * 'c Typerep.t * 'd Typerep.t * 'e Typerep.t)
219
-> ('a * 'b * 'c * 'd * 'e) t
221
val arity : _ t -> int
222
val typename_of_t : 'a t -> 'a Typename.t
225
include Variant_and_record_intf.S with type 'a t := 'a Typerep.t
227
val same : _ t -> _ t -> bool
228
val same_witness : 'a t -> 'b t -> ('a, 'b) Type_equal.t option
229
val same_witness_exn : 'a t -> 'b t -> ('a, 'b) Type_equal.t
230
val typename_of_t : 'a t -> 'a Typename.t
231
val head : 'a t -> 'a t
238
| Nativeint : nativeint t
244
| Option : 'a t -> 'a option t
245
| List : 'a t -> 'a list t
246
| Array : 'a t -> 'a array t
247
| Lazy : 'a t -> 'a Lazy.t t
248
| Ref : 'a t -> 'a ref t
249
| Function : ('dom t * 'rng t) -> ('dom -> 'rng) t
250
| Tuple : 'a Typerep.Tuple.t -> 'a t
251
| Record : 'a Typerep.Record.t -> 'a t
252
| Variant : 'a Typerep.Variant.t -> 'a t
253
| Named : ('a Typerep.Named.t * 'a t Lazy.t option) -> 'a t
255
type packed = T : 'a t -> packed
257
module Named = struct
261
val typename_of_named : named Typename.t
262
val typename_of_t : t Typename.t
263
val witness : (t, named) Type_equal.t
267
type a val a : a Typerep.t
269
val typename_of_named : 'a Typename.t -> 'a named Typename.t
270
val typename_of_t : t Typename.t
271
val witness : (t, a named) Type_equal.t
275
type a val a : a Typerep.t
276
type b val b : b Typerep.t
278
val typename_of_named :
281
-> ('a, 'b) named Typename.t
282
val typename_of_t : t Typename.t
283
val witness : (t, (a, b) named) Type_equal.t
286
type ('a, 'b, 'c) named
287
type a val a : a Typerep.t
288
type b val b : b Typerep.t
289
type c val c : c Typerep.t
291
val typename_of_named :
295
-> ('a, 'b, 'c) named Typename.t
296
val typename_of_t : t Typename.t
297
val witness : (t, (a, b, c) named) Type_equal.t
300
type ('a, 'b, 'c, 'd) named
301
type a val a : a Typerep.t
302
type b val b : b Typerep.t
303
type c val c : c Typerep.t
304
type d val d : d Typerep.t
306
val typename_of_named :
311
-> ('a, 'b, 'c, 'd) named Typename.t
312
val typename_of_t : t Typename.t
313
val witness : (t, (a, b, c, d) named) Type_equal.t
316
type ('a, 'b, 'c, 'd, 'e) named
317
type a val a : a Typerep.t
318
type b val b : b Typerep.t
319
type c val c : c Typerep.t
320
type d val d : d Typerep.t
321
type e val e : e Typerep.t
323
val typename_of_named :
329
-> ('a, 'b, 'c, 'd, 'e) named Typename.t
330
val typename_of_t : t Typename.t
331
val witness : (t, (a, b, c, d, e) named) Type_equal.t
333
(* there the module is necessary because we need to deal with a type [t] with
334
parameters whose kind is not representable as a type variable: ['a 't], even with
337
| T0 of (module T0 with type t = 'a)
338
| T1 of (module T1 with type t = 'a)
339
| T2 of (module T2 with type t = 'a)
340
| T3 of (module T3 with type t = 'a)
341
| T4 of (module T4 with type t = 'a)
342
| T5 of (module T5 with type t = 'a)
352
let typename_of_t (type a) = function
354
let module T = (val rep : T0 with type t = a) in
357
let module T = (val rep : T1 with type t = a) in
360
let module T = (val rep : T2 with type t = a) in
363
let module T = (val rep : T3 with type t = a) in
366
let module T = (val rep : T4 with type t = a) in
369
let module T = (val rep : T5 with type t = a) in
373
Typename.Uid.name (Typename.uid (typename_of_t rep))
376
module Tuple = struct
377
(* these constructors could be plunged at toplevel of Typerep.t, however it is less
380
| T2 : ('a Typerep.t * 'b Typerep.t)
382
| T3 : ('a Typerep.t * 'b Typerep.t * 'c Typerep.t)
384
| T4 : ('a Typerep.t * 'b Typerep.t * 'c Typerep.t * 'd Typerep.t)
385
-> ('a * 'b * 'c * 'd) t
386
| T5 : ('a Typerep.t * 'b Typerep.t * 'c Typerep.t * 'd Typerep.t * 'e Typerep.t)
387
-> ('a * 'b * 'c * 'd * 'e) t
389
let arity : type a. a t -> int = function
390
| Typerep.Tuple.T2 _ -> 2
391
| Typerep.Tuple.T3 _ -> 3
392
| Typerep.Tuple.T4 _ -> 4
393
| Typerep.Tuple.T5 _ -> 5
395
let typename_of_t : type a. a t -> a Typename.t = function
397
Name_of.typename_of_tuple2
398
(Typerep.typename_of_t a)
399
(Typerep.typename_of_t b)
401
Name_of.typename_of_tuple3
402
(Typerep.typename_of_t a)
403
(Typerep.typename_of_t b)
404
(Typerep.typename_of_t c)
406
Name_of.typename_of_tuple4
407
(Typerep.typename_of_t a)
408
(Typerep.typename_of_t b)
409
(Typerep.typename_of_t c)
410
(Typerep.typename_of_t d)
411
| T5 (a, b, c, d, e) ->
412
Name_of.typename_of_tuple5
413
(Typerep.typename_of_t a)
414
(Typerep.typename_of_t b)
415
(Typerep.typename_of_t c)
416
(Typerep.typename_of_t d)
417
(Typerep.typename_of_t e)
420
include Variant_and_record_intf.M (struct type 'a rep = 'a t type 'a t = 'a rep end)
422
let rec typename_of_t : type a. a t -> a Typename.t = function
423
| Int -> Name_of.typename_of_int
424
| Int32 -> Name_of.typename_of_int32
425
| Int64 -> Name_of.typename_of_int64
426
| Nativeint -> Name_of.typename_of_nativeint
427
| Char -> Name_of.typename_of_char
428
| Float -> Name_of.typename_of_float
429
| String -> Name_of.typename_of_string
430
| Bool -> Name_of.typename_of_bool
431
| Unit -> Name_of.typename_of_unit
433
| Option rep -> Name_of.typename_of_option (typename_of_t rep)
434
| List rep -> Name_of.typename_of_list (typename_of_t rep)
435
| Array rep -> Name_of.typename_of_array (typename_of_t rep)
436
| Lazy rep -> Name_of.typename_of_lazy_t (typename_of_t rep)
437
| Ref rep -> Name_of.typename_of_ref (typename_of_t rep)
439
| Function (dom, rng) ->
440
Name_of.typename_of_function (typename_of_t dom) (typename_of_t rng)
442
| Tuple rep -> Typerep.Tuple.typename_of_t rep
444
| Record rep -> Typerep.Record.typename_of_t rep
445
| Variant rep -> Typerep.Variant.typename_of_t rep
447
| Named (name, _) -> Named.typename_of_t name
450
let rec same_witness : type a b. a t -> b t -> (a, b) Type_equal.t option = fun t1 t2 ->
451
let module E = Type_equal in
453
| Named (name1, r1), Named (name2, r2) -> begin
454
match Typename.same_witness
455
(Named.typename_of_t name1)
456
(Named.typename_of_t name2) with
460
| Some (lazy t1), Some (lazy t2) -> same_witness t1 t2
461
| Some (lazy t1), None -> same_witness t1 t2
462
| None, Some (lazy t2) -> same_witness t1 t2
465
| Named (_, r1), t2 -> begin
467
| Some (lazy t1) -> same_witness t1 t2
470
| t1, Named (_, r2) -> begin
472
| Some (lazy t2) -> same_witness t1 t2
475
| Int , Int -> Some E.T
476
| Int32 , Int32 -> Some E.T
477
| Int64 , Int64 -> Some E.T
478
| Nativeint , Nativeint -> Some E.T
479
| Char , Char -> Some E.T
480
| Float , Float -> Some E.T
481
| String , String -> Some E.T
482
| Bool , Bool -> Some E.T
483
| Unit , Unit -> Some E.T
484
| Option r1, Option r2 -> begin
485
match same_witness r1 r2 with
489
| List r1, List r2 -> begin
490
match same_witness r1 r2 with
494
| Array r1, Array r2 -> begin
495
match same_witness r1 r2 with
499
| Lazy r1, Lazy r2 -> begin
500
match same_witness r1 r2 with
504
| Ref r1, Ref r2 -> begin
505
match same_witness r1 r2 with
509
| Function (dom1, rng1), Function (dom2, rng2) -> begin
510
match same_witness dom1 dom2, same_witness rng1 rng2 with
511
| Some E.T, Some E.T -> Some E.T
512
| None, _ | _, None -> None
514
| Tuple t1, Tuple t2 -> begin
515
let module T = Typerep.Tuple in
517
| T.T2 (a1, b1), T.T2 (a2, b2) -> begin
518
match same_witness a1 a2, same_witness b1 b2 with
519
| Some E.T, Some E.T -> Some E.T
520
| None, _ | _, None -> None
522
| T.T3 (a1, b1, c1), T.T3 (a2, b2, c2) -> begin
528
| Some E.T, Some E.T, Some E.T -> Some E.T
534
| T.T4 (a1, b1, c1, d1), T.T4 (a2, b2, c2, d2) -> begin
541
| Some E.T, Some E.T, Some E.T, Some E.T -> Some E.T
548
| T.T5 (a1, b1, c1, d1, e1), T.T5 (a2, b2, c2, d2, e2) -> begin
556
| Some E.T, Some E.T, Some E.T, Some E.T, Some E.T -> Some E.T
569
| Record r1, Record r2 ->
570
Typename.same_witness
571
(Typerep.Record.typename_of_t r1)
572
(Typerep.Record.typename_of_t r2)
573
| Variant r1, Variant r2 ->
574
Typename.same_witness
575
(Typerep.Variant.typename_of_t r1)
576
(Typerep.Variant.typename_of_t r2)
580
| Nativeint, _ -> None
586
| Option _, _ -> None
591
| Function _, _ -> None
593
| Record _, _ -> None
594
| Variant _, _ -> None
597
let same a b = same_witness a b <> None
598
let same_witness_exn a b =
599
match same_witness a b with
600
| Some proof -> proof
601
| None -> assert false
603
let rec head = function
604
| Typerep.Named (_, Some (lazy t)) -> head t
608
let typerep_of_int = Typerep.Int
609
let typerep_of_int32 = Typerep.Int32
610
let typerep_of_int64 = Typerep.Int64
611
let typerep_of_nativeint = Typerep.Nativeint
612
let typerep_of_char = Typerep.Char
613
let typerep_of_float = Typerep.Float
614
let typerep_of_string = Typerep.String
615
let typerep_of_bool = Typerep.Bool
616
let typerep_of_unit = Typerep.Unit
618
let typerep_of_option rep = Typerep.Option rep
619
let typerep_of_list rep = Typerep.List rep
620
let typerep_of_array rep = Typerep.Array rep
621
let typerep_of_lazy_t rep = Typerep.Lazy rep
622
let typerep_of_ref rep = Typerep.Ref rep
624
let typerep_of_function dom rng = Typerep.Function (dom, rng)
626
let typerep_of_tuple0 = Typerep.Unit
627
let typerep_of_tuple2 a b = Typerep.Tuple (Typerep.Tuple.T2 (a, b))
628
let typerep_of_tuple3 a b c = Typerep.Tuple (Typerep.Tuple.T3 (a, b, c))
629
let typerep_of_tuple4 a b c d = Typerep.Tuple (Typerep.Tuple.T4 (a, b, c, d))
630
let typerep_of_tuple5 a b c d e = Typerep.Tuple (Typerep.Tuple.T5 (a, b, c, d, e))
633
let value_tuple0 = ()
added
removed
lib/std_internal.ml
