Backport of upstream -H implementation (ocaml-flambda#1849)

native_toplevel/opttopdirs.ml

@@ -34,7 +34,7 @@ let _ = Hashtbl.add directive_table "quit" (Directive_none dir_quit)
 
 let dir_directory s =
   let d = expand_directory Config.standard_library s in
-  let dir = Load_path.Dir.create d in
+  let dir = Load_path.Dir.create ~hidden:false d in
   Load_path.append_dir dir;
   toplevel_env :=
     Stdlib.String.Set.fold
@@ -62,7 +62,7 @@ let _ =
 let _ = Hashtbl.add directive_table "show_dirs"
   (Directive_none
      (fun () ->
-        List.iter print_endline (Load_path.get_paths ())
+        List.iter print_endline (Load_path.get_path_list ())
      ))
 
 (* To change the current directory *)

native_toplevel/opttoploop.ml

@@ -720,17 +720,22 @@ let set_paths () =
      but keep the directories that user code linked in with ocamlmktop
      may have added to load_path. *)
   let expand = Misc.expand_directory Config.standard_library in
-  let current_load_path = Load_path.get_paths () in
-  let load_path = List.concat [
+  let Load_path.{ visible; hidden } = Load_path.get_paths () in
+  let visible = List.concat [
       [ "" ];
       List.map expand (List.rev !Compenv.first_include_dirs);
       List.map expand (List.rev !Clflags.include_dirs);
       List.map expand (List.rev !Compenv.last_include_dirs);
-      current_load_path;
+      visible;
       [expand "+camlp4"];
     ]
   in
-  Load_path.init load_path ~auto_include:Compmisc.auto_include
+  let hidden = List.concat [
+      List.map expand (List.rev !Clflags.hidden_include_dirs);
+      hidden
+    ]
+  in
+  Load_path.init ~auto_include:Compmisc.auto_include ~visible ~hidden
 
 let initialize_toplevel_env () =
   toplevel_env := Compmisc.initial_env();

ocaml/.depend

@@ -1280,6 +1280,7 @@ typing/persistent_env.cmi : \
     typing/subst.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
+    utils/load_path.cmi \
     utils/lazy_backtrack.cmi \
     utils/import_info.cmi \
     utils/consistbl.cmi \
@@ -4543,6 +4544,7 @@ file_formats/cmt_format.cmi : \
     typing/typedtree.cmi \
     typing/shape.cmi \
     parsing/location.cmi \
+    utils/load_path.cmi \
     utils/import_info.cmi \
     typing/env.cmi \
     utils/compilation_unit.cmi \

ocaml/bytecomp/bytelink.ml

@@ -376,7 +376,7 @@ let link_bytecode ?final_name tolink exec_name standalone =
        if check_dlls then begin
          (* Initialize the DLL machinery *)
          Dll.init_compile !Clflags.no_std_include;
-         Dll.add_path (Load_path.get_paths ());
+         Dll.add_path (Load_path.get_path_list ());
          try Dll.open_dlls Dll.For_checking sharedobjs
          with Failure reason -> raise(Error(Cannot_open_dll reason))
        end;

ocaml/debugger/command_line.ml

@@ -262,7 +262,8 @@ let instr_dir ppf lexbuf =
   let new_directory = argument_list_eol argument lexbuf in
     if new_directory = [] then begin
       if yes_or_no "Reinitialize directory list" then begin
-        Load_path.init ~auto_include:Compmisc.auto_include !default_load_path;
+        Load_path.init ~auto_include:Compmisc.auto_include
+          ~visible:!default_load_path ~hidden:[];
         Envaux.reset_cache ~preserve_persistent_env:false;
         Hashtbl.clear Debugger_config.load_path_for;
         flush_buffer_list ()
@@ -278,7 +279,8 @@ let instr_dir ppf lexbuf =
           List.iter (function x -> add_path (expand_path x)) new_directory'
     end;
     let print_dirs ppf l = List.iter (function x -> fprintf ppf "@ %s" x) l in
-    fprintf ppf "@[<2>Directories: %a@]@." print_dirs (Load_path.get_paths ());
+    fprintf ppf "@[<2>Directories: %a@]@." print_dirs
+      (Load_path.get_path_list ());
     Hashtbl.iter
       (fun mdl dirs ->
          fprintf ppf "@[<2>Source directories for %s: %a@]@." mdl print_dirs

ocaml/debugger/loadprinter.ml

@@ -40,8 +40,8 @@ let rec loadfiles ppf name =
     Dynlink.loadfile filename;
     let d = Filename.dirname name in
     if d <> Filename.current_dir_name then begin
-      if not (List.mem d (Load_path.get_paths ())) then
-        Load_path.add_dir d;
+      if not (List.mem d (Load_path.get_path_list ())) then
+        Load_path.add_dir ~hidden:false d;
     end;
     fprintf ppf "File %s loaded@."
       (if d <> Filename.current_dir_name then

ocaml/debugger/main.ml

@@ -224,7 +224,8 @@ let main () =
     end;
     if !Parameters.version
     then printf "\tOCaml Debugger version %s@.@." Config.version;
-    Load_path.init ~auto_include:Compmisc.auto_include !default_load_path;
+    Load_path.init ~auto_include:Compmisc.auto_include
+      ~visible:!default_load_path ~hidden:[];
     Clflags.recursive_types := true;    (* Allow recursive types. *)
     toplevel_loop ();                   (* Toplevel. *)
     kill_program ();

ocaml/debugger/parameters.ml

@@ -31,7 +31,7 @@ let time = ref true
 let version = ref true
 
 let add_path dir =
-  Load_path.add_dir dir;
+  Load_path.add_dir ~hidden:false dir;
   Envaux.reset_cache ~preserve_persistent_env:false
 
 let add_path_for mdl dir =

ocaml/debugger/program_management.ml

@@ -128,8 +128,9 @@ let initialize_loading () =
   end;
   Symbols.clear_symbols ();
   Symbols.read_symbols Debugcom.main_frag !program_name;
-  let dirs = Load_path.get_paths () @ !Symbols.program_source_dirs in
-  Load_path.init ~auto_include:Compmisc.auto_include dirs;
+  let Load_path.{visible; hidden} = Load_path.get_paths () in
+  let visible = visible @ !Symbols.program_source_dirs in
+  Load_path.init ~auto_include:Compmisc.auto_include ~visible ~hidden;
   Envaux.reset_cache ~preserve_persistent_env:false;
   if !debug_loading then
     prerr_endline "Opening a socket...";

ocaml/debugger/source.ml

@@ -40,7 +40,7 @@ let source_of_module pos mdle =
         else
           acc)
       Debugger_config.load_path_for
-      (Load_path.get_paths ()) in
+      (Load_path.get_path_list ()) in
   let fname = pos.Lexing.pos_fname in
   if fname = "" then
     let innermost_module =

ocaml/driver/compmisc.ml

@@ -23,28 +23,36 @@ let auto_include find_in_dir fn =
 (* Initialize the search path.
    [dir] (default: the current directory)
    is always searched first  unless -nocwd is specified,
-   then the directories specified with the -I option (in command-line order),
-   then the standard library directory (unless the -nostdlib option is given).
+   then the directories specified with the -I option (in command line order),
+   then the standard library directory (unless the -nostdlib option is given),
+   then the directories specified with the -H option (in command line order).
  *)
 
 let init_path ?(auto_include=auto_include) ?(dir="") () =
-  let dirs =
+  let visible =
     if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs
     else
       !Clflags.include_dirs
   in
-  let dirs =
-    !Compenv.last_include_dirs @ dirs @ Config.flexdll_dirs @
-    !Compenv.first_include_dirs
+  let visible =
+    List.concat
+      [!Compenv.last_include_dirs;
+       visible;
+       Config.flexdll_dirs;
+       !Compenv.first_include_dirs]
   in
-  let exp_dirs =
-    List.map (Misc.expand_directory Config.standard_library) dirs
+  let visible =
+    List.map (Misc.expand_directory Config.standard_library) visible
   in
-  let dirs =
+  let visible =
     (if !Clflags.no_cwd then [] else [dir])
-    @ List.rev_append exp_dirs (Clflags.std_include_dir ())
+    @ List.rev_append visible (Clflags.std_include_dir ())
   in
-  Load_path.init ~auto_include dirs;
+  let hidden =
+    List.rev_map (Misc.expand_directory Config.standard_library)
+      !Clflags.hidden_include_dirs
+  in
+  Load_path.init ~auto_include ~visible ~hidden;
   Env.reset_cache ~preserve_persistent_env:false
 
 (* Return the initial environment in which compilation proceeds. *)

ocaml/driver/main_args.ml

@@ -153,6 +153,11 @@ let mk_i f =
 let mk_I f =
   "-I", Arg.String f, "<dir>  Add <dir> to the list of include directories"
 
+let mk_H f =
+  "-H", Arg.String 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_impl f =
   "-impl", Arg.String f, "<file>  Compile <file> as a .ml file"
 
@@ -849,6 +854,7 @@ module type Common_options = sig
   val _no_absname : unit -> unit
   val _alert : string -> unit
   val _I : string -> unit
+  val _H : string -> unit
   val _labels : unit -> unit
   val _alias_deps : unit -> unit
   val _no_alias_deps : unit -> unit
@@ -1136,6 +1142,7 @@ struct
     mk_stop_after ~native:false F._stop_after;
     mk_i F._i;
     mk_I F._I;
+    mk_H F._H;
     mk_impl F._impl;
     mk_intf F._intf;
     mk_intf_suffix F._intf_suffix;
@@ -1238,6 +1245,7 @@ struct
     mk_no_absname F._no_absname;
     mk_alert F._alert;
     mk_I F._I;
+    mk_H F._H;
     mk_init F._init;
     mk_labels F._labels;
     mk_alias_deps F._alias_deps;
@@ -1346,6 +1354,7 @@ struct
     mk_no_probes F._no_probes;
     mk_i F._i;
     mk_I F._I;
+    mk_H F._H;
     mk_impl F._impl;
     mk_inline F._inline;
     mk_inline_toplevel F._inline_toplevel;
@@ -1489,6 +1498,7 @@ module Make_opttop_options (F : Opttop_options) = struct
     mk_alert F._alert;
     mk_compact F._compact;
     mk_I F._I;
+    mk_H F._H;
     mk_init F._init;
     mk_inline F._inline;
     mk_inline_toplevel F._inline_toplevel;
@@ -1602,6 +1612,7 @@ struct
     mk_no_absname F._no_absname;
     mk_alert F._alert;
     mk_I F._I;
+    mk_H F._H;
     mk_impl F._impl;
     mk_intf F._intf;
     mk_intf_suffix F._intf_suffix;
@@ -1745,7 +1756,8 @@ module Default = struct
 
   module Core = struct
     include Common
-    let _I dir = include_dirs := (dir :: (!include_dirs))
+    let _I dir = include_dirs := dir :: (!include_dirs)
+    let _H dir = hidden_include_dirs := dir :: (!hidden_include_dirs)
     let _color = Misc.set_or_ignore color_reader.parse color
     let _dlambda = set dump_lambda
     let _dparsetree = set dump_parsetree
@@ -1994,6 +2006,11 @@ module Default = struct
       (* placeholder:
          Odoc_global.include_dirs := (s :: (!Odoc_global.include_dirs))
       *) ()
+    let _H(_:string) =
+      (* placeholder:
+         Odoc_global.hidden_include_dirs :=
+           (s :: (!Odoc_global.hidden_include_dirs))
+      *) ()
     let _impl (_:string) =
       (* placeholder:
          Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Impl_file s])

ocaml/driver/main_args.mli

@@ -21,6 +21,7 @@ module type Common_options = sig
   val _no_absname : unit -> unit
   val _alert : string -> unit
   val _I : string -> unit
+  val _H : string -> unit
   val _labels : unit -> unit
   val _alias_deps : unit -> unit
   val _no_alias_deps : unit -> unit

ocaml/driver/makedepend.ml

@@ -408,7 +408,8 @@ let process_file_as process_fun def source_file =
   load_path := [];
   let cwd = if !nocwd then [] else [Filename.current_dir_name] in
   List.iter add_to_load_path (
-      (!Compenv.last_include_dirs @
+      (!Clflags.hidden_include_dirs @
+       !Compenv.last_include_dirs @
        !Clflags.include_dirs @
        !Compenv.first_include_dirs @
        cwd
@@ -609,6 +610,8 @@ let run_main argv =
         " Dump the delayed dependency map for each map file";
       "-I", Arg.String (add_to_list Clflags.include_dirs),
         "<dir>  Add <dir> to the list of include directories";
+      "-H", Arg.String (add_to_list Clflags.hidden_include_dirs),
+        "<dir>  Add <dir> to the list of include directories";
       "-nocwd", Arg.Set nocwd,
         " Do not add current working directory to \
           the list of include directories";

ocaml/file_formats/cmt_format.ml

@@ -54,7 +54,7 @@ type cmt_infos = {
   cmt_args : string array;
   cmt_sourcefile : string option;
   cmt_builddir : string;
-  cmt_loadpath : string list;
+  cmt_loadpath : Load_path.paths;
   cmt_source_digest : Digest.t option;
   cmt_initial_env : Env.t;
   cmt_imports : Import_info.t array;

ocaml/file_formats/cmt_format.mli

@@ -57,7 +57,7 @@ type cmt_infos = {
   cmt_args : string array;
   cmt_sourcefile : string option;
   cmt_builddir : string;
-  cmt_loadpath : string list;
+  cmt_loadpath : Load_path.paths;
   cmt_source_digest : string option;
   cmt_initial_env : Env.t;
   cmt_imports : Import_info.t array;

ocaml/manual/src/cmds/ocamldep.etex

@@ -65,6 +65,12 @@ and no dependencies are generated. For programs that span multiple
 directories, it is recommended to pass "ocamldep" the same "-I" options
 that are passed to the compiler.
 
+\item["-H" \var{directory}]
+Behaves identically to "-I", except that the "-H" directories are searched
+last.  This flag is included to make it easier to invoke "ocamldep" with
+the same options as the compiler, where "-H" is used for transitive
+dependencies that the program should not directly mention.
+
 \item["-nocwd"]
 Do not add current working directory to the list of include directories.
 

ocaml/manual/src/cmds/ocamldoc.etex

@@ -207,6 +207,10 @@ They have the same meaning as for the "ocamlc" and "ocamlopt" commands.
 Add \var{directory} to the list of directories search for compiled
 interface files (".cmi" files).
 
+\item["-H" \var{directory}]
+Like "-I", but the "-H" directories are searched last and the program may
+not directly refer to the modules added to the search path this way.
+
 \item["-nolabels"]
 Ignore non-optional labels in types.
 

ocaml/manual/src/cmds/unified-options.etex

@@ -300,6 +300,16 @@ the toplevel is running with the "#directory" directive
 (section~\ref{s:toplevel-directives}).
 }%top
 
+\notop{%
+\item["-H" \var{directory}]
+Behaves identically to "-I", except that (a) programs may not directly refer to
+modules added to the search path this way, and (b) these directories are
+searched after any "-I" directories.  This makes it possible to provide the
+compiler with compiled interface and object code files for the current program's
+transitive dependencies (the dependencies of its dependencies) without allowing
+them to silently become direct dependencies.
+}%notop
+
 \top{%
 \item["-init" \var{file}]
 Load the given file instead of the default initialization file.

ocaml/ocamldoc/odoc_args.ml

@@ -187,6 +187,7 @@ let anonymous f =
 module Options = Main_args.Make_ocamldoc_options(struct
     include Main_args.Default.Odoc_args
     let _I s = Odoc_global.include_dirs := s :: !Odoc_global.include_dirs
+    let _H s = Odoc_global.hidden_include_dirs := s :: !Odoc_global.hidden_include_dirs
     let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s]
     let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s]
 end)

ocaml/ocamldoc/odoc_global.ml

@@ -24,6 +24,7 @@ type source_file =
   | Text_file of string
 
 let include_dirs = Clflags.include_dirs
+let hidden_include_dirs = Clflags.hidden_include_dirs
 
 let errors = ref 0
 

ocaml/ocamldoc/odoc_global.mli

@@ -24,6 +24,9 @@ type source_file =
 (** The include_dirs in the OCaml compiler. *)
 val include_dirs : string list ref
 
+(** The hidden_include_dirs in the OCaml compiler. *)
+val hidden_include_dirs : string list ref
+
 (** The merge options to be used. *)
 val merge_options : Odoc_types.merge_option list ref
 

ocaml/ocamldoc/odoc_info.ml

@@ -111,13 +111,15 @@ module Module = Odoc_module
 let analyse_files
     ?(merge_options=([] : Odoc_types.merge_option list))
     ?(include_dirs=([] : string list))
+    ?(hidden_include_dirs=([] : string list))
     ?(labels=false)
     ?(sort_modules=false)
     ?(no_stop=false)
     ?(init=[])
     files =
   Odoc_global.merge_options := merge_options;
   Odoc_global.include_dirs := include_dirs;
+  Odoc_global.hidden_include_dirs := hidden_include_dirs;
   Odoc_global.classic := not labels;
   Odoc_global.sort_modules := sort_modules;
   Odoc_global.no_stop := no_stop;