Merge pull request #12550 from Sudha247/merlin_params_fix

fix(oxcaml): generate merlin config for library parameters

Author: rgrinberg

src/dune_rules/exe_rules.ml

@@ -309,6 +309,7 @@ let executables_rules
       ~dialects:(Dune_project.dialects (Scope.project scope))
       ~ident:(Merlin_ident.for_exes ~names:(Nonempty_list.map ~f:snd exes.names))
       ~modes:`Exe
+      ~parameters:(Resolve.return [])
   in
   cctx, merlin
 ;;

src/dune_rules/lib_rules.ml

@@ -622,7 +622,8 @@ let library_rules
     Sub_system.gen_rules
       { super_context = sctx; dir; stanza = lib; scope; source_modules; compile_info }
   and+ merlin =
-    let+ requires_hidden = Compilation_context.requires_hidden cctx in
+    let+ requires_hidden = Compilation_context.requires_hidden cctx
+    and+ parameters = Compilation_context.parameters cctx in
     let flags = Compilation_context.flags cctx in
     Merlin.make
       ~requires_compile
@@ -636,6 +637,7 @@ let library_rules
       ~dialects:(Dune_project.dialects (Scope.project scope))
       ~ident:(Merlin_ident.for_lib (Library.best_name lib))
       ~modes:(`Lib (Lib_info.modes lib_info))
+      ~parameters
   in
   merlin
 ;;

src/dune_rules/melange/melange_rules.ml

@@ -482,7 +482,8 @@ let setup_emit_cmj_rules
         ~obj_dir
         ~ident:merlin_ident
         ~dialects:(Dune_project.dialects (Scope.project scope))
-        ~modes:`Melange_emit )
+        ~modes:`Melange_emit
+        ~parameters:(Resolve.return []) )
   in
   let* () = Buildable_rules.gen_select_rules sctx compile_info ~dir in
   Buildable_rules.with_lib_deps ctx merlin_ident ~dir ~f

src/dune_rules/merlin/merlin.ml

@@ -61,6 +61,7 @@ module Processed = struct
     ; flags : string list
     ; extensions : string option Ml_kind.Dict.t list
     ; indexes : Path.t list
+    ; parameters : Module_name.t list
     }
 
   let dyn_of_config
@@ -73,6 +74,7 @@ module Processed = struct
         ; flags
         ; extensions
         ; indexes
+        ; parameters
         }
     =
     let open Dyn in
@@ -86,6 +88,7 @@ module Processed = struct
       ; "flags", list string flags
       ; "extensions", list (Ml_kind.Dict.to_dyn (Dyn.option string)) extensions
       ; "indexes", list Path.to_dyn indexes
+      ; "parameters", list Module_name.to_dyn parameters
       ]
   ;;
 
@@ -124,7 +127,7 @@ module Processed = struct
     type nonrec t = t
 
     let name = "merlin-conf"
-    let version = 7
+    let version = 8
     let to_dyn _ = Dyn.String "Use [dune ocaml dump-dot-merlin] instead"
 
     let test_example () =
@@ -138,6 +141,7 @@ module Processed = struct
           ; flags = [ "-x" ]
           ; extensions = [ { Ml_kind.Dict.intf = None; impl = Some "ext" } ]
           ; indexes = []
+          ; parameters = []
           }
       ; per_file_config = Path.Build.Map.empty
       ; pp_config =
@@ -191,6 +195,7 @@ module Processed = struct
         ; flags
         ; extensions
         ; indexes
+        ; parameters
         }
     =
     let make_directive tag value = Sexp.List [ Atom tag; value ] in
@@ -240,7 +245,20 @@ module Processed = struct
           in
           Some (make_directive "FLG" (Sexp.List open_flags))
       in
-      List.filter_opt [ base_flags; pp_flags; open_flags ]
+      let parameter_flags =
+        match parameters with
+        | [] -> None
+        | params ->
+          Some
+            (make_directive
+               "FLG"
+               (Sexp.List
+                  (List.concat_map
+                     ~f:(fun m ->
+                       [ Sexp.Atom "-parameter"; Sexp.Atom (Module_name.to_string m) ])
+                     params)))
+      in
+      List.filter_opt [ base_flags; pp_flags; open_flags; parameter_flags ]
     in
     let unit_name = [ make_directive "UNIT_NAME" (Sexp.Atom unit_name) ] in
     let suffixes =
@@ -297,6 +315,7 @@ module Processed = struct
         hidden_src_dirs
         extensions
         indexes
+        parameters
     =
     let b = Buffer.create 256 in
     let printf = Printf.bprintf b in
@@ -327,6 +346,14 @@ module Processed = struct
         print "# FLG";
         List.iter flags ~f:(fun f -> printf " %s" (quote_for_dot_merlin f));
         print "\n");
