Refactor: include name in Typed locType.

Author: cristianoc

analysis/src/Hover.ml

@@ -101,7 +101,7 @@ let newHover ~full:{SharedTypes.file; package} locItem =
     | Some file ->
       showModule ~docstring:file.contents.docstring ~name:file.moduleName ~file
         None)
-  | Typed (_, Definition (_, (Field _ | Constructor _))) -> None
+  | Typed (_, _, Definition (_, (Field _ | Constructor _))) -> None
   | Constant t ->
     Some
       (codeBlock
@@ -113,7 +113,7 @@ let newHover ~full:{SharedTypes.file; package} locItem =
          | Const_int32 _ -> "int32"
          | Const_int64 _ -> "int64"
          | Const_nativeint _ -> "int"))
-  | Typed (t, locKind) ->
+  | Typed (_, t, locKind) ->
     let fromType ~docstring typ =
       let typeString = codeBlock (typ |> Shared.typeToString) in
       let extraTypeInfo =

analysis/src/ProcessCmt.ml

@@ -568,7 +568,8 @@ let extraForFile ~(file : File.t) =
          addReference stamp d.name.loc);
   file.stamps.values
   |> Hashtbl.iter (fun stamp d ->
-         addLocItem extra d.name.loc (Typed (d.item, Definition (stamp, Value)));
+         addLocItem extra d.name.loc
+           (Typed (d.name.txt, d.item, Definition (stamp, Value)));
          addReference stamp d.name.loc);
   file.stamps.types
   |> Hashtbl.iter (fun stamp d ->
@@ -581,7 +582,8 @@ let extraForFile ~(file : File.t) =
            |> List.iter (fun {stamp; fname; typ} ->
                   addReference stamp fname.loc;
                   addLocItem extra fname.loc
-                    (Typed (typ, Definition (d.stamp, Field fname.txt))))
+                    (Typed
+                       (d.name.txt, typ, Definition (d.stamp, Field fname.txt))))
          | Variant constructos ->
            constructos
            |> List.iter (fun {stamp; cname} ->
@@ -599,7 +601,10 @@ let extraForFile ~(file : File.t) =
                     }
                   in
                   addLocItem extra cname.loc
-                    (Typed (t, Definition (d.stamp, Constructor cname.txt))))
+                    (Typed
+                       ( d.name.txt,
+                         t,
+                         Definition (d.stamp, Constructor cname.txt) )))
          | _ -> ());
   extra
 
