Skip to content

Restructure and normalize Load_path #27

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

Open
shym wants to merge 3 commits into
base: trunk
Choose a base branch
from
Open

Restructure and normalize Load_path #27

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
3ccafaf
Add an internal `Load_path.Path_cache` module
shym Sep 21, 2026
ecf476c
Distinguish the internal and exported interfaces for `Load_path.Dir`
shym Sep 21, 2026
781d39c
Rename variable suffix `_uncap` into `_normalized`
shym Sep 23, 2026
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
179 changes: 114 additions & 65 deletions utils/load_path.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,18 +14,29 @@

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

let visible_files : registry ref = s_table STbl.create 42
let visible_files_uncap : registry ref = s_table STbl.create 42
val files : t -> string list
(** All the files in that directory. This doesn't include files in
sub-directories of this directory. *)

let hidden_files : registry ref = s_table STbl.create 42
let hidden_files_uncap : registry ref = s_table STbl.create 42
val create : hidden:bool -> string -> t

module Dir = struct
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_normalized : t -> string -> string option
(** As {!find}, but search also for normalized name (see
{!Misc.normalized_unit_filename}), i.e. if name is Foo.ml, either
/path/Foo.ml or /path/foo.ml may be returned. *)
end = struct
type t = {
path : string;
files : string list;
Expand Down Expand Up @@ -65,6 +76,88 @@ module Dir = struct
{ path; files = Array.to_list (readdir_compat path); hidden }
end

type visibility = Visible | Hidden

(** Store 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 intented 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. Assume the basename has been normalized if
[normalized] is true. *)
val find : normalized: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_normalized : registry ref = s_table STbl.create 42

let hidden_files : registry ref = s_table STbl.create 42
let hidden_files_normalized : registry ref = s_table STbl.create 42

let reset () =
STbl.clear !hidden_files;
STbl.clear !hidden_files_normalized;
STbl.clear !visible_files;
STbl.clear !visible_files_normalized

let prepend_add dir =
List.iter (fun base ->
Result.iter (fun filename ->
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_normalized filename fn
end else begin
STbl.replace !visible_files base fn;
STbl.replace !visible_files_normalized filename fn
end)
(Misc.normalized_unit_filename base)
) (Dir.files dir)

let add (dir : Dir.t) =
let update base fn visible_files hidden_files =
if Dir.hidden dir then begin
if not (STbl.mem !hidden_files base) then
STbl.replace !hidden_files base fn
end else if not (STbl.mem !visible_files base) then
STbl.replace !visible_files base fn
in
List.iter
(fun base ->
Result.iter (fun ubase ->
let fn = Filename.concat (Dir.path dir) base in
update base fn visible_files hidden_files;
update ubase fn visible_files_normalized hidden_files_normalized
)
(Misc.normalized_unit_filename base)
)
(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 ~normalized fn =
if normalized then find fn visible_files_normalized hidden_files_normalized
else find fn visible_files hidden_files
end

type auto_include_callback =
(Dir.t -> string -> string option) -> string -> string

Expand All @@ -75,10 +168,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,30 +189,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 ->
Result.iter (fun filename ->
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 filename fn
end else begin
STbl.replace !visible_files base fn;
STbl.replace !visible_files_uncap filename fn
end)
(Misc.normalized_unit_filename base)
) 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 @@ -135,8 +207,8 @@ 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;
auto_include_callback := saved_auto_include
end

Expand All @@ -145,24 +217,8 @@ let remove_dir dir =
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 then begin
if not (STbl.mem !hidden_files base) then
STbl.replace !hidden_files base fn
end else if not (STbl.mem !visible_files base) then
STbl.replace !visible_files base fn
in
List.iter
(fun base ->
Result.iter (fun ubase ->
let fn = Filename.concat dir.Dir.path base in
update base fn visible_files hidden_files;
update ubase fn visible_files_uncap hidden_files_uncap
)
(Misc.normalized_unit_filename base)
)
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 @@ -175,8 +231,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 @@ -205,17 +261,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 ~normalized:false fn)
else
Misc.find_in_path (get_path_list ()) fn
with Not_found ->
Expand All @@ -225,18 +275,17 @@ let find_normalized_with_visibility fn =
assert (not Config.merlin || Local_store.is_bound ());
match Misc.normalized_unit_filename fn with
| Error _ -> raise Not_found
| Ok fn_uncap ->
| Ok fn_normalized ->
try
if is_basename fn && not !Sys.interactive then
find_file_in_cache fn_uncap
visible_files_uncap hidden_files_uncap
Path_cache.find ~normalized:true fn_normalized
else
try
(Misc.find_in_path_normalized (get_visible_path_list ()) fn, Visible)
with
| Not_found ->
(Misc.find_in_path_normalized (get_hidden_path_list ()) fn, Hidden)
with Not_found ->
(!auto_include_callback Dir.find_normalized fn_uncap, Visible)
(!auto_include_callback Dir.find_normalized fn_normalized, Visible)

let find_normalized fn = fst (find_normalized_with_visibility fn)
16 changes: 3 additions & 13 deletions utils/load_path.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,23 +36,13 @@ module Dir : sig
(** Represent one directory in the load path. *)

val create : hidden:bool -> string -> t

val path : t -> string
(** [create ~hidden path] creates the representation for the directory at
[path]. When [hidden] is true, the modules in this directory should not be
bound in the initial scope. *)

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_normalized : 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
Loading