diff --git a/src/analysis/occurrences.ml b/src/analysis/occurrences.ml index a1236a483..c3ce3abbe 100644 --- a/src/analysis/occurrences.ml +++ b/src/analysis/occurrences.ml @@ -25,7 +25,7 @@ let decl_of_path_or_lid env namespace path lid = end | _ -> Env_lookup.by_path path namespace env -let index_buffer_ ~config ~source ~current_buffer_path ~local_defs () = +let index_buffer_ ~current_buffer_path ~local_defs () = let {Logger. log} = Logger.for_section "index" in let defs = Hashtbl.create 64 in let module Shape_reduce = @@ -80,38 +80,6 @@ let index_buffer_ ~config ~source ~current_buffer_path ~local_defs () = index_decl () end in - let f ~namespace env path (lid : Longident.t Location.loc) = - (* The compiler lacks sufficient location information to precisely hihglight - modules in paths. This function hacks around that issue when looking for - occurrences in the current buffer only. *) - (* We rely on a custom re-parsing of the longidents that provide us with - location information and match these with the real path and longident. *) - let rec iter_on_path ~namespace (path : Path.t) lid reparsed = - log ~title:"iter_on_path" "Path %a, lid: %a" - Logger.fmt (Fun.flip Path.print path) - Logger.fmt (Fun.flip Pprintast.longident lid.Location.txt); - match path, lid.txt, reparsed with - | Pdot (path', n), (Ldot (_, s) | Lident s), _ - when n <> s && String.lowercase_ascii n = n -> - iter_on_path ~namespace path' lid reparsed - | (Pdot _ | Pident _), Lident s, [{ Location.txt = name; loc}] - when name = s -> - log ~title:"iter_on_path" "Last %a, lid: %a" - Logger.fmt (Fun.flip Path.print path) - Logger.fmt (Fun.flip Pprintast.longident lid.Location.txt); - f ~namespace env path { lid with loc = loc } - | Pdot (path', _), Ldot (lid', s), { txt = name; loc} :: tl when name = s -> - let () = f ~namespace env path { lid with loc = loc } in - iter_on_path ~namespace:Module path' { lid with txt = lid' } tl - | Papply _, _, _ -> f ~namespace env path lid - | _, _, _ -> f ~namespace env path lid - in - let reparsed_lid = - Misc_utils.parse_identifier (config, source) lid.loc.loc_end - |> List.rev - in - iter_on_path ~namespace path lid reparsed_lid - in Ast_iterators.iter_on_usages ~f local_defs; defs @@ -119,7 +87,7 @@ let index_buffer = (* Right now, we only cache the last used index. We could do better by caching the index for every known buffer. *) let cache = ref None in - fun ~config ~source ~current_buffer_path ~stamp ~local_defs () -> + fun ~current_buffer_path ~stamp ~local_defs () -> let {Logger. log} = Logger.for_section "index" in match !cache with | Some (path, stamp', value) when @@ -131,7 +99,7 @@ let index_buffer = | _ -> log ~title:"index_cache" "No valid cache found, reindexing."; let result = - index_buffer_ ~config ~source ~current_buffer_path ~local_defs () + index_buffer_ ~current_buffer_path ~local_defs () in cache := Some (current_buffer_path, stamp, result); result @@ -189,7 +157,7 @@ let comp_unit_of_uid = function | Item { comp_unit; _ } -> Some comp_unit | Internal | Predef _ -> None -let locs_of ~config ~source ~env ~typer_result ~pos path = +let locs_of ~config ~env ~typer_result ~pos path = log ~title:"occurrences" "Looking for occurences of %s (pos: %s)" path (Lexing.print_position () pos); @@ -233,7 +201,7 @@ let locs_of ~config ~source ~env ~typer_result ~pos path = log ~title:"locs_of" "Indexing current buffer"; let buffer_index = let stamp = Mtyper.get_stamp typer_result in - index_buffer ~config ~source ~current_buffer_path ~stamp ~local_defs () + index_buffer ~current_buffer_path ~stamp ~local_defs () in let buffer_locs = Hashtbl.find_opt buffer_index def_uid in let locs = Option.value ~default:LidSet.empty buffer_locs in diff --git a/src/analysis/occurrences.mli b/src/analysis/occurrences.mli index 871341430..eea7b6b3e 100644 --- a/src/analysis/occurrences.mli +++ b/src/analysis/occurrences.mli @@ -1,6 +1,5 @@ val locs_of : config:Mconfig.t - -> source:Msource.t -> env:Env.t -> typer_result:Mtyper.result -> pos:Lexing.position diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml index e5b1518ff..b2686fbe5 100644 --- a/src/frontend/query_commands.ml +++ b/src/frontend/query_commands.ml @@ -797,7 +797,6 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = | Occurrences (`Ident_at pos, _) -> let config = Mpipeline.final_config pipeline in - let source = Mpipeline.raw_source pipeline in let typer_result = Mpipeline.typer_result pipeline in let pos = Mpipeline.get_lexing_pos pipeline pos in let env, _node = Mbrowse.leaf_node (Mtyper.node_at typer_result pos) in @@ -810,7 +809,7 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = path in let locs = - Occurrences.locs_of ~config ~source ~env ~typer_result ~pos path + Occurrences.locs_of ~config ~env ~typer_result ~pos path |> Result.value ~default:[] in let loc_start l = l.Location.loc_start in diff --git a/tests/test-dirs/occurrences/mod-in-path-2.t b/tests/test-dirs/occurrences/mod-in-path-2.t index 1f120c0a2..b335bca5e 100644 --- a/tests/test-dirs/occurrences/mod-in-path-2.t +++ b/tests/test-dirs/occurrences/mod-in-path-2.t @@ -7,6 +7,7 @@ > | Mod.A -> () > EOF +FIXME: we could expect module appearing in paths to be highlighted $ $MERLIN single occurrences -identifier-at 1:8 -filename test.ml jq '.value' [ @@ -19,26 +20,6 @@ "line": 1, "col": 10 } - }, - { - "start": { - "line": 5, - "col": 8 - }, - "end": { - "line": 5, - "col": 11 - } - }, - { - "start": { - "line": 6, - "col": 4 - }, - "end": { - "line": 6, - "col": 7 - } } ] diff --git a/tests/test-dirs/occurrences/mod-in-path-3.t b/tests/test-dirs/occurrences/mod-in-path-3.t index 6ba604a26..e0f972739 100644 --- a/tests/test-dirs/occurrences/mod-in-path-3.t +++ b/tests/test-dirs/occurrences/mod-in-path-3.t @@ -8,6 +8,7 @@ > | Mod.A r -> r.lbl > EOF +FIXME: we could expect module appearing in paths to be highlighted $ $MERLIN single occurrences -identifier-at 4:9 -filename test.ml jq '.value' [ @@ -20,26 +21,6 @@ "line": 1, "col": 10 } - }, - { - "start": { - "line": 4, - "col": 8 - }, - "end": { - "line": 4, - "col": 11 - } - }, - { - "start": { - "line": 7, - "col": 4 - }, - "end": { - "line": 7, - "col": 7 - } } ] diff --git a/tests/test-dirs/occurrences/mod-in-path.t b/tests/test-dirs/occurrences/mod-in-path.t index eeadb5848..010ec9054 100644 --- a/tests/test-dirs/occurrences/mod-in-path.t +++ b/tests/test-dirs/occurrences/mod-in-path.t @@ -13,6 +13,7 @@ > let _ = let open Mod in Nod.x > EOF +FIXME: we could expect module appearing in paths to be highlighted $ $MERLIN single occurrences -identifier-at 6:13 -filename test.ml jq '.value' [ @@ -25,50 +26,10 @@ "line": 2, "col": 12 } - }, - { - "start": { - "line": 6, - "col": 12 - }, - "end": { - "line": 6, - "col": 15 - } - }, - { - "start": { - "line": 7, - "col": 14 - }, - "end": { - "line": 7, - "col": 17 - } - }, - { - "start": { - "line": 9, - "col": 0 - }, - "end": { - "line": 9, - "col": 3 - } - }, - { - "start": { - "line": 12, - "col": 24 - }, - "end": { - "line": 12, - "col": 27 - } } ] - +FIXME: we could expect module appearing in paths to be highlighted $ $MERLIN single occurrences -identifier-at 12:18 -filename test.ml jq '.value' [ @@ -82,36 +43,6 @@ "col": 10 } }, - { - "start": { - "line": 6, - "col": 8 - }, - "end": { - "line": 6, - "col": 11 - } - }, - { - "start": { - "line": 7, - "col": 8 - }, - "end": { - "line": 7, - "col": 11 - } - }, - { - "start": { - "line": 8, - "col": 8 - }, - "end": { - "line": 8, - "col": 11 - } - }, { "start": { "line": 12,