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 2 commits into
base: main
Choose a base branch
from
Open

Make visible and hidden libloc files separate #3974

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
5bfb37a
Test
Forestryks May 5, 2025
ee0f0ad
Change naming
Forestryks May 7, 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
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -165,19 +165,18 @@ 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).

"-I-paths", Arg.String f, "<file> Read list of paths that compiler can reference from\n\
\ a given file. This option is alternative to -I flag, but lists available files\n\
\ directly instead of adding the whole directory to the search path.\n\
\ Each line of <file> describes one file available to compiler and should be of\n\
\ format '<filename> <path>', which tells compiler that <filename> is available at\n\
\ <path>. If <path> is relative, then it is relative to a parent directory\n\
\ of <file>."
Comment on lines +174 to +175
Copy link
Contributor

Choose a reason for hiding this comment

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

This sentence is still confusing, it was confusing in the oridingal version too. Is it avoidable? It would be nice to match the logic of -I <dir>.


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

let mk_impl f =
"-impl", Arg.String f, "<file> Compile <file> as a .ml file"
Expand Down Expand Up @@ -911,7 +910,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
Expand Down Expand Up @@ -1207,7 +1207,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;
Expand Down Expand Up @@ -1318,7 +1319,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;
Expand Down Expand Up @@ -1436,7 +1438,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;
Expand Down Expand Up @@ -1579,7 +1582,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;
Expand Down Expand Up @@ -1687,7 +1691,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;
Expand Down Expand Up @@ -1840,18 +1845,8 @@ 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 _dletreclambda = set dump_letreclambda
Expand Down Expand Up @@ -2110,7 +2105,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])
Expand Down
3 changes: 2 additions & 1 deletion driver/main_args.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
11 changes: 2 additions & 9 deletions utils/clflags.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 *)
Expand Down
11 changes: 2 additions & 9 deletions utils/clflags.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
25 changes: 13 additions & 12 deletions utils/load_path.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 () ->
Expand All @@ -94,18 +94,17 @@ 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 create_from_path_list_file ~hidden ~path_list_file =
let files = read_path_list_file path_list_file in
let files = 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_list_file) path
else
path
in
Comment on lines 100 to 105
Copy link
Contributor

Choose a reason for hiding this comment

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

Consider moving this logic into read_path_list_file.

{ basename; path }) files in
{ path = libloc_lib_path; files; hidden }
{ path = path_list_file; files; hidden }
end

type visibility = Visible | Hidden
Expand Down Expand Up @@ -216,10 +215,12 @@ 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;
Comment on lines +218 to +223
Copy link
Contributor

Choose a reason for hiding this comment

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

This is not symmetric to the use of visible and hidden paramters, should include_paths_files and hidden_include_paths_files also be parameters?

List.iter Path_cache.prepend_add !hidden_dirs;
List.iter Path_cache.prepend_add !visible_dirs;
auto_include_callback := auto_include
Expand Down
Loading