Skip to content

Commit

Permalink
allow inline records in constrs
Browse files Browse the repository at this point in the history
  • Loading branch information
zth committed Jan 11, 2025
1 parent f962dd0 commit 10634fe
Show file tree
Hide file tree
Showing 5 changed files with 74 additions and 39 deletions.
43 changes: 34 additions & 9 deletions compiler/syntax/src/res_core.ml
Original file line number Diff line number Diff line change
Expand Up @@ -141,11 +141,15 @@ module ErrorMessages = struct

let forbidden_inline_record_declaration =
"An inline record type declaration is only allowed in a variant \
constructor's declaration"
constructor's declaration or nested inside of a record type declaration"

let poly_var_int_with_suffix number =
"A numeric polymorphic variant cannot be followed by a letter. Did you \
mean `#" ^ number ^ "`?"

let multiple_inline_record_definitions_at_same_path =
"Only one inline record definition is allowed per record field. This \
defines more than one inline record."
end

module InExternal = struct
Expand Down Expand Up @@ -4146,7 +4150,22 @@ and parse_atomic_typ_expr ?current_type_name_path ?inline_types ~attrs p =
| Lbracket -> parse_polymorphic_variant_type ~attrs p
| Uident _ | Lident _ ->
let constr = parse_value_path p in
let args = parse_type_constructor_args ~constr_name:constr p in
let args =
parse_type_constructor_args ?inline_types ?current_type_name_path
~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
in
if number_of_inline_records_in_args > 1 then
Parser.err ~start_pos ~end_pos:p.prev_end_pos p
(Diagnostics.message
ErrorMessages.multiple_inline_record_definitions_at_same_path);
Ast_helper.Typ.constr
~loc:(mk_loc start_pos p.prev_end_pos)
~attrs constr args
Expand Down Expand Up @@ -4253,7 +4272,7 @@ and parse_record_or_object_type ?current_type_name_path ?inline_types ~attrs p =

let lid = Location.mkloc (Longident.Lident inline_type_name) loc in
Ast_helper.Typ.constr
~attrs:[(Location.mknoloc "inlineRecordReference", PStr [])]
~attrs:[(Location.mknoloc "res.inlineRecordReference", PStr [])]
~loc lid []
| _ ->
let () =
Expand Down Expand Up @@ -4531,15 +4550,17 @@ and parse_tuple_type ~attrs ~first ~start_pos p =
let tuple_loc = mk_loc start_pos p.prev_end_pos in
Ast_helper.Typ.tuple ~attrs ~loc:tuple_loc typexprs

and parse_type_constructor_arg_region p =
if Grammar.is_typ_expr_start p.Parser.token then Some (parse_typ_expr p)
and parse_type_constructor_arg_region ?inline_types ?current_type_name_path p =
if Grammar.is_typ_expr_start p.Parser.token then
Some (parse_typ_expr ?inline_types ?current_type_name_path p)
else if p.token = LessThan then (
Parser.next p;
parse_type_constructor_arg_region p)
parse_type_constructor_arg_region ?inline_types ?current_type_name_path p)
else None

(* Js.Nullable.value<'a> *)
and parse_type_constructor_args ~constr_name p =
and parse_type_constructor_args ?inline_types ?current_type_name_path
~constr_name p =
let opening = p.Parser.token in
let opening_start_pos = p.start_pos in
match opening with
Expand All @@ -4549,7 +4570,11 @@ and parse_type_constructor_args ~constr_name p =
let type_args =
(* TODO: change Grammar.TypExprList to TypArgList!!! Why did I wrote this? *)
parse_comma_delimited_region ~grammar:Grammar.TypExprList
~closing:GreaterThan ~f:parse_type_constructor_arg_region p
~closing:GreaterThan
~f:
(parse_type_constructor_arg_region ?inline_types
?current_type_name_path)
p
in
let () =
match p.token with
Expand Down Expand Up @@ -5648,7 +5673,7 @@ and parse_type_definition_or_extension ~attrs p =
!inline_types
|> List.map (fun (inline_type_name, loc, kind) ->
Ast_helper.Type.mk
~attrs:[(Location.mknoloc "inlineRecordDefinition", PStr [])]
~attrs:[(Location.mknoloc "res.inlineRecordDefinition", PStr [])]
~loc ~kind
{name with txt = inline_type_name})
in
Expand Down
9 changes: 6 additions & 3 deletions compiler/syntax/src/res_parsetree_viewer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -247,7 +247,8 @@ let filter_parsing_attrs attrs =
( "res.braces" | "ns.braces" | "res.iflet" | "res.namedArgLoc"
| "res.ternary" | "res.async" | "res.await" | "res.template"
| "res.taggedTemplate" | "res.patVariantSpread"
| "res.dictPattern" );
| "res.dictPattern" | "res.inlineRecordReference"
| "res.inlineRecordDefinition" );
},
_ ) ->
false
Expand Down Expand Up @@ -396,7 +397,8 @@ let has_attributes attrs =
| ( {
Location.txt =
( "res.braces" | "ns.braces" | "res.iflet" | "res.ternary"
| "res.async" | "res.await" | "res.template" );
| "res.async" | "res.await" | "res.template"
| "res.inlineRecordReference" | "res.inlineRecordDefinition" );
},
_ ) ->
false
Expand Down Expand Up @@ -580,7 +582,8 @@ let is_printable_attribute attr =
| ( {
Location.txt =
( "res.iflet" | "res.braces" | "ns.braces" | "JSX" | "res.async"
| "res.await" | "res.template" | "res.ternary" );
| "res.await" | "res.template" | "res.ternary"
| "res.inlineRecordReference" | "res.inlineRecordDefinition" );
},
_ ) ->
false
Expand Down
53 changes: 26 additions & 27 deletions compiler/syntax/src/res_printer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -553,12 +553,12 @@ end
let is_inline_record_definition attrs =
attrs
|> List.exists (fun (({txt}, _) : Parsetree.attribute) ->
txt = "inlineRecordDefinition")
txt = "res.inlineRecordDefinition")

