Use identifier loc in certain scenarios (rescript-lang#993)

* use identifier location to look up type information in certain scenarios, when in incremental type checking mode

* changelog

* fix

* fix

Author: zth

CHANGELOG.md

@@ -27,6 +27,7 @@
 - Hover: print signature above docstrings. https://github.com/rescript-lang/rescript-vscode/pull/969
 - Adjust function template snippet return. https://github.com/rescript-lang/rescript-vscode/pull/985
 - Don't expand `type t` maker functions in patterns. https://github.com/rescript-lang/rescript-vscode/pull/986
+- Use `loc` for identifiers to get more and better completions in certain scenarios with type parameters. https://github.com/rescript-lang/rescript-vscode/pull/993
 
 #### :rocket: New Feature
 

analysis/src/Cfg.ml

@@ -1,3 +1,11 @@
 let debugFollowCtxPath = ref false
 
 let isDocGenFromCompiler = ref false
+
+let inIncrementalTypecheckingMode =
+  ref
+    (try
+       match Sys.getenv "RESCRIPT_INCREMENTAL_TYPECHECKING" with
+       | "true" -> true
+       | _ -> false
+     with _ -> false)

analysis/src/Cmt.ml

@@ -16,14 +16,19 @@ let fullFromUri ~uri =
     let moduleName =
       BuildSystem.namespacedName package.namespace (FindFiles.getName path)
     in
-    let incrementalCmtPath =
-      package.rootPath ^ "/lib/bs/___incremental" ^ "/" ^ moduleName
-      ^
-      match Files.classifySourceFile path with
-      | Resi -> ".cmti"
-      | _ -> ".cmt"
+    let incremental =
+      if !Cfg.inIncrementalTypecheckingMode then
+        let incrementalCmtPath =
+          package.rootPath ^ "/lib/bs/___incremental" ^ "/" ^ moduleName
+          ^
+          match Files.classifySourceFile path with
+          | Resi -> ".cmti"
+          | _ -> ".cmt"
+        in
+        fullForCmt ~moduleName ~package ~uri incrementalCmtPath
+      else None
     in
-    match fullForCmt ~moduleName ~package ~uri incrementalCmtPath with
+    match incremental with
     | Some cmtInfo ->
       if Debug.verbose () then Printf.printf "[cmt] Found incremental cmt\n";
       Some cmtInfo

analysis/src/Commands.ml

@@ -344,6 +344,8 @@ let test ~path =
           | "db-" -> Log.verbose := false
           | "dv+" -> Debug.debugLevel := Verbose
           | "dv-" -> Debug.debugLevel := Off
+          | "in+" -> Cfg.inIncrementalTypecheckingMode := true
+          | "in-" -> Cfg.inIncrementalTypecheckingMode := false
           | "ve+" -> (
             let version = String.sub rest 3 (String.length rest - 3) in
             let version = String.trim version in

analysis/src/CompletionBackEnd.ml

@@ -869,11 +869,45 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
     | Some (Tpromise (env, typ), _env) ->
       [Completion.create "dummy" ~env ~kind:(Completion.Value typ)]
     | _ -> [])
-  | CPId (path, completionContext) ->
+  | CPId {path; completionContext; loc} ->
     if Debug.verbose () then print_endline "[ctx_path]--> CPId";
-    path
-    |> getCompletionsForPath ~debug ~opens ~full ~pos ~exact ~completionContext
-         ~env ~scope
+    (* Looks up the type of an identifier.
+
+       Because of reasons we sometimes don't get enough type
+       information when looking up identifiers where the type
+       has type parameters. This in turn means less completions.
+
+       There's a heuristic below that tries to look up the type
+       of the ID in the usual way first. But if the type found
+       still has uninstantiated type parameters, we check the
+       location for the identifier from the compiler type artifacts.
+       That type usually has the type params instantiated, if they are.
+       This leads to better completion.
+
+       However, we only do it in incremental type checking mode,
+       because more type information is always available in that mode. *)
+    let useTvarLookup = !Cfg.inIncrementalTypecheckingMode in
+    let byPath =
+      path
+      |> getCompletionsForPath ~debug ~opens ~full ~pos ~exact
+           ~completionContext ~env ~scope
+    in
+    let hasTvars =
+      if useTvarLookup then
+        match byPath with
+        | [{kind = Value typ}] when TypeUtils.hasTvar typ -> true
+        | _ -> false
+      else false
+    in
+    let result =
+      if hasTvars then
+        let byLoc = TypeUtils.findTypeViaLoc loc ~full ~debug in
+        match (byLoc, byPath) with
+        | Some t, [({kind = Value _} as item)] -> [{item with kind = Value t}]
+        | _ -> byPath
+      else byPath
+    in
+    result
   | CPApply (cp, labels) -> (
     if Debug.verbose () then print_endline "[ctx_path]--> CPApply";
     match
@@ -916,7 +950,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
         [Completion.create "dummy" ~env ~kind:(Completion.Value retType)]
       | _ -> [])
     | _ -> [])
