refactor away the need for res.inlineRecordReference

Author: zth

compiler/syntax/src/res_core.ml

@@ -4080,12 +4080,19 @@ and parse_atomic_typ_expr ?current_type_name_path ?inline_types ~attrs p =
           ~constr_name:constr p
       in
       let number_of_inline_records_in_args =
-        args
-        |> List.filter (fun (c : Parsetree.core_type) ->
-               c.ptyp_attributes
-               |> List.exists (fun (({txt}, _) : Parsetree.attribute) ->
-                      txt = "res.inlineRecordReference"))
-        |> List.length
+        match inline_types with
+        | None -> 0
+        | Some inline_types ->
+          let inline_types = !inline_types in
+          args
+          |> List.filter (fun (c : Parsetree.core_type) ->
+                 match c.ptyp_desc with
+                 | Ptyp_constr ({txt = Lident typename}, _)
+                   when String.contains typename '.' ->
+                   inline_types
+                   |> List.exists (fun (name, _, _) -> name = typename)
+                 | _ -> false)
+          |> List.length
       in
       if number_of_inline_records_in_args > 1 then
         Parser.err ~start_pos ~end_pos:p.prev_end_pos p
@@ -4196,9 +4203,7 @@ and parse_record_or_object_type ?current_type_name_path ?inline_types ~attrs p =
       (inline_type_name, loc, Parsetree.Ptype_record labels) :: !inline_types;
 
     let lid = Location.mkloc (Longident.Lident inline_type_name) loc in
-    Ast_helper.Typ.constr
-      ~attrs:[(Location.mknoloc "res.inlineRecordReference", PStr [])]
-      ~loc lid []
+    Ast_helper.Typ.constr ~loc lid []
   | _ ->
     let () =
       match p.token with

compiler/syntax/src/res_parsetree_viewer.ml

@@ -79,13 +79,6 @@ let has_inline_record_definition_attribute attrs =
       | _ -> false)
     attrs
 
-let has_inline_record_reference_attribute attrs =
-  List.exists
-    (function
-      | {Location.txt = "res.inlineRecordReference"}, _ -> true
-      | _ -> false)
-    attrs
-
 let has_res_pat_variant_spread_attribute attrs =
   List.exists
     (function
@@ -213,7 +206,7 @@ let filter_parsing_attrs attrs =
               ( "res.braces" | "ns.braces" | "res.iflet" | "res.ternary"
               | "res.await" | "res.template" | "res.taggedTemplate"
               | "res.patVariantSpread" | "res.dictPattern"
-              | "res.inlineRecordReference" | "res.inlineRecordDefinition" );
+              | "res.inlineRecordDefinition" );
           },
           _ ) ->
         false
@@ -367,8 +360,7 @@ let has_attributes attrs =
       | ( {
             Location.txt =
               ( "res.braces" | "ns.braces" | "res.iflet" | "res.ternary"
-              | "res.await" | "res.template" | "res.inlineRecordReference"
-              | "res.inlineRecordDefinition" );
+              | "res.await" | "res.template" | "res.inlineRecordDefinition" );
           },
           _ ) ->
         false
@@ -563,8 +555,7 @@ let is_printable_attribute attr =
   | ( {
         Location.txt =
           ( "res.iflet" | "res.braces" | "ns.braces" | "JSX" | "res.await"
-          | "res.template" | "res.ternary" | "res.inlineRecordReference"
-          | "res.inlineRecordDefinition" );
+          | "res.template" | "res.ternary" | "res.inlineRecordDefinition" );
       },
       _ ) ->
     false

compiler/syntax/src/res_parsetree_viewer.mli

@@ -16,7 +16,6 @@ val functor_type :
 
 val has_await_attribute : Parsetree.attributes -> bool
 val has_inline_record_definition_attribute : Parsetree.attributes -> bool
-val has_inline_record_reference_attribute : Parsetree.attributes -> bool
 val has_res_pat_variant_spread_attribute : Parsetree.attributes -> bool
 val has_dict_pattern_attribute : Parsetree.attributes -> bool
 

compiler/syntax/src/res_printer.ml

@@ -550,16 +550,6 @@ module State = struct
   let should_break_callback t = t.custom_layout > custom_layout_threshold
 end
 
-let is_inline_record_definition attrs =
-  attrs
-  |> List.exists (fun (({txt}, _) : Parsetree.attribute) ->
-         txt = "res.inlineRecordDefinition")
-
-let is_inline_record_reference attrs =
-  attrs
-  |> List.exists (fun (({txt}, _) : Parsetree.attribute) ->
-         txt = "res.inlineRecordReference")
-
 let rec print_structure ~state (s : Parsetree.structure) t =
   match s with
   | [] -> print_comments_inside_file t
@@ -582,12 +572,14 @@ and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl =
   | Pstr_type (Recursive, type_declarations)
     when type_declarations
          |> List.find_opt (fun (td : Parsetree.type_declaration) ->
-                is_inline_record_definition td.ptype_attributes)
+                Res_parsetree_viewer.has_inline_record_definition_attribute
+                  td.ptype_attributes)
          |> Option.is_some ->
     let inline_record_definitions, regular_declarations =
       type_declarations
       |> List.partition (fun (td : Parsetree.type_declaration) ->
-             is_inline_record_definition td.ptype_attributes)
+             Res_parsetree_viewer.has_inline_record_definition_attribute
+               td.ptype_attributes)
     in
     print_type_declarations ~inline_record_definitions ~state
       ~rec_flag:
@@ -1722,7 +1714,8 @@ and print_typ_expr ?inline_record_definitions ~(state : State.t)
       print_object ~state ~inline:false fields open_flag cmt_tbl
     | Ptyp_arrow {arity} -> print_arrow ~arity typ_expr
     | Ptyp_constr ({txt = Lident inline_record_name}, [])
-      when is_inline_record_reference typ_expr.ptyp_attributes -> (
+      when inline_record_definitions |> Option.is_some
+           && String.contains inline_record_name '.' -> (
       let inline_record_definitions =
         match inline_record_definitions with
         | None -> []

tests/syntax_tests/data/parsing/errors/typeDef/expected/inlineRecord.res.txt

@@ -30,10 +30,9 @@ type nonrec entity =
 type user.address = {
   street: string ;
   country: string }[@@res.inlineRecordDefinition ]
-and user =
-  {
+and user = {
   name: string ;
-  address: ((user.address)[@res.inlineRecordReference ]) }
+  address: user.address }
 let make
   [arity:1](props :
              < handleClick: Click.t -> unit (a:1)  ;value: string   > )