Fix context

janestreet · Jan 16, 2025 · 14d1873 · 14d1873
1 parent 4b21242
commit 14d1873
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 9 deletions.
diff --git a/src/analysis/context.ml b/src/analysis/context.ml
@@ -37,8 +37,10 @@ type t =
        path (cf. #486, #794). *)
   | Unknown_constructor
   | Expr
-  | Label of Types.label_description (* Similar to constructors. *)
-  | Unknown_label
+  | Label :
+      'rep Types.gen_label_description * 'rep Types.record_form
+      -> t (* Similar to constructors. *)
+  | Unknown_label : 'rep Types.record_form -> t
   | Module_path
   | Module_type
   | Patt
@@ -50,8 +52,11 @@ let to_string = function
   | Constructor (cd, _) -> Printf.sprintf "constructor %s" cd.cstr_name
   | Unknown_constructor -> Printf.sprintf "unknown constructor"
   | Expr -> "expression"
-  | Label lbl -> Printf.sprintf "record field %s" lbl.lbl_name
-  | Unknown_label -> Printf.sprintf "record field"
+  | Label (lbl, Legacy) -> Printf.sprintf "record field %s" lbl.lbl_name
+  | Unknown_label Legacy -> Printf.sprintf "record field"
+  | Label (lbl, Unboxed_product) ->
+    Printf.sprintf "unboxed record field %s" lbl.lbl_name
+  | Unknown_label Unboxed_product -> Printf.sprintf "unboxed record field"
   | Module_path -> "module path"
   | Module_type -> "module type"
   | Patt -> "pattern"
@@ -67,7 +72,8 @@ let of_locate_context : Query_protocol.Locate_context.t -> t = function
   | Type -> Type
   | Constant -> Constant
   | Constructor -> Unknown_constructor
-  | Label -> Unknown_label
+  | Label -> Unknown_label Legacy
+  | Unboxed_label -> Unknown_label Unboxed_product
   | Unknown -> Unknown
 
 (* Distinguish between "Mo[d]ule.something" and "Module.some[t]hing" *)
@@ -158,9 +164,10 @@ let inspect_browse_tree ?let_pun_behavior ~cursor lid browse : t option =
     | Module_type _ -> Some Module_type
     | Core_type { ctyp_desc = Ttyp_package _; _ } -> Some Module_type
     | Core_type _ -> Some Type
-    | Record_field (_, lbl, _) when Longident.last lid = lbl.lbl_name ->
+    | Record_field (_, lbl, record_form, _)
+      when Longident.last lid = lbl.lbl_name ->
       (* if we stopped here, then we're on the label itself, and whether or
           not punning is happening is not important *)
-      Some (Label lbl)
+      Some (Label (lbl, record_form))
     | Expression e -> Some (inspect_expression ~cursor ~lid e)
     | _ -> Some Unknown)
diff --git a/src/analysis/context.mli b/src/analysis/context.mli
@@ -33,8 +33,10 @@ type t =
        path (cf. #486, #794). *)
   | Unknown_constructor
   | Expr
-  | Label of Types.label_description (* Similar to constructors. *)
-  | Unknown_label
+  | Label :
+      'rep Types.gen_label_description * 'rep Types.record_form
+      -> t (* Similar to constructors. *)
+  | Unknown_label : 'rep Types.record_form -> t
   | Module_path
   | Module_type
   | Patt

diff --git a/src/frontend/query_protocol.ml b/src/frontend/query_protocol.ml
@@ -139,6 +139,7 @@ module Locate_context = struct
     | Constant
     | Constructor
     | Label
+    | Unboxed_label
     | Unknown
 
   let to_string = function
@@ -150,6 +151,7 @@ module Locate_context = struct
     | Constant -> "constant"
     | Constructor -> "constructor"
     | Label -> "label"
+    | Unboxed_label -> "unboxed_label"
     | Unknown -> "unknown"
 
   let of_string = function
@@ -161,6 +163,7 @@ module Locate_context = struct
     | "constant" -> Some Constant
     | "constructor" -> Some Constructor
     | "label" -> Some Label
+    | "unboxed_label" -> Some Label
     | "unknown" -> Some Unknown
     | _ -> None
 
@@ -173,6 +176,7 @@ module Locate_context = struct
       Constant;
       Constructor;
       Label;
+      Unboxed_label;
       Unknown
     ]
 end