Type-enclosing: revert deduplication in most cases

Since deduplciation has been introduced a while ago the results of type-enclosing (the number of enclosings) have been unstable. This cannot be solved easily on the server-side without printing more types which can lead to performance issues when large modules are involed. We now leave the responsability of deduplication to the clients.
ocaml · Nov 25, 2024 · 8cf640a · 8cf640a
1 parent 42ff215
commit 8cf640a
Show file tree

Hide file tree

Showing 15 changed files with 425 additions and 62 deletions.
diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml
@@ -223,13 +223,28 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
       | browse -> Browse_misc.annotate_tail_calls browse
     in
 
+    (* Type enclosing results come from two sources: 1. the typedtree nodes
+       aroung the cursor's position and 2. the result of reconstructing the
+       identifier around the cursor and typing the resulting paths.
+
+       Having the results from 2 is useful because ot is finer-grained than the
+       typedtree's nodes and can provide types for modules appearing in paths.
+
+       This introduces two possible sources of duplicate results:
+       - Sometimes the typedtree nodes in 1 overlaps and we simply remove these.
+       - The last reconstructed enclosing usually overlaps with the first
+         typedtree node but the printed types are not always the same (generic /
+         specialized types). Because systematically printing these types to
+         compare them can be very expensive in the presence of large modules, we
+         defer this deduplication to the clients.
+    *)
     let enclosing_nodes =
       let cmp (loc1, _, _) (loc2, _, _) = Location_aux.compare loc1 loc2 in
-      (* There might be duplicates in the list *)
+      (* There might be duplicates in the list: we remove them *)
       Type_enclosing.from_nodes ~path |> List.dedup_adjacent ~cmp
     in
 
-    (* enclosings of cursor in given expression *)
+    (* Enclosings of cursor in given expression *)
     let exprs = Misc_utils.reconstruct_identifier pipeline pos expro in
     let () =
       Logger.log ~section:Type_enclosing.log_section
@@ -254,30 +269,7 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
           (Format.pp_print_list ~pp_sep:Format.pp_print_space
              (fun fmt (loc, _, _) -> Location.print_loc fmt loc))
           small_enclosings);
-
-    let all_results =
-      let same_loc (l1, _, _) (l2, _, _) = Location_aux.compare l1 l2 == 0 in
-      let print_type (loc, type_info, tail) =
-        let open Type_enclosing in
-        (loc, String (print_type ~verbosity type_info), tail)
-      in
-      let rec concat_dedup acc l1 l2 =
-        match (l1, l2) with
-        | [ last ], first :: rest ->
-          (* The last reconstructed enclosing might be a duplicate of the first
-             enclosing from the tree. We need to print these enclosings types to
-             check if they differ or not. *)
-          if same_loc last first then
-            let ((_, last_type, _) as last) = print_type last in
-            let ((_, first_type, _) as first) = print_type first in
-            if last_type = first_type then concat_dedup (first :: acc) [] rest
-            else concat_dedup (last :: acc) [] (first :: rest)
-          else concat_dedup (last :: acc) [] l2
-        | hd :: tl, _ -> concat_dedup (hd :: acc) tl l2
-        | [], _ -> List.rev_append acc l2
-      in
-      concat_dedup [] small_enclosings enclosing_nodes
-    in
+    let all_results = List.concat [ small_enclosings; enclosing_nodes ] in
     let index =
       (* Clamp the index to [0; number_of_results[ *)
       let number_of_results = List.length all_results in

diff --git a/tests/test-dirs/hidden-deps/dash-h.t b/tests/test-dirs/hidden-deps/dash-h.t
@@ -55,6 +55,18 @@ Check the type of `x`, should work.
         "type": "t",
         "tail": "no"
       },
+      {
+        "start": {
+          "line": 3,
+          "col": 8
+        },
+        "end": {
+          "line": 3,
+          "col": 9
+        },
+        "type": "t",
+        "tail": "no"
+      },
       {
         "start": {
           "line": 3,

diff --git a/tests/test-dirs/issue1109.t/run.t b/tests/test-dirs/issue1109.t/run.t
@@ -20,9 +20,9 @@
       },
       "end": {
         "line": 5,
-        "col": 16
+        "col": 14
       },
-      "type": "'a",
+      "type": "'a -> 'a",
       "tail": "no"
     }
   ]