+    let () =
+      match parameters with
+      | [] -> ()
+      | params ->
+        print "# FLG";
+        List.iter params ~f:(fun f -> printf " -parameter %s" (Module_name.to_string f));
+        print "\n"
+    in
     Buffer.contents b
   ;;
 
@@ -428,6 +455,7 @@ module Processed = struct
                   ; flags
                   ; extensions
                   ; indexes
+                  ; parameters = _
                   }
               }
             ->
@@ -452,7 +480,8 @@ module Processed = struct
            hidden_obj_dirs
            hidden_src_dirs
            extensions
-           indexes)
+           indexes
+           init.config.parameters)
   ;;
 end
 
@@ -482,6 +511,7 @@ module Unprocessed = struct
     ; extensions : string option Ml_kind.Dict.t list
     ; readers : string list String.Map.t
     ; mode : Lib_mode.t
+    ; parameters : Module_name.t list Resolve.t
     }
 
   type t =
@@ -502,6 +532,7 @@ module Unprocessed = struct
         ~dialects
         ~ident
         ~modes
+        ~parameters
     =
     (* Merlin shouldn't cause the build to fail, so we just ignore errors *)
     let mode =
@@ -526,6 +557,7 @@ module Unprocessed = struct
       ; objs_dirs
       ; extensions
       ; readers
+      ; parameters
       }
     in
     { ident; config; modules }
@@ -654,6 +686,7 @@ module Unprocessed = struct
              ; preprocess = _
              ; libname = _
              ; mode
+             ; parameters
              }
          } as t)
         sctx
@@ -713,6 +746,7 @@ module Unprocessed = struct
         let requires_hidden = Resolve.peek requires_hidden |> Result.value ~default:[] in
         add_lib_dirs sctx mode requires_hidden
       in
+      let parameters = Resolve.peek parameters |> Result.value ~default:[] in
       let src_dirs =
         Path.Set.of_list_map ~f:Path.source more_src_dirs |> Path.Set.union deps_src_dirs
       in
@@ -727,6 +761,7 @@ module Unprocessed = struct
       ; flags
       ; extensions
       ; indexes
+      ; parameters
       }
     and+ pp_config = pp_config t (Super_context.context sctx) ~expander in
     let per_file_config =

src/dune_rules/merlin/merlin.mli

@@ -52,6 +52,10 @@ val make
   -> dialects:Dialect.DB.t
   -> ident:Merlin_ident.t
   -> modes:[ `Lib of Lib_mode.Map.Set.t | `Exe | `Melange_emit ]
+  -> parameters:Module_name.t list Resolve.t
+       (** The `parameters` argument takes the list of parameters from the
+       compilation context and stores it in the form of `["-parameter"; "P1";
+       "-parameter"; "P2"]` where P1 and P2 are the parameters. *)
   -> t
 
 val more_src_dirs : Dir_contents.t -> source_dirs:Path.Source.t list -> Path.Source.t list

test/blackbox-tests/test-cases/oxcaml/library-field-parameters.t

@@ -1,3 +1,7 @@
+Set up path masking
+
+  $ export BUILD_PATH_PREFIX_MAP="/OCAMLC_WHERE=$(ocamlc -where)":$BUILD_PATH_PREFIX_MAP
+
 Testing the `parameters` field in library stanzas.
 
   $ cat >> dune-project <<EOF
@@ -379,4 +383,14 @@ A library can have more parameters than its dependencies:
   > (library (name lib2) (parameters a b c) (libraries lib))
   > EOF
 
+  $ ocamlc_where="$(ocamlc -where)"
+  $ export BUILD_PATH_PREFIX_MAP="/OCAMLC_WHERE=$ocamlc_where:$BUILD_PATH_PREFIX_MAP"
+  $ melc_compiler="$(which melc)" &> /dev/null
+  $ export BUILD_PATH_PREFIX_MAP="/MELC_COMPILER=$melc_compiler:$BUILD_PATH_PREFIX_MAP"
   $ dune build
+  $ dune ocaml dump-dot-merlin lib2 | grep 'parameter'
+  # FLG -parameter A -parameter B -parameter C
+
+  $ dune ocaml merlin dump-config lib2 | grep 'parameter'
+   (FLG (-parameter A -parameter B -parameter C))
+   (FLG (-parameter A -parameter B -parameter C))

test/expect-tests/persistent_tests.ml

@@ -47,8 +47,8 @@ let%expect_test "persistent digests" =
     65e543aaf5ccc8148d50a1305aa3622b
     ---
 
-    merlin-conf version 7
-    a14a4700929a15bb2030e36f71e66d20
+    merlin-conf version 8
+    699a5c5c686662da218d0be3cb2f161c
     ---
 
     INCREMENTAL-DB version 6