Make reconstruct_identifier aware of Papply

Author: voodoos

src/kernel/mreader_lexer.ml

@@ -258,12 +258,34 @@ let reconstruct_identifier_from_tokens tokens pos =
       look_for_dot [item] items
 
     (* RPAREN UIDENT means that we are in presence of a functor application. *)
-    | (RPAREN, _, end_pos) :: ((UIDENT s, _, _ ) as _item) :: items
+    | (RPAREN, _, end_pos) :: ((UIDENT _, _, _ ) as item) :: items
       when acc <> [] ->
-      let app, start_pos, items =
-        look_for_apply ~inside_paren:true [ s; ")"] items
-      in
-      look_for_dot ((UIDENT app, start_pos, end_pos ) :: acc) items
+      let param_items, items = group_until_lparen [item] items in
+      begin try
+        begin try
+          (* Is the cursor on the parameter ? *)
+          look_for_dot [] (List.rev param_items)
+        with Not_found ->
+          (* Is the cursor on the functor or before ? *)
+          look_for_component [] items
+        end
+      with Not_found ->
+        (* The cursor must be after the application [M.N(F).|t]
+           We make a single component with the applciation and continue *)
+        match items with
+        | (UIDENT f, start_pos, _ ) :: items ->
+          let app =
+            let param = List.map ~f:(function
+              | (DOT, _, _ ) -> "."
+              | (UIDENT s, _, _) -> s
+              | _ -> raise Not_found
+            ) param_items
+            in
+            Format.sprintf "%s(%s)" f (String.concat ~sep:"" param)
+          in
+          look_for_dot ((UIDENT app, start_pos, end_pos ) :: acc) items
+        | _ -> raise Not_found
+      end
 
     (* An operator alone is an identifier on its own *)
     | (token, _, _ as item) :: items
@@ -276,16 +298,9 @@ let reconstruct_identifier_from_tokens tokens pos =
 
     | [] -> raise Not_found
 
-  (* FIXME: this function treats applications as a single component ["M(N.P)"].
-     This prevent jumping to M, N or P. *)
-  and look_for_apply ~inside_paren acc = function
-    | (LPAREN, _, _) :: items when inside_paren ->
-      look_for_apply ~inside_paren:false ("(" :: acc) items
-    | (UIDENT s, _, _) :: items when inside_paren ->
-      look_for_apply ~inside_paren (s :: "." :: acc) items
-    | (UIDENT s, start_pos, _) :: items when not inside_paren ->
-      let item = String.concat ~sep:"" (s :: acc) in
-      item, start_pos, items
+  and group_until_lparen acc = function
+    | (LPAREN,_,_) :: items -> acc, items
+    | item :: items -> group_until_lparen (item::acc) items
     | _ -> raise Not_found
 
   and look_for_dot acc = function

tests/test-dirs/locate/issue1610.t

@@ -3,36 +3,63 @@
   >   type 'a t
   > end
   > 
-  > module M (T : T) = struct
-  >   type t = int T.t
+  > module N = struct
+  >   module M (T : T) = struct
+  >     type t = int T.t
+  >   end
   > end
   > 
-  > module T = struct type 'a t end
+  > module F = struct
+  >   module T = struct type 'a t end
+  > end
   > 
-  > type t = M(T).t
+  > type u = N.M(F.T).t
   > EOF
 
-We should jump to the functor's body
-  $ $MERLIN single locate -look-for ml -position 11:15 \
+We should jump to the functor's body (line 7)
+  $ $MERLIN single locate -look-for ml -position 15:18 \
   > -filename main.ml <main.ml | jq '.value.pos'
   {
-    "line": 6,
+    "line": 7,
+    "col": 4
+  }
+
+Should jump to T's definition  (line 12)
+  $ $MERLIN single locate -look-for ml -position 15:15 \
+  > -filename main.ml <main.ml | jq '.value.pos'
+  {
+    "line": 12,
     "col": 2
   }
 
-FIXME: should jump to T's definition 
-  $ $MERLIN single locate -look-for ml -position 11:11 \
-  > -filename main.ml <main.ml
+Should jump to F's definition (line 11)
+  $ $MERLIN single locate -look-for ml -position 15:13 \
+  > -filename main.ml <main.ml | jq '.value.pos'
   {
-    "class": "return",
-    "value": "didn't manage to find M(T)",
-    "notifications": []
+    "line": 11,
+    "col": 0
   }
 
-It also works as expected when the user inputs the expression manually
-  $ $MERLIN single locate -prefix 'M(T).t' -look-for ml -position 11:15 \
+Should jump to M's definition (line 6)
+  $ $MERLIN single locate -look-for ml -position 15:11 \
   > -filename main.ml <main.ml | jq '.value.pos'
   {
     "line": 6,
     "col": 2
   }
+
+Should jump to N's definition (line 5)
+  $ $MERLIN single locate -look-for ml -position 15:9 \
+  > -filename main.ml <main.ml | jq '.value.pos'
+  {
+    "line": 5,
+    "col": 0
+  }
+
+It also works as expected when the user inputs the expression manually
+  $ $MERLIN single locate -prefix 'N.M(F.T).t' -look-for ml -position 15:18 \
+  > -filename main.ml <main.ml | jq '.value.pos'
+  {
+    "line": 7,
+    "col": 4
+  }