diff --git a/tests/test-dirs/misc/load_path.t b/tests/test-dirs/misc/load_path.t
@@ -16,6 +16,18 @@ Here is what merlin sees:
   {
     "class": "return",
     "value": [
+      {
+        "start": {
+          "line": 1,
+          "col": 8
+        },
+        "end": {
+          "line": 1,
+          "col": 16
+        },
+        "type": "int",
+        "tail": "no"
+      },
       {
         "start": {
           "line": 1,

diff --git a/tests/test-dirs/type-enclosing/constructors_and_paths.t/run.t b/tests/test-dirs/type-enclosing/constructors_and_paths.t/run.t
@@ -4,6 +4,18 @@ Various parts of the cons.ml:
   $ $MERLIN single type-enclosing -position 4:14 -verbosity 0 \
   > -filename ./cons.ml < ./cons.ml| jq ".value[0:2]"
   [
+    {
+      "start": {
+        "line": 4,
+        "col": 13
+      },
+      "end": {
+        "line": 4,
+        "col": 14
+      },
+      "type": "t",
+      "tail": "no"
+    },
     {
       "start": {
         "line": 4,
@@ -37,14 +49,14 @@ Various parts of the cons.ml:
     },
     {
       "start": {
-        "line": 7,
-        "col": 2
+        "line": 8,
+        "col": 4
       },
       "end": {
         "line": 8,
-        "col": 11
+        "col": 5
       },
-      "type": "unit",
+      "type": "t",
       "tail": "no"
     }
   ]
@@ -127,13 +139,13 @@ Various parts of the cons.ml:
     {
       "start": {
         "line": 15,
-        "col": 6
+        "col": 12
       },
       "end": {
         "line": 15,
-        "col": 22
+        "col": 15
       },
-      "type": "unit -> M.t",
+      "type": "M.t",
       "tail": "no"
     }
   ]
@@ -233,6 +245,18 @@ the expression reconstructed from  (M|.A 3).
   $ $MERLIN single type-enclosing -position 26:11 -verbosity 0 \
   > -filename ./cons.ml < ./cons.ml | jq ".value[0:2]"
   [
+    {
+      "start": {
+        "line": 26,
+        "col": 8
+      },
+      "end": {
+        "line": 26,
+        "col": 11
+      },
+      "type": "int",
+      "tail": "no"
+    },
     {
       "start": {
         "line": 26,

diff --git a/tests/test-dirs/type-enclosing/generic-types.t b/tests/test-dirs/type-enclosing/generic-types.t
@@ -26,7 +26,7 @@ With index 0 only the first type is shown:
       "line": 1,
       "col": 16
     },
-    "type": "(int -> int) -> int list -> int list",
+    "type": 1,
     "tail": "no"
   }
 
@@ -107,7 +107,7 @@ With index 0 only the first type is shown:
 
 With index 1 only the second is shown (the first is a string so it is always shown):
 FIXME? We don't see the generic version
-  $ $MERLIN single type-enclosing -position 1:10 -index 1 \
+  $ $MERLIN single type-enclosing -short-paths -position 1:10 -index 1 \
   > -filename ./main.ml < ./main.ml 
   {
     "class": "return",
@@ -121,7 +121,7 @@ FIXME? We don't see the generic version
           "line": 1,
           "col": 12
         },
-        "type": "(module Stdlib__List)",
+        "type": "(module List)",
         "tail": "no"
       },
       {
@@ -157,7 +157,8 @@ FIXME? We don't see the generic version
   > let _ = List.map Fun.id [3]
   > EOF
 
-With index 0 only the first type is shown and deduplication id working
+With index 0 only the first type is shown. The next enclosing is not
+deduplicated as intended, this should be done by the client.
   $ $MERLIN single type-enclosing -position 2:14 -index 0 \
   > -filename ./main.ml < ./main.ml 
   {
@@ -182,10 +183,22 @@ With index 0 only the first type is shown and deduplication id working
         },
         "end": {
           "line": 2,
-          "col": 27
+          "col": 16
         },
         "type": 1,
         "tail": "no"
+      },
+      {
+        "start": {
+          "line": 2,
+          "col": 8
+        },
+        "end": {
+          "line": 2,
+          "col": 27
+        },
+        "type": 2,
+        "tail": "no"
       }
     ],
     "notifications": []
@@ -209,6 +222,18 @@ And with index=1 the correct type is shown
         "type": "(int -> int) -> int list -> int list",
         "tail": "no"
       },
+      {
+        "start": {
+          "line": 2,
+          "col": 8
+        },
+        "end": {
+          "line": 2,
+          "col": 16
+        },
+        "type": "(int -> int) -> int list -> int list",
+        "tail": "no"
+      },
       {
         "start": {
           "line": 2,
@@ -218,15 +243,15 @@ And with index=1 the correct type is shown
           "line": 2,
           "col": 27
         },
-        "type": "int list",
+        "type": 2,
         "tail": "no"
       }
     ],
     "notifications": []
   }
 
