Add support for -H compiler flag

doc/changes/10644.md

@@ -0,0 +1,4 @@
+- Add support for the -H flag (introduced in OCaml compiler 5.2) in dune
+  (only supported for lang versions 3.17 and higher). This adaptation gives
+  the correct semantics for `(implicit_transitive_deps false)`.
+  (#10644, fixes #9333, ocsigen/tyxml#274, #2733, #4963, @MA0100)

src/dune_rules/compilation_context.ml

@@ -3,36 +3,45 @@ 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_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 +83,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 +109,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,10 +150,24 @@ 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* 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) 5 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 =
@@ -153,8 +178,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 +203,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 +287,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

@@ -85,13 +85,16 @@ let link_deps sctx t mode =
 module L = struct
   type nonrec t = Lib.t list
 
-  let to_iflags dirs =
+  let to_flags flag dirs =
     Command.Args.S
       (Path.Set.fold dirs ~init:[] ~f:(fun dir acc ->
-         Command.Args.Path dir :: A "-I" :: acc)
+         Command.Args.Path dir :: A flag :: acc)
        |> List.rev)
   ;;
 
+  let to_iflags dir = to_flags "-I" dir
+  let to_hflags dir = to_flags "-H" dir
+
   let remove_stdlib dirs libs =
     match libs with
     | [] -> dirs
@@ -155,8 +158,13 @@ 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 include_paths ts =
+      include_paths ?project ts { lib_mode = mode; melange_emit = false }
+    in
+    let hidden_includes = to_hflags (include_paths ts_hidden) in
+    let direct_includes = to_iflags (include_paths ts_direct) 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

@@ -24,19 +24,21 @@ let cctx_rules cctx =
     let obj_dir = Compilation_context.obj_dir cctx in
     let fn = index_path_in_obj_dir obj_dir in
     let additional_libs =
-      let open Resolve.Memo.O in
-      let+ non_compile_libs =
-        (* The indexer relies on the load_path of cmt files. When
-           [implicit_transitive_deps] is set to [false] some necessary paths will
-           be missing.These are passed to the indexer with the `-I` flag.
-
-           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)))
-      in
-      Lib_flags.L.include_flags non_compile_libs (Lib_mode.Ocaml Byte)
+      let scope = Compilation_context.scope cctx in
+      if Dune_project.dune_version (Scope.project scope) < (3, 17)
+      then
+        let open Resolve.Memo.O in
+        let+ non_compile_libs =
+          (* This is only needed for the case where OCaml < 5.2 or the dune language version
+             < 3.17, since in the latter cases those additional libs will be already included in the compilation
+             with -H flag.*)
+          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)))
+        in
+        Lib_flags.L.include_flags non_compile_libs [] (Lib_mode.Ocaml Byte)
+      else Resolve.Memo.return Command.Args.empty
     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