blob: 182272c1ba5d368d3522aef617d4a7dd3f58e9cc (
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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
(* Test for "include <module-expr>" inside structures *)
module A =
struct
type t = int
let x = (1 : t)
let y = (2 : t)
let f (z : t) = (x + z : t)
end
module B =
struct
include A
type u = t * t
let p = ((x, y) : u)
let g ((x, y) : u) = ((f x, f y) : u)
end
let _ =
let print_pair (x,y) =
print_int x; print_string ", "; print_int y; print_newline() in
print_pair B.p;
print_pair (B.g B.p);
print_pair (B.g (123, 456))
module H =
struct
include A
let f (z : t) = (x - 1 : t)
end
let _ =
print_int (H.f H.x); print_newline()
module C =
struct
include (A : sig type t val f : t -> int val x : t end)
let z = f x
end
let _ =
print_int C.z; print_newline();
print_int (C.f C.x); print_newline()
(* Toplevel inclusion *)
include A
let _ =
print_int x; print_newline();
print_int (f y); print_newline()
(* With a functor *)
module F(X: sig end) =
struct
let _ = print_string "F is called"; print_newline()
type t = A | B of int
let print_t = function A -> print_string "A"
| B x -> print_int x
end
module D =
struct
include F(struct end)
let test() = print_t A; print_newline(); print_t (B 42); print_newline()
end
let _ =
D.test();
D.print_t D.A; print_newline(); D.print_t (D.B 42); print_newline()
(* Exceptions and classes *)
module E =
struct
exception Exn of string
class c = object method m = 1 end
end
module G =
struct
include E
let _ =
begin try raise (Exn "foo") with Exn s -> print_string s end;
print_int ((new c)#m); print_newline()
end
let _ =
begin try raise (G.Exn "foo") with G.Exn s -> print_string s end;
print_int ((new G.c)#m); print_newline()
|
