flambda-backend: Refactor load_path.ml (#2420)

* Refactor load_path.ml

* Typo

---------

Co-authored-by: Pierre Oechsel <[email protected]>

Author: Forestryks

utils/load_path.ml

@@ -14,18 +14,18 @@
 
 open Local_store
 
-module STbl = Misc.Stdlib.String.Tbl
+module Dir : sig
+  type t
 
-(* Mapping from basenames to full filenames *)
-type registry = string STbl.t
+  val path : t -> string
+  val files : t -> string list
+  val hidden : t -> bool
 
-let visible_files : registry ref = s_table STbl.create 42
-let visible_files_uncap : registry ref = s_table STbl.create 42
+  val create : hidden:bool -> string -> t
 
-let hidden_files : registry ref = s_table STbl.create 42
-let hidden_files_uncap : registry ref = s_table STbl.create 42
-
-module Dir = struct
+  val find : t -> string -> string option
+  val find_uncap : t -> string -> string option
+end = struct
   type t = {
     path : string;
     files : string list;
@@ -65,6 +65,81 @@ module Dir = struct
     { path; files = Array.to_list (readdir_compat path); hidden }
 end
 
+type visibility = Visible | Hidden
+
+(** Stores cached paths to files *)
+module Path_cache : sig
+  (* Clear cache *)
+  val reset : unit -> unit
+
+  (* Same as [add] below, but will replace existing entries.
+
+     [prepend_add] is faster than [add] and intended for use in [init] and [remove_dir]:
+     since we are starting from an empty cache, we can avoid checking whether a unit name
+     already exists in the cache simply by adding entries in reverse order. *)
+  val prepend_add : Dir.t -> unit
+
+  (* Add path to cache. If path with same basename is already in cache, skip adding. *)
+  val add : Dir.t -> unit
+
+  (* Search for a basename in cache. Ignore case if [uncap] is true *)
+  val find : uncap:bool -> string -> string * visibility
+end = struct
+  module STbl = Misc.Stdlib.String.Tbl
+
+  (* Mapping from basenames to full filenames *)
+  type registry = string STbl.t
+
+  let visible_files : registry ref = s_table STbl.create 42
+  let visible_files_uncap : registry ref = s_table STbl.create 42
+
+  let hidden_files : registry ref = s_table STbl.create 42
+  let hidden_files_uncap : registry ref = s_table STbl.create 42
+
+  let reset () =
+    STbl.clear !hidden_files;
+    STbl.clear !hidden_files_uncap;
+    STbl.clear !visible_files;
+    STbl.clear !visible_files_uncap
+
+  let prepend_add dir =
+    List.iter (fun base ->
+        let fn = Filename.concat (Dir.path dir) base in
+        if Dir.hidden dir then begin
+          STbl.replace !hidden_files base fn;
+          STbl.replace !hidden_files_uncap (String.uncapitalize_ascii base) fn
+        end else begin
+          STbl.replace !visible_files base fn;
+          STbl.replace !visible_files_uncap (String.uncapitalize_ascii base) fn
+        end
+      ) (Dir.files dir)
+
+  let add dir =
+    let update base fn visible_files hidden_files =
+      if (Dir.hidden dir) && not (STbl.mem !hidden_files base) then
+        STbl.replace !hidden_files base fn
+      else if not (STbl.mem !visible_files base) then
+        STbl.replace !visible_files base fn
+    in
+    List.iter
+      (fun base ->
+         let fn = Filename.concat (Dir.path dir) base in
+         update base fn visible_files hidden_files;
+         let ubase = String.uncapitalize_ascii base in
+         update ubase fn visible_files_uncap hidden_files_uncap)
+      (Dir.files dir)
+
+  let find fn visible_files hidden_files =
+    try (STbl.find !visible_files fn, Visible) with
+    | Not_found -> (STbl.find !hidden_files fn, Hidden)
+
+  let find ~uncap fn =
+    if uncap then
+      find (String.uncapitalize_ascii fn) visible_files_uncap hidden_files_uncap
+    else
+      find fn visible_files hidden_files
+end
+
 type auto_include_callback =
   (Dir.t -> string -> string option) -> string -> string
 
@@ -75,10 +150,7 @@ let auto_include_callback = ref no_auto_include
 
 let reset () =
   assert (not Config.merlin || Local_store.is_bound ());
-  STbl.clear !hidden_files;
-  STbl.clear !hidden_files_uncap;
-  STbl.clear !visible_files;
-  STbl.clear !visible_files_uncap;
+  Path_cache.reset ();
   hidden_dirs := [];
   visible_dirs := [];
   auto_include_callback := no_auto_include
@@ -99,28 +171,12 @@ let get_paths () =
 let get_visible_path_list () = List.rev_map Dir.path !visible_dirs
 let get_hidden_path_list () = List.rev_map Dir.path !hidden_dirs
 
-(* Optimized version of [add] below, for use in [init] and [remove_dir]: since
-   we are starting from an empty cache, we can avoid checking whether a unit
-   name already exists in the cache simply by adding entries in reverse
-   order. *)
-let prepend_add dir =
-  List.iter (fun base ->
-      let fn = Filename.concat dir.Dir.path base in
-      if dir.Dir.hidden then begin
-        STbl.replace !hidden_files base fn;
-        STbl.replace !hidden_files_uncap (String.uncapitalize_ascii base) fn
-      end else begin
-        STbl.replace !visible_files base fn;
-        STbl.replace !visible_files_uncap (String.uncapitalize_ascii base) fn
-      end
-    ) dir.Dir.files
-
 let init ~auto_include ~visible ~hidden =
   reset ();
   visible_dirs := List.rev_map (Dir.create ~hidden:false) visible;
   hidden_dirs := List.rev_map (Dir.create ~hidden:true) hidden;
-  List.iter prepend_add !hidden_dirs;
-  List.iter prepend_add !visible_dirs;
+  List.iter Path_cache.prepend_add !hidden_dirs;
+  List.iter Path_cache.prepend_add !visible_dirs;
   auto_include_callback := auto_include
 
 let remove_dir dir =
@@ -132,29 +188,17 @@ let remove_dir dir =
     reset ();
     visible_dirs := visible;
     hidden_dirs := hidden;
-    List.iter prepend_add hidden;
-    List.iter prepend_add visible
+    List.iter Path_cache.prepend_add hidden;
+    List.iter Path_cache.prepend_add visible
   end
 
 (* General purpose version of function to add a new entry to load path: We only
    add a basename to the cache if it is not already present, in order to enforce
    left-to-right precedence. *)
 let add (dir : Dir.t) =
   assert (not Config.merlin || Local_store.is_bound ());
-  let update base fn visible_files hidden_files =
-    if dir.hidden && not (STbl.mem !hidden_files base) then
-      STbl.replace !hidden_files base fn
-    else if not (STbl.mem !visible_files base) then
-      STbl.replace !visible_files base fn
-  in
-  List.iter
-    (fun base ->
-       let fn = Filename.concat dir.Dir.path base in
-       update base fn visible_files hidden_files;
-       let ubase = String.uncapitalize_ascii base in
-       update ubase fn visible_files_uncap hidden_files_uncap)
-    dir.files;
-  if dir.hidden then
+  Path_cache.add dir;
+  if (Dir.hidden dir) then
     hidden_dirs := dir :: !hidden_dirs
   else
     visible_dirs := dir :: !visible_dirs
@@ -167,8 +211,8 @@ let add_dir ~hidden dir = add (Dir.create ~hidden dir)
    unconditionally added. *)
 let prepend_dir (dir : Dir.t) =
   assert (not Config.merlin || Local_store.is_bound ());
-  prepend_add dir;
-  if dir.hidden then
+  Path_cache.prepend_add dir;
+  if (Dir.hidden dir) then
     hidden_dirs := !hidden_dirs @ [dir]
   else
     visible_dirs := !visible_dirs @ [dir]
@@ -197,17 +241,11 @@ let auto_include_otherlibs =
     List.map (fun lib -> (lib, read_lib lib)) ["dynlink"; "str"; "unix"] in
   auto_include_libs otherlibs
 
-type visibility = Visible | Hidden
-
-let find_file_in_cache fn visible_files hidden_files =
-  try (STbl.find !visible_files fn, Visible) with
-  | Not_found -> (STbl.find !hidden_files fn, Hidden)
-
 let find fn =
   assert (not Config.merlin || Local_store.is_bound ());
   try
     if is_basename fn && not !Sys.interactive then
-      fst (find_file_in_cache fn visible_files hidden_files)
+      fst (Path_cache.find ~uncap:false fn)
     else
       Misc.find_in_path (get_path_list ()) fn
   with Not_found ->
@@ -217,8 +255,7 @@ let find_uncap_with_visibility fn =
   assert (not Config.merlin || Local_store.is_bound ());
   try
     if is_basename fn && not !Sys.interactive then
-      find_file_in_cache (String.uncapitalize_ascii fn)
-        visible_files_uncap hidden_files_uncap
+      Path_cache.find ~uncap:true fn
     else
       try
         (Misc.find_in_path_uncap (get_visible_path_list ()) fn, Visible)

utils/load_path.mli

@@ -37,22 +37,9 @@ module Dir : sig
 
   val create : hidden:bool -> string -> t
 
-  val path : t -> string
-
   val files : t -> string list
   (** All the files in that directory. This doesn't include files in
       sub-directories of this directory. *)
-
-  val hidden : t -> bool
-  (** If the modules in this directory should not be bound in the initial
-      scope *)
-
-  val find : t -> string -> string option
-  (** [find dir fn] returns the full path to [fn] in [dir]. *)
-
-  val find_uncap : t -> string -> string option
-  (** As {!find}, but search also for uncapitalized name, i.e. if name is
-      Foo.ml, either /path/Foo.ml or /path/foo.ml may be returned. *)
 end
 
 type auto_include_callback =