diff --git a/CHANGES.md b/CHANGES.md index 2ab336785..957bb63e0 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,10 @@ +unreleased +========== + + + merlin binary + - A new `WRAPPING_PREFIX` configuration directive that can be used to tell Merlin + what to append to the current unit name in the presence of wrapping (#1788) + merlin 5.1 ========== Tue Jun 18 12:00:42 CEST 2024 diff --git a/src/dot-merlin/dot_merlin_reader.ml b/src/dot-merlin/dot_merlin_reader.ml index 791d778a6..4dfb0d2f6 100644 --- a/src/dot-merlin/dot_merlin_reader.ml +++ b/src/dot-merlin/dot_merlin_reader.ml @@ -102,6 +102,8 @@ module Cache = File_cache.Make (struct tell (`SOURCE_ROOT (String.drop 12 line)) else if String.is_prefixed ~by:"UNIT_NAME " line then tell (`UNIT_NAME (String.drop 10 line)) + else if String.is_prefixed ~by:"WRAPPING_PREFIX " line then + tell (`WRAPPING_PREFIX (String.drop 16 line)) else if String.is_prefixed ~by:"FINDLIB " line then tell (`FINDLIB (String.drop 8 line)) else if String.is_prefixed ~by:"SUFFIX " line then @@ -316,7 +318,6 @@ type config = { to_canonicalize : (string * Merlin_dot_protocol.Directive.include_path) list; stdlib : string option; source_root : string option; - unit_name : string option; packages_to_load : string list; findlib : string option; findlib_path : string list; @@ -328,7 +329,6 @@ let empty_config = { to_canonicalize = []; stdlib = None; source_root = None; - unit_name = None; packages_to_load = []; findlib = None; findlib_path = []; @@ -341,7 +341,11 @@ let prepend_config ~cwd ~cfg = | `B _ | `S _ | `BH _ | `SH _ | `CMI _ | `CMT _ | `INDEX _ as directive -> { cfg with to_canonicalize = (cwd, directive) :: cfg.to_canonicalize } | `EXT _ | `SUFFIX _ | `FLG _ | `READER _ - | (`EXCLUDE_QUERY_DIR | `USE_PPX_CACHE | `UNKNOWN_TAG _) as directive -> + | (`EXCLUDE_QUERY_DIR + | `USE_PPX_CACHE + | `UNIT_NAME _ + | `WRAPPING_PREFIX _ + | `UNKNOWN_TAG _) as directive -> { cfg with pass_forward = directive :: cfg.pass_forward } | `PKG ps -> { cfg with packages_to_load = ps @ cfg.packages_to_load } @@ -356,8 +360,6 @@ let prepend_config ~cwd ~cfg = | `SOURCE_ROOT path -> let canon_path = canonicalize_filename ~cwd path in { cfg with source_root = Some canon_path } - | `UNIT_NAME name -> - { cfg with unit_name = Some name } | `FINDLIB path -> let canon_path = canonicalize_filename ~cwd path in begin match cfg.stdlib with diff --git a/src/dot-protocol/merlin_dot_protocol.ml b/src/dot-protocol/merlin_dot_protocol.ml index c9d80f6e9..9953e5290 100644 --- a/src/dot-protocol/merlin_dot_protocol.ml +++ b/src/dot-protocol/merlin_dot_protocol.ml @@ -45,6 +45,7 @@ module Directive = struct | `STDLIB of string | `SOURCE_ROOT of string | `UNIT_NAME of string + | `WRAPPING_PREFIX of string | `SUFFIX of string | `READER of string list | `EXCLUDE_QUERY_DIR @@ -98,6 +99,7 @@ module Sexp = struct | "STDLIB" -> `STDLIB value | "SOURCE_ROOT" -> `SOURCE_ROOT value | "UNIT_NAME" -> `UNIT_NAME value + | "WRAPPING_PREFIX" -> `WRAPPING_PREFIX value | "SUFFIX" -> `SUFFIX value | "ERROR" -> `ERROR_MSG value | "FLG" -> @@ -132,6 +134,7 @@ module Sexp = struct | `INDEX s -> ("INDEX", single s) | `SOURCE_ROOT s -> ("SOURCE_ROOT", single s) | `UNIT_NAME s -> ("UNIT_NAME", single s) + | `WRAPPING_PREFIX s -> ("WRAPPING_PREFIX", single s) | `EXT ss -> ("EXT", [ List (atoms_of_strings ss) ]) | `FLG ss -> ("FLG", [ List (atoms_of_strings ss) ]) | `STDLIB s -> ("STDLIB", single s) diff --git a/src/dot-protocol/merlin_dot_protocol.mli b/src/dot-protocol/merlin_dot_protocol.mli index 3557a538f..e949e3648 100644 --- a/src/dot-protocol/merlin_dot_protocol.mli +++ b/src/dot-protocol/merlin_dot_protocol.mli @@ -57,6 +57,7 @@ module Directive : sig | `STDLIB of string | `SOURCE_ROOT of string | `UNIT_NAME of string + | `WRAPPING_PREFIX of string | `SUFFIX of string | `READER of string list | `EXCLUDE_QUERY_DIR diff --git a/src/kernel/mconfig.ml b/src/kernel/mconfig.ml index 695c5fe9a..55875fa6b 100644 --- a/src/kernel/mconfig.ml +++ b/src/kernel/mconfig.ml @@ -82,6 +82,7 @@ type merlin = { stdlib : string option; source_root : string option; unit_name : string option; + wrapping_prefix : string option; reader : string list; protocol : [`Json | `Sexp]; log_file : string option; @@ -125,6 +126,7 @@ let dump_merlin x = "stdlib" , Json.option Json.string x.stdlib; "source_root" , Json.option Json.string x.source_root; "unit_name" , Json.option Json.string x.unit_name; + "wrapping_prefix" , Json.option Json.string x.wrapping_prefix; "reader" , `List (List.map ~f:Json.string x.reader); "protocol" , (match x.protocol with | `Json -> `String "json" @@ -260,6 +262,10 @@ let merge_merlin_config dot merlin ~failures ~config_path = (if dot.source_root = None then merlin.source_root else dot.source_root); unit_name = (if dot.unit_name = None then merlin.unit_name else dot.unit_name); + wrapping_prefix = + if dot.wrapping_prefix = None + then merlin.wrapping_prefix + else dot.wrapping_prefix; reader = if dot.reader = [] then merlin.reader @@ -662,6 +668,7 @@ let initial = { stdlib = None; source_root = None; unit_name = None; + wrapping_prefix = None; reader = []; protocol = `Json; log_file = None; @@ -842,4 +849,9 @@ let filename t = t.query.filename let unitname t = match t.merlin.unit_name with | Some name -> Misc.unitname name - | None -> Misc.unitname t.query.filename + | None -> + let basename = Misc.unitname t.query.filename in + begin match t.merlin.wrapping_prefix with + | Some prefix -> prefix ^ basename + | None -> basename + end diff --git a/src/kernel/mconfig.mli b/src/kernel/mconfig.mli index 49e69ecd4..87b33d2b4 100644 --- a/src/kernel/mconfig.mli +++ b/src/kernel/mconfig.mli @@ -40,6 +40,7 @@ type merlin = { stdlib : string option; source_root : string option; unit_name : string option; + wrapping_prefix : string option; reader : string list; protocol : [`Json | `Sexp]; log_file : string option; diff --git a/src/kernel/mconfig_dot.ml b/src/kernel/mconfig_dot.ml index ab00eb611..aad310e9d 100644 --- a/src/kernel/mconfig_dot.ml +++ b/src/kernel/mconfig_dot.ml @@ -46,6 +46,7 @@ type config = { stdlib : string option; source_root : string option; unit_name : string option; + wrapping_prefix : string option; reader : string list; exclude_query_dir : bool; use_ppx_cache : bool; @@ -65,6 +66,7 @@ let empty_config = { stdlib = None; source_root = None; unit_name = None; + wrapping_prefix = None; reader = []; exclude_query_dir = false; use_ppx_cache = false; @@ -264,6 +266,8 @@ let prepend_config ~dir:cwd configurator (directives : directive list) config = {config with source_root = Some path}, errors | `UNIT_NAME name -> {config with unit_name = Some name}, errors + | `WRAPPING_PREFIX prefix -> + {config with wrapping_prefix = Some prefix}, errors | `READER reader -> {config with reader}, errors | `EXCLUDE_QUERY_DIR -> @@ -297,6 +301,7 @@ let postprocess_config config = stdlib = config.stdlib; source_root = config.source_root; unit_name = config.unit_name; + wrapping_prefix = config.wrapping_prefix; reader = config.reader; exclude_query_dir = config.exclude_query_dir; use_ppx_cache = config.use_ppx_cache; diff --git a/src/kernel/mconfig_dot.mli b/src/kernel/mconfig_dot.mli index 3d897ec7b..5452d73df 100644 --- a/src/kernel/mconfig_dot.mli +++ b/src/kernel/mconfig_dot.mli @@ -48,6 +48,7 @@ type config = { stdlib : string option; source_root : string option; unit_name : string option; + wrapping_prefix : string option; reader : string list; exclude_query_dir : bool; use_ppx_cache : bool; diff --git a/tests/test-dirs/config/dot-merlin-reader/load-config.t b/tests/test-dirs/config/dot-merlin-reader/load-config.t index 382a659ba..7c1bd12c0 100644 --- a/tests/test-dirs/config/dot-merlin-reader/load-config.t +++ b/tests/test-dirs/config/dot-merlin-reader/load-config.t @@ -44,6 +44,7 @@ This test comes from: https://github.com/janestreet/merlin-jst/pull/59 "stdlib": null, "source_root": null, "unit_name": null, + "wrapping_prefix": null, "reader": [], "protocol": "json", "log_file": null, diff --git a/tests/test-dirs/config/dot-merlin-reader/quoting.t b/tests/test-dirs/config/dot-merlin-reader/quoting.t index 184162b09..84a5d607c 100644 --- a/tests/test-dirs/config/dot-merlin-reader/quoting.t +++ b/tests/test-dirs/config/dot-merlin-reader/quoting.t @@ -56,6 +56,7 @@ "stdlib": null, "source_root": null, "unit_name": null, + "wrapping_prefix": null, "reader": [], "protocol": "json", "log_file": null, diff --git a/tests/test-dirs/occurrences/project-wide/prefix.t/a.ml b/tests/test-dirs/occurrences/project-wide/prefix.t/a.ml new file mode 100644 index 000000000..6149cb14d --- /dev/null +++ b/tests/test-dirs/occurrences/project-wide/prefix.t/a.ml @@ -0,0 +1,2 @@ +let foo = B.x +let bar = foo + B.x diff --git a/tests/test-dirs/occurrences/project-wide/prefix.t/b.ml b/tests/test-dirs/occurrences/project-wide/prefix.t/b.ml new file mode 100644 index 000000000..bff6cda29 --- /dev/null +++ b/tests/test-dirs/occurrences/project-wide/prefix.t/b.ml @@ -0,0 +1,2 @@ +let x = 10 +let y = x + 20 diff --git a/tests/test-dirs/occurrences/project-wide/prefix.t/run.t b/tests/test-dirs/occurrences/project-wide/prefix.t/run.t new file mode 100644 index 000000000..e8a2327d5 --- /dev/null +++ b/tests/test-dirs/occurrences/project-wide/prefix.t/run.t @@ -0,0 +1,191 @@ +Compile a libary with prefixes, like dune + + $ cat >mylib.ml <<'EOF' + > module A = Mylib__A + > module B = Mylib__B + > EOF + + $ ocamlc -bin-annot -bin-annot-occurrences -w -49 -no-alias-deps -o mylib.cmo -c -impl mylib.ml + + $ ocamlc -bin-annot -bin-annot-occurrences -open Mylib -o mylib__B.cmo -c b.ml + + $ ocamlc -bin-annot -bin-annot-occurrences -open Mylib -o mylib__A.cmo -c a.ml + +Create an index + + $ ocaml-index aggregate *.cmt -o .merlin-index + + $ ocaml-index dump .merlin-index + 9 uids: + {uid: Mylib__A; locs: "Mylib__A": File "mylib.ml", line 1, characters 11-19 + uid: Mylib__B; locs: "Mylib__B": File "mylib.ml", line 2, characters 11-19 + uid: Mylib.0; locs: "A": File "mylib.ml", line 1, characters 7-8 + uid: Mylib.1; locs: "B": File "mylib.ml", line 2, characters 7-8 + uid: Mylib__A.0; locs: + "foo": File "a.ml", line 1, characters 4-7; + "foo": File "a.ml", line 2, characters 10-13 + uid: Mylib__A.1; locs: "bar": File "a.ml", line 2, characters 4-7 + uid: Mylib__B.0; locs: + "B.x": File "a.ml", line 1, characters 10-13; + "B.x": File "a.ml", line 2, characters 16-19; + "x": File "b.ml", line 1, characters 4-5; + "x": File "b.ml", line 2, characters 8-9 + uid: Mylib__B.1; locs: "y": File "b.ml", line 2, characters 4-5 + uid: Stdlib.53; locs: + "+": File "a.ml", line 2, characters 14-15; + "+": File "b.ml", line 2, characters 10-11 + }, 0 approx shapes: {}, and shapes for CUS . + +Merlin fails to find occurrences outside of file because of the module prefixes + + $ cat >.merlin <<'EOF' + > INDEX .merlin-index + > EOF + + $ $MERLIN single occurrences -scope project -identifier-at 1:4 -filename b.ml < b.ml + { + "class": "return", + "value": [ + { + "file": "$TESTCASE_ROOT/b.ml", + "start": { + "line": 1, + "col": 4 + }, + "end": { + "line": 1, + "col": 5 + } + }, + { + "file": "$TESTCASE_ROOT/b.ml", + "start": { + "line": 2, + "col": 8 + }, + "end": { + "line": 2, + "col": 9 + } + } + ], + "notifications": [] + } + +Merlin successfully finds occurrences outside file when UNIT_NAME directive is used + + $ cat >.merlin <<'EOF' + > INDEX .merlin-index + > UNIT_NAME Mylib__B + > EOF + + $ $MERLIN single occurrences -scope project -identifier-at 1:4 -filename b.ml < b.ml + { + "class": "return", + "value": [ + { + "file": "$TESTCASE_ROOT/b.ml", + "start": { + "line": 1, + "col": 4 + }, + "end": { + "line": 1, + "col": 5 + } + }, + { + "file": "$TESTCASE_ROOT/a.ml", + "start": { + "line": 1, + "col": 12 + }, + "end": { + "line": 1, + "col": 13 + } + }, + { + "file": "$TESTCASE_ROOT/a.ml", + "start": { + "line": 2, + "col": 18 + }, + "end": { + "line": 2, + "col": 19 + } + }, + { + "file": "$TESTCASE_ROOT/b.ml", + "start": { + "line": 2, + "col": 8 + }, + "end": { + "line": 2, + "col": 9 + } + } + ], + "notifications": [] + } + +Merlin successfully finds occurrences outside file when WRAPPING_PREFIX directive is used + + $ cat >.merlin <<'EOF' + > INDEX .merlin-index + > WRAPPING_PREFIX Mylib__ + > EOF + + $ $MERLIN single occurrences -scope project -identifier-at 1:4 -filename b.ml < b.ml + { + "class": "return", + "value": [ + { + "file": "$TESTCASE_ROOT/b.ml", + "start": { + "line": 1, + "col": 4 + }, + "end": { + "line": 1, + "col": 5 + } + }, + { + "file": "$TESTCASE_ROOT/a.ml", + "start": { + "line": 1, + "col": 12 + }, + "end": { + "line": 1, + "col": 13 + } + }, + { + "file": "$TESTCASE_ROOT/a.ml", + "start": { + "line": 2, + "col": 18 + }, + "end": { + "line": 2, + "col": 19 + } + }, + { + "file": "$TESTCASE_ROOT/b.ml", + "start": { + "line": 2, + "col": 8 + }, + "end": { + "line": 2, + "col": 9 + } + } + ], + "notifications": [] + }