Skip to content

Make visible and hidden libloc files separate #3974

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
wants to merge 6 commits into
base: main
Choose a base branch
from
+56 −65
Open

Make visible and hidden libloc files separate #3974

Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
5bfb37a
Test
Forestryks May 5, 2025
ee0f0ad
Change naming
Forestryks May 7, 2025
8d3c2f8
Merge branch 'main' into aodintsov-support-individual-libloc-files
Forestryks May 16, 2025
9ed1997
Fix >80 char lines
Forestryks May 16, 2025
c5aec09
Merge remote-tracking branch 'origin/main' into aodintsov-support-ind…
Forestryks May 29, 2025
0740795
Minor refactoring
Forestryks May 29, 2025
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
60 changes: 28 additions & 32 deletions driver/main_args.ml
View file
Original file line number Diff line number Diff line change
@@ -175,19 +175,17 @@ let mk_H f =
"<dir> Add <dir> to the list of \"hidden\" include directories\n\
\ (Like -I, but the program can not directly reference these dependencies)"

let mk_libloc f =
"-libloc", Arg.String f, "<dir>:<libs>:<hidden_libs> Add .libloc directory configuration.\n\
\ .libloc directory is alternative (to -I and -H flags) way of telling\n\
\ compiler where to find files. Each `.libloc` directory should have a\n\
\ structure of `.libloc/<lib>/cmi-cmx`, where `<lib>` is a library name\n\
\ and `cmi-cmx` is a file where each line is of format `<filename> <path>`\n\
\ telling compiler that <filename> for library <lib> is accessible\n\
\ at <path>. If <path> is relative, then it is relative to a parent directory\n\
\ of a `.libloc` directory.\n\
\ <libs> and <hidden_libs> are comma-separated lists of libraries, to let\n\
\ compiler know which libraries should be accessible via this `.libloc`\n\
\ directory. Difference between <libs> and <hidden_libs> is the same as\n\
\ the difference between -I and -H flags"
let mk_I_paths f =
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What is the motivation for the proposed format, in particular, do we have to separate basename and path? It'd be much simpler and more intuitvite to have each line of the input file as a single path. Then we could update the doc to something like this:

-I-paths
<file> Add each line of <file> to the list of paths that the compiler can reference.
Similar to -I, but specifies individual files instead of adding the whole directory.

-H-paths
<file> Same as -I-paths, but adds to the list of "hidden" paths (like -H).

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The motivation is that we want compiler to be able to find files both in a shared cache. Let's say we have the following file:

foo.mli /shared-cache/71b51a2ef8e6111ed5a0376ccdc6fcc2
bar.mli /shared-cache/04c4994b726bfffdc88b98319be94c35

If we pass that file as -I-paths, this will tell compiler that foo.mli and bar.mli are available at given paths in shared cache.

"-I-paths", Arg.String f, "<file> Read list of paths that compiler can\n\
\ reference from a given file. This option is alternative to -I flag,\n\
\ but specifies available files directly instead of adding the whole\n\
\ directory to the search path. Each line of files passed to -I-paths\n\
\ should be in format '<filename> <path>', which tells compiler that\n\
\ <filename> can be found at <path> relative to file given to -I-paths."

let mk_H_paths f =
"-H-paths", Arg.String f, "<file> Same as -I-paths, but adds given paths\n\
\ to the list of \"hidden\" files (see -H for more details)"

