New UNIT_NAME configuration directive

src/dot-merlin/dot_merlin_reader.ml

@@ -90,6 +90,10 @@ module Cache = File_cache.Make (struct
             recurse := true
           else if String.is_prefixed ~by:". " line then
             includes := String.trim (String.drop 2 line) :: !includes
+          else if String.is_prefixed ~by:"INDEX_FILE " line then
+            tell (`INDEX_FILE (String.drop 11 line))
+          else if String.is_prefixed ~by:"UNIT_NAME " line then
+            tell (`UNIT_NAME (String.drop 10 line))
           else if String.is_prefixed ~by:"STDLIB " line then
             tell (`STDLIB (String.drop 7 line))
           else if String.is_prefixed ~by:"FINDLIB " line then
@@ -306,6 +310,7 @@ type config = {
   to_canonicalize : (string * Merlin_dot_protocol.Directive.include_path) list;
   stdlib : string option;
   index_file : string option;
+  unit_name : string option;
   packages_to_load : string list;
   findlib : string option;
   findlib_path : string list;
@@ -317,6 +322,7 @@ let empty_config = {
   to_canonicalize   = [];
   stdlib            = None;
   index_file        = None;
+  unit_name         = None;
   packages_to_load  = [];
   findlib           = None;
   findlib_path      = [];
@@ -328,7 +334,7 @@ let prepend_config ~cwd ~cfg =
     match d with
     | `B _ | `S _ | `CMI _ | `CMT _  as directive ->
       { cfg with to_canonicalize = (cwd, directive) :: cfg.to_canonicalize }
-    | `EXT _ | `SUFFIX _ | `FLG _ | `READER _
+    | `EXT _ | `SUFFIX _ | `FLG _ | `READER _ | `UNIT_NAME _
     | (`EXCLUDE_QUERY_DIR | `USE_PPX_CACHE | `UNKNOWN_TAG _) as directive ->
       { cfg with pass_forward = directive :: cfg.pass_forward }
     | `PKG ps ->
@@ -343,12 +349,7 @@ let prepend_config ~cwd ~cfg =
       { cfg with stdlib = Some canon_path }
     | `INDEX_FILE path ->
       let canon_path = canonicalize_filename ~cwd path in
-      begin match cfg.index_file with
-      | None -> ()
-      | Some p ->
-        log ~title:"conflicting paths for index file" "%s\n%s" p canon_path
-      end;
-      { cfg with index_file = Some canon_path }
+      { cfg with pass_forward = `INDEX_FILE canon_path :: cfg.pass_forward }
     | `FINDLIB path ->
       let canon_path = canonicalize_filename ~cwd path in
       begin match cfg.stdlib with

src/dot-protocol/merlin_dot_protocol.ml

@@ -38,6 +38,7 @@ module Directive = struct
     | `FLG of string list
     | `STDLIB of string
     | `INDEX_FILE of string
+    | `UNIT_NAME of string
     | `SUFFIX of string
     | `READER of string list
     | `EXCLUDE_QUERY_DIR
@@ -87,6 +88,7 @@ module Sexp = struct
         | "CMT" -> `CMT value
         | "STDLIB" -> `STDLIB value
         | "INDEX_FILE" -> `INDEX_FILE value
+        | "UNIT_NAME" -> `UNIT_NAME value
         | "SUFFIX" -> `SUFFIX value
         | "ERROR" -> `ERROR_MSG value
         | "FLG" ->
@@ -120,6 +122,7 @@ module Sexp = struct
         | `FLG ss -> ("FLG", [ List (atoms_of_strings ss) ])
         | `STDLIB s -> ("STDLIB", single s)
         | `INDEX_FILE s -> ("INDEX_FILE", single s)
+        | `UNIT_NAME s -> ("UNIT_NAME", single s)
         | `SUFFIX s -> ("SUFFIX", single s)
         | `READER ss -> ("READER", [ List (atoms_of_strings ss) ])
         | `EXCLUDE_QUERY_DIR -> ("EXCLUDE_QUERY_DIR", [])

src/dot-protocol/merlin_dot_protocol.mli

@@ -50,6 +50,7 @@ module Directive : sig
     | `FLG of string list
     | `STDLIB of string
     | `INDEX_FILE of string
+    | `UNIT_NAME of string
     | `SUFFIX of string
     | `READER of string list
     | `EXCLUDE_QUERY_DIR

src/kernel/mconfig.ml

@@ -78,6 +78,7 @@ type merlin = {
   suffixes    : (string * string) list;
   stdlib      : string option;
   index_file  : string option;
+  unit_name   : string option;
   reader      : string list;
   protocol    : [`Json | `Sexp];
   log_file    : string option;
@@ -117,6 +118,7 @@ let dump_merlin x =
     );
     "stdlib"       , Json.option Json.string x.stdlib;
     "index_file"   , Json.option Json.string x.index_file;
+    "unit_name"    , Json.option Json.string x.unit_name;
     "reader"       , `List (List.map ~f:Json.string x.reader);
     "protocol"     , (match x.protocol with
         | `Json -> `String "json"
@@ -254,6 +256,7 @@ let get_external_config path t =
       suffixes = dot.suffixes @ merlin.suffixes;
       stdlib = (if dot.stdlib = None then merlin.stdlib else dot.stdlib);
       index_file = dot.index_file;
+      unit_name = dot.unit_name;
       reader =
         if dot.reader = []
         then merlin.reader
@@ -627,6 +630,7 @@ let initial = {
     suffixes    = [(".ml", ".mli"); (".re", ".rei")];
     stdlib      = None;
     index_file  = None;
+    unit_name   = None;
     reader      = [];
     protocol    = `Json;
     log_file    = None;
@@ -799,4 +803,7 @@ let global_modules ?(include_current=false) config = (
 
 let filename t = t.query.filename
 
-let unitname t = Misc.unitname t.query.filename
+let unitname t =
+  match t.merlin.unit_name with
+  | None -> Misc.unitname t.query.filename
+  | Some unit_name -> String.capitalize_ascii unit_name

src/kernel/mconfig.mli

@@ -36,6 +36,7 @@ type merlin = {
   suffixes    : (string * string) list;
   stdlib      : string option;
   index_file  : string option;
+  unit_name   : string option;
   reader      : string list;
   protocol    : [`Json | `Sexp];
   log_file    : string option;

src/kernel/mconfig_dot.ml

@@ -42,6 +42,7 @@ type config = {
   suffixes     : (string * string) list;
   stdlib       : string option;
   index_file   : string option;
+  unit_name    : string option;
   reader       : string list;
   exclude_query_dir : bool;
   use_ppx_cache : bool;
@@ -57,6 +58,7 @@ let empty_config = {
   flags        = [];
   stdlib       = None;
   index_file   = None;
+  unit_name    = None;
   reader       = [];
   exclude_query_dir = false;
   use_ppx_cache = false;
@@ -250,6 +252,8 @@ let prepend_config ~dir:cwd configurator (directives : directive list) config =
       {config with stdlib = Some path}, errors
     | `INDEX_FILE path ->
       {config with index_file = Some path}, errors
+    | `UNIT_NAME unit_name ->
+      {config with unit_name = Some unit_name}, errors
     | `READER reader ->
       {config with reader}, errors
     | `EXCLUDE_QUERY_DIR ->
@@ -279,6 +283,7 @@ let postprocess_config config =
     flags        = clean config.flags;
     stdlib       = config.stdlib;
     index_file   = config.index_file;
+    unit_name    = config.unit_name;
     reader       = config.reader;
     exclude_query_dir = config.exclude_query_dir;
     use_ppx_cache = config.use_ppx_cache;

src/kernel/mconfig_dot.mli

@@ -38,6 +38,7 @@ type config = {
   suffixes     : (string * string) list;
   stdlib       : string option;
   index_file   : string option;
+  unit_name    : string option;
   reader       : string list;
   exclude_query_dir : bool;
   use_ppx_cache : bool;

tests/test-dirs/config/dot-merlin-reader/quoting.t

@@ -52,6 +52,7 @@
     ],
     "stdlib": null,
     "index_file": null,
+    "unit_name": null,
     "reader": [],
     "protocol": "json",
     "log_file": null,