Make visible and hidden libloc files separate

driver/main_args.ml

@@ -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 =
+  "-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])

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

utils/clflags.ml

@@ -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 *)

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

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