let is_inline_record_reference attrs =
attrs
|> List.exists (fun (({txt}, _) : Parsetree.attribute) ->
txt = "inlineRecordReference")
txt = "res.inlineRecordReference")

let rec print_structure ~state (s : Parsetree.structure) t =
match s with
Expand Down Expand Up @@ -587,9 +587,7 @@ and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl =
let inline_record_definitions, regular_declarations =
type_declarations
|> List.partition (fun (td : Parsetree.type_declaration) ->
td.ptype_attributes
|> List.exists (fun (({txt}, _) : Parsetree.attribute) ->
txt = "inlineRecordDefinition"))
is_inline_record_definition td.ptype_attributes)
in
print_type_declarations ~inline_record_definitions ~state
~rec_flag:
Expand Down Expand Up @@ -1616,28 +1614,11 @@ and print_label_declaration ?inline_record_definitions ~state
name;
optional;
(if is_dot then Doc.nil else Doc.text ": ");
(match
( inline_record_definitions,
is_inline_record_reference ld.pld_type.ptyp_attributes,
ld.pld_type )
with
| ( Some inline_record_definitions,
true,
{ptyp_desc = Ptyp_constr ({txt = Lident constr_name}, _)} ) -> (
let record_definition =
inline_record_definitions
|> List.find_opt (fun (r : Parsetree.type_declaration) ->
r.ptype_name.txt = constr_name)
in
match record_definition with
| Some {ptype_kind = Ptype_record lds} ->
print_record_declaration ~inline_record_definitions ~state lds
cmt_tbl
| _ -> assert false)
| _ -> print_typ_expr ~state ld.pld_type cmt_tbl);
print_typ_expr ?inline_record_definitions ~state ld.pld_type cmt_tbl;
])

and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl =
and print_typ_expr ?inline_record_definitions ~(state : State.t)
(typ_expr : Parsetree.core_type) cmt_tbl =
let print_arrow ~arity typ_expr =
let max_arity =
match arity with
Expand Down Expand Up @@ -1742,6 +1723,22 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl =
| Ptyp_object (fields, open_flag) ->
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 -> (
let inline_record_definitions =
match inline_record_definitions with
| None -> []
| Some v -> v
in
let record_definition =
inline_record_definitions
|> List.find_opt (fun (r : Parsetree.type_declaration) ->
r.ptype_name.txt = inline_record_name)
in
match record_definition with
| Some {ptype_kind = Ptype_record lds} ->
print_record_declaration ~inline_record_definitions ~state lds cmt_tbl
| _ -> assert false)
| Ptyp_constr
(longident_loc, [{ptyp_desc = Ptyp_object (fields, open_flag)}]) ->
(* for foo<{"a": b}>, when the object is long and needs a line break, we
Expand Down Expand Up @@ -1782,15 +1779,17 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl =
~sep:(Doc.concat [Doc.comma; Doc.line])
(List.map
(fun typexpr ->
print_typ_expr ~state typexpr cmt_tbl)
print_typ_expr ?inline_record_definitions ~state
typexpr cmt_tbl)
constr_args);
]);
Doc.trailing_comma;
Doc.soft_line;
Doc.greater_than;
]))
| Ptyp_tuple types -> print_tuple_type ~state ~inline:false types cmt_tbl
| Ptyp_poly ([], typ) -> print_typ_expr ~state typ cmt_tbl
| Ptyp_poly ([], typ) ->
print_typ_expr ?inline_record_definitions ~state typ cmt_tbl
| Ptyp_poly (string_locs, typ) ->
Doc.concat
[
Expand Down
6 changes: 6 additions & 0 deletions tests/tests/src/nested_records.mjs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,12 @@ let options = {
name: "test",
superExtra: {
age: 2222
},
otherExtra: {
test: true,
anotherInlined: {
record: true
}
}
}
};
Expand Down
2 changes: 2 additions & 0 deletions tests/tests/src/nested_records.res
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ type options = {
extra?: {
name: string,
superExtra?: {age: int},
otherExtra: option<{test: bool, anotherInlined: {record: bool}}>,
},
}

Expand All @@ -11,5 +12,6 @@ let options = {
superExtra: {
age: 2222,
},
otherExtra: Some({test: true, anotherInlined: {record: true}}),
},
}

0 comments on commit 10634fe

Please sign in to comment.