Represent inline record definitions with a type declaration origin

CHANGELOG.md

@@ -32,6 +32,7 @@
 
 #### :house: Internal
 
+- Represent inline record definitions with an explicit parsetree origin while retaining the existing PPX wire representation. https://github.com/rescript-lang/rescript/pull/8686
 - Make expression attributes immutable in the current parsetree, now that editor refactors construct new expression nodes. https://github.com/rescript-lang/rescript/pull/8685
 - Remove the unused `pat_record_label` alias from the current parsetree. https://github.com/rescript-lang/rescript/pull/8684
 - Remove the unused `Ppat_open` and `Tpat_open` AST nodes, with current-AST and CMT format bumps. https://github.com/rescript-lang/rescript/pull/8682

analysis/src/hover.ml

@@ -110,11 +110,15 @@ let find_relevant_types_from_type ~state ~file ~package typ =
   let constructors = Shared.find_type_constructors types_to_search in
   constructors |> List.filter_map (from_constructor_path ~env:env_to_search)
 
+let is_inline_record_definition (decl : Types.type_declaration) path =
+  List.exists
+    (function
+      | Types.Record {type_name} -> type_name = Path.last path)
+    decl.type_inlined_types
+
 let expand_types ~state ~file ~package ~supports_markdown_links typ =
   match find_relevant_types_from_type ~state typ ~file ~package with
-  | {decl; path} :: _
-    when Res_parsetree_viewer.has_inline_record_definition_attribute
-           decl.type_attributes ->
+  | {decl; path} :: _ when is_inline_record_definition decl path ->
     (* We print inline record types just with their definition, not the constr pointing
     to them, since that doesn't make sense to show the user. *)
     ( [
@@ -142,9 +146,7 @@ let expand_types ~state ~file ~package ~supports_markdown_links typ =
           let link_to_type_definition_str =
             if
               supports_markdown_links
-              && not
-                   (Res_parsetree_viewer.has_inline_record_definition_attribute
-                      decl.type_attributes)
+              && not (is_inline_record_definition decl path)
             then Markdown.go_to_definition_text ~env ~pos:loc.Warnings.loc_start
             else ""
           in

compiler/ext/config.ml

@@ -1,10 +1,10 @@
-let cmi_magic_number = "Caml1999I034"
+let cmi_magic_number = "Caml1999I035"
 
 (* Magic numbers for marshaled values of the *current* parsetree, whose layout
    changes across compiler versions. *)
-and ast_impl_magic_number = "ResImpl01310"
+and ast_impl_magic_number = "ResImpl01311"
 
-and ast_intf_magic_number = "ResIntf01310"
+and ast_intf_magic_number = "ResIntf01311"
 
 (* Magic numbers of the frozen Parsetree0 (OCaml 4.06) layout used on the
    external-PPX wire. They must never be written in front of a
@@ -13,6 +13,6 @@ and ast0_impl_magic_number = "Caml1999M022"
 
 and ast0_intf_magic_number = "Caml1999N022"
 
-and cmt_magic_number = "Caml1999T038"
+and cmt_magic_number = "Caml1999T039"
 
 let load_path = ref ([] : string list)

compiler/frontend/ast_derive_util.ml

@@ -42,6 +42,7 @@ let new_type_of_type_declaration (tdcl : Parsetree.type_declaration) new_name =
         ptype_cstrs = [];
         ptype_private = Public;
         ptype_manifest = None;
+        ptype_origin = Declared;
       } )
 let not_applicable loc deriving_name =
   Location.prerr_warning loc

compiler/ml/ast_helper.ml

@@ -390,18 +390,36 @@ end
 
 module Type = struct
   let mk ?(loc = !default_loc) ?(attrs = []) ?(params = []) ?(cstrs = [])
-      ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name =
+      ?(kind = Ptype_abstract) ?(priv = Public) ?manifest ?(origin = Declared)
+      name =
+    let origin, attrs =
+      let rec extract acc = function
+        | ({txt = "res.inlineRecordDefinition"}, _) :: rest ->
+          (Inline_record_definition, List.rev_append acc rest)
+        | attr :: rest -> extract (attr :: acc) rest
+        | [] -> (origin, List.rev acc)
+      in
+      extract [] attrs
+    in
     {
       ptype_name = name;
       ptype_params = params;
       ptype_cstrs = cstrs;
       ptype_kind = kind;
       ptype_private = priv;
       ptype_manifest = manifest;
+      ptype_origin = origin;
       ptype_attributes = attrs;
       ptype_loc = loc;
     }
 
+  let declaration_attributes (decl : Parsetree.type_declaration) =
+    match decl.ptype_origin with
+    | Declared -> decl.ptype_attributes
+    | Inline_record_definition ->
+      (Location.mknoloc "res.inlineRecordDefinition", PStr [])
+      :: decl.ptype_attributes
+
   let constructor ?(loc = !default_loc) ?(attrs = []) ?(args = Pcstr_tuple [])
       ?res ?runtime_tag name =
     let runtime_tag, attrs =

compiler/ml/ast_helper.mli

@@ -309,9 +309,13 @@ module Type : sig
     ?kind:type_kind ->
     ?priv:private_flag ->
     ?manifest:core_type ->
+    ?origin:type_declaration_origin ->
     str ->
     type_declaration
 
+  val declaration_attributes : type_declaration -> attributes
+  (** Restore the inline-record marker for the frozen v0 PPX tree. *)
+
   val constructor :
     ?loc:loc ->
     ?attrs:attrs ->

compiler/ml/ast_mapper.ml

@@ -126,6 +126,7 @@ module T = struct
         ptype_kind;
         ptype_private;
         ptype_manifest;
+        ptype_origin;
         ptype_attributes;
         ptype_loc;
       } =
@@ -138,6 +139,7 @@ module T = struct
            ptype_cstrs)
       ~kind:(sub.type_kind sub ptype_kind)
       ?manifest:(map_opt (sub.typ sub) ptype_manifest)
