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
|
open Ppxlib
let () =
let unused_code_warnings = true in
Deriving.add "zero_do_warn"
~str_type_decl:
(Deriving.Generator.make_noarg ~unused_code_warnings
(fun ~loc ~path:_ _ ->
[%str
module Zero = struct
type t = T0
end
let zero = Zero.T0]))
~sig_type_decl:
(Deriving.Generator.make_noarg ~unused_code_warnings
(fun ~loc ~path:_ _ ->
[%sig:
module Zero : sig
type t
end
val zero : Zero.t]))
|> Deriving.ignore
let () =
let unused_code_warnings = false in
Deriving.add "one_no_warn"
~str_type_decl:
(Deriving.Generator.make_noarg ~unused_code_warnings
(fun ~loc ~path:_ _ ->
[%str
module One = struct
type 'a t = T1 of 'a
end
let one = One.T1 zero]))
~sig_type_decl:
(Deriving.Generator.make_noarg ~unused_code_warnings
(fun ~loc ~path:_ _ ->
[%sig:
module One : sig
type 'a t
end
val one : Zero.t One.t]))
|> Deriving.ignore
let () =
let unused_code_warnings = true in
Deriving.add "two_do_warn"
~str_type_decl:
(Deriving.Generator.make_noarg ~unused_code_warnings
(fun ~loc ~path:_ _ ->
[%str
module Two = struct
type ('a, 'b) t = T2 of 'a * 'b
end
let two = Two.T2 (zero, one)]))
~sig_type_decl:
(Deriving.Generator.make_noarg ~unused_code_warnings
(fun ~loc ~path:_ _ ->
[%sig:
module Two : sig
type ('a, 'b) t
end
val two : (Zero.t, Zero.t One.t) Two.t]))
|> Deriving.ignore
let () =
let alias_do_warn =
let unused_code_warnings = true in
Deriving.add "alias_do_warn"
~str_type_decl:
(Deriving.Generator.make_noarg ~unused_code_warnings
(fun ~loc ~path:_ _ -> [%str let unit_one = ()]))
~sig_type_decl:
(Deriving.Generator.make_noarg ~unused_code_warnings
(fun ~loc ~path:_ _ -> [%sig: val unit_one : unit]))
in
let alias_no_warn =
let unused_code_warnings = false in
Deriving.add "alias_no_warn"
~str_type_decl:
(Deriving.Generator.make_noarg ~unused_code_warnings
(fun ~loc ~path:_ _ -> [%str let unit_two = unit_one]))
~sig_type_decl:
(Deriving.Generator.make_noarg ~unused_code_warnings
(fun ~loc ~path:_ _ -> [%sig: val unit_two : unit]))
in
(* The derivers are added from right to left *)
Deriving.add_alias "alias_warn" [ alias_no_warn; alias_do_warn ]
|> Deriving.ignore
let () = Driver.standalone ()
|