let mk_impl f =
"-impl", Arg.String f, "<file> Compile <file> as a .ml file"
@@ -925,7 +923,8 @@ module type Common_options = sig
val _alert : string -> unit
val _I : string -> unit
val _H : string -> unit
val _libloc : string -> unit
val _I_paths : string -> unit
val _H_paths : string -> unit
val _labels : unit -> unit
val _alias_deps : unit -> unit
val _no_alias_deps : unit -> unit
@@ -1223,7 +1222,8 @@ struct
mk_i F._i;
mk_I F._I;
mk_H F._H;
mk_libloc F._libloc;
mk_I_paths F._I_paths;
mk_H_paths F._H_paths;
mk_impl F._impl;
mk_instantiate_byt F._instantiate;
mk_intf F._intf;
@@ -1335,7 +1335,8 @@ struct
mk_alert F._alert;
mk_I F._I;
mk_H F._H;
mk_libloc F._libloc;
mk_I_paths F._I_paths;
mk_H_paths F._H_paths;
mk_init F._init;
mk_labels F._labels;
mk_alias_deps F._alias_deps;
@@ -1455,7 +1456,8 @@ struct
mk_i F._i;
mk_I F._I;
mk_H F._H;
mk_libloc F._libloc;
mk_I_paths F._I_paths;
mk_H_paths F._H_paths;
mk_impl F._impl;
mk_inline F._inline;
mk_inline_toplevel F._inline_toplevel;
@@ -1599,7 +1601,8 @@ module Make_opttop_options (F : Opttop_options) = struct
mk_compact F._compact;
mk_I F._I;
mk_H F._H;
mk_libloc F._libloc;
mk_I_paths F._I_paths;
mk_H_paths F._H_paths;
mk_init F._init;
mk_inline F._inline;
mk_inline_toplevel F._inline_toplevel;
@@ -1708,7 +1711,8 @@ struct
mk_alert F._alert;
mk_I F._I;
mk_H F._H;
mk_libloc F._libloc;
mk_I_paths F._I_paths;
mk_H_paths F._H_paths;
mk_impl F._impl;
mk_intf F._intf;
mk_intf_suffix F._intf_suffix;
@@ -1861,18 +1865,9 @@ module Default = struct
include Common
let _I dir = include_dirs := dir :: (!include_dirs)
let _H dir = hidden_include_dirs := dir :: (!hidden_include_dirs)
let _libloc s =
match String.split_on_char ':' s with
| [ path; libs; hidden_libs ] ->
let split libs =
match libs |> String.split_on_char ',' with
| [ "" ] -> []
| libs -> libs
in
let libs = split libs in
let hidden_libs = split hidden_libs in
libloc := { Libloc.path; libs; hidden_libs } :: !libloc
| _ -> Compenv.fatal "Incorrect -libloc format, expected: <path>:<lib1>,<lib2>,...:<hidden_lib1>,<hidden_lib2>,..."
let _I_paths file = include_paths_files := file :: !include_paths_files
let _H_paths file =
hidden_include_paths_files := file :: !hidden_include_paths_files
let _color = Misc.set_or_ignore color_reader.parse color
let _dlambda = set dump_lambda
let _dblambda = set dump_blambda
@@ -2140,7 +2135,8 @@ module Default = struct
Odoc_global.hidden_include_dirs :=
(s :: (!Odoc_global.hidden_include_dirs))
*) ()
let _libloc(_:string) = ()
let _I_paths(_:string) = ()
let _H_paths(_:string) = ()
let _impl (_:string) =
(* placeholder:
Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Impl_file s])
3 changes: 2 additions & 1 deletion driver/main_args.mli
View file
Original file line number Diff line number Diff line change
@@ -22,7 +22,8 @@ module type Common_options = sig
val _alert : string -> unit
val _I : string -> unit
val _H : string -> unit
val _libloc : string -> unit
val _I_paths : string -> unit
val _H_paths : string -> unit
val _labels : unit -> unit
val _alias_deps : unit -> unit
val _no_alias_deps : unit -> unit
11 changes: 2 additions & 9 deletions utils/clflags.ml
View file
Original file line number Diff line number Diff line change
@@ -44,23 +44,16 @@ and dllibs = ref ([] : string list) (* .so and -dllib -lxxx *)

let cmi_file = ref None

module Libloc = struct
type t = {
path: string;
libs: string list;
hidden_libs: string list
}
end

