diff --git a/driver/main_args.ml b/driver/main_args.ml index fda12e98136..123f21ab47d 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -175,19 +175,17 @@ let mk_H f = " Add 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, ":: 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//cmi-cmx`, where `` is a library name\n\ - \ and `cmi-cmx` is a file where each line is of format ` `\n\ - \ telling compiler that for library is accessible\n\ - \ at . If is relative, then it is relative to a parent directory\n\ - \ of a `.libloc` directory.\n\ - \ and are comma-separated lists of libraries, to let\n\ - \ compiler know which libraries should be accessible via this `.libloc`\n\ - \ directory. Difference between and is the same as\n\ - \ the difference between -I and -H flags" +let mk_I_paths f = + "-I-paths", Arg.String f, " 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 ' ', which tells compiler that\n\ + \ can be found at relative to file given to -I-paths." + +let mk_H_paths f = + "-H-paths", Arg.String f, " 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, " Compile 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: :,,...:,,..." + 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]) diff --git a/driver/main_args.mli b/driver/main_args.mli index fbec1e65590..fa1abcac82d 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -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 diff --git a/utils/clflags.ml b/utils/clflags.ml index 686d9e90700..837151df70b 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -44,14 +44,6 @@ 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 @@ -59,8 +51,9 @@ 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 *) diff --git a/utils/clflags.mli b/utils/clflags.mli index 4db8649e7fe..120079f22c8 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -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 diff --git a/utils/load_path.ml b/utils/load_path.ml index fff46e5d5bc..142e7e924ff 100644 --- a/utils/load_path.ml +++ b/utils/load_path.ml @@ -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