gazagnaire.org
Find and remove dead code and unused APIs in OCaml projects
1(* Warning parsing and handling for prune *)
2
3module Log = (val Logs.src_log (Logs.Src.create "prune.warning") : Logs.LOG)
4
5(* Create regex patterns for warning location parsing *)
6let single_line_pattern =
7 Re.(
8 compile
9 (seq
10 [
11 bos;
12 str "File \"";
13 group (rep1 (compl [ char '"' ]));
14 str "\", line ";
15 group (rep1 digit);
16 str ", characters ";
17 group (rep1 digit);
18 str "-";
19 group (rep1 digit);
20 str ":";
21 ]))
22
23let multi_line_pattern =
24 Re.(
25 compile
26 (seq
27 [
28 bos;
29 str "File \"";
30 group (rep1 (compl [ char '"' ]));
31 str "\", lines ";
32 group (rep1 digit);
33 str "-";
34 group (rep1 digit);
35 str ", characters ";
36 group (rep1 digit);
37 str "-";
38 group (rep1 digit);
39 str ":";
40 ]))
41
42(* Parse single line warning format *)
43let parse_single_line line =
44 try
45 let groups = Re.exec ~pos:0 single_line_pattern line in
46 let file = Re.Group.get groups 1 in
47 let line = int_of_string (Re.Group.get groups 2) in
48 let start_col = int_of_string (Re.Group.get groups 3) in
49 let end_col = int_of_string (Re.Group.get groups 4) in
50 Some (Types.location file ~line ~start_col ~end_col)
51 with Not_found -> None
52
53(* Parse multi-line warning format *)
54let parse_multi_line line =
55 try
56 let groups = Re.exec ~pos:0 multi_line_pattern line in
57 let file = Re.Group.get groups 1 in
58 let start_line = int_of_string (Re.Group.get groups 2) in
59 let end_line = int_of_string (Re.Group.get groups 3) in
60 let start_col = int_of_string (Re.Group.get groups 4) in
61 let end_col = int_of_string (Re.Group.get groups 5) in
62 Some (Types.location file ~line:start_line ~start_col ~end_line ~end_col)
63 with Not_found -> None
64
65(* Parse warning 32/34 location from build output line *)
66let parse_warning_line line =
67 (* Examples: File "lib/prune.ml", line 15, characters 4-17: File
68 "lib/brui.mli", lines 5-6, characters 2-80: *)
69 let line = String.trim line in
70 match parse_single_line line with
71 | Some location -> Some location
72 | None -> parse_multi_line line
73
74(* Parse warning 32/33/34/69 symbol name and type from warning message *)
75(* Helper to create regex for standard unused pattern *)
76let unused_pattern prefix =
77 (* For warnings that end with a dot, capture everything up to the final dot *)
78 Re.(
79 seq
80 [
81 str prefix;
82 group (rep1 (alt [ alnum; char '_'; char '.'; char '\'' ]));
83 char '.';
84 ])
85
86(* Helper to create regex for unused field pattern *)
87let unused_field_pattern () =
88 Re.(
89 alt
90 [
91 (* Pattern for regular unused fields *)
92 seq
93 [
94 rep (compl [ char ':' ]);
95 (* Skip everything before colon *)
96 str ":";
97 space;
98 str "record field ";
99 group (rep1 (alt [ alnum; char '_' ]));
100 str " is never read";
101 ];
102 (* Pattern for mutable fields that are never mutated *)
103 seq
104 [
105 rep (compl [ char ':' ]);
106 (* Skip everything before colon *)
107 str ":";
108 space;
109 str "mutable record field ";
110 group (rep1 (alt [ alnum; char '_' ]));
111 str " is never mutated";
112 ];
113 ])
114
115(* Helper to create regex for warning name extraction *)
116let name_regex warning_num =
117 Re.compile
118 (match warning_num with
119 | "32" -> unused_pattern ": unused value "
120 | "33" -> unused_pattern ": unused open "
121 | "34" -> unused_pattern ": unused type "
122 | "37" -> unused_pattern ": unused constructor "
123 | "38" ->
124 Re.(
125 seq
126 [
127 str ": unused exception ";
128 group (rep1 (compl [ char '.' ]));
129 opt (char '.');
130 ])
131 | "69" -> unused_field_pattern ()
132 | _ -> failwith "Unexpected warning number")
133
134(* Helper to extract module name from qualified name *)
135let extract_module_name warning_num raw_name =
136 match warning_num with
137 | "33" ->
138 (* Extract the last component of a qualified module name *)
139 let parts = String.split_on_char '.' raw_name in
140 List.hd (List.rev parts)
141 | _ -> raw_name
142
143(* Helper to get warning type from number *)
144let type_of_number = function
145 | "32" -> Types.Unused_value
146 | "33" -> Types.Unused_open
147 | "34" -> Types.Unused_type
148 | "37" -> Types.Unused_constructor
149 | "38" -> Types.Unused_exception
150 | "69" -> Types.Unused_field
151 | n -> Fmt.failwith "Unexpected warning number: %s" n
152
153let parse_warning_name line =
154 (* Parse name and type from warning messages *)
155 (* First extract the warning number using Re DSL *)
156 let num_re =
157 Re.(
158 compile
159 (seq
160 [
161 alt [ str "Warning"; seq [ str "Error"; space; str "(warning" ] ];
162 space;
163 group
164 (alt
165 [ str "32"; str "33"; str "34"; str "37"; str "38"; str "69" ]);
166 (* Match optional space, bracket, or other characters after warning
167 number *)
168 rep (compl [ char ':' ]);
169 ]))
170 in
171
172 try
173 let num_groups = Re.exec num_re line in
174 let warning_num = Re.Group.get num_groups 1 in
175
176 (* Then extract the name based on warning type *)
177 let name_re = name_regex warning_num in
178 let name_groups = Re.exec name_re line in
179 (* For warning 69, we need to find which group has the field name *)
180 let raw_name =
181 if warning_num = "69" then
182 (* Try group 1 first (regular field), then group 2 (mutable field) *)
183 try Re.Group.get name_groups 1
184 with Not_found -> Re.Group.get name_groups 2
185 else Re.Group.get name_groups 1
186 in
187
188 (* Extract final name and warning type *)
189 let name = extract_module_name warning_num raw_name in
190 let warning_type =
191 if warning_num = "69" then
192 (* Check if it's "never mutated" vs "never read" *)
193 if Re.execp (Re.compile (Re.str "is never mutated")) line then
194 Types.Unnecessary_mutable
195 else Types.Unused_field
196 else type_of_number warning_num
197 in
198
199 Some (name, warning_type)
200 with Not_found -> None
201
202(* Create warning info from parsed components *)
203let v location name warning_type =
204 {
205 Types.location;
206 name;
207 warning_type;
208 location_precision = Types.precision_of_warning_type warning_type;
209 }
210
211(* Parse signature mismatch errors from build output *)
212(* Extract signature name from error line *)
213let extract_signature_name line =
214 let value_required_re =
215 Re.(
216 compile
217 (seq
218 [
219 str "The value ";
220 opt (char '"');
221 group (rep1 (compl [ space; char '"' ]));
222 opt (char '"');
223 str " is required but not provided";
224 ]))
225 in
226 try
227 let groups = Re.exec value_required_re line in
228 Some (Re.Group.get groups 1)
229 with Not_found -> None
230
231(* Find location in the next few lines *)
232let mli_location lines_to_check =
233 let rec search = function
234 | [] -> None
235 | loc_line :: more -> (
236 match parse_warning_line loc_line with
237 | Some location when String.ends_with ~suffix:".mli" location.file ->
238 Some location
239 | _ -> search more)
240 in
241 search lines_to_check
242
243(* Get next few lines to search for location *)
244let next_lines rest =
245 match rest with l1 :: l2 :: l3 :: _ -> [ l1; l2; l3 ] | lines -> lines
246
247(* Create pairs of (line, remaining_lines) *)
248let line_pairs lines =
249 let rec make_pairs = function
250 | [] -> []
251 | line :: rest -> (line, rest) :: make_pairs rest
252 in
253 make_pairs lines
254
255(* Process a single line for signature mismatch *)
256let process_signature_line line rest =
257 match extract_signature_name line with
258 | None -> []
259 | Some name -> (
260 let next_lines = next_lines rest in
261 match mli_location next_lines with
262 | Some location ->
263 let warning = v location name Types.Signature_mismatch in
264 [ warning ]
265 | None -> [])
266
267let parse_signature_mismatch_error lines =
268 (* Look for pattern: Error: The implementation "lib/base.ml" does not match
269 the interface "lib/base.ml": The value "missing_func" is required but not
270 provided File "lib/base.mli", line 2, characters 0-35: Expected
271 declaration *)
272 let rec find_error = function
273 | [] -> []
274 | (line, rest) :: remaining_pairs ->
275 let warnings = process_signature_line line rest in
276 warnings @ find_error remaining_pairs
277 in
278 find_error (line_pairs lines)
279
280(* Parse warnings using a simpler approach - scan for all warning messages
281 first, then match with locations *)
282let parse_all_from_lines lines =
283 let rec find_warnings acc lines_with_idx =
284 match lines_with_idx with
285 | [] -> List.rev acc
286 | (line, idx) :: rest -> (
287 (* Look for warning pattern in current line *)
288 match parse_warning_name line with
289 | Some (name, warning_type) -> (
290 Log.debug (fun m ->
291 m "Found warning '%s' type %s on line %d: %s" name
292 (Fmt.str "%a" Types.pp_warning_type warning_type)
293 idx line);
294 (* Found a warning, now search backwards for the corresponding
295 location *)
296 let rec find_location search_idx =
297 if search_idx < 0 then None
298 else
299 let search_line = List.nth lines search_idx in
300 match parse_warning_line search_line with
301 | Some location -> Some location
302 | None ->
303 if search_idx > 0 then find_location (search_idx - 1)
304 else None
305 in
306 match find_location (idx - 1) with
307 | Some location ->
308 let warning = v location name warning_type in
309 find_warnings (warning :: acc) rest
310 | None ->
311 Log.debug (fun m ->
312 m
313 "Warning %s (type %s) found at line %d but no location \
314 found before it"
315 name
316 (Fmt.str "%a" Types.pp_warning_type warning_type)
317 idx);
318 find_warnings acc rest)
319 | None -> find_warnings acc rest)
320 in
321 let indexed_lines = List.mapi (fun i line -> (line, i)) lines in
322 find_warnings [] indexed_lines
323
324(* Parse unbound record field errors from build output *)
325let parse_unbound_field_error lines =
326 (* Look for pattern: Error: Unbound record field address *)
327 let unbound_field_re =
328 Re.(
329 compile
330 (seq
331 [
332 str "Error: Unbound record field";
333 rep (alt [ space; char '\t' ]);
334 opt (char '"');
335 group
336 (seq
337 [
338 alt [ alpha; char '_' ];
339 rep (alt [ alnum; char '_'; char '\'' ]);
340 ]);
341 opt (char '"');
342 ]))
343 in
344 let rec find_error line_and_idx_pairs acc =
345 match line_and_idx_pairs with
346 | [] -> acc
347 | (line, idx) :: remaining_pairs -> (
348 try
349 let groups = Re.exec unbound_field_re line in
350 let field_name = Re.Group.get groups 1 in
351
352 (* Look backwards for the file location (it comes before the error) *)
353 let rec find_location i =
354 if i <= 0 then None
355 else
356 let prev_line = List.nth lines (i - 1) in
357 match parse_warning_line prev_line with
358 | Some location ->
359 let warning = v location field_name Types.Unbound_field in
360 Some warning
361 | None -> if i > 1 then find_location (i - 1) else None
362 in
363 match find_location idx with
364 | Some warning -> find_error remaining_pairs (warning :: acc)
365 | None -> find_error remaining_pairs acc
366 with Not_found -> find_error remaining_pairs acc)
367 in
368 (* Create pairs of (line, index) for easier processing *)
369 let indexed_lines = List.mapi (fun i line -> (line, i)) lines in
370 find_error indexed_lines []
371
372(* Parse all warning 32/33/34/69 messages and signature mismatches from build
373 output *)
374let parse output =
375 let lines = String.split_on_char '\n' output in
376 (* Parse all types of warnings/errors *)
377 let warnings = parse_all_from_lines lines in
378 let sig_mismatches = parse_signature_mismatch_error lines in
379 let unbound_fields = parse_unbound_field_error lines in
380
381 let all_warnings = warnings @ sig_mismatches @ unbound_fields in
382
383 (* Single summary log if we found anything *)
384 if all_warnings <> [] then (
385 Log.debug (fun m ->
386 m "Parsed %d warnings/errors from %d lines" (List.length all_warnings)
387 (List.length lines));
388 List.iter
389 (fun (w : Types.warning_info) ->
390 Log.debug (fun m ->
391 m " %a: %a %s" Types.pp_location w.location Types.pp_warning_type
392 w.warning_type w.name))
393 all_warnings)
394 else
395 Log.debug (fun m ->
396 m "No warnings found in %d lines of output" (List.length lines));
397 all_warnings