gazagnaire.org
Find and remove dead code and unused APIs in OCaml projects
1(* File caching for efficient prune operations *)
2
3open Bos
4
5let src = Logs.Src.create "prune.cache" ~doc:"File caching"
6
7module Log = (val Logs.src_log src : Logs.LOG)
8
9(* Error helper functions *)
10let err fmt = Fmt.kstr (fun e -> Error (`Msg e)) fmt
11let err_file_not_cached file = err "File %s not found in cache" file
12
13let err_ast_parse_syntax file e =
14 err "Syntax error in %s: %s" file (Printexc.to_string e)
15
16let err_ast_parse_failed file e =
17 err "Failed to parse %s: %s" file (Printexc.to_string e)
18
19type diff_entry = { line_num : int; old_content : string; new_content : string }
20
21type ast_entry =
22 | Implementation of Parsetree.structure
23 | Interface of Parsetree.signature
24
25type file_entry = {
26 lines : string array;
27 mutable diffs : diff_entry list;
28 mutable ast : ast_entry option;
29}
30
31type t = {
32 files : (string, file_entry) Hashtbl.t;
33 mutable total_lines_removed : int;
34}
35
36(* Pretty printer for cache *)
37let pp fmt cache =
38 let file_count = Hashtbl.length cache.files in
39 let modified_count =
40 Hashtbl.fold
41 (fun _ entry count -> if entry.diffs <> [] then count + 1 else count)
42 cache.files 0
43 in
44 Fmt.pf fmt "<cache: %d files, %d modified, %d lines removed>" file_count
45 modified_count cache.total_lines_removed
46
47(* Create a new cache *)
48let v () = { files = Hashtbl.create 16; total_lines_removed = 0 }
49
50(* Clear all entries from cache *)
51let clear cache =
52 Hashtbl.clear cache.files;
53 cache.total_lines_removed <- 0
54
55(* Track a line change for diff logging *)
56let track_diff entry line_num old_content new_content =
57 if old_content <> new_content then
58 let new_diff = { line_num; old_content; new_content } in
59 entry.diffs <- new_diff :: entry.diffs
60
61let or_create cache file content =
62 let lines_list = String.split_on_char '\n' content in
63 let lines = Array.of_list lines_list in
64 let entry = { lines; diffs = []; ast = None } in
65 Hashtbl.replace cache.files file entry;
66 entry
67
68(* Load a file into cache if not already present *)
69let load cache file =
70 match Hashtbl.find_opt cache.files file with
71 | Some _ -> Ok ()
72 | None -> (
73 match OS.File.read (Fpath.v file) with
74 | Error (`Msg msg) -> Error (`Msg msg)
75 | Ok content ->
76 let (_ : file_entry) = or_create cache file content in
77 Ok ())
78
79(* Get a single line from cache *)
80let line cache file line_num =
81 match Hashtbl.find_opt cache.files file with
82 | None -> None
83 | Some entry ->
84 if line_num > 0 && line_num <= Array.length entry.lines then
85 Some entry.lines.(line_num - 1)
86 else None
87
88(* Replace a line in the cache *)
89let replace_line cache file line_num new_content =
90 match Hashtbl.find_opt cache.files file with
91 | None -> Log.warn (fun m -> m "replace_line: file %s not in cache" file)
92 | Some entry ->
93 if line_num > 0 && line_num <= Array.length entry.lines then (
94 let idx = line_num - 1 in
95 let old_content = entry.lines.(idx) in
96 Log.debug (fun m ->
97 m "replace_line %s:%d '%s' -> '%s'" file line_num old_content
98 new_content);
99 track_diff entry line_num old_content new_content;
100 (* Track lines removed *)
101 if old_content <> "" && new_content = "" then
102 cache.total_lines_removed <- cache.total_lines_removed + 1;
103 entry.lines.(idx) <- new_content;
104 (* Clear AST cache since file was modified *)
105 entry.ast <- None)
106 else
107 Log.warn (fun m ->
108 m "replace_line: line %d out of bounds for %s" line_num file)
109
110(* Clear a line (replace with empty string) *)
111let clear_line cache file line_num = replace_line cache file line_num ""
112
113(* Get the number of lines in a file *)
114let line_count cache file =
115 match Hashtbl.find_opt cache.files file with
116 | None -> None
117 | Some entry -> Some (Array.length entry.lines)
118
119(* Check if a file has any changes *)
120let has_changes cache file =
121 match Hashtbl.find_opt cache.files file with
122 | None -> false
123 | Some entry -> entry.diffs <> []
124
125(* Count the number of lines removed (cleared) across all files *)
126let count_lines_removed cache = cache.total_lines_removed
127
128(* Check if a file is effectively empty (only blank lines) *)
129let is_file_empty cache file =
130 match Hashtbl.find_opt cache.files file with
131 | None -> false
132 | Some entry ->
133 (* A file is empty if all lines are blank *)
134 Array.for_all (fun line -> String.trim line = "") entry.lines
135
136(* Get the full content of a file from cache *)
137let file_content cache file =
138 match Hashtbl.find_opt cache.files file with
139 | None -> None
140 | Some entry -> Some (String.concat "\n" (Array.to_list entry.lines))
141
142(* Parse AST from entry content *)
143let parse_ast_for_entry file entry =
144 let content = String.concat "\n" (Array.to_list entry.lines) in
145 let lexbuf = Lexing.from_string content in
146 Location.init lexbuf file;
147 try
148 if Filename.check_suffix file ".mli" then (
149 let ast = Parse.interface lexbuf in
150 entry.ast <- Some (Interface ast);
151 Ok ())
152 else
153 let ast = Parse.implementation lexbuf in
154 entry.ast <- Some (Implementation ast);
155 Ok ()
156 with
157 | Syntaxerr.Error _ as e -> err_ast_parse_syntax file e
158 | e -> err_ast_parse_failed file e
159
160(* Get AST from cache, parsing if necessary *)
161let ast cache file =
162 match Hashtbl.find_opt cache.files file with
163 | None -> err_file_not_cached file
164 | Some entry -> (
165 match entry.ast with
166 | Some ast -> Ok ast
167 | None -> (
168 match parse_ast_for_entry file entry with
169 | Ok () -> (
170 match entry.ast with
171 | Some ast -> Ok ast
172 | None -> err "Failed to cache AST for %s" file)
173 | Error e -> Error e))
174
175(* Log diffs for debugging *)
176let log_diffs file diffs =
177 Log.debug (fun m -> m "Found %d diffs for file %s" (List.length diffs) file);
178 List.iter
179 (fun diff ->
180 Log.debug (fun m ->
181 m " Line %d: '%s' -> '%s'" diff.line_num diff.old_content
182 diff.new_content))
183 (List.rev diffs)
184
185(* Write file content to disk *)
186let write_file_content file entry =
187 let result =
188 OS.File.with_output (Fpath.v file)
189 (fun oc () ->
190 (* Write all lines, preserving line numbers *)
191 Array.iteri
192 (fun i line ->
193 oc (Some (Bytes.of_string line, 0, String.length line));
194 if i < Array.length entry.lines - 1 then
195 oc (Some (Bytes.of_string "\n", 0, 1)))
196 entry.lines;
197 Ok ())
198 ()
199 in
200 match result with
201 | Ok (Ok ()) ->
202 Log.debug (fun m -> m "Successfully flushed file to disk: %s" file);
203 Ok ()
204 | Ok (Error (`Msg msg)) | Error (`Msg msg) ->
205 Log.err (fun m -> m "Failed to write file %s: %s" file msg);
206 Error (`Msg msg)
207
208(* Write file to disk *)
209let write cache file =
210 match Hashtbl.find_opt cache.files file with
211 | None -> err_file_not_cached file
212 | Some entry -> (
213 (* Fail hard if no diffs - this shouldn't happen *)
214 if entry.diffs = [] then
215 failwith
216 (Fmt.str
217 "BUG: Attempted to write file %s with no changes. This indicates \
218 a logic error in the removal process."
219 file);
220
221 (* Check if file exists before attempting to write *)
222 let file_path = Fpath.v file in
223 match OS.Path.exists file_path with
224 | Error (`Msg msg) -> err "Failed to check file existence: %s" msg
225 | Ok false -> err "File %s does not exist" file
226 | Ok true ->
227 Log.info (fun m -> m "Writing modified content to disk: %s" file);
228 log_diffs file entry.diffs;
229 (* Clear diffs after writing *)
230 entry.diffs <- [];
231 write_file_content file entry)