Refactor type substitution inside extractRecordType.

This reveals one record case that is not handled.

Author: cristianoc

analysis/src/CompletionBackEnd.ml

@@ -980,13 +980,70 @@ let findLocalCompletionsWithOpens ~pos ~(env : QueryEnv.t) ~prefix ~exact ~opens
     (* There's no local completion for fields *)
     []
 
+let instantiateType ~typeParams ~typeArgs (t : Types.type_expr) =
+  if typeParams = [] || typeArgs = [] then t
+  else
+    let rec applySub tp ta t =
+      match (tp, ta) with
+      | t1 :: tRest1, t2 :: tRest2 ->
+        if t1 = t then t2 else applySub tRest1 tRest2 t
+      | [], _ | _, [] -> assert false
+    in
+    let rec loop (t : Types.type_expr) =
+      match t.desc with
+      | Tlink t -> loop t
+      | Tvar _ -> applySub typeParams typeArgs t
+      | Tunivar _ -> t
+      | Tconstr (path, args, memo) ->
+        {t with desc = Tconstr (path, args |> List.map loop, memo)}
+      | Tsubst t -> loop t
+      | Tvariant rd -> {t with desc = Tvariant (rowDesc rd)}
+      | Tnil -> t
+      | Tarrow (lbl, t1, t2, c) ->
+        {t with desc = Tarrow (lbl, loop t1, loop t2, c)}
+      | Ttuple tl -> {t with desc = Ttuple (tl |> List.map loop)}
+      | Tobject (t, r) -> {t with desc = Tobject (loop t, r)}
+      | Tfield (n, k, t1, t2) -> {t with desc = Tfield (n, k, loop t1, loop t2)}
+      | Tpoly (t, []) -> loop t
+      | Tpoly (t, tl) -> {t with desc = Tpoly (loop t, tl |> List.map loop)}
+      | Tpackage (p, l, tl) ->
+        {t with desc = Tpackage (p, l, tl |> List.map loop)}
+    and rowDesc (rd : Types.row_desc) =
+      let row_fields =
+        rd.row_fields |> List.map (fun (l, rf) -> (l, rowField rf))
+      in
+      let row_more = loop rd.row_more in
+      let row_name =
+        match rd.row_name with
+        | None -> None
+        | Some (p, tl) -> Some (p, tl |> List.map loop)
+      in
+      {rd with row_fields; row_more; row_name}
+    and rowField (rf : Types.row_field) =
+      match rf with
+      | Rpresent None -> rf
+      | Rpresent (Some t) -> Rpresent (Some (loop t))
+      | Reither (b1, tl, b2, r) -> Reither (b1, tl |> List.map loop, b2, r)
+      | Rabsent -> Rabsent
+    in
+    loop t
+
 let rec extractRecordType ~env ~package (t : Types.type_expr) =
   match t.desc with
   | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractRecordType ~env ~package t1
-  | Tconstr (path, args, _) -> (
+  | Tconstr (path, typeArgs, _) -> (
     match References.digConstructor ~env ~package path with
     | Some (env, ({item = {kind = Record fields}} as typ)) ->
-      Some (env, fields, typ, args)
+      let typeParams = typ.item.decl.type_params in
+      let fields =
+        fields
+        |> List.map (fun field ->
+               let fieldTyp =
+                 field.typ |> instantiateType ~typeParams ~typeArgs
+               in
+               {field with typ = fieldTyp})
+      in
+      Some (env, fields, typ)
     | Some (env, {item = {decl = {type_manifest = Some t1}}}) ->
       extractRecordType ~env ~package t1
     | _ -> None)
@@ -1087,54 +1144,6 @@ let completionsGetTypeEnv = function
   | {Completion.kind = Field ({typ}, _); env} :: _ -> Some (typ, env)
   | _ -> None
 
-let instantiateType ~typeParams ~typeArgs (t : Types.type_expr) =
-  if typeParams = [] || typeArgs = [] then t
-  else
-    let rec applySub tp ta t =
-      match (tp, ta) with
-      | t1 :: tRest1, t2 :: tRest2 ->
-        if t1 = t then t2 else applySub tRest1 tRest2 t
-      | [], _ | _, [] -> assert false
-    in
-    let rec loop (t : Types.type_expr) =
-      match t.desc with
-      | Tlink t -> loop t
-      | Tvar _ -> applySub typeParams typeArgs t
-      | Tunivar _ -> t
-      | Tconstr (path, args, memo) ->
-        {t with desc = Tconstr (path, args |> List.map loop, memo)}
-      | Tsubst t -> loop t
-      | Tvariant rd -> {t with desc = Tvariant (rowDesc rd)}
-      | Tnil -> t
-      | Tarrow (lbl, t1, t2, c) ->
-        {t with desc = Tarrow (lbl, loop t1, loop t2, c)}
-      | Ttuple tl -> {t with desc = Ttuple (tl |> List.map loop)}
-      | Tobject (t, r) -> {t with desc = Tobject (loop t, r)}
-      | Tfield (n, k, t1, t2) -> {t with desc = Tfield (n, k, loop t1, loop t2)}
-      | Tpoly (t, []) -> loop t
-      | Tpoly (t, tl) -> {t with desc = Tpoly (loop t, tl |> List.map loop)}
-      | Tpackage (p, l, tl) ->
-        {t with desc = Tpackage (p, l, tl |> List.map loop)}
-    and rowDesc (rd : Types.row_desc) =
-      let row_fields =
-        rd.row_fields |> List.map (fun (l, rf) -> (l, rowField rf))
-      in
-      let row_more = loop rd.row_more in
-      let row_name =
-        match rd.row_name with
-        | None -> None
-        | Some (p, tl) -> Some (p, tl |> List.map loop)
-      in
-      {rd with row_fields; row_more; row_name}
-    and rowField (rf : Types.row_field) =
-      match rf with
-      | Rpresent None -> rf
-      | Rpresent (Some t) -> Rpresent (Some (loop t))
-      | Reither (b1, tl, b2, r) -> Reither (b1, tl |> List.map loop, b2, r)
-      | Rabsent -> Rabsent
-    in
-    loop t
-
 let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
     ~env ~exact ~scope (contextPath : Completable.contextPath) =
   match contextPath with
@@ -1211,14 +1220,9 @@ let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
     with
     | Some (typ, env) -> (
       match typ |> extractRecordType ~env ~package with
-      | Some (env, fields, typDecl, typeArgs) ->
-        let typeParams = typDecl.item.decl.type_params in
+      | Some (env, fields, typDecl) ->
         fields
         |> Utils.filterMap (fun field ->
-               let fieldTyp =
-                 field.typ |> instantiateType ~typeParams ~typeArgs
-               in
-               let field = {field with typ = fieldTyp} in
                if checkName field.fname.txt ~prefix:fieldName ~exact then
                  Some
                    (Completion.create ~name:field.fname.txt ~env