Add support for -H compiler flag

src/dune_rules/compilation_context.ml

@@ -3,36 +3,51 @@ open Import
 module Includes = struct
   type t = Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind.Map.t
 
-  let make ~project ~opaque ~requires : _ Lib_mode.Cm_kind.Map.t =
+  let make
+    ~project
+    ~opaque
+    ~direct_requires
+    ~(hidden_requires : Lib_flags.L.t Resolve.Memo.t)
+    : _ Lib_mode.Cm_kind.Map.t
+    =
     (* TODO : some of the requires can filtered out using [ocamldep] info *)
     let open Resolve.Memo.O in
-    let iflags libs mode = Lib_flags.L.include_flags ~project libs mode in
+    let iflags direct_libs hidden_libs mode =
+      Lib_flags.L.include_flags ~project direct_libs hidden_libs mode
+    in
     let make_includes_args ~mode groups =
       Command.Args.memo
         (Resolve.Memo.args
-           (let+ libs = requires in
+           (let+ direct_libs = direct_requires
+            and+ hidden_libs = hidden_requires in
             Command.Args.S
-              [ iflags libs mode; Hidden_deps (Lib_file_deps.deps libs ~groups) ]))
+              [ iflags direct_libs hidden_libs mode
+              ; Hidden_deps
+                  (Lib_file_deps.deps (List.concat [ direct_libs; hidden_libs ]) ~groups)
+              ]))
     in
     let cmi_includes = make_includes_args ~mode:(Ocaml Byte) [ Ocaml Cmi ] in
     let cmx_includes =
       Command.Args.memo
         (Resolve.Memo.args
-           (let+ libs = requires in
+           (let+ direct_libs = direct_requires
+            and+ hidden_libs = hidden_requires in
             Command.Args.S
-              [ iflags libs (Ocaml Native)
+              [ iflags direct_libs hidden_libs (Ocaml Native)
               ; Hidden_deps
                   (if opaque
                    then
-                     List.map libs ~f:(fun lib ->
-                       ( lib
-                       , if Lib.is_local lib
-                         then [ Lib_file_deps.Group.Ocaml Cmi ]
-                         else [ Ocaml Cmi; Ocaml Cmx ] ))
+                     List.map
+                       (List.concat [ direct_libs; hidden_libs ])
+                       ~f:(fun lib ->
+                         ( lib
+                         , if Lib.is_local lib
+                           then [ Lib_file_deps.Group.Ocaml Cmi ]
+                           else [ Ocaml Cmi; Ocaml Cmx ] ))
                      |> Lib_file_deps.deps_with_exts
                    else
                      Lib_file_deps.deps
-                       libs
+                       (List.concat [ direct_libs; hidden_libs ])
                        ~groups:[ Lib_file_deps.Group.Ocaml Cmi; Ocaml Cmx ])
               ]))
     in
@@ -74,6 +89,7 @@ type t =
   ; modules : modules
   ; flags : Ocaml_flags.t
   ; requires_compile : Lib.t list Resolve.Memo.t
+  ; requires_hidden : Lib.t list Resolve.Memo.t
   ; requires_link : Lib.t list Resolve.t Memo.Lazy.t
   ; includes : Includes.t
   ; preprocessing : Pp_spec.t
@@ -99,6 +115,7 @@ let obj_dir t = t.obj_dir
 let modules t = t.modules.modules
 let flags t = t.flags
 let requires_compile t = t.requires_compile
+let requires_hidden t = t.requires_hidden
 let requires_link t = Memo.Lazy.force t.requires_link
 let includes t = t.includes
 let preprocessing t = t.preprocessing
@@ -139,12 +156,26 @@ let create
   =
   let open Memo.O in
   let project = Scope.project scope in
-  let requires_compile =
+  let context = Super_context.context super_context in
+  let sandbox = Sandbox_config.no_special_requirements in
+  let* ocaml = Context.ocaml context in
+  let direct_requires, hidden_requires =
     if Dune_project.implicit_transitive_deps project
-    then Memo.Lazy.force requires_link
-    else requires_compile
+    then Memo.Lazy.force requires_link, Resolve.Memo.return []
+    else if Version.supports_hidden_includes ocaml.version
+            && Dune_project.dune_version project >= (3, 17)
+    then (
+      let requires_hidden =
+        let open Resolve.Memo.O in
+        let+ requires = requires_compile
+        and+ requires_link = Memo.Lazy.force requires_link in
+        let requires_table = Table.create (module Lib) 500 in
+        let () = List.iter ~f:(fun lib -> Table.set requires_table lib ()) requires in
+        List.filter requires_link ~f:(fun l -> not (Table.mem requires_table l))
+      in
+      requires_compile, requires_hidden)
+    else requires_compile, Resolve.Memo.return []
   in
-  let sandbox = Sandbox_config.no_special_requirements in
   let modes =
     let default =
       { Lib_mode.Map.ocaml = Mode.Dict.make_both (Some Mode_conf.Kind.Inherited)
@@ -153,8 +184,6 @@ let create
     in
     Option.value ~default modes |> Lib_mode.Map.map ~f:Option.is_some
   in
-  let context = Super_context.context super_context in
-  let* ocaml = Context.ocaml context in
   let opaque =
     let profile = Context.profile context in
     eval_opaque ocaml profile opaque
@@ -180,9 +209,10 @@ let create
   ; obj_dir
   ; modules = { modules; dep_graphs }
   ; flags
-  ; requires_compile
+  ; requires_compile = direct_requires
+  ; requires_hidden = hidden_requires
   ; requires_link
-  ; includes = Includes.make ~project ~opaque ~requires:requires_compile
+  ; includes = Includes.make ~project ~opaque ~direct_requires ~hidden_requires
   ; preprocessing
   ; opaque
   ; stdlib
@@ -263,8 +293,16 @@ let for_module_generated_at_link_time cctx ~requires ~module_ =
        their implementation must also be compiled with -opaque *)
     Ocaml.Version.supports_opaque_for_mli cctx.ocaml.version
   in
+  let direct_requires = requires in
+  let hidden_requires = Resolve.Memo.return [] in
   let modules = singleton_modules module_ in
-  let includes = Includes.make ~project:(Scope.project cctx.scope) ~opaque ~requires in
+  let includes =
+    Includes.make
+      ~project:(Scope.project cctx.scope)
+      ~opaque
+      ~direct_requires
+      ~hidden_requires
+  in
   { cctx with
     opaque
   ; flags = Ocaml_flags.empty

src/dune_rules/compilation_context.mli

@@ -55,6 +55,7 @@ val obj_dir : t -> Path.Build.t Obj_dir.t
 val modules : t -> Modules.With_vlib.t
 val flags : t -> Ocaml_flags.t
 val requires_link : t -> Lib.t list Resolve.Memo.t
+val requires_hidden : t -> Lib.t list Resolve.Memo.t
 val requires_compile : t -> Lib.t list Resolve.Memo.t
 val includes : t -> Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind.Map.t
 val preprocessing : t -> Pp_spec.t

src/dune_rules/lib_flags.ml

@@ -92,6 +92,13 @@ module L = struct
        |> List.rev)
   ;;
 
+  let to_hflags dirs =
+    Command.Args.S
+      (Path.Set.fold dirs ~init:[] ~f:(fun dir acc ->
+         Command.Args.Path dir :: A "-H" :: acc)
+       |> List.rev)
+  ;;
+
   let remove_stdlib dirs libs =
     match libs with
     | [] -> dirs
@@ -155,8 +162,16 @@ module L = struct
       remove_stdlib dirs ts
   ;;
 
-  let include_flags ?project ts mode =
-    to_iflags (include_paths ?project ts { lib_mode = mode; melange_emit = false })
+  let include_flags ?project ts_direct ts_hidden mode =
+    let hidden_includes =
+      to_hflags
+        (include_paths ?project ts_hidden { lib_mode = mode; melange_emit = false })
+    in
+    let direct_includes =
+      to_iflags
+        (include_paths ?project ts_direct { lib_mode = mode; melange_emit = false })
+    in
+    Command.Args.S [ direct_includes; hidden_includes ]
   ;;
 
   let melange_emission_include_flags ?project ts =

src/dune_rules/lib_flags.mli

@@ -24,7 +24,7 @@ module L : sig
 
   val to_iflags : Path.Set.t -> _ Command.Args.t
   val include_paths : ?project:Dune_project.t -> t -> Lib_mode.t -> Path.Set.t
-  val include_flags : ?project:Dune_project.t -> t -> Lib_mode.t -> _ Command.Args.t
+  val include_flags : ?project:Dune_project.t -> t -> t -> Lib_mode.t -> _ Command.Args.t
   val melange_emission_include_flags : ?project:Dune_project.t -> t -> _ Command.Args.t
   val c_include_flags : t -> Super_context.t -> _ Command.Args.t
   val toplevel_ld_paths : t -> Path.Set.t

src/dune_rules/merlin/ocaml_index.ml

@@ -32,11 +32,9 @@ let cctx_rules cctx =
 
            The implicit transitive libs correspond to the set:
            (requires_link \ req_compile) *)
-        let* req_link = Compilation_context.requires_link cctx in
-        let+ req_compile = Compilation_context.requires_compile cctx in
-        List.filter req_link ~f:(fun l -> not (List.exists req_compile ~f:(Lib.equal l)))
+        Compilation_context.requires_hidden cctx
       in
-      Lib_flags.L.include_flags non_compile_libs (Lib_mode.Ocaml Byte)
+      Lib_flags.L.include_flags [] non_compile_libs (Lib_mode.Ocaml Byte)
     in
     (* Indexing depends (recursively) on [required_compile] libs:
        - These libs's cmt files should be built before indexing starts

src/ocaml/version.ml

@@ -29,3 +29,4 @@ let supports_alerts version = version >= (4, 8, 0)
 let has_sandboxed_otherlibs version = version >= (5, 0, 0)
 let has_META_files version = version >= (5, 0, 0)
 let supports_bin_annot_occurrences version = version >= (5, 2, 0)
+let supports_hidden_includes version = version >= (5, 2, 0)

src/ocaml/version.mli

@@ -76,3 +76,6 @@ val has_META_files : t -> bool
 
 (** Whether the compiler supports occurrences indexation *)
 val supports_bin_annot_occurrences : t -> bool
+
+(** Whether the compiler supports the -H flag *)
+val supports_hidden_includes : t -> bool

test/blackbox-tests/test-cases/hidden-deps.t/bar.ml

@@ -0,0 +1,3 @@
+let x = 5
+
+let y = Foo.v

test/blackbox-tests/test-cases/hidden-deps.t/dune

@@ -0,0 +1,18 @@
+(library
+ (name foo)
+ (modules foo))
+
+(library
+ (name bar)
+ (modules bar)
+ (libraries foo))
+
+(executable
+ (name run)
+ (modules run)
+ (libraries bar))
+
+ (executable
+ (name runf)
+ (modules runf)
+ (libraries bar))

test/blackbox-tests/test-cases/hidden-deps.t/foo.ml

@@ -0,0 +1,3 @@
+let v = 9
+
+let w = 4

test/blackbox-tests/test-cases/hidden-deps.t/run.ml

@@ -0,0 +1 @@
+let _ = Bar.y

test/blackbox-tests/test-cases/hidden-deps.t/run.t

@@ -0,0 +1,36 @@
+Should include Foo with -H:
+
+  $ getincludes () {
+  > dune build --verbose ./run.exe 2>&1 | grep run.ml | grep -E -o "\-$1\s(.foo)\S*" | sed s/\-$1//g | tr -d '[:space:]'
+  > }
+
+  $ supports_H=$(if ocamlc -H x --help >/dev/null 2>&1; then echo true; else echo false; fi)
+  $ fooincludes='.foo.objs/byte.foo.objs/byte.foo.objs/native'
+  $ cat >dune-project <<EOF
+  > (lang dune 3.17)
+  > (implicit_transitive_deps true)
+  > EOF
+
+  $ if $supports_H; then [ "$(getincludes I)" = $fooincludes ]; fi
+  $ if ! $supports_H; then [ "$(getincludes I)" = $fooincludes ]; fi
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.17)
+  > (implicit_transitive_deps false)
+  > EOF
+
+  $ if $supports_H; then [ "$(getincludes H)" = $fooincludes ]; fi
+  $ if ! $supports_H; then [ "$(getincludes I)" = '' ]; fi
+
+
+Test transitive deps can not be directly accessed, both for compiler versions supporting -H or not:
+  $ cat >dune-project <<EOF
+  > (lang dune 3.17)
+  > (implicit_transitive_deps false)
+  > EOF
+
+  $ dune build ./runf.exe 2>&1 | grep -v ocamlc
+  File "runf.ml", line 1, characters 16-21:
+  1 | let a = Bar.y + Foo.v
+                      ^^^^^
+  Error: Unbound module Foo

test/blackbox-tests/test-cases/hidden-deps.t/runf.ml

@@ -0,0 +1 @@
+let a = Bar.y + Foo.v

test/blackbox-tests/test-cases/hidden-deps.t/tyxml/dune

@@ -0,0 +1,3 @@
+(executable
+  (name run)
+  (libraries tyxml))

test/blackbox-tests/test-cases/hidden-deps.t/tyxml/dune-project

@@ -0,0 +1,2 @@
+(lang dune 3.17)
+(implicit_transitive_deps false)

test/blackbox-tests/test-cases/hidden-deps.t/tyxml/run.ml

@@ -0,0 +1,2 @@
+open Tyxml.Html
+let _ = p [ a [ txt "a" ] ]

test/blackbox-tests/test-cases/hidden-deps.t/tyxml/run.t

@@ -0,0 +1,5 @@
+Test if the issue #274 is solved: the tyxml.functor is included with -H flag in
+ITD = false case, and thus no type abstraction happens when it is used.
+
+  $ ocamlc -H x --help > /dev/null
+  $ if [ $? = 0 ]; then dune build fi