From 770d371693e637d6e4ded1f07b9bc16c712f190e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Thu, 26 Nov 2020 16:14:37 +0100 Subject: [PATCH] .merlin: add a SUFFIX directive for each dialect with no preprocessing MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Jérôme Vouillon --- CHANGES.md | 4 ++++ src/dune_engine/dialect.ml | 2 ++ src/dune_engine/dialect.mli | 2 ++ src/dune_rules/exe_rules.ml | 3 ++- src/dune_rules/lib_rules.ml | 3 ++- src/dune_rules/merlin.ml | 43 +++++++++++++++++++++++++++++++------ src/dune_rules/merlin.mli | 1 + 7 files changed, 50 insertions(+), 8 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index e3af170f3c6..91eba8e40c6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -93,6 +93,10 @@ Unreleased - Add support for Coq's native compute compilation mode (@ejgallego, #3210) +- Add a SUFFIX directive in `.merlin` files for each dialect with no + preprocessing, to let merlin know of additional file extensions + (#3977, @vouillon) + 2.7.1 (2/09/2020) ----------------- diff --git a/src/dune_engine/dialect.ml b/src/dune_engine/dialect.ml index 24863cb0a24..3d93fe367db 100644 --- a/src/dune_engine/dialect.ml +++ b/src/dune_engine/dialect.ml @@ -186,6 +186,8 @@ module DB = struct (dialect, kind)) (String.Map.find by_extension extension) + let fold { by_name; _ } = String.Map.fold by_name + let to_dyn { by_name; _ } = String.Map.to_dyn to_dyn by_name let builtin = of_list [ ocaml; reason ] diff --git a/src/dune_engine/dialect.mli b/src/dune_engine/dialect.mli index fca3e1f1fb3..6f8895200e7 100644 --- a/src/dune_engine/dialect.mli +++ b/src/dune_engine/dialect.mli @@ -51,6 +51,8 @@ module DB : sig val find_by_extension : t -> string -> (dialect * Ml_kind.t) option + val fold : t -> init:'a -> f:(dialect -> 'a -> 'a) -> 'a + val to_dyn : t -> Dyn.t val builtin : t diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index b95e4a5d70d..2eee209f335 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -182,7 +182,8 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info ( cctx , Merlin.make () ~requires:requires_compile ~flags ~modules ~preprocess:(Preprocess.Per_module.single_preprocess preprocess) - ~obj_dir ) + ~obj_dir + ~dialects:(Dune_project.dialects (Scope.project scope)) ) let compile_info ~scope (exes : Dune_file.Executables.t) = let dune_version = Scope.project scope |> Dune_project.dune_version in diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index f41b5053809..7e0e6201306 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -422,7 +422,8 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents ( cctx , Merlin.make () ~requires:requires_compile ~flags ~modules ~preprocess:(Preprocess.Per_module.single_preprocess preprocess) - ~libname:(snd lib.name) ~obj_dir ) + ~libname:(snd lib.name) ~obj_dir + ~dialects:(Dune_project.dialects (Scope.project scope)) ) let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope : Compilation_context.t * Merlin.t = diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index ad365f6c759..e13681770f9 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -5,6 +5,14 @@ open Build.O open! No_io module SC = Super_context +module Extensions = Comparable.Make (struct + type t = string * string + + let compare = Tuple.T2.compare String.compare String.compare + + let to_dyn = Tuple.T2.to_dyn String.to_dyn String.to_dyn +end) + let warn_dropped_pp loc ~allow_approx_merlin ~reason = if not allow_approx_merlin then User_warning.emit ~loc @@ -73,11 +81,11 @@ let quote_for_merlin s = module Dot_file = struct let b = Buffer.create 256 - let printf = Printf.bprintf b + let printf f = Printf.bprintf b f let print = Buffer.add_string b - let to_string ~obj_dirs ~src_dirs ~flags ~pp ~remaindir = + let to_string ~obj_dirs ~src_dirs ~flags ~pp ~remaindir ~extensions = let serialize_path = Path.reach ~from:(Path.source remaindir) in Buffer.clear b; print "EXCLUDE_QUERY_DIR\n"; @@ -90,6 +98,8 @@ module Dot_file = struct print "FLG"; List.iter flags ~f:(fun f -> printf " %s" (quote_for_merlin f)); print "\n" ); + Extensions.Set.iter extensions ~f:(fun (impl, intf) -> + printf "SUFFIX %s %s\n" (quote_for_merlin impl) (quote_for_merlin intf)); Buffer.contents b end @@ -100,10 +110,12 @@ type t = ; libname : Lib_name.Local.t option ; source_dirs : Path.Source.Set.t ; objs_dirs : Path.Set.t + ; extensions : Extensions.Set.t } let make ?(requires = Ok []) ~flags ?(preprocess = Preprocess.No_preprocessing) - ?libname ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir () = + ?libname ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects + () = (* Merlin shouldn't cause the build to fail, so we just ignore errors *) let requires = match requires with @@ -122,12 +134,29 @@ let make ?(requires = Ok []) ~flags ?(preprocess = Preprocess.No_preprocessing) flags |> Ocaml_flags.common in + let extensions = + Dialect.DB.fold dialects ~init:Extensions.Set.empty ~f:(fun d s -> + let impl = Dialect.extension d Ml_kind.Impl in + let intf = Dialect.extension d Ml_kind.Intf in + if + (* Only include dialects with no preprocessing and skip default file + extensions *) + Dialect.preprocess d Ml_kind.Impl <> None + || Dialect.preprocess d Ml_kind.Intf <> None + || impl = Dialect.extension Dialect.ocaml Ml_kind.Impl + && intf = Dialect.extension Dialect.ocaml Ml_kind.Intf + then + s + else + Extensions.Set.add s (impl, intf)) + in { requires ; flags = Build.catch flags ~on_error:(fun _ -> []) ; preprocess ; libname ; source_dirs ; objs_dirs + ; extensions } let merlin_file_name = ".merlin" @@ -217,8 +246,8 @@ let lib_src_dirs ~sctx lib = Path.Set.map ~f:Path.drop_optional_build_context (Modules.source_dirs modules) -let dot_merlin sctx ~dir ~more_src_dirs ~expander ({ requires; flags; _ } as t) - = +let dot_merlin sctx ~dir ~more_src_dirs ~expander + ({ requires; flags; extensions; _ } as t) = Path.Build.drop_build_context dir |> Option.iter ~f:(fun remaindir -> let open Build.With_targets.O in @@ -256,7 +285,8 @@ let dot_merlin sctx ~dir ~more_src_dirs ~expander ({ requires; flags; _ } as t) Path.Set.union src_dirs (Path.Set.of_list_map ~f:Path.source more_src_dirs) in - Dot_file.to_string ~remaindir ~pp ~flags ~src_dirs ~obj_dirs) + Dot_file.to_string ~remaindir ~pp ~flags ~src_dirs ~obj_dirs + ~extensions) in SC.add_rule sctx ~dir ~mode:(Promote { lifetime = Until_clean; into = None; only = None }) @@ -275,6 +305,7 @@ let merge_two ~allow_approx_merlin a b = | None -> b.libname ) ; source_dirs = Path.Source.Set.union a.source_dirs b.source_dirs ; objs_dirs = Path.Set.union a.objs_dirs b.objs_dirs + ; extensions = Extensions.Set.union a.extensions b.extensions } let merge_all ~allow_approx_merlin = function diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index 9c6569a50e8..1036afb556f 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -14,6 +14,7 @@ val make : -> ?source_dirs:Path.Source.Set.t -> modules:Modules.t -> obj_dir:Path.Build.t Obj_dir.t + -> dialects:Dialect.DB.t -> unit -> t