Source file Normalize_extended_ast.ml
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
open Extended_ast
let dedup_cmts fragment ast =
let of_ast ast =
let docs = ref (Set.empty (module Cmt)) in
let attribute m atr =
match atr with
| { attr_payload=
PStr
[ { pstr_desc=
Pstr_eval
( { pexp_desc=
Pexp_constant
{pconst_desc= Pconst_string (doc, _, None); _}
; pexp_loc
; _ }
, [] )
; _ } ]
; _ }
when Ast.Attr.is_doc atr ->
docs := Set.add !docs (Cmt.create ("*" ^ doc) pexp_loc) ;
atr
| _ -> Ast_mapper.default_mapper.attribute m atr
in
map fragment {Ast_mapper.default_mapper with attribute} ast |> ignore ;
!docs
in
Set.(to_list (diff (of_list (module Cmt) comments) (of_ast ast)))
let dedup fmt =
let = dedup comments in
List.sort comments ~compare:(fun {Cmt.loc= a; _} {Cmt.loc= b; _} ->
Migrate_ast.Location.compare a b )
|> List.iter ~f:(fun {Cmt.txt; _} -> Format.fprintf fmt "%s," txt)
let normalize_parse_result ast_kind ast =
Format.asprintf "AST,%a,COMMENTS,[%a]" (Printast.ast ast_kind) ast
(normalize_comments (dedup_cmts ast_kind ast))
comments
let normalize_code conf (m : Ast_mapper.mapper) txt =
let input_name = "<output>" in
match Parse_with_comments.parse_toplevel conf ~input_name ~source:txt with
| First {ast; ; _} ->
normalize_parse_result Use_file
(List.map ~f:(m.toplevel_phrase m) ast)
comments
| Second {ast; ; _} ->
normalize_parse_result Repl_file
(List.map ~f:(m.repl_phrase m) ast)
comments
| exception _ -> txt
let docstring (c : Conf.t) =
Docstring.normalize ~parse_docstrings:c.fmt_opts.parse_docstrings.v
let sort_attributes : attributes -> attributes =
List.sort ~compare:Poly.compare
let make_mapper conf ~ =
let open Ast_helper in
let location _ _ = Location.none in
let attribute (m : Ast_mapper.mapper) (attr : attribute) =
match attr.attr_payload with
| PStr
[ ( { pstr_desc=
Pstr_eval
( ( { pexp_desc=
Pexp_constant
( { pconst_desc=
Pconst_string (doc, str_loc, None)
; _ } as const )
; _ } as exp )
, [] )
; _ } as pstr ) ]
when Ast.Attr.is_doc attr ->
let normalize_code = normalize_code conf m in
let doc' = docstring conf ~normalize_code doc in
Ast_mapper.default_mapper.attribute m
{ attr with
attr_payload=
PStr
[ { pstr with
pstr_desc=
Pstr_eval
( { exp with
pexp_desc=
Pexp_constant
{ const with
pconst_desc=
Pconst_string (doc', str_loc, None) }
; pexp_loc_stack= [] }
, [] ) } ] }
| _ -> Ast_mapper.default_mapper.attribute m attr
in
let attributes (m : Ast_mapper.mapper) (atrs : attribute list) =
let atrs =
if ignore_doc_comments then
List.filter atrs ~f:(fun a -> not (Ast.Attr.is_doc a))
else atrs
in
Ast_mapper.default_mapper.attributes m (sort_attributes atrs)
in
let repl_phrase (m : Ast_mapper.mapper) {prepl_phrase; prepl_output} =
let p =
{prepl_phrase; prepl_output= Docstring.normalize_text prepl_output}
in
Ast_mapper.default_mapper.repl_phrase m p
in
let expr (m : Ast_mapper.mapper) exp =
let exp = {exp with pexp_loc_stack= []} in
let {pexp_desc; pexp_loc= loc1; pexp_attributes= attrs1; _} = exp in
match pexp_desc with
| Pexp_poly ({pexp_desc= Pexp_constraint (e, t); _}, None) ->
m.expr m {exp with pexp_desc= Pexp_poly (e, Some t)}
| Pexp_constraint (e, {ptyp_desc= Ptyp_poly ([], _t); _}) -> m.expr m e
| Pexp_sequence
( exp1
, { pexp_desc= Pexp_sequence (exp2, exp3)
; pexp_loc= loc2
; pexp_attributes= attrs2
; _ } ) ->
m.expr m
(Exp.sequence ~loc:loc1 ~attrs:attrs1
(Exp.sequence ~loc:loc2 ~attrs:attrs2 exp1 exp2)
exp3 )
| _ -> Ast_mapper.default_mapper.expr m exp
in
let typ (m : Ast_mapper.mapper) typ =
let typ = {typ with ptyp_loc_stack= []} in
Ast_mapper.default_mapper.typ m typ
in
{ Ast_mapper.default_mapper with
location
; attribute
; attributes
; repl_phrase
; expr
; typ }
let ast fragment ~ c =
map fragment (make_mapper c ~ignore_doc_comments)
let docstring conf =
let mapper = make_mapper conf ~ignore_doc_comments:false in
let normalize_code = normalize_code conf mapper in
docstring conf ~normalize_code
let diff_docstrings c x y =
let norm z =
let f Cmt.{txt; _} = docstring c txt in
Set.of_list (module String) (List.map ~f z)
in
Set.symmetric_diff (norm x) (norm y)
let diff_cmts (conf : Conf.t) x y =
let mapper = make_mapper conf ~ignore_doc_comments:false in
let normalize_code = normalize_code conf mapper in
let norm z =
let norm_non_code {Cmt.txt; _} = Docstring.normalize_text txt in
let f z =
match Cmt.txt z with
| "" | "$" -> norm_non_code z
| str ->
if Char.equal str.[0] '$' then
let chars_removed =
if Char.equal str.[String.length str - 1] '$' then 2 else 1
in
let len = String.length str - chars_removed in
let source = String.sub ~pos:1 ~len str in
normalize_code source
else norm_non_code z
in
Set.of_list (module String) (List.map ~f z)
in
Set.symmetric_diff (norm x) (norm y)
let equal fragment ~ c ast1 ast2 =
let map = ast fragment c ~ignore_doc_comments in
equal fragment (map ast1) (map ast2)