+      ~origin:ptype_origin
       ~loc:(sub.location sub ptype_loc)
       ~attrs:(sub.attributes sub ptype_attributes)
 

compiler/ml/ast_mapper_to0.ml

@@ -222,16 +222,15 @@ module T = struct
     | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x)
 
   let map_type_declaration sub
-      {
-        ptype_name;
-        ptype_params;
-        ptype_cstrs;
-        ptype_kind;
-        ptype_private;
-        ptype_manifest;
-        ptype_attributes;
-        ptype_loc;
-      } =
+      ({
+         ptype_name;
+         ptype_params;
+         ptype_cstrs;
+         ptype_kind;
+         ptype_private;
+         ptype_manifest;
+         ptype_loc;
+       } as decl) =
     Type.mk (map_loc sub ptype_name)
       ~params:(List.map (map_fst (sub.typ sub)) ptype_params)
       ~priv:ptype_private
@@ -242,7 +241,7 @@ module T = struct
       ~kind:(sub.type_kind sub ptype_kind)
       ?manifest:(map_opt (sub.typ sub) ptype_manifest)
       ~loc:(sub.location sub ptype_loc)
-      ~attrs:(sub.attributes sub ptype_attributes)
+      ~attrs:(sub.attributes sub (Ast_helper.Type.declaration_attributes decl))
 
   let map_type_kind sub = function
     | Ptype_abstract -> Pt.Ptype_abstract

compiler/ml/parsetree.ml

@@ -530,10 +530,15 @@ and type_declaration = {
   ptype_kind: type_kind;
   ptype_private: private_flag; (* = private ... *)
   ptype_manifest: core_type option; (* = T *)
+  ptype_origin: type_declaration_origin;
   ptype_attributes: attributes; (* ... [@@id1] [@@id2] *)
   ptype_loc: Location.t;
 }
 
+(* Inline records in field and external types are lifted to named declarations
+   for type checking. Keep their source origin separate from user attributes. *)
+and type_declaration_origin = Declared | Inline_record_definition
+
 (*
   type t                     (abstract, no manifest)
   type t = T0                (abstract, manifest=T0)

compiler/ml/printast.ml

@@ -480,6 +480,10 @@ and type_declaration i ppf x =
   line i ppf "ptype_kind =\n";
   type_kind (i + 1) ppf x.ptype_kind;
   line i ppf "ptype_private = %a\n" fmt_private_flag x.ptype_private;
+  (match x.ptype_origin with
+  | Declared -> ()
+  | Inline_record_definition ->
+    line i ppf "ptype_origin = Inline_record_definition\n");
   line i ppf "ptype_manifest =\n";
   option (i + 1) core_type ppf x.ptype_manifest
 

compiler/ml/typedecl.ml

@@ -1527,15 +1527,10 @@ let transl_type_decl env rec_flag sdecl_list =
     List.map2 transl_declaration sdecl_list (List.map id_slots id_list)
   in
   let inline_types =
-    tdecls
-    |> List.filter (fun tdecl ->
-        tdecl.typ_attributes
-        |> List.find_opt (fun (({txt}, _) : Parsetree.attribute) ->
-            txt = "res.inlineRecordDefinition")
-        |> Option.is_some)
-    |> List.filter_map (fun tdecl ->
-        match tdecl.typ_type.type_kind with
-        | Type_record (labels, _) ->
+    List.combine sdecl_list tdecls
+    |> List.filter_map (fun (sdecl, tdecl) ->
+        match (sdecl.ptype_origin, tdecl.typ_type.type_kind) with
+        | Inline_record_definition, Type_record (labels, _) ->
           Some (Record {type_name = tdecl.typ_name.txt; labels})
         | _ -> None)
   in

compiler/ml/typetexp.ml

@@ -178,6 +178,7 @@ let create_package_mty fake loc env (p, l) =
             ptype_kind = Ptype_abstract;
             ptype_private = Asttypes.Public;
             ptype_manifest = (if fake then None else Some t);
+            ptype_origin = Declared;
             ptype_attributes = [];
             ptype_loc = loc;
           }

compiler/syntax/src/res_ast_debugger.ml

@@ -460,6 +460,14 @@ module Sexp_ast = struct
             | Some typ -> Sexp.list [Sexp.atom "Some"; core_type typ]);
           ];
         Sexp.list [Sexp.atom "ptype_private"; private_flag td.ptype_private];