-  | CPField (CPId (path, Module), fieldName) ->
+  | CPField (CPId {path; completionContext = Module}, fieldName) ->
     if Debug.verbose () then print_endline "[ctx_path]--> CPField: M.field";
     (* M.field *)
     path @ [fieldName]
@@ -1271,13 +1305,9 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
     | None -> [])
   | CTypeAtPos loc -> (
     if Debug.verbose () then print_endline "[ctx_path]--> CTypeAtPos";
-    match
-      References.getLocItem ~full ~pos:(Pos.ofLexing loc.loc_start) ~debug
-    with
+    match TypeUtils.findTypeViaLoc loc ~full ~debug with
     | None -> []
-    | Some {locType = Typed (_, typExpr, _)} ->
-      [Completion.create "dummy" ~env ~kind:(Value typExpr)]
-    | _ -> [])
+    | Some typExpr -> [Completion.create "dummy" ~env ~kind:(Value typExpr)])
 
 let getOpens ~debug ~rawOpens ~package ~env =
   if debug && rawOpens <> [] then

analysis/src/CompletionFrontEnd.ml

@@ -219,14 +219,24 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
          | [] -> None
          | exp :: _ -> exprToContextPath exp))
   | Pexp_ident {txt = Lident ("|." | "|.u")} -> None
-  | Pexp_ident {txt} -> Some (CPId (Utils.flattenLongIdent txt, Value))
+  | Pexp_ident {txt; loc} ->
+    Some
+      (CPId {path = Utils.flattenLongIdent txt; completionContext = Value; loc})
   | Pexp_field (e1, {txt = Lident name}) -> (
     match exprToContextPath e1 with
     | Some contextPath -> Some (CPField (contextPath, name))
     | _ -> None)
-  | Pexp_field (_, {txt = Ldot (lid, name)}) ->
+  | Pexp_field (_, {loc; txt = Ldot (lid, name)}) ->
     (* Case x.M.field ignore the x part *)