@@ -757,7 +762,7 @@ struct
         | None -> NotFound)
       | `GlobalMod _ -> NotFound
     in
-    addLocItem extra loc (Typed (typ, locType))
+    addLocItem extra loc (Typed (identName, typ, locType))
 
   let addForPathParent path loc =
     let locType =
@@ -834,7 +839,7 @@ struct
           GlobalReference (moduleName, path, Field name)
         | _ -> NotFound
       in
-      addLocItem extra nameLoc (Typed (lbl_res, locType))
+      addLocItem extra nameLoc (Typed (name, lbl_res, locType))
     | _ -> ()
 
   let addForRecord recordType items =
@@ -862,13 +867,12 @@ struct
                  GlobalReference (moduleName, path, Field name)
                | _ -> NotFound
              in
-             addLocItem extra nameLoc (Typed (lbl_res, locType)))
+             addLocItem extra nameLoc (Typed (name, lbl_res, locType)))
     | _ -> ()
 
   let addForConstructor constructorType {Asttypes.txt; loc} {Types.cstr_name} =
     match (Shared.dig constructorType).desc with
     | Tconstr (path, _args, _memo) ->
-      (* let name = Longident.last(txt); *)
       let name, typeLident = handleConstructor path txt in
       maybeAddUse path typeLident loc (Constructor name);
       let nameLoc = Utils.endOfLocation loc (String.length name) in
@@ -888,7 +892,7 @@ struct
           GlobalReference (moduleName, path, Constructor name)
         | _ -> NotFound
       in
-      addLocItem extra nameLoc (Typed (constructorType, locType))
+      addLocItem extra nameLoc (Typed (name, constructorType, locType))
     | _ -> ()
 
   let currentScopeExtent () =
@@ -999,7 +1003,7 @@ struct
         Hashtbl.add Collector.file.stamps.values stamp declared;
         addReference stamp name.loc;
         addLocItem extra name.loc
-          (Typed (val_desc.ctyp_type, Definition (stamp, Value))))
+          (Typed (name.txt, val_desc.ctyp_type, Definition (stamp, Value))))
     | _ -> ()
 
   let enter_core_type {ctyp_type; ctyp_desc} =
@@ -1024,7 +1028,8 @@ struct
         in
         Hashtbl.add Collector.file.stamps.values stamp declared;
         addReference stamp name.loc;
-        addLocItem extra name.loc (Typed (pat_type, Definition (stamp, Value))))
+        addLocItem extra name.loc
+          (Typed (name.txt, pat_type, Definition (stamp, Value))))
     in
     (* Log.log("Entering pattern " ++ Utils.showLocation(pat_loc)); *)
     match pat_desc with

analysis/src/References.ml

@@ -27,16 +27,18 @@ let locItemForPos ~full pos =
   | _ :: _ :: _ :: l :: _ when full.file.uri |> Uri2.isInterface ->
     (* heuristic for makeProps in interface files *)
     Some l
-  | [({locType = Typed (_, LocalReference _)} as li1); li3]
+  | [({locType = Typed (_, _, LocalReference _)} as li1); li3]
     when li1.loc = li3.loc ->
     (* JSX and compiler combined:
        ~x becomes Props#x
        heuristic for: [Props, x], give loc of `x` *)
     Some li3
   | [
-   ({locType = Typed (_, LocalReference _)} as li1);
-   ({locType = Typed (_, GlobalReference ("Js_OO", Tip "unsafe_downgrade", _))}
-   as li2);
+   ({locType = Typed (_, _, LocalReference _)} as li1);
+   ({
+      locType =
+        Typed (_, _, GlobalReference ("Js_OO", Tip "unsafe_downgrade", _));
+    } as li2);
    li3;
   ]
   (* For older compiler 9.0 or earlier *)
@@ -46,8 +48,8 @@ let locItemForPos ~full pos =
        heuristic for: [Props, unsafe_downgrade, x], give loc of `x` *)
     Some li3
   | [
-   {locType = Typed (_, LocalReference (_, Value))};
-   ({locType = Typed (_, Definition (_, Value))} as li2);
+   {locType = Typed (_, _, LocalReference (_, Value))};
+   ({locType = Typed (_, _, Definition (_, Value))} as li2);
   ] ->
     (* JSX on type-annotated labeled (~arg:t):
        (~arg:t) becomes Props#arg
@@ -297,7 +299,7 @@ let orLog message v =
 
 let definitionForLocItem ~full:{file; package} locItem =
   match locItem.locType with
-  | Typed (_, Definition (stamp, tip)) -> (
+  | Typed (_, _, Definition (stamp, tip)) -> (
     maybeLog "Trying to find a defintion for a definition";
     match declaredForTip ~stamps:file.stamps stamp tip with
     | None -> None
@@ -311,7 +313,7 @@ let definitionForLocItem ~full:{file; package} locItem =
           let loc = validateLoc declared.name.loc declared.extentLoc in
           Some (file.uri, loc))
       else None)
-  | Typed (_, NotFound)
+  | Typed (_, _, NotFound)
   | LModule (NotFound | Definition (_, _))
   | TypeDefinition (_, _, _)
   | Constant _ ->
@@ -326,11 +328,11 @@ let definitionForLocItem ~full:{file; package} locItem =
     | None -> None
     | Some src -> Some (Uri2.fromPath src, Utils.topLoc src))
   | LModule (LocalReference (stamp, tip))
-  | Typed (_, LocalReference (stamp, tip)) ->
+  | Typed (_, _, LocalReference (stamp, tip)) ->
     maybeLog ("Local defn " ^ tipToString tip);
     definition ~file ~package stamp tip
   | LModule (GlobalReference (moduleName, path, tip))
-  | Typed (_, GlobalReference (moduleName, path, tip)) -> (
+  | Typed (_, _, GlobalReference (moduleName, path, tip)) -> (
     maybeLog
       ("Global defn " ^ moduleName ^ " " ^ pathToString path ^ " : "
      ^ tipToString tip);
@@ -450,16 +452,17 @@ let forLocalStamp ~full:{file; extra; package} stamp tip =
 
 let allReferencesForLocItem ~full:({file; package} as full) locItem =
   match locItem.locType with
-  | Typed (_, NotFound) | LModule NotFound | TopLevelModule _ | Constant _ -> []
+  | Typed (_, _, NotFound) | LModule NotFound | TopLevelModule _ | Constant _ ->
+    []
   | TypeDefinition (_, _, stamp) -> forLocalStamp ~full stamp Type
-  | Typed (_, (LocalReference (stamp, tip) | Definition (stamp, tip)))
+  | Typed (_, _, (LocalReference (stamp, tip) | Definition (stamp, tip)))
   | LModule (LocalReference (stamp, tip) | Definition (stamp, tip)) ->
     maybeLog
       ("Finding references for " ^ Uri2.toString file.uri ^ " and stamp "
      ^ string_of_int stamp ^ " and tip " ^ tipToString tip);
     forLocalStamp ~full stamp tip
   | LModule (GlobalReference (moduleName, path, tip))
-  | Typed (_, GlobalReference (moduleName, path, tip)) -> (
+  | Typed (_, _, GlobalReference (moduleName, path, tip)) -> (
     match ProcessCmt.fileForModule ~package moduleName with
     | None -> []
     | Some file -> (

analysis/src/SharedTypes.ml

@@ -175,7 +175,7 @@ type locKind =
   | Definition of int * tip
 
 type locType =
-  | Typed of Types.type_expr * locKind
+  | Typed of string * Types.type_expr * locKind
   | Constant of Asttypes.constant
   | LModule of locKind
   | TopLevelModule of string
@@ -245,8 +245,8 @@ let locKindToString = function
   | Definition (_, tip) -> "(Definition " ^ tipToString tip ^ ")"
 
 let locTypeToString = function
-  | Typed (e, locKind) ->
-    "Typed " ^ Shared.typeToString e ^ " " ^ locKindToString locKind
+  | Typed (name, e, locKind) ->
+    "Typed " ^ name ^ " " ^ Shared.typeToString e ^ " " ^ locKindToString locKind
   | Constant _ -> "Constant"
   | LModule locKind -> "LModule " ^ locKindToString locKind
   | TopLevelModule _ -> "TopLevelModule"