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
|
open Stdppx
open Ppxlib
(* Linters *)
let lint = object
inherit [Driver.Lint_error.t list] Ast_traverse.fold as super
method! type_declaration td acc =
let acc = super#type_declaration td acc in
match td.ptype_kind with
| Ptype_record lds ->
if Poly.(<>)
(List.sort lds ~cmp:(fun a b -> String.compare a.pld_name.txt b.pld_name.txt))
lds
then
Driver.Lint_error.of_string { td.ptype_loc with loc_ghost = true }
"Fields are not sorted!"
:: acc
else
acc
| _ -> acc
end
let () =
Driver.register_transformation "lint" ~lint_impl:(fun st -> lint#structure st [])
[%%expect{|
val lint : Driver.Lint_error.t list Ast_traverse.fold = <obj>
|}]
type t =
{ b : int
; a : int
}
[%%expect{|
Line _, characters 0-36:
Error (warning 22): Fields are not sorted!
|}]
(* Extension with a path argument *)
let () =
Driver.register_transformation "plop"
~rules:[Context_free.Rule.extension
(Extension.declare_with_path_arg "plop"
Expression
Ast_pattern.(pstr nil)
(fun ~loc ~path:_ ~arg ->
let open Ast_builder.Default in
match arg with
| None -> estring ~loc "-"
| Some { loc; txt } -> estring ~loc (Longident.name txt)))]
[%%expect{|
|}]
let _ = Stdlib.Printf.sprintf "%s\n" [%plop]
[%%expect{|
- : string = "-\n"
|}]
let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc]
[%%expect{|
- : string = "Truc\n"
|}]
let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc.Bidule]
[%%expect{|
- : string = "Truc.Bidule\n"
|}]
(* Extension with a path argument and ctxt *)
let () =
Driver.register_transformation "plop_ctxt"
~rules:[Context_free.Rule.extension
(Extension.V3.declare_with_path_arg "plop_ctxt"
Expression
Ast_pattern.(pstr nil)
(fun ~ctxt ~arg ->
let open Ast_builder.Default in
let loc = Expansion_context.Extension.extension_point_loc ctxt in
match arg with
| None -> estring ~loc "-"
| Some { loc; txt } -> estring ~loc (Longident.name txt)))]
[%%expect{|
|}]
let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt]
[%%expect{|
- : string = "-\n"
|}]
let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc]
[%%expect{|
- : string = "Truc\n"
|}]
let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc.Bidule]
[%%expect{|
- : string = "Truc.Bidule\n"
|}]
|