-    Some (CPField (CPId (Utils.flattenLongIdent lid, Module), name))
+    Some
+      (CPField
+         ( CPId
+             {
+               path = Utils.flattenLongIdent lid;
+               completionContext = Module;
+               loc;
+             },
+           name ))
   | Pexp_send (e1, {txt}) -> (
     match exprToContextPath e1 with
     | None -> None
@@ -411,8 +421,9 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
       let ctxPath =
         if contextPathToSave = None then
           match p with
-          | {ppat_desc = Ppat_var {txt}} ->
-            Some (Completable.CPId ([txt], Value))
+          | {ppat_desc = Ppat_var {txt; loc}} ->
+            Some
+              (Completable.CPId {path = [txt]; completionContext = Value; loc})
           | _ -> None
         else None
       in
@@ -1055,12 +1066,16 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
             setResult
               (Cpath
                  (CPId
-                    ( lidPath,
-                      if
-                        isLikelyModulePath
-                        && expr |> Res_parsetree_viewer.isBracedExpr
-                      then ValueOrField
-                      else Value )))
+                    {
+                      loc = lid.loc;
+                      path = lidPath;
+                      completionContext =
+                        (if
+                           isLikelyModulePath
+                           && expr |> Res_parsetree_viewer.isBracedExpr
+                         then ValueOrField
+                         else Value);
+                    }))
         | Pexp_construct ({txt = Lident ("::" | "()")}, _) ->
           (* Ignore list expressions, used in JSX, unit, and more *) ()
         | Pexp_construct (lid, eOpt) -> (
@@ -1075,7 +1090,11 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
           if
             eOpt = None && (not lid.loc.loc_ghost)
             && lid.loc |> Loc.hasPos ~pos:posBeforeCursor
-          then setResult (Cpath (CPId (lidPath, Value)))
+          then
+            setResult
+              (Cpath
+                 (CPId
+                    {loc = lid.loc; path = lidPath; completionContext = Value}))
           else
             match eOpt with
             | Some e when locHasCursor e.pexp_loc -> (
@@ -1106,7 +1125,12 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
               (* Case x.M.field ignore the x part *)
               let contextPath =
                 Completable.CPField
-                  ( CPId (Utils.flattenLongIdent id, Module),
+                  ( CPId
+                      {
+                        loc = fieldName.loc;
+                        path = Utils.flattenLongIdent id;
+                        completionContext = Module;
+                      },
                     if blankAfterCursor = Some '.' then
                       (* x.M. field  --->  M. *) ""
                     else if name = "_" then ""
@@ -1149,7 +1173,14 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
               (match compNamePath with
               | [prefix] when Char.lowercase_ascii prefix.[0] = prefix.[0] ->
                 ChtmlElement {prefix}
-              | _ -> Cpath (CPId (compNamePath, Module)))
+              | _ ->
+                Cpath
+                  (CPId
+                     {
+                       loc = compName.loc;
+                       path = compNamePath;
+                       completionContext = Module;
+                     }))
           else iterateJsxProps ~iterator jsxProps
         | Pexp_apply
             ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
@@ -1356,7 +1387,9 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
             (lidPath |> String.concat ".")
             (Loc.toString lid.loc);
         if lid.loc |> Loc.hasPos ~pos:posBeforeCursor then
-          setResult (Cpath (CPId (lidPath, Type)))
+          setResult
+            (Cpath
+               (CPId {loc = lid.loc; path = lidPath; completionContext = Type}))
       | _ -> ());
     Ast_iterator.default_iterator.typ iterator core_type
   in
@@ -1374,7 +1407,10 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
           Printf.printf "Ppat_construct %s:%s\n"
             (lidPath |> String.concat ".")
             (Loc.toString lid.loc);
-        let completion = Completable.Cpath (CPId (lidPath, Value)) in
+        let completion =
+          Completable.Cpath
+            (CPId {loc = lid.loc; path = lidPath; completionContext = Value})
+        in
         match !result with
         | Some (Completable.Cpattern p, scope) ->
           result := Some (Cpattern {p with fallback = Some completion}, scope)
@@ -1392,7 +1428,9 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
           (lidPath |> String.concat ".")
           (Loc.toString lid.loc);
       found := true;
-      setResult (Cpath (CPId (lidPath, Module)))
+      setResult
+        (Cpath
+           (CPId {loc = lid.loc; path = lidPath; completionContext = Module}))
     | _ -> ());
     Ast_iterator.default_iterator.module_expr iterator me
   in
@@ -1406,7 +1444,9 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
           (lidPath |> String.concat ".")
           (Loc.toString lid.loc);
       found := true;
-      setResult (Cpath (CPId (lidPath, Module)))
+      setResult
+        (Cpath
+           (CPId {loc = lid.loc; path = lidPath; completionContext = Module}))
     | _ -> ());
     Ast_iterator.default_iterator.module_type iterator mt
   in
@@ -1422,7 +1462,14 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
         Printf.printf "Ptype_variant unary %s:%s\n" decl.pcd_name.txt
           (Loc.toString decl.pcd_name.loc);
       found := true;
-      setResult (Cpath (CPId ([decl.pcd_name.txt], Value)))
+      setResult
+        (Cpath
+           (CPId
+              {
+                loc = decl.pcd_name.loc;
+                path = [decl.pcd_name.txt];
+                completionContext = Value;
+              }))
     | _ -> ());
     Ast_iterator.default_iterator.type_kind iterator type_kind
   in