type profile_column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap | `Counters ]
type profile_granularity_level = File_level | Function_level | Block_level
type flambda_invariant_checks = No_checks | Light_checks | Heavy_checks

let compile_only = ref false (* -c *)
and output_name = ref (None : string option) (* -o *)
and include_dirs = ref ([] : string list) (* -I *)
and libloc = ref ([] : Libloc.t list) (* -libloc *)
and hidden_include_dirs = ref ([] : string list) (* -H *)
and include_paths_files = ref ([] : string list) (* -I-paths *)
and hidden_include_paths_files = ref ([] : string list) (* -H-paths *)
and no_std_include = ref false (* -nostdlib *)
and no_cwd = ref false (* -nocwd *)
and print_types = ref false (* -i *)
11 changes: 2 additions & 9 deletions utils/clflags.mli
View file
Original file line number Diff line number Diff line change
@@ -51,14 +51,6 @@ val set_int_arg :
val set_float_arg :
int option -> Float_arg_helper.parsed ref -> float -> float option -> unit

module Libloc : sig
type t = {
path: string;
libs: string list;
hidden_libs: string list
}
end

type profile_column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap | `Counters ]
type profile_granularity_level = File_level | Function_level | Block_level
type flambda_invariant_checks = No_checks | Light_checks | Heavy_checks
@@ -70,8 +62,9 @@ val cmi_file : string option ref
val compile_only : bool ref
val output_name : string option ref
val include_dirs : string list ref
val libloc : Libloc.t list ref
val hidden_include_dirs : string list ref
val include_paths_files : string list ref
val hidden_include_paths_files : string list ref
val no_std_include : bool ref
val no_cwd : bool ref
val print_types : bool ref
36 changes: 22 additions & 14 deletions utils/load_path.ml
View file
Original file line number Diff line number Diff line change
@@ -28,7 +28,7 @@ module Dir : sig
val hidden : t -> bool

val create : hidden:bool -> string -> t
val create_libloc : hidden:bool -> libloc:string -> string -> t
val create_from_path_list_file : hidden:bool -> path_list_file:string -> t

val find : t -> string -> string option
val find_normalized : t -> string -> string option
@@ -80,7 +80,7 @@ end = struct
|> List.map (fun basename -> { basename; path = Filename.concat path basename }) in
{ path; files; hidden }

let read_libloc_file path =
let read_path_list_file' path =
let ic = open_in path in
Misc.try_finally
(fun () ->
@@ -94,18 +94,20 @@ end = struct
loop [])
~always:(fun () -> close_in ic)

let create_libloc ~hidden ~libloc libname =
let libloc_lib_path = Filename.concat libloc libname in
let files = read_libloc_file (Filename.concat libloc_lib_path "cmi-cmx") in
let files = List.map (fun { basename; path } ->
let read_path_list_file path =
let files = read_path_list_file' path in
List.map (fun { basename; path } ->
let path = if Filename.is_relative path then
(* Paths are relative to parent directory of libloc directory *)
Filename.concat (Filename.dirname libloc) path
(* Paths are relative to parent directory of path list file *)
Filename.concat (Filename.dirname path) path
else
path
in
{ basename; path }) files in
{ path = libloc_lib_path; files; hidden }
{ basename; path }) files

let create_from_path_list_file ~hidden ~path_list_file =
let files = read_path_list_file path_list_file in
{ path = path_list_file; files; hidden }
end

type visibility = Visible | Hidden
@@ -216,10 +218,16 @@ 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 (fun (libloc : Clflags.Libloc.t) ->
visible_dirs := Misc.rev_map_end (fun lib -> Dir.create_libloc ~hidden:false ~libloc:libloc.path lib) libloc.libs !visible_dirs;
hidden_dirs := Misc.rev_map_end (fun lib -> Dir.create_libloc ~hidden:true ~libloc:libloc.path lib) libloc.hidden_libs !hidden_dirs
) !Clflags.libloc;
List.iter (fun path_list_file ->
visible_dirs :=
Dir.create_from_path_list_file ~hidden:false ~path_list_file ::
!visible_dirs;
) !Clflags.include_paths_files;
List.iter (fun path_list_file ->
hidden_dirs :=
Dir.create_from_path_list_file ~hidden:true ~path_list_file ::
!hidden_dirs;
) !Clflags.hidden_include_paths_files;
List.iter Path_cache.prepend_add !hidden_dirs;
List.iter Path_cache.prepend_add !visible_dirs;
auto_include_callback := auto_include