diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 536ee728ab99..f0f0dc424518 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -182,6 +182,7 @@ let executables_rules let lib_config = ocaml.lib_config in let stdlib_dir = lib_config.stdlib_dir in let* requires_compile = Compilation_context.requires_compile cctx in + let* requires_link = Compilation_context.requires_link cctx in let* dep_graphs = (* Building an archive for foreign stubs, we link the corresponding object files directly to improve perf. *) @@ -265,7 +266,8 @@ let executables_rules in ( cctx , Merlin.make - ~requires:requires_compile + ~requires_compile + ~requires_link ~stdlib_dir ~flags ~modules diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 82f729dd807b..5f75686f0e56 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -579,6 +579,7 @@ let library_rules let scope = Compilation_context.scope cctx in let* requires_compile = Compilation_context.requires_compile cctx in let ocaml = Compilation_context.ocaml cctx in + let* requires_link = Compilation_context.requires_link cctx in let stdlib_dir = ocaml.lib_config.stdlib_dir in let top_sorted_modules = let impl_only = Modules.With_vlib.impl_only modules in @@ -631,7 +632,8 @@ let library_rules in ( cctx , Merlin.make - ~requires:requires_compile + ~requires_compile + ~requires_link ~stdlib_dir ~flags ~modules diff --git a/src/dune_rules/melange/melange_rules.ml b/src/dune_rules/melange/melange_rules.ml index f3a456459a6b..19a93aed4d87 100644 --- a/src/dune_rules/melange/melange_rules.ml +++ b/src/dune_rules/melange/melange_rules.ml @@ -326,6 +326,7 @@ let setup_emit_cmj_rules in let* () = Module_compilation.build_all cctx in let* requires_compile = Compilation_context.requires_compile cctx in + let* requires_link = Compilation_context.requires_link cctx in let stdlib_dir = (Compilation_context.ocaml cctx).lib_config.stdlib_dir in let+ () = let emit_and_libs_deps = @@ -354,7 +355,8 @@ let setup_emit_cmj_rules in ( cctx , Merlin.make - ~requires:requires_compile + ~requires_compile + ~requires_link ~stdlib_dir ~flags ~modules diff --git a/src/dune_rules/merlin/merlin.ml b/src/dune_rules/merlin/merlin.ml index fa70393ae8ef..e0d074029958 100644 --- a/src/dune_rules/merlin/merlin.ml +++ b/src/dune_rules/merlin/merlin.ml @@ -50,16 +50,29 @@ module Processed = struct { stdlib_dir : Path.t option ; obj_dirs : Path.Set.t ; src_dirs : Path.Set.t + ; hidden_obj_dirs : Path.Set.t + ; hidden_src_dirs : Path.Set.t ; flags : string list ; extensions : string option Ml_kind.Dict.t list } - let dyn_of_config { stdlib_dir; obj_dirs; src_dirs; flags; extensions } = + let dyn_of_config + { stdlib_dir + ; obj_dirs + ; src_dirs + ; hidden_obj_dirs + ; hidden_src_dirs + ; flags + ; extensions + } + = let open Dyn in record [ "stdlib_dir", option Path.to_dyn stdlib_dir ; "obj_dirs", Path.Set.to_dyn obj_dirs ; "src_dirs", Path.Set.to_dyn src_dirs + ; "hidden_obj_dirs", Path.Set.to_dyn hidden_obj_dirs + ; "hidden_src_dirs", Path.Set.to_dyn hidden_src_dirs ; "flags", list string flags ; "extensions", list (Ml_kind.Dict.to_dyn (Dyn.option string)) extensions ] @@ -100,7 +113,7 @@ module Processed = struct type nonrec t = t let name = "merlin-conf" - let version = 4 + let version = 5 let to_dyn _ = Dyn.String "Use [dune ocaml dump-dot-merlin] instead" let test_example () = @@ -108,6 +121,8 @@ module Processed = struct { stdlib_dir = None ; obj_dirs = Path.Set.empty ; src_dirs = Path.Set.empty + ; hidden_obj_dirs = Path.Set.empty + ; hidden_src_dirs = Path.Set.empty ; flags = [ "-x" ] ; extensions = [ { Ml_kind.Dict.intf = None; impl = Some "ext" } ] } @@ -149,7 +164,19 @@ module Processed = struct | None, None -> None ;; - let to_sexp ~opens ~pp ~reader { stdlib_dir; obj_dirs; src_dirs; flags; extensions } = + let to_sexp + ~opens + ~pp + ~reader + { stdlib_dir + ; obj_dirs + ; src_dirs + ; hidden_obj_dirs + ; hidden_src_dirs + ; flags + ; extensions + } + = let make_directive tag value = Sexp.List [ Atom tag; value ] in let make_directive_of_path tag path = make_directive tag (Sexp.Atom (serialize_path path)) @@ -162,6 +189,12 @@ module Processed = struct let exclude_query_dir = [ Sexp.List [ Atom "EXCLUDE_QUERY_DIR" ] ] in let obj_dirs = Path.Set.to_list_map obj_dirs ~f:(make_directive_of_path "B") in let src_dirs = Path.Set.to_list_map src_dirs ~f:(make_directive_of_path "S") in + let hidden_obj_dirs = + Path.Set.to_list_map hidden_obj_dirs ~f:(make_directive_of_path "BH") + in + let hidden_src_dirs = + Path.Set.to_list_map hidden_src_dirs ~f:(make_directive_of_path "SH") + in let flags = let flags = match flags with @@ -199,7 +232,16 @@ module Processed = struct in Sexp.List (List.concat - [ stdlib_dir; exclude_query_dir; obj_dirs; src_dirs; flags; suffixes; reader ]) + [ stdlib_dir + ; exclude_query_dir + ; obj_dirs + ; src_dirs + ; hidden_obj_dirs + ; hidden_src_dirs + ; flags + ; suffixes + ; reader + ]) ;; let quote_for_dot_merlin s = @@ -215,7 +257,16 @@ module Processed = struct if String.need_quoting s then Filename.quote s else s ;; - let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions = + let to_dot_merlin + stdlib_dir + pp_configs + flags + obj_dirs + src_dirs + hidden_obj_dirs + hidden_src_dirs + extensions + = let b = Buffer.create 256 in let printf = Printf.bprintf b in let print = Buffer.add_string b in @@ -224,6 +275,8 @@ module Processed = struct printf "STDLIB %s\n" (serialize_path stdlib_dir)); Path.Set.iter obj_dirs ~f:(fun p -> printf "B %s\n" (serialize_path p)); Path.Set.iter src_dirs ~f:(fun p -> printf "S %s\n" (serialize_path p)); + Path.Set.iter hidden_obj_dirs ~f:(fun p -> printf "BH %s\n" (serialize_path p)); + Path.Set.iter hidden_src_dirs ~f:(fun p -> printf "SH %s\n" (serialize_path p)); List.iter extensions ~f:(fun x -> Option.iter (get_ext x) ~f:(fun (impl, intf) -> printf "SUFFIX %s" (Printf.sprintf "%s %s" impl intf))); @@ -295,7 +348,14 @@ module Processed = struct | Error msg -> Printf.eprintf "%s\n" msg | Ok [] -> Printf.eprintf "No merlin configuration found.\n" | Ok (init :: tl) -> - let pp_configs, obj_dirs, src_dirs, flags, extensions = + let ( pp_configs + , obj_dirs + , src_dirs + , hidden_obj_dirs + , hidden_src_dirs + , flags + , extensions ) + = (* We merge what is easy to merge and ignore the rest *) List.fold_left tl @@ -303,19 +363,37 @@ module Processed = struct ( [ init.pp_config ] , init.config.obj_dirs , init.config.src_dirs + , init.config.hidden_obj_dirs + , init.config.hidden_src_dirs , [ init.config.flags ] , init.config.extensions ) ~f: (fun - (acc_pp, acc_obj, acc_src, acc_flags, acc_ext) + ( acc_pp + , acc_obj + , acc_src + , acc_hidden_obj + , acc_hidden_src + , acc_flags + , acc_ext ) { per_file_config = _ ; pp_config - ; config = { stdlib_dir = _; obj_dirs; src_dirs; flags; extensions } + ; config = + { stdlib_dir = _ + ; obj_dirs + ; src_dirs + ; hidden_obj_dirs + ; hidden_src_dirs + ; flags + ; extensions + } } -> ( pp_config :: acc_pp , Path.Set.union acc_obj obj_dirs , Path.Set.union acc_src src_dirs + , Path.Set.union acc_hidden_obj hidden_obj_dirs + , Path.Set.union acc_hidden_src hidden_src_dirs , flags :: acc_flags , extensions @ acc_ext )) in @@ -327,6 +405,8 @@ module Processed = struct flags obj_dirs src_dirs + hidden_obj_dirs + hidden_src_dirs extensions) ;; end @@ -348,6 +428,7 @@ module Unprocessed = struct type config = { stdlib_dir : Path.t ; requires : Lib.Set.t + ; requires_hidden : Lib.Set.t ; flags : string list Action_builder.t ; preprocess : Preprocess.Without_instrumentation.t Preprocess.t Module_name.Per_item.t @@ -366,7 +447,8 @@ module Unprocessed = struct } let make - ~requires + ~requires_compile + ~requires_link ~stdlib_dir ~flags ~preprocess @@ -386,10 +468,19 @@ module Unprocessed = struct | `Lib (m : Lib_mode.Map.Set.t) -> Lib_mode.Map.Set.for_merlin m in let requires = - match Resolve.peek requires with + match Resolve.peek requires_compile with + | Ok l -> Lib.Set.of_list l + | Error () -> Lib.Set.empty + in + let requires_link = + match Resolve.peek requires_link with | Ok l -> Lib.Set.of_list l | Error () -> Lib.Set.empty in + let requires_hidden = + Lib.Set.filter requires_link ~f:(fun l -> + not (Lib.Set.exists requires ~f:(Lib.equal l))) + in let objs_dirs = Path.Set.singleton @@ obj_dir_of_lib `Private mode (Obj_dir.of_local obj_dir) in @@ -399,6 +490,7 @@ module Unprocessed = struct { stdlib_dir ; mode ; requires + ; requires_hidden ; flags ; preprocess ; libname @@ -515,6 +607,7 @@ module Unprocessed = struct ; objs_dirs ; source_dirs ; requires + ; requires_hidden ; preprocess = _ ; libname = _ ; mode @@ -539,9 +632,9 @@ module Unprocessed = struct | [] -> None | stdlib_dir :: _ -> Some stdlib_dir) in - let* requires = + let* requires, requires_hidden = match t.config.mode with - | Ocaml _ -> Action_builder.return requires + | Ocaml _ -> Action_builder.return (requires, requires_hidden) | Melange -> Action_builder.of_memo (let open Memo.O in @@ -560,8 +653,8 @@ module Unprocessed = struct | Ok libs -> libs | Error _ -> [] in - Lib.Set.union requires (Lib.Set.of_list libs) - | None -> Memo.return requires) + Lib.Set.union requires (Lib.Set.of_list libs), requires_hidden + | None -> Memo.return (requires, requires_hidden)) in let+ flags = flags and+ src_dirs, obj_dirs = @@ -579,11 +672,33 @@ module Unprocessed = struct obj_dir_of_lib `Public mode (Lib_info.obj_dir info) in Path.Set.add obj_dirs public_cmi_dir ))) + and+ hidden_src_dirs, hidden_obj_dirs = + Action_builder.of_memo + (let open Memo.O in + Memo.parallel_map (Lib.Set.to_list requires_hidden) ~f:(fun lib -> + let+ dirs = src_dirs sctx lib in + lib, dirs) + >>| List.fold_left + ~init:(Path.Set.empty, Path.Set.empty) + ~f:(fun (src_dirs, obj_dirs) (lib, more_src_dirs) -> + ( Path.Set.union src_dirs more_src_dirs + , let public_cmi_dir = + let info = Lib.info lib in + obj_dir_of_lib `Public mode (Lib_info.obj_dir info) + in + Path.Set.add obj_dirs public_cmi_dir ))) in let src_dirs = Path.Set.union src_dirs (Path.Set.of_list_map ~f:Path.source more_src_dirs) in - { Processed.stdlib_dir; src_dirs; obj_dirs; flags; extensions } + { Processed.stdlib_dir + ; src_dirs + ; obj_dirs + ; hidden_src_dirs + ; hidden_obj_dirs + ; flags + ; extensions + } and+ pp_config = pp_config t (Super_context.context sctx) ~expander in let per_file_config = (* And copy for each module the resulting pp flags *) diff --git a/src/dune_rules/merlin/merlin.mli b/src/dune_rules/merlin/merlin.mli index 57f92caa22c1..67592064e12b 100644 --- a/src/dune_rules/merlin/merlin.mli +++ b/src/dune_rules/merlin/merlin.mli @@ -41,7 +41,8 @@ module Processed : sig end val make - : requires:Lib.t list Resolve.t + : requires_compile:Lib.t list Resolve.t + -> requires_link:Lib.t list Resolve.t -> stdlib_dir:Path.t -> flags:Ocaml_flags.t -> preprocess:Preprocess.Without_instrumentation.t Preprocess.t Module_name.Per_item.t diff --git a/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/run.t b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/run.t index 63411a3e183d..986f83de60e1 100644 --- a/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/run.t @@ -3,7 +3,7 @@ $ dune build @check -FIXME: Merlin must be able to locate the definitions of values coming from an +Merlin must be able to locate the definitions of values coming from an implicit transitive dependency, even when `implicit-transitive-dependency` is set to `false`. They should be part of the source path returned by the configuration. @@ -18,6 +18,8 @@ main -> lib1 -> lib2 -> stdlib ?:B?:$TESTCASE_ROOT/_build/default/src/lib1/.lib1.objs/byte) ?:S?:$TESTCASE_ROOT/bin) ?:S?:$TESTCASE_ROOT/src/lib1) + ?:BH?:$TESTCASE_ROOT/_build/default/src/lib2/.lib2.objs/byte) + ?:SH?:$TESTCASE_ROOT/src/lib2) $ FILE=$PWD/src/lib1/lib1.ml $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | @@ -30,7 +32,5 @@ main -> lib1 -> lib2 -> stdlib $ FILE=$PWD/src/lib2/lib2.ml $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | > sed -E "s/[[:digit:]]+:/\?:/g" | tr '(' '\n' | grep -E ":[BS]H?\?" - ?:B?:/STDLIB) ?:B?:$TESTCASE_ROOT/_build/default/src/lib2/.lib2.objs/byte) - ?:S?:/STDLIB) ?:S?:$TESTCASE_ROOT/src/lib2) diff --git a/test/expect-tests/persistent_tests.ml b/test/expect-tests/persistent_tests.ml index 96263336a2a8..1b1870175c8c 100644 --- a/test/expect-tests/persistent_tests.ml +++ b/test/expect-tests/persistent_tests.ml @@ -43,8 +43,8 @@ let%expect_test "persistent digests" = 7e311b06ebde9ff1708e4c3a1d3f5633 --- - merlin-conf version 4 - 782b1c9ea57a40a427f80fa24ba6d853 + merlin-conf version 5 + f2295d0d81947acce46109ea3d1b4950 --- INCREMENTAL-DB version 5