-And with index>=2 Merlin sticks to the last item
-  $ $MERLIN single type-enclosing -position 2:14 -index 2 \
+And with index>=3 Merlin sticks to the last item
+  $ $MERLIN single type-enclosing -position 2:14 -index 7 \
   > -filename ./main.ml < ./main.ml 
   {
     "class": "return",
@@ -243,6 +268,18 @@ And with index>=2 Merlin sticks to the last item
         "type": "(int -> int) -> int list -> int list",
         "tail": "no"
       },
+      {
+        "start": {
+          "line": 2,
+          "col": 8
+        },
+        "end": {
+          "line": 2,
+          "col": 16
+        },
+        "type": 1,
+        "tail": "no"
+      },
       {
         "start": {
           "line": 2,

diff --git a/tests/test-dirs/type-enclosing/github1003.t/run.t b/tests/test-dirs/type-enclosing/github1003.t/run.t
@@ -1,6 +1,18 @@
   $ $MERLIN single type-enclosing -position 5:14 -verbosity 0 \
   > -filename ./issue1003.ml < ./issue1003.ml | jq ".value[0:2]"
   [
+    {
+      "start": {
+        "line": 5,
+        "col": 8
+      },
+      "end": {
+        "line": 5,
+        "col": 16
+      },
+      "type": "int",
+      "tail": "no"
+    },
     {
       "start": {
         "line": 5,

diff --git a/tests/test-dirs/type-enclosing/issue1477.t b/tests/test-dirs/type-enclosing/issue1477.t
@@ -19,6 +19,18 @@
       "type": "int -> int",
       "tail": "no"
     },
+    {
+      "start": {
+        "line": 2,
+        "col": 8
+      },
+      "end": {
+        "line": 2,
+        "col": 9
+      },
+      "type": "int -> int",
+      "tail": "no"
+    },
     {
       "start": {
         "line": 2,

diff --git a/tests/test-dirs/type-enclosing/letop.t/run.t b/tests/test-dirs/type-enclosing/letop.t/run.t
@@ -86,9 +86,9 @@ Various parts of the letop:
       },
       "end": {
         "line": 4,
-        "col": 37
+        "col": 29
       },
-      "type": "'a option",
+      "type": "('a, 'b) Hashtbl.t -> 'a -> 'b option",
       "tail": "no"
     }
   ]
@@ -111,13 +111,13 @@ Various parts of the letop:
     {
       "start": {
         "line": 4,
-        "col": 13
+        "col": 30
       },
       "end": {
         "line": 4,
-        "col": 37
+        "col": 33
       },
-      "type": "'a option",
+      "type": "('a, 'b) Hashtbl.t",
       "tail": "no"
     }
   ]
@@ -140,13 +140,13 @@ Various parts of the letop:
     {
       "start": {
         "line": 4,
-        "col": 13
+        "col": 34
       },
       "end": {
         "line": 4,
         "col": 37
       },
-      "type": "'a option",
+      "type": "'a",
       "tail": "no"
     }
   ]
@@ -175,7 +175,7 @@ Various parts of the letop:
       },
       "end": {
         "line": 5,
-        "col": 9
+        "col": 5
       },
       "type": "int",
       "tail": "no"