+        Sexp.list
+          [
+            Sexp.atom "ptype_origin";
+            Sexp.atom
+              (match td.ptype_origin with
+              | Declared -> "Declared"
+              | Inline_record_definition -> "Inline_record_definition");
+          ];
         attributes td.ptype_attributes;
       ]
 

compiler/syntax/src/res_core.ml

@@ -6360,8 +6360,8 @@ and parse_type_definition_or_extension ~attrs p =
       inline_types_context.found_inline_types
       |> List.map (fun inline_type ->
           Ast_helper.Type.mk ~params:inline_type.params
-            ~attrs:[(Location.mknoloc "res.inlineRecordDefinition", PStr [])]
-            ~loc:inline_type.loc ~kind:inline_type.kind
+            ~origin:Inline_record_definition ~loc:inline_type.loc
+            ~kind:inline_type.kind
             {name with txt = inline_type.name})
     in
     TypeDef {rec_flag; types = inline_types @ type_defs}
@@ -6404,8 +6404,8 @@ and parse_external_def ~attrs ~start_pos p =
         inline_types_context.found_inline_types
         |> List.rev_map (fun inline_type ->
             Ast_helper.Type.mk ~params:inline_type.params
-              ~attrs:[(Location.mknoloc "res.inlineRecordDefinition", PStr [])]
-              ~loc:inline_type.loc ~kind:inline_type.kind
+              ~origin:Inline_record_definition ~loc:inline_type.loc
+              ~kind:inline_type.kind
               {name with txt = inline_type.name})
         |> List.rev
       in

compiler/syntax/src/res_parsetree_viewer.ml

@@ -37,13 +37,6 @@ let expr_is_await e =
   | Pexp_await _ -> true
   | _ -> false
 
-let has_inline_record_definition_attribute attrs =
-  List.exists
-    (function
-      | {Location.txt = "res.inlineRecordDefinition"}, _ -> true
-      | _ -> false)
-    attrs
-
 let has_res_pat_variant_spread_attribute attrs =
   List.exists
     (function
@@ -239,8 +232,7 @@ let filter_parsing_attrs attrs =
       | ( {
             Location.txt =
               ( "res.iflet" | "res.ternary" | "res.await"
-              | "res.patVariantSpread" | "res.dictPattern" | "res.dictSpread"
-              | "res.inlineRecordDefinition" );
+              | "res.patVariantSpread" | "res.dictPattern" | "res.dictSpread" );
           },
           _ ) ->
         false
@@ -396,13 +388,7 @@ let has_attributes attrs =
   List.exists
     (fun attr ->
       match attr with
-      | ( {
-            Location.txt =
-              ( "res.iflet" | "res.ternary" | "res.await"
-              | "res.inlineRecordDefinition" );
-          },
-          _ ) ->
-        false
+      | {Location.txt = "res.iflet" | "res.ternary" | "res.await"}, _ -> false
       (* Remove the fragile pattern warning for iflet expressions *)
       | ( {Location.txt = "warning"},
           PStr
@@ -554,8 +540,7 @@ let is_printable_attribute attr =
   match attr with
   | ( {
         Location.txt =
-          ( "res.iflet" | "JSX" | "res.await" | "res.ternary"
-          | "res.inlineRecordDefinition" | "res.dictSpread" );
+          "res.iflet" | "JSX" | "res.await" | "res.ternary" | "res.dictSpread";
       },
       _ ) ->
     false

compiler/syntax/src/res_parsetree_viewer.mli

@@ -17,7 +17,6 @@ val functor_type :
 
 val expr_is_await : Parsetree.expression -> bool
 val has_await_attribute : Parsetree.attributes -> bool
-val has_inline_record_definition_attribute : Parsetree.attributes -> bool
 val has_res_pat_variant_spread_attribute : Parsetree.attributes -> bool
 val has_dict_pattern_attribute : Parsetree.attributes -> bool
 val has_dict_spread_attribute : Parsetree.attributes -> bool

compiler/syntax/src/res_printer.ml

@@ -43,8 +43,7 @@ let add_async doc = Doc.concat [Doc.text "async "; doc]
 let has_inline_type_definitions type_declarations =
   type_declarations
   |> List.find_opt (fun (td : Parsetree.type_declaration) ->
-      Res_parsetree_viewer.has_inline_record_definition_attribute
-        td.ptype_attributes)
+      td.ptype_origin = Inline_record_definition)
   |> Option.is_some
 
 let get_first_leading_comment tbl loc =
@@ -1305,8 +1304,7 @@ and print_type_declarations ~state ~rec_flag type_declarations cmt_tbl =
     let inline_record_definitions, regular_declarations =
       type_declarations
       |> List.partition (fun (td : Parsetree.type_declaration) ->
-          Res_parsetree_viewer.has_inline_record_definition_attribute
-            td.ptype_attributes)
+          td.ptype_origin = Inline_record_definition)
     in
     match regular_declarations with
     | [] -> (

tests/analysis_tests/tests/src/HoverInlineRecord.res

@@ -0,0 +1,4 @@
+type person = {details: {name: string}}
+
+let getName = (person: person) => person.details.name
+//                                       ^hov

tests/analysis_tests/tests/src/expected/HoverInlineRecord.res.txt

@@ -0,0 +1,8 @@
+Hover src/HoverInlineRecord.res 2:41
+{
+  "contents": {
+    "kind": "markdown",
+    "value": "```rescript\ntype person.details = {name: string}\n```"
+  }
+}
+

tests/ounit_tests/ounit_ast_mapper0_tests.ml

@@ -308,6 +308,36 @@ let test_braces_roundtrip_through_ast0 _ =
   | _ ->
     assert_failure "Expected two structural brace nodes after ast0 roundtrip"
 
+let test_inline_record_definition_roundtrips_through_ast0 _ =
+  let name = located_string "person.details" in
+  let field =
+    Ast_helper.Type.field ~loc (located_string "name")
+      (Ast_helper.Typ.constr ~loc
+         (located_string (Longident.Lident "string"))
+         [])
+  in
+  let decl =
+    Ast_helper.Type.mk ~loc ~origin:Parsetree.Inline_record_definition
+      ~kind:(Parsetree.Ptype_record [field])
+      ~attrs:[attr "other" (Parsetree.PStr [])]
+      name
+  in
+  let wire =
+    Ast_mapper_to0.default_mapper.type_declaration Ast_mapper_to0.default_mapper
+      decl
+  in
+  OUnit.assert_bool "inline record marker reaches the v0 wire"
+    (has_attr "res.inlineRecordDefinition" wire.ptype_attributes);
+  let roundtrip =
+    Ast_mapper_from0.default_mapper.type_declaration
+      Ast_mapper_from0.default_mapper wire
+  in
+  OUnit.assert_equal Parsetree.Inline_record_definition roundtrip.ptype_origin;
+  OUnit.assert_bool "other attributes survive the bridge"
+    (has_attr "other" roundtrip.ptype_attributes);
+  OUnit.assert_bool "the v0 marker is decoded into the origin field"
+    (not (has_attr "res.inlineRecordDefinition" roundtrip.ptype_attributes))
+
 let test_this_on_braced_function_reaches_builtin_ppx _ =
   let function_expr =
     Ast_helper.Exp.fun_
@@ -1689,6 +1719,8 @@ let suites =
          "v0_if_without_alternate_stays_if"
          >:: test_v0_if_without_alternate_stays_if;
          "braces_roundtrip_through_ast0" >:: test_braces_roundtrip_through_ast0;
+         "inline_record_definition_roundtrips_through_ast0"
+         >:: test_inline_record_definition_roundtrips_through_ast0;
          "this_on_braced_function_reaches_builtin_ppx"
          >:: test_this_on_braced_function_reaches_builtin_ppx;
          "constructor_args_roundtrip_through_ast0"