Merge pull request #1772 from voodoos/remove-mod-in-paths-hack

Revert: remove reparsing of longident to index modules in paths
ocaml · May 17, 2024 · df63ca4 · df63ca4
2 parents 94dea9d + df27557
commit df63ca4
Show file tree

Hide file tree

Showing 6 changed files with 10 additions and 151 deletions.
diff --git 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,46 +80,14 @@ 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
 
 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
@@ -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
@@ -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
@@ -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 <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
@@ -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 <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
@@ -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 <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 <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,