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
|
open Ppxlib
let expand_into_extension_node ~ctxt =
let loc = Expansion_context.Extension.extension_point_loc ctxt in
let extension_node =
Location.error_extensionf ~loc "An error message in an extension node"
in
Ast_builder.Default.pexp_extension ~loc extension_node
let expand_raise_exception ~ctxt:_ = failwith "A raised exception"
let expand_raise_located_error ~ctxt =
let loc = Expansion_context.Extension.extension_point_loc ctxt in
Location.raise_errorf ~loc "A raised located error"
let expand_raise_located_error2 ~ctxt =
let loc = Expansion_context.Extension.extension_point_loc ctxt in
Location.raise_errorf ~loc "A second raised located error"
let extension_point_extension =
Extension.V3.declare "gen_ext_node" Extension.Context.expression
Ast_pattern.(pstr nil)
expand_into_extension_node
let raise_exception_extension =
Extension.V3.declare "gen_raise_exc" Extension.Context.expression
Ast_pattern.(pstr nil)
expand_raise_exception
let raise_located_error_extension =
Extension.V3.declare "gen_raise_located_error" Extension.Context.expression
Ast_pattern.(pstr nil)
expand_raise_located_error
let raise_located_error_extension2 =
Extension.V3.declare "gen_raise_located_error2" Extension.Context.expression
Ast_pattern.(pstr nil)
expand_raise_located_error2
let rule1 = Ppxlib.Context_free.Rule.extension extension_point_extension
let rule2 = Ppxlib.Context_free.Rule.extension raise_exception_extension
let rule3 = Ppxlib.Context_free.Rule.extension raise_located_error_extension
let rule4 = Ppxlib.Context_free.Rule.extension raise_located_error_extension2
let () =
Driver.register_transformation
~rules:[ rule1; rule2; rule3; rule4 ]
"gen_errors"
let () = Driver.standalone ()
|