@@ -1459,7 +1506,9 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
     iterator.structure iterator str |> ignore;
     if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then (
       scope := !lastScopeBeforeCursor;
-      setResult (Cpath (CPId ([""], Value))));
+      setResult
+        (Cpath
+           (CPId {loc = Location.none; path = [""]; completionContext = Value})));
     if !found = false then if debug then Printf.printf "XXX Not found!\n";
     !result)
   else if Filename.check_suffix path ".resi" then (
@@ -1468,7 +1517,9 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
     iterator.signature iterator signature |> ignore;
     if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then (
       scope := !lastScopeBeforeCursor;
-      setResult (Cpath (CPId ([""], Type))));
+      setResult
+        (Cpath
+           (CPId {loc = Location.none; path = [""]; completionContext = Type})));
     if !found = false then if debug then Printf.printf "XXX Not found!\n";
     !result)
   else None

analysis/src/SharedTypes.ml

@@ -606,7 +606,11 @@ module Completable = struct
     | CPBool
     | CPOption of contextPath
     | CPApply of contextPath * Asttypes.arg_label list
-    | CPId of string list * completionContext
+    | CPId of {
+        path: string list;
+        completionContext: completionContext;
+        loc: Location.t;
+      }
     | CPField of contextPath * string
     | CPObj of contextPath * string
     | CPAwait of contextPath
@@ -689,8 +693,8 @@ module Completable = struct
       ^ ")"
     | CPArray (Some ctxPath) -> "array<" ^ contextPathToString ctxPath ^ ">"
     | CPArray None -> "array"
-    | CPId (sl, completionContext) ->
-      completionContextToString completionContext ^ list sl
+    | CPId {path; completionContext} ->
+      completionContextToString completionContext ^ list path
     | CPField (cp, s) -> contextPathToString cp ^ "." ^ str s
     | CPObj (cp, s) -> contextPathToString cp ^ "[\"" ^ s ^ "\"]"
     | CPPipe {contextPath; id; inJsx} ->

analysis/src/TypeUtils.ml

@@ -6,6 +6,34 @@ let debugLogTypeArgContext {env; typeArgs; typeParams} =
     (typeArgs |> List.map Shared.typeToString |> String.concat ", ")
     (typeParams |> List.map Shared.typeToString |> String.concat ", ")
 
+(** Checks whether this type has any uninstantiated type parameters. *)
+let rec hasTvar (ty : Types.type_expr) : bool =
+  match ty.desc with
+  | Tvar _ -> true
+  | Tarrow (_, ty1, ty2, _) -> hasTvar ty1 || hasTvar ty2
+  | Ttuple tyl -> List.exists hasTvar tyl
+  | Tconstr (_, tyl, _) -> List.exists hasTvar tyl
+  | Tobject (ty, _) -> hasTvar ty
+  | Tfield (_, _, ty1, ty2) -> hasTvar ty1 || hasTvar ty2
+  | Tnil -> false
+  | Tlink ty -> hasTvar ty
+  | Tsubst ty -> hasTvar ty
+  | Tvariant {row_fields; _} ->
+    List.exists
+      (function
+        | _, Types.Rpresent (Some ty) -> hasTvar ty
+        | _, Reither (_, tyl, _, _) -> List.exists hasTvar tyl
+        | _ -> false)
+      row_fields
+  | Tunivar _ -> true
+  | Tpoly (ty, tyl) -> hasTvar ty || List.exists hasTvar tyl
+  | Tpackage (_, _, tyl) -> List.exists hasTvar tyl
+
+let findTypeViaLoc ~full ~debug (loc : Location.t) =
+  match References.getLocItem ~full ~pos:(Pos.ofLexing loc.loc_end) ~debug with
+  | Some {locType = Typed (_, typExpr, _)} -> Some typExpr
+  | _ -> None
+
 let rec pathFromTypeExpr (t : Types.type_expr) =
   match t.desc with
   | Tconstr (Pident {name = "function$"}, [t; _], _) -> pathFromTypeExpr t
@@ -927,7 +955,13 @@ let rec contextPathFromCoreType (coreType : Parsetree.core_type) =
   | Ptyp_constr ({txt = Lident "array"}, [innerTyp]) ->
     Some (Completable.CPArray (innerTyp |> contextPathFromCoreType))
   | Ptyp_constr (lid, _) ->
-    Some (CPId (lid.txt |> Utils.flattenLongIdent, Type))
+    Some
+      (CPId
+         {
+           path = lid.txt |> Utils.flattenLongIdent;
+           completionContext = Type;
+           loc = lid.loc;
+         })
   | _ -> None
 
 let unwrapCompletionTypeIfOption (t : SharedTypes.completionType) =