Skip to content

Refactor load_path.ml #2420

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Apr 22, 2024
Merged

Refactor load_path.ml #2420

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
74951f8
Refactor load_path.ml
Forestryks Mar 21, 2024
a151f0b
Typo
poechsel Apr 17, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
153 changes: 95 additions & 58 deletions ocaml/utils/load_path.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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

Expand All @@ -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
Expand All @@ -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 =
Expand All @@ -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
Expand All @@ -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]
Expand Down Expand Up @@ -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 ->
Expand All @@ -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)
Expand Down
13 changes: 0 additions & 13 deletions ocaml/utils/load_path.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down