Skip to content

Commit 3c27607

Browse files
authored
Ignore none locations instead of ghost locations (#110)
* Add tests demonstrating occurrences on punned expressions * Fix occurrences with let punning * Add comment to should_ignore_lid * Include location of entire identifier * Don't filter hidden nodes when doing occurrences
1 parent 052eb68 commit 3c27607

File tree

18 files changed

+206
-40
lines changed

18 files changed

+206
-40
lines changed

src/analysis/ast_iterators.ml

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -162,6 +162,8 @@ let iter_on_usages ~f (local_defs : Mtyper.typedtree) =
162162
| `Implementation structure -> iter.structure iter structure
163163
end
164164

165-
let iterator_on_usages ~f =
165+
let iterator_on_usages ~include_hidden ~f =
166166
let occ_iter = Cmt_format.iter_on_occurrences ~f in
167-
iter_only_visible occ_iter
167+
match include_hidden with
168+
| false -> iter_only_visible occ_iter
169+
| true -> occ_iter

src/analysis/index_occurrences.ml

Lines changed: 15 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -25,11 +25,23 @@ let decl_of_path_or_lid env namespace path lid =
2525
end
2626
| _ -> Env_lookup.by_path path namespace env
2727

28+
let should_ignore_lid (lid : Longident.t Location.loc) =
29+
(* Ignore occurrence if the location of the identifier is "none" because there is not a
30+
useful location to report to the user. This can occur when the occurrence is in ppx
31+
generated code and the ppx does not give location information.
32+
33+
An alternative implementation could instead ignore the occurrence if the location is
34+
marked as "ghost". However, this seems too aggressive for two reasons:
35+
- The expression being bound in a punned let expression is marked as ghost
36+
- Ppx-generated code is often "ghost", but occurrences within ppx-generated code may
37+
be useful
38+
*)
39+
Location.is_none lid.loc
40+
2841
let iterator ~current_buffer_path ~index ~stamp ~reduce_for_uid =
2942
let add uid loc = Stamped_hashtable.add index ~stamp (uid, loc) () in
3043
let f ~namespace env path (lid : Longident.t Location.loc) =
3144
log ~title:"index_buffer" "Path: %a" Logger.fmt (Fun.flip Path.print path);
32-
let not_ghost { Location.loc = { loc_ghost; _ }; _ } = not loc_ghost in
3345
let lid = { lid with loc = set_fname ~file:current_buffer_path lid.loc } in
3446
let index_decl () =
3547
begin
@@ -42,7 +54,7 @@ let iterator ~current_buffer_path ~index ~stamp ~reduce_for_uid =
4254
add decl.uid lid
4355
end
4456
in
45-
if not_ghost lid then
57+
if not (should_ignore_lid lid) then
4658
match Env.shape_of_path ~namespace env path with
4759
| exception Not_found -> ()
4860
| path_shape ->
@@ -69,7 +81,7 @@ let iterator ~current_buffer_path ~index ~stamp ~reduce_for_uid =
6981
index_decl ()
7082
end
7183
in
72-
Ast_iterators.iterator_on_usages ~f
84+
Ast_iterators.iterator_on_usages ~include_hidden:true ~f
7385

7486
let items ~index ~stamp (config : Mconfig.t) items =
7587
let module Shape_reduce = Shape_reduce.Make (struct

src/analysis/occurrences.ml

Lines changed: 33 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,17 @@ let set_fname ~file (loc : Location.t) =
1515
loc_end = { loc.loc_end with pos_fname }
1616
}
1717

18+
(* Merlin-jst: Upstream Merlin only includes the location of the last segment of an
19+
identifier. (ex: If the user wrote "Foo.bar", only the location of "bar") is included.
20+
We instead choose to include the entire "Foo.bar", for two reasons:
21+
1. We think that this is a slightly better user experience
22+
2. Upstream Merlin does not include occurrences within ppx generated code, but we do.
23+
Because of this, it is not always true for us that the reported location in the
24+
buffer is text corresponding to the identifier. (For example, the location may
25+
correspond to a ppx extension node.) In such a case, attempting to modify the
26+
location to only include the last segment of the identifier is nonsensical. Since we
27+
don't have a way to detect such a case, it forces us to not try. *)
28+
(*
1829
(* A longident can have the form: A.B.x Right now we are only interested in
1930
values, but we will eventually want to index all occurrences of modules in
2031
such longidents. However there is an issue with that: we only have the
@@ -39,6 +50,7 @@ let last_loc (loc : Location.t) lid =
3950
{ loc.loc_end with pos_cnum = loc.loc_end.pos_cnum - last_size }
4051
}
4152
else loc
53+
*)
4254

4355
let uid_and_loc_of_node env node =
4456
let open Browse_raw in
@@ -200,18 +212,25 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path =
200212
Option.map external_locs ~f:(fun (index, locs) ->
201213
let stats = Stat_check.create ~cache_size:128 index in
202214
( Lid_set.filter
203-
(fun { loc; _ } ->
204-
(* We ignore external results that concern the current buffer *)
205-
let file = loc.Location.loc_start.Lexing.pos_fname in
206-
let file, buf =
207-
match config.merlin.source_root with
208-
| Some root ->
209-
(Filename.concat root file, current_buffer_path)
210-
| None -> (file, config.query.filename)
215+
(fun ({ loc; _ } as lid) ->
216+
let is_current_buffer =
217+
(* We filter external results that concern the current buffer *)
218+
let file = loc.Location.loc_start.Lexing.pos_fname in
219+
let file, buf =
220+
match config.merlin.source_root with
221+
| Some root ->
222+
(Filename.concat root file, current_buffer_path)
223+
| None -> (file, config.query.filename)
224+
in
225+
let file = Misc.canonicalize_filename file in
226+
let buf = Misc.canonicalize_filename buf in
227+
String.equal file buf
211228
in
212-
let file = Misc.canonicalize_filename file in
213-
let buf = Misc.canonicalize_filename buf in
214-
if String.equal file buf then false
229+
let should_be_ignored =
230+
(* We ignore results that don't have a location *)
231+
Index_occurrences.should_ignore_lid lid
232+
in
233+
if is_current_buffer || should_be_ignored then false
215234
else begin
216235
(* We ignore external results if their source was modified *)
217236
let check = Stat_check.check stats ~file in
@@ -249,7 +268,9 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path =
249268
let lid = try Longident.head txt with _ -> "not flat lid" in
250269
log ~title:"occurrences" "Found occ: %s %a" lid Logger.fmt
251270
(Fun.flip Location.print_loc loc);
252-
let loc = last_loc loc txt in
271+
(* Merlin-jst: See comment at the commented-out definition of last_loc for
272+
explanation of why this is commented out. *)
273+
(* let loc = last_loc loc txt in *)
253274
let fname = loc.Location.loc_start.Lexing.pos_fname in
254275
if not (Filename.is_relative fname) then Some loc
255276
else

tests/test-dirs/let-punning.t/run.t

Lines changed: 15 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -248,8 +248,6 @@ Test that finding occurrences of a variable includes usages in a punned let. i.e
248248
finding occurrences of x on line 1 returns the definition on line 1 and the usage on
249249
line 2.
250250

251-
TODO: fix these tests
252-
253251
let*
254252
$ occurrences 12:8
255253
Occurrences of:
@@ -258,6 +256,9 @@ let*
258256
Occurrence at 12:8-9:
259257
let a = return 1 in
260258
^
259+
Occurrence at 13:9-10:
260+
let* a in
261+
^
261262

262263
parallel let*
263264
$ occurrences 18:8
@@ -267,13 +268,19 @@ parallel let*
267268
Occurrence at 18:8-9:
268269
let a = return 1 in
269270
^
271+
Occurrence at 20:9-10:
272+
let* a and* b in
273+
^
270274
$ occurrences 19:8
271275
Occurrences of:
272276
let b = return 1 in
273277
^
274278
Occurrence at 19:8-9:
275279
let b = return 1 in
276280
^
281+
Occurrence at 20:16-17:
282+
let* a and* b in
283+
^
277284

278285
sequential let*
279286
$ occurrences 25:8
@@ -283,10 +290,16 @@ sequential let*
283290
Occurrence at 25:8-9:
284291
let a = return 1 in
285292
^
293+
Occurrence at 27:9-10:
294+
let* a in
295+
^
286296
$ occurrences 26:8
287297
Occurrences of:
288298
let b = return 1 in
289299
^
290300
Occurrence at 26:8-9:
291301
let b = return 1 in
292302
^
303+
Occurrence at 28:9-10:
304+
let* b in
305+
^

tests/test-dirs/occurrences/issue827.t/run.t

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ Reproduction case:
1717
{
1818
"start": {
1919
"line": 4,
20-
"col": 10
20+
"col": 8
2121
},
2222
"end": {
2323
"line": 4,
@@ -76,7 +76,7 @@ work:
7676
{
7777
"start": {
7878
"line": 4,
79-
"col": 10
79+
"col": 8
8080
},
8181
"end": {
8282
"line": 4,

tests/test-dirs/occurrences/lid-locs.t

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ The parenthesis are typed as an open statement
3030
{
3131
"start": {
3232
"line": 4,
33-
"col": 10
33+
"col": 8
3434
},
3535
"end": {
3636
"line": 4,
@@ -40,7 +40,7 @@ The parenthesis are typed as an open statement
4040
{
4141
"start": {
4242
"line": 5,
43-
"col": 11
43+
"col": 8
4444
},
4545
"end": {
4646
"line": 5,
@@ -69,8 +69,8 @@ The parenthesis are typed as an open statement
6969
},
7070
{
7171
"start": {
72-
"line": 9,
73-
"col": 2
72+
"line": 8,
73+
"col": 8
7474
},
7575
"end": {
7676
"line": 9,

tests/test-dirs/occurrences/mod-in-path-2.t

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ FIXME: we could expect module appearing in paths to be highlighted
3939
{
4040
"start": {
4141
"line": 5,
42-
"col": 12
42+
"col": 8
4343
},
4444
"end": {
4545
"line": 5,
@@ -49,7 +49,7 @@ FIXME: we could expect module appearing in paths to be highlighted
4949
{
5050
"start": {
5151
"line": 6,
52-
"col": 8
52+
"col": 4
5353
},
5454
"end": {
5555
"line": 6,

tests/test-dirs/occurrences/mod-in-path-3.t

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,7 @@ FIXME: we could expect module appearing in paths to be highlighted
4040
{
4141
"start": {
4242
"line": 4,
43-
"col": 12
43+
"col": 8
4444
},
4545
"end": {
4646
"line": 4,
@@ -50,7 +50,7 @@ FIXME: we could expect module appearing in paths to be highlighted
5050
{
5151
"start": {
5252
"line": 7,
53-
"col": 8
53+
"col": 4
5454
},
5555
"end": {
5656
"line": 7,

tests/test-dirs/occurrences/project-wide/prefix.t/run.t

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -98,7 +98,7 @@ Merlin successfully finds occurrences outside file when UNIT_NAME directive is u
9898
"file": "$TESTCASE_ROOT/a.ml",
9999
"start": {
100100
"line": 1,
101-
"col": 12
101+
"col": 10
102102
},
103103
"end": {
104104
"line": 1,
@@ -109,7 +109,7 @@ Merlin successfully finds occurrences outside file when UNIT_NAME directive is u
109109
"file": "$TESTCASE_ROOT/a.ml",
110110
"start": {
111111
"line": 2,
112-
"col": 18
112+
"col": 16
113113
},
114114
"end": {
115115
"line": 2,
@@ -157,7 +157,7 @@ Merlin successfully finds occurrences outside file when WRAPPING_PREFIX directiv
157157
"file": "$TESTCASE_ROOT/a.ml",
158158
"start": {
159159
"line": 1,
160-
"col": 12
160+
"col": 10
161161
},
162162
"end": {
163163
"line": 1,
@@ -168,7 +168,7 @@ Merlin successfully finds occurrences outside file when WRAPPING_PREFIX directiv
168168
"file": "$TESTCASE_ROOT/a.ml",
169169
"start": {
170170
"line": 2,
171-
"col": 18
171+
"col": 16
172172
},
173173
"end": {
174174
"line": 2,
Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
let a = Some 1
2+
3+
type t = { value : string }
4+
let value = "hello"

0 commit comments

Comments
 (0)