blob: aa6e530e78fd32f698d6faf3ed2441a643edb6b5 (
plain)
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
|
(* cvs update -r fixedtypes parsing typing *)
(* recursive types *)
class c = object (self) method m = 1 method s = self end
module type S = sig type t = private #c end;;
module M : S = struct type t = c end
module type S' = S with type t = c;;
class d = object inherit c method n = 2 end
module type S2 = S with type t = private #d;;
module M2 : S = struct type t = d end;;
module M3 : S = struct type t = private #d end;;
module T1 = struct
type ('a,'b) a = [`A of 'a | `B of 'b]
type ('a,'b) b = [`Z | ('a,'b) a]
end
module type T2 = sig
type a and b
val evala : a -> int
val evalb : b -> int
end
module type T3 = sig
type a0 = private [> (a0,b0) T1.a]
and b0 = private [> (a0,b0) T1.b]
end
module type T4 = sig
include T3
include T2 with type a = a0 and type b = b0
end
module F(X:T4) = struct
type a = X.a and b = X.b
let a = X.evala (`B `Z)
let b = X.evalb (`A(`B `Z))
let a2b (x : a) : b = `A x
let b2a (x : b) : a = `B x
end
module M4 = struct
type a = [`A of a | `B of b | `ZA]
and b = [`A of a | `B of b | `Z]
type a0 = a
type b0 = b
let rec eval0 = function
`A a -> evala a
| `B b -> evalb b
and evala : a -> int = function
#T1.a as x -> 1 + eval0 x
| `ZA -> 3
and evalb : b -> int = function
#T1.a as x -> 1 + eval0 x
| `Z -> 7
end
module M5 = F(M4)
module M6 : sig
class ci : int ->
object
val x : int
method x : int
method move : int -> unit
end
type c = private #ci
val create : int -> c
end = struct
class ci x = object
val mutable x : int = x
method x = x
method move d = x <- x+d
end
type c = ci
let create = new ci
end
let f (x : M6.c) = x#move 3; x#x;;
module M : sig type t = private [> `A of bool] end =
struct type t = [`A of int] end
|
