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
|
(* Test for the ppx_import old syntax compat support *)
open Ppxlib
let id =
Extension.__declare_ppx_import
"id"
(fun ~ctxt:_ td ->
match td.ptype_manifest with
| Some {ptyp_desc = Ptyp_extension (_, PTyp wrapped_manifest); _} ->
{td with ptype_manifest = Some wrapped_manifest}
| _ -> assert false)
[%%expect{|
val id : Extension.t = <abstr>
|}]
Driver.register_transformation
~rules:[Context_free.Rule.extension id]
"id"
[%%expect{|
- : unit = ()
|}]
(* The expander receives the type decl with the extension point removed, it should preserve
attibutes *)
type t = [%id: int]
[%%expect{|
type t = int
|}]
(* It also should work in signatures by default *)
module type T = sig
type t = [%id: int]
end
[%%expect{|
module type T = sig type t = int end
|}]
let foo =
let check_interpreted (_, type_decls) =
let {ptype_manifest; _} = List.hd type_decls in
match ptype_manifest with
| Some {ptyp_desc = Ptyp_extension _; _} ->
failwith "Extension should be intepreted before attributes"
| _ -> ()
in
Deriving.add "foo"
~str_type_decl:(Deriving.Generator.make_noarg
(fun ~loc ~path:_ type_decl ->
check_interpreted type_decl;
[%str let foo = 42]))
~sig_type_decl:(Deriving.Generator.make_noarg
(fun ~loc ~path:_ type_decl ->
check_interpreted type_decl;
[%sig: val foo : int]))
[%%expect{|
val foo : Deriving.t = <abstr>
|}]
(* It should properly compose with [@@deriving] *)
type t = [%id: int]
[@@deriving foo]
[%%expect{|
type t = int
val foo : t = 42
|}]
module type T = sig
type t = [%id: int]
[@@deriving foo]
end
[%%expect{|
module type T = sig type t = int val foo : t end
|}]
(* It should be properly interpreted if it's the result of the expansion of a
previous node as well *)
let gen_id =
Extension.V3.declare
"gen_id"
Extension.Context.structure_item
Ast_pattern.(pstr nil)
(fun ~ctxt ->
let loc = Expansion_context.Extension.extension_point_loc ctxt in
[%stri type t = [%id: int]])
[%%expect{|
val gen_id : Extension.t = <abstr>
|}]
Driver.register_transformation
~rules:[Context_free.Rule.extension gen_id]
"gen_id"
[%%expect{|
- : unit = ()
|}]
[%%gen_id]
[%%expect{|
type t = int
|}]
(* One can't have ppx_import-like and core_type extensions with the same name *)
let id_for_core_types =
Extension.V3.declare
"id"
Extension.Context.core_type
Ast_pattern.(ptyp __)
(fun ~ctxt:_ core_type -> core_type)
[%%expect{|
Exception:
Failure
"Some ppx-es tried to register conflicting transformations: Extension 'id' on type declarations matches extension 'id'".
|}]
|
