From 66eaabdcb07d1efcdb46e86b9302f407745d76e0 Mon Sep 17 00:00:00 2001 From: Alex Snezhko Date: Sat, 7 Jan 2023 12:45:44 -0500 Subject: [PATCH] feat(compiler): Record spread syntax (#1565) Closes https://github.com/grain-lang/grain/issues/778 --- compiler/src/codegen/mashtree.re | 2 +- compiler/src/codegen/transl_anf.re | 6 +- compiler/src/formatting/debug.re | 2 +- compiler/src/formatting/format.re | 108 +++++++++++------ compiler/src/middle_end/anf_helper.rei | 2 +- compiler/src/middle_end/anftree.re | 2 +- compiler/src/middle_end/anftree.rei | 2 +- compiler/src/middle_end/linearize.re | 59 +++++++--- compiler/src/parsing/ast_helper.re | 47 +++++++- compiler/src/parsing/ast_helper.rei | 13 ++- compiler/src/parsing/ast_iterator.re | 5 +- compiler/src/parsing/ast_mapper.re | 3 +- compiler/src/parsing/parser.messages | 74 ++++++++++++ compiler/src/parsing/parser.mly | 10 +- compiler/src/parsing/parsetree.re | 2 +- compiler/src/typed/typecore.re | 102 +++++++++++----- compiler/src/typed/typedtree.re | 7 +- compiler/src/typed/typedtree.rei | 7 +- compiler/src/typed/typedtreeIter.re | 5 +- compiler/src/typed/typedtreeMap.re | 3 +- compiler/src/utils/warnings.re | 14 ++- compiler/src/utils/warnings.rei | 3 +- .../__snapshots__/records.012b017b.0.snapshot | 109 ++++++++++++++++++ compiler/test/formatter_inputs/records.gr | 11 ++ compiler/test/formatter_outputs/records.gr | 16 +++ compiler/test/suites/records.re | 45 ++++++++ 26 files changed, 547 insertions(+), 112 deletions(-) create mode 100644 compiler/test/__snapshots__/records.012b017b.0.snapshot diff --git a/compiler/src/codegen/mashtree.re b/compiler/src/codegen/mashtree.re index 09da972cfc..cc1753a19b 100644 --- a/compiler/src/codegen/mashtree.re +++ b/compiler/src/codegen/mashtree.re @@ -314,7 +314,7 @@ type allocation_type = | MTuple(list(immediate)) | MBox(immediate) | MArray(list(immediate)) - | MRecord(immediate, list((string, immediate))) + | MRecord(immediate, list((option(string), immediate))) | MADT(immediate, immediate, list(immediate)) /* Type Tag, Variant Tag, Elements */ | MBytes(bytes) | MString(string) diff --git a/compiler/src/codegen/transl_anf.re b/compiler/src/codegen/transl_anf.re index 9f9aaa4263..577fa39f2f 100644 --- a/compiler/src/codegen/transl_anf.re +++ b/compiler/src/codegen/transl_anf.re @@ -822,7 +822,11 @@ let rec compile_comp = (~id=?, env, c) => { MRecord( compile_imm(env, ttag), List.map( - (({txt: name}, arg)) => (name, compile_imm(env, arg)), + ((name, arg)) => + ( + Option.map(({txt: name}) => name, name), + compile_imm(env, arg), + ), args, ), ), diff --git a/compiler/src/formatting/debug.re b/compiler/src/formatting/debug.re index c0b6a3b702..30b37586fb 100644 --- a/compiler/src/formatting/debug.re +++ b/compiler/src/formatting/debug.re @@ -56,7 +56,7 @@ let debug_expression = (expr: Parsetree.expression) => { print_loc("PExpArrayGet", expr.pexp_loc) | PExpArraySet(expression1, expression2, expression3) => print_loc("PExpArraySet", expr.pexp_loc) - | PExpRecord(record) => print_loc("PExpRecord", expr.pexp_loc) + | PExpRecord(base, record) => print_loc("PExpRecord", expr.pexp_loc) | PExpRecordGet(expression, {txt, _}) => print_loc("PExpRecordGet", expr.pexp_loc) | PExpRecordSet(expression, {txt, _}, expression2) => diff --git a/compiler/src/formatting/format.re b/compiler/src/formatting/format.re index 519736cd82..fd2c443b36 100644 --- a/compiler/src/formatting/format.re +++ b/compiler/src/formatting/format.re @@ -128,6 +128,10 @@ type sugared_list_item = | Regular(Parsetree.expression) | Spread(Parsetree.expression); +type record_item = + | Field((Location.loc(Identifier.t), Parsetree.expression)) + | RecordSpread(Parsetree.expression); + type sugared_pattern_item = | RegularPattern(Parsetree.pattern) | SpreadPattern(Parsetree.pattern); @@ -1627,53 +1631,81 @@ and print_ident = (ident: Identifier.t) => { and print_record = ( + ~base: option(Parsetree.expression), ~fields: list((Location.loc(Identifier.t), Parsetree.expression)), ~original_source: array(string), ~comments: list(Parsetree.comment), recloc: Location.t, ) => { - let get_loc = (field: (Location.loc(Identifier.t), Parsetree.expression)) => { - let (_, expr) = field; - expr.pexp_loc; + let get_loc = item => { + switch (item) { + | Field((_, expr)) => expr.pexp_loc + | RecordSpread(base) => base.pexp_loc + }; }; - let print_item = - (~comments, field: (Location.loc(Identifier.t), Parsetree.expression)) => { - let (locidentifier, expr) = field; - let ident = locidentifier.txt; - let printed_ident = print_ident(ident); - let printed_expr = - print_expression( - ~expression_parent=GenericExpression, - ~original_source, - ~comments, - expr, - ); - let punned_expr = check_for_pun(expr); + let print_item = (~comments, item) => { + switch (item) { + | Field(field) => + let (locidentifier, expr) = field; + let ident = locidentifier.txt; + let printed_ident = print_ident(ident); + let printed_expr = + print_expression( + ~expression_parent=GenericExpression, + ~original_source, + ~comments, + expr, + ); + let punned_expr = check_for_pun(expr); - let pun = - switch (printed_ident, punned_expr: Doc.t) { - | (Text(i), Text(e)) => i == e - | _ => false - }; + let pun = + switch (printed_ident, punned_expr: Doc.t) { + | (Text(i), Text(e)) => i == e + | _ => false + }; - if (!pun) { - Doc.group( - Doc.concat([printed_ident, Doc.text(":"), Doc.space, printed_expr]), - ); - } else { - Doc.group(printed_ident); + if (!pun) { + Doc.group( + Doc.concat([ + printed_ident, + Doc.text(":"), + Doc.space, + printed_expr, + ]), + ); + } else { + Doc.group(printed_ident); + }; + | RecordSpread(base) => + Doc.concat([ + Doc.text("..."), + print_expression( + ~expression_parent=GenericExpression, + ~original_source, + ~comments, + base, + ), + ]) }; }; + let items = + Option.to_list(Option.map(x => RecordSpread(x), base)) + @ List.map(x => Field(x), fields); + let after_brace_comments = - switch (fields) { - | [field, ..._] => - let (ident, expr) = field; + switch (items) { + | [item, ..._] => + let loc = + switch (item) { + | Field((ident, _)) => ident.loc + | RecordSpread(exp) => exp.pexp_loc + }; Comment_utils.get_after_brace_comments( ~loc=recloc, - ~first=ident.loc, + ~first=loc, comments, ); @@ -1689,7 +1721,7 @@ and print_record = ~print_item, ~comments=cleaned_comments, ~iterated_item=IteratedRecord, - fields, + items, ); let printed_fields = Doc.join(~sep=Doc.line, items); @@ -1707,7 +1739,7 @@ and print_record = printed_fields_after_brace, Doc.ifBreaks( Doc.nil, - switch (fields) { + switch (items) { | [_one] => // TODO: not needed once we annotate with :: Doc.comma // append a comma as single argument record look like block {data:val} @@ -2787,8 +2819,14 @@ and print_expression_inner = ]), ) - | PExpRecord(record) => - print_record(~fields=record, ~original_source, ~comments, expr.pexp_loc) + | PExpRecord(base, record) => + print_record( + ~base, + ~fields=record, + ~original_source, + ~comments, + expr.pexp_loc, + ) | PExpRecordGet(expression, {txt, _}) => Doc.concat([ print_expression( diff --git a/compiler/src/middle_end/anf_helper.rei b/compiler/src/middle_end/anf_helper.rei index 6b2275e0ea..251e211546 100644 --- a/compiler/src/middle_end/anf_helper.rei +++ b/compiler/src/middle_end/anf_helper.rei @@ -168,7 +168,7 @@ module Comp: { ~attributes: attributes=?, ~env: env=?, imm_expression, - list((str, imm_expression)) + list((option(str), imm_expression)) ) => comp_expression; let adt: diff --git a/compiler/src/middle_end/anftree.re b/compiler/src/middle_end/anftree.re index e351c36ef1..187a832b7f 100644 --- a/compiler/src/middle_end/anftree.re +++ b/compiler/src/middle_end/anftree.re @@ -328,7 +328,7 @@ and comp_expression_desc = | CArray(list(imm_expression)) | CArrayGet(imm_expression, imm_expression) | CArraySet(imm_expression, imm_expression, imm_expression) - | CRecord(imm_expression, list((loc(string), imm_expression))) + | CRecord(imm_expression, list((option(loc(string)), imm_expression))) | CAdt(imm_expression, imm_expression, list(imm_expression)) | CGetTupleItem(int32, imm_expression) | CSetTupleItem(int32, imm_expression, imm_expression) diff --git a/compiler/src/middle_end/anftree.rei b/compiler/src/middle_end/anftree.rei index a7cd7b5c3c..8f36f5e660 100644 --- a/compiler/src/middle_end/anftree.rei +++ b/compiler/src/middle_end/anftree.rei @@ -308,7 +308,7 @@ and comp_expression_desc = | CArray(list(imm_expression)) | CArrayGet(imm_expression, imm_expression) | CArraySet(imm_expression, imm_expression, imm_expression) - | CRecord(imm_expression, list((loc(string), imm_expression))) + | CRecord(imm_expression, list((option(loc(string)), imm_expression))) | CAdt(imm_expression, imm_expression, list(imm_expression)) | CGetTupleItem(int32, imm_expression) | CSetTupleItem(int32, imm_expression, imm_expression) diff --git a/compiler/src/middle_end/linearize.re b/compiler/src/middle_end/linearize.re index 34aaf7ed8f..ab1bbbcd14 100644 --- a/compiler/src/middle_end/linearize.re +++ b/compiler/src/middle_end/linearize.re @@ -757,35 +757,56 @@ let rec transl_imm = ), ], ); - | TExpRecord(args) => + | TExpRecord(base, args) => + let base_imm = Option.map(transl_imm, base); let tmp = gensym("record"); - let definitions = - Array.to_list @@ Array.map(((desc, def)) => def, args); - let definitions = - List.map( - fun - | Kept(_) => assert(false) - | Overridden(name, def) => (name, def), - definitions, - ); let (new_args, new_setup) = List.split( List.map( - (({txt: name, loc}, expr)) => { - let (var, setup) = transl_imm(expr); - ( - (Location.mkloc(Identifier.string_of_ident(name), loc), var), - setup, - ); - }, - definitions, + arg => + switch (arg) { + | (ld, Kept) => + let (base_var, _) = Option.get(base_imm); + let fieldtmp = gensym("field"); + ( + (None, Imm.id(~loc, ~env, fieldtmp)), + [ + BLet( + fieldtmp, + Comp.record_get( + ~loc, + ~env, + ~allocation_type, + Int32.of_int(ld.lbl_pos), + base_var, + ), + Nonglobal, + ), + ], + ); + | (_, Overridden({txt: name, loc}, expr)) => + let (var, setup) = transl_imm(expr); + ( + ( + Some( + Location.mkloc(Identifier.string_of_ident(name), loc), + ), + var, + ), + setup, + ); + }, + Array.to_list(args), ), ); let (typath, _, _) = Typepat.extract_concrete_record(env, typ); let ty_id = get_type_id(typath); ( Imm.id(~loc, ~env, tmp), - List.concat(new_setup) + List.concat( + Option.to_list(Option.map(((_, setup)) => setup, base_imm)) + @ new_setup, + ) @ [ BLet( tmp, diff --git a/compiler/src/parsing/ast_helper.re b/compiler/src/parsing/ast_helper.re index cb6ab5d460..d766220b67 100644 --- a/compiler/src/parsing/ast_helper.re +++ b/compiler/src/parsing/ast_helper.re @@ -24,6 +24,10 @@ type listitem('a) = | ListItem('a) | ListSpread('a, Location.t); +type recorditem = + | RecordItem(loc(Identifier.t), expression) + | RecordSpread(expression, Location.t); + type id = loc(Identifier.t); type str = loc(string); type loc = Location.t; @@ -192,8 +196,47 @@ module Exp = { mk(~loc?, ~attributes?, PExpConstant(a)); let tuple = (~loc=?, ~attributes=?, a) => mk(~loc?, ~attributes?, PExpTuple(a)); - let record = (~loc=?, ~attributes=?, a) => - mk(~loc?, ~attributes?, PExpRecord(a)); + let record = (~loc=?, ~attributes=?, a, b) => + mk(~loc?, ~attributes?, PExpRecord(a, b)); + let record_fields = (~loc=?, ~attributes=?, a) => + switch (a) { + | [] => failwith("Impossible: empty record field list") + | [base, ...rest] => + let (spread_base, record_items) = + switch (base) { + | RecordItem(id, expr) => (None, [(id, expr)]) + | RecordSpread(expr, _) => (Some(expr), []) + }; + let record_items = + List.fold_left( + (acc, expr) => { + switch (expr) { + | RecordItem(id, expr) => [(id, expr), ...acc] + | RecordSpread(_, loc) => + switch (spread_base) { + | None => + raise( + SyntaxError( + loc, + "A record spread can only appear at the beginning of a record expression.", + ), + ) + | Some(_) => + raise( + SyntaxError( + loc, + "A record expression may only contain one record spread.", + ), + ) + } + } + }, + record_items, + rest, + ); + let record_items = List.rev(record_items); + record(~loc?, ~attributes?, spread_base, record_items); + }; let record_get = (~loc=?, ~attributes=?, a, b) => mk(~loc?, ~attributes?, PExpRecordGet(a, b)); let record_set = (~loc=?, ~attributes=?, a, b, c) => diff --git a/compiler/src/parsing/ast_helper.rei b/compiler/src/parsing/ast_helper.rei index a24063c56c..38bb82fe5d 100644 --- a/compiler/src/parsing/ast_helper.rei +++ b/compiler/src/parsing/ast_helper.rei @@ -24,6 +24,10 @@ type listitem('a) = | ListItem('a) | ListSpread('a, Location.t); +type recorditem = + | RecordItem(loc(Identifier.t), expression) + | RecordSpread(expression, Location.t); + type id = loc(Identifier.t); type str = loc(string); type loc = Location.t; @@ -113,8 +117,15 @@ module Exp: { let tuple: (~loc: loc=?, ~attributes: attributes=?, list(expression)) => expression; let record: - (~loc: loc=?, ~attributes: attributes=?, list((id, expression))) => + ( + ~loc: loc=?, + ~attributes: attributes=?, + option(expression), + list((id, expression)) + ) => expression; + let record_fields: + (~loc: loc=?, ~attributes: attributes=?, list(recorditem)) => expression; let record_get: (~loc: loc=?, ~attributes: attributes=?, expression, id) => expression; let record_set: diff --git a/compiler/src/parsing/ast_iterator.re b/compiler/src/parsing/ast_iterator.re index 2068dd5ff3..6a67f81176 100644 --- a/compiler/src/parsing/ast_iterator.re +++ b/compiler/src/parsing/ast_iterator.re @@ -62,14 +62,15 @@ module E = { sub.expr(sub, a); sub.expr(sub, i); sub.expr(sub, arg); - | PExpRecord(es) => + | PExpRecord(b, es) => + Option.iter(sub.expr(sub), b); List.iter( ((name, exp)) => { iter_loc(sub, name); sub.expr(sub, exp); }, es, - ) + ); | PExpRecordGet(e, f) => sub.expr(sub, e); iter_loc(sub, f); diff --git a/compiler/src/parsing/ast_mapper.re b/compiler/src/parsing/ast_mapper.re index ba844da6e0..88a8bdcd4d 100644 --- a/compiler/src/parsing/ast_mapper.re +++ b/compiler/src/parsing/ast_mapper.re @@ -63,10 +63,11 @@ module E = { sub.expr(sub, i), sub.expr(sub, arg), ) - | PExpRecord(es) => + | PExpRecord(b, es) => record( ~loc, ~attributes, + Option.map(sub.expr(sub), b), List.map( ((name, expr)) => (map_loc(sub, name), sub.expr(sub, expr)), es, diff --git a/compiler/src/parsing/parser.messages b/compiler/src/parsing/parser.messages index 540f82b7a5..0d1de61fbb 100644 --- a/compiler/src/parsing/parser.messages +++ b/compiler/src/parsing/parser.messages @@ -513,6 +513,15 @@ program: LBRACK ELLIPSIS WHEN ## The known suffix of the stack is as follows: ## ELLIPSIS ## +program: LBRACE ELLIPSIS WHEN +## +## Ends in an error in state: 184. +## +## spread_record_field -> ELLIPSIS . expr [ RBRACE EOL COMMA ] +## +## The known suffix of the stack is as follows: +## ELLIPSIS +## program: LET WASMI64 EQUAL EOL UNDERSCORE ## ## Ends in an error in state: 430. @@ -3229,6 +3238,30 @@ program: LBRACE UIDENT COMMA EOL UIDENT COLON BREAK WHILE ## The known suffix of the stack is as follows: ## punned_record_field comma lseparated_nonempty_list_inner(comma,record_field) ## +program: LBRACE ELLIPSIS BIGINT COMMA ELLIPSIS BIGINT ARROW +## +## Ends in an error in state: 227. +## +## lseparated_nonempty_list_inner(comma,record_field) -> lseparated_nonempty_list_inner(comma,record_field) . comma punned_record_field [ RBRACE EOL COMMA ] +## lseparated_nonempty_list_inner(comma,record_field) -> lseparated_nonempty_list_inner(comma,record_field) . comma non_punned_record_field [ RBRACE EOL COMMA ] +## lseparated_nonempty_list_inner(comma,record_field) -> lseparated_nonempty_list_inner(comma,record_field) . comma spread_record_field [ RBRACE EOL COMMA ] +## record_exprs -> spread_record_field comma lseparated_nonempty_list_inner(comma,record_field) . option(comma) [ RBRACE EOL ] +## +## The known suffix of the stack is as follows: +## spread_record_field comma lseparated_nonempty_list_inner(comma,record_field) +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 171, spurious reduction of production non_assign_expr -> left_accessor_expr +## In state 125, spurious reduction of production non_binop_expr -> non_assign_expr +## In state 69, spurious reduction of production annotated_expr -> non_binop_expr +## In state 203, spurious reduction of production non_stmt_expr -> annotated_expr +## In state 59, spurious reduction of production expr -> non_stmt_expr +## In state 208, spurious reduction of production spread_record_field -> ELLIPSIS expr +## In state 224, spurious reduction of production lseparated_nonempty_list_inner(comma,record_field) -> spread_record_field +## Expected a comma followed by more record fields or an immediate `}` to complete the record expression. @@ -3290,6 +3323,47 @@ program: LBRACE UIDENT COMMA UIDENT COMMA EOL WHILE Expected more record fields or an immediate `}` to complete the record expression. +program: LBRACE ELLIPSIS BIGINT ARROW +## +## Ends in an error in state: 222. +## +## record_exprs -> spread_record_field . comma lseparated_nonempty_list_inner(comma,record_field) option(comma) [ RBRACE EOL ] +## +## The known suffix of the stack is as follows: +## spread_record_field +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 171, spurious reduction of production non_assign_expr -> left_accessor_expr +## In state 125, spurious reduction of production non_binop_expr -> non_assign_expr +## In state 69, spurious reduction of production annotated_expr -> non_binop_expr +## In state 203, spurious reduction of production non_stmt_expr -> annotated_expr +## In state 59, spurious reduction of production expr -> non_stmt_expr +## In state 208, spurious reduction of production spread_record_field -> ELLIPSIS expr +## + +Expected a comma followed by one or more record field overrides to complete the record expression. + +program: LBRACE ELLIPSIS BIGINT COMMA WHILE +## +## Ends in an error in state: 223. +## +## record_exprs -> spread_record_field comma . lseparated_nonempty_list_inner(comma,record_field) option(comma) [ RBRACE EOL ] +## +## The known suffix of the stack is as follows: +## spread_record_field comma +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 93, spurious reduction of production comma -> COMMA +## + +Expected one or more record field overrides to complete the record expression. + program: LBRACE UIDENT COMMA UIDENT THICKARROW ## ## Ends in an error in state: 211. diff --git a/compiler/src/parsing/parser.mly b/compiler/src/parsing/parser.mly index d0a8e6142b..dc2f21583d 100644 --- a/compiler/src/parsing/parser.mly +++ b/compiler/src/parsing/parser.mly @@ -450,7 +450,7 @@ simple_expr: braced_expr: | lbrace block_body rbrace { Exp.block ~loc:(to_loc $loc) $2 } - | lbrace record_exprs rbrace { Exp.record ~loc:(to_loc $loc) $2 } + | lbrace record_exprs rbrace { Exp.record_fields ~loc:(to_loc $loc) $2 } block: | lbrace block_body rbrace { Exp.block ~loc:(to_loc $loc) $2 } @@ -579,14 +579,18 @@ record_set: | colon expr {$2} punned_record_field: - | id { $1, (Exp.ident ~loc:(to_loc $loc) $1) } + | id { RecordItem ($1, (Exp.ident ~loc:(to_loc $loc) $1)) } non_punned_record_field: - | id record_field_value { $1, $2 } + | id record_field_value { RecordItem ($1, $2) } + +spread_record_field: + | ELLIPSIS expr { RecordSpread ($2, to_loc $loc) } %inline record_field: | punned_record_field { $1 } | non_punned_record_field { $1 } + | spread_record_field { $1 } record_exprs: // Don't ever parse {x} as a record diff --git a/compiler/src/parsing/parsetree.re b/compiler/src/parsing/parsetree.re index 11b7cbedd7..91af5f5d35 100644 --- a/compiler/src/parsing/parsetree.re +++ b/compiler/src/parsing/parsetree.re @@ -435,7 +435,7 @@ and expression_desc = | PExpArray(list(expression)) | PExpArrayGet(expression, expression) | PExpArraySet(expression, expression, expression) - | PExpRecord(list((loc(Identifier.t), expression))) + | PExpRecord(option(expression), list((loc(Identifier.t), expression))) | PExpRecordGet(expression, loc(Identifier.t)) | PExpRecordSet(expression, loc(Identifier.t), expression) | PExpLet(rec_flag, mut_flag, list(value_binding)) diff --git a/compiler/src/typed/typecore.re b/compiler/src/typed/typecore.re index 3f5e156bb6..52c2812c38 100644 --- a/compiler/src/typed/typecore.re +++ b/compiler/src/typed/typecore.re @@ -726,7 +726,9 @@ and type_expect_ = exp_type: Builtin_types.type_void, exp_env: env, }); - | PExpRecord(es) => + | PExpRecord(b, es) => + let opt_exp = Option.map(type_exp(env), b); + let (ty_record, opath) = { let get_path = ty => try({ @@ -738,9 +740,19 @@ and type_expect_ = | Not_found => None }; - switch (get_path(ty_expected)) { - | None => (newvar(), None) - | op => (ty_expected, op) + let expected_opath = get_path(ty_expected); + let opt_exp_opath = Option.bind(opt_exp, exp => get_path(exp.exp_type)); + switch (expected_opath, opt_exp_opath) { + | (None, None) => (newvar(), None) + | (Some(_), None) + | (Some((_, _, true)), Some(_)) => (ty_expected, expected_opath) + | (None | Some((_, _, false)), Some((_, p', _))) => + let decl = Env.find_type(p', env); + begin_def(); + let ty = newconstr(p', instance_list(env, decl.type_params)); + end_def(); + generalize_structure(ty); + (ty, opt_exp_opath); }; }; @@ -782,7 +794,7 @@ and type_expect_ = ); check_duplicates(lbl_exp_list); - let label_definitions = { + let (opt_exp, label_definitions) = { let (_lid, lbl, _lbl_exp) = List.hd(lbl_exp_list); let matching_label = lbl => List.find( @@ -790,33 +802,65 @@ and type_expect_ = lbl_exp_list, ); - Array.map( - lbl => + switch (opt_exp) { + | None => + let label_definitions = + Array.map( + lbl => + switch (matching_label(lbl)) { + | (lid, _lbl, lbl_exp) => Overridden(lid, lbl_exp) + | exception Not_found => + let present_indices = + List.map(((_, lbl, _)) => lbl.lbl_pos, lbl_exp_list); + + let label_names = extract_label_names(env, ty_expected); + let rec missing_labels = n => ( + fun + | [] => [] + | [lbl, ...rem] => + if (List.mem(n, present_indices)) { + missing_labels(n + 1, rem); + } else { + [lbl, ...missing_labels(n + 1, rem)]; + } + ); + + let missing = missing_labels(0, label_names); + raise(Error(loc, env, Label_missing(missing))); + }, + lbl.lbl_all, + ); + (None, label_definitions); + | Some(exp) => + let ty_exp = instance(env, exp.exp_type); + let unify_kept = lbl => { + let (_, ty_arg1, ty_res1) = instance_label(false, lbl); + unify_exp_types(exp.exp_loc, env, ty_exp, ty_res1); switch (matching_label(lbl)) { - | (lid, _lbl, lbl_exp) => Overridden(lid, lbl_exp) + | (lid, _lbl, lbl_exp) => + // do not connect result types for overridden labels + Overridden(lid, lbl_exp) | exception Not_found => - let present_indices = - List.map(((_, lbl, _)) => lbl.lbl_pos, lbl_exp_list); - - let label_names = extract_label_names(env, ty_expected); - let rec missing_labels = n => ( - fun - | [] => [] - | [lbl, ...rem] => - if (List.mem(n, present_indices)) { - missing_labels(n + 1, rem); - } else { - [lbl, ...missing_labels(n + 1, rem)]; - } + let (_, ty_arg2, ty_res2) = instance_label(false, lbl); + unify_exp_types(loc, env, ty_arg1, ty_arg2); + with_explanation(() => + unify_exp_types(loc, env, instance(env, ty_expected), ty_res2) ); - - let missing = missing_labels(0, label_names); - raise(Error(loc, env, Label_missing(missing))); - }, - lbl.lbl_all, - ); + Kept; + }; + }; + let label_definitions = Array.map(unify_kept, lbl.lbl_all); + (Some({...exp, exp_type: ty_exp}), label_definitions); + }; + }; + let num_fields = + switch (lbl_exp_list) { + | [] => assert(false) + | [(_, lbl, _), ..._] => Array.length(lbl.lbl_all) + }; + if (b != None && List.length(es) == num_fields) { + Location.prerr_warning(loc, Grain_utils.Warnings.UselessRecordSpread); }; - let label_descriptions = { let (_, {lbl_all}, _) = List.hd(lbl_exp_list); lbl_all; @@ -830,7 +874,7 @@ and type_expect_ = ); re({ - exp_desc: TExpRecord(fields), + exp_desc: TExpRecord(opt_exp, fields), exp_loc: loc, exp_extra: [], exp_attributes: attributes, diff --git a/compiler/src/typed/typedtree.re b/compiler/src/typed/typedtree.re index bcbb810e20..3e6ce77a36 100644 --- a/compiler/src/typed/typedtree.re +++ b/compiler/src/typed/typedtree.re @@ -444,7 +444,10 @@ and expression_desc = | TExpArray(list(expression)) | TExpArrayGet(expression, expression) | TExpArraySet(expression, expression, expression) - | TExpRecord(array((Types.label_description, record_label_definition))) + | TExpRecord( + option(expression), + array((Types.label_description, record_label_definition)), + ) | TExpRecordGet(expression, loc(Identifier.t), Types.label_description) | TExpRecordSet( expression, @@ -481,7 +484,7 @@ and expression_desc = | TExpNull and record_label_definition = - | Kept(Types.type_expr) + | Kept | Overridden(loc(Identifier.t), expression) [@deriving sexp] diff --git a/compiler/src/typed/typedtree.rei b/compiler/src/typed/typedtree.rei index b17a43584a..0b4524ca44 100644 --- a/compiler/src/typed/typedtree.rei +++ b/compiler/src/typed/typedtree.rei @@ -412,7 +412,10 @@ and expression_desc = | TExpArray(list(expression)) | TExpArrayGet(expression, expression) | TExpArraySet(expression, expression, expression) - | TExpRecord(array((Types.label_description, record_label_definition))) + | TExpRecord( + option(expression), + array((Types.label_description, record_label_definition)), + ) | TExpRecordGet(expression, loc(Identifier.t), Types.label_description) | TExpRecordSet( expression, @@ -449,7 +452,7 @@ and expression_desc = | TExpNull and record_label_definition = - | Kept(Types.type_expr) + | Kept | Overridden(loc(Identifier.t), expression) and value_binding = { diff --git a/compiler/src/typed/typedtreeIter.re b/compiler/src/typed/typedtreeIter.re index dd8358ce20..ed55642079 100644 --- a/compiler/src/typed/typedtreeIter.re +++ b/compiler/src/typed/typedtreeIter.re @@ -214,13 +214,14 @@ module MakeIterator = | TExpMatch(value, branches, _) => iter_expression(value); iter_match_branches(branches); - | TExpRecord(args) => + | TExpRecord(b, args) => + Option.iter(iter_expression, b); Array.iter( fun | (_, Overridden(_, expr)) => iter_expression(expr) | _ => (), args, - ) + ); | TExpRecordGet(expr, _, _) => iter_expression(expr) | TExpRecordSet(e1, _, _, e2) => iter_expression(e1); diff --git a/compiler/src/typed/typedtreeMap.re b/compiler/src/typed/typedtreeMap.re index 4e34659c15..205d7f304a 100644 --- a/compiler/src/typed/typedtreeMap.re +++ b/compiler/src/typed/typedtreeMap.re @@ -214,8 +214,9 @@ module MakeMap = map_expression(a2), map_expression(a3), ) - | TExpRecord(args) => + | TExpRecord(b, args) => TExpRecord( + Option.map(map_expression, b), Array.map( fun | (desc, Overridden(name, expr)) => ( diff --git a/compiler/src/utils/warnings.re b/compiler/src/utils/warnings.re index 1c33586292..7eb490b672 100644 --- a/compiler/src/utils/warnings.re +++ b/compiler/src/utils/warnings.re @@ -27,7 +27,10 @@ type t = | FromNumberLiteralI32(string) | FromNumberLiteralI64(string) | FromNumberLiteralF32(string) - | FromNumberLiteralF64(string); + | FromNumberLiteralF64(string) + | UselessRecordSpread; + +let last_warning_number = 22; let number = fun @@ -51,9 +54,8 @@ let number = | FromNumberLiteralI32(_) => 18 | FromNumberLiteralI64(_) => 19 | FromNumberLiteralF32(_) => 20 - | FromNumberLiteralF64(_) => 21; - -let last_warning_number = 21; + | FromNumberLiteralF64(_) => 21 + | UselessRecordSpread => last_warning_number; let message = fun @@ -136,7 +138,8 @@ let message = Printf.sprintf( "it looks like you are calling Float64.fromNumber() with a constant number. Try using the literal syntax (e.g. `%sd`) instead.", n, - ); + ) + | UselessRecordSpread => "this record spread is useless as all of the record's fields are overridden."; let sub_locs = fun @@ -183,6 +186,7 @@ let defaults = [ FromNumberLiteralI64(""), FromNumberLiteralF32(""), FromNumberLiteralF64(""), + UselessRecordSpread, ]; let _ = List.iter(x => current^.active[number(x)] = true, defaults); diff --git a/compiler/src/utils/warnings.rei b/compiler/src/utils/warnings.rei index 7d2c2097e2..76e99cd8a5 100644 --- a/compiler/src/utils/warnings.rei +++ b/compiler/src/utils/warnings.rei @@ -41,7 +41,8 @@ type t = | FromNumberLiteralI32(string) | FromNumberLiteralI64(string) | FromNumberLiteralF32(string) - | FromNumberLiteralF64(string); + | FromNumberLiteralF64(string) + | UselessRecordSpread; let is_active: t => bool; let is_error: t => bool; diff --git a/compiler/test/__snapshots__/records.012b017b.0.snapshot b/compiler/test/__snapshots__/records.012b017b.0.snapshot new file mode 100644 index 0000000000..3dca6535d5 --- /dev/null +++ b/compiler/test/__snapshots__/records.012b017b.0.snapshot @@ -0,0 +1,109 @@ +records › record_spread_2 +(module + (type $none_=>_i32 (func (result i32))) + (type $none_=>_none (func)) + (type $i32_i32_=>_i32 (func (param i32 i32) (result i32))) + (import \"_grainEnv\" \"mem\" (memory $0 0)) + (import \"_grainEnv\" \"tbl\" (table $tbl 0 funcref)) + (import \"_grainEnv\" \"relocBase\" (global $relocBase_0 i32)) + (import \"_grainEnv\" \"moduleRuntimeId\" (global $moduleRuntimeId_0 i32)) + (import \"GRAIN$MODULE$runtime/gc\" \"GRAIN$EXPORT$malloc\" (global $GRAIN$EXPORT$malloc_0 (mut i32))) + (import \"GRAIN$MODULE$runtime/gc\" \"malloc\" (func $malloc_0 (param i32 i32) (result i32))) + (global $GRAIN$TABLE_SIZE i32 (i32.const 0)) + (elem $elem (global.get $relocBase_0)) + (export \"memory\" (memory $0)) + (export \"_gmain\" (func $_gmain)) + (export \"_start\" (func $_start)) + (export \"GRAIN$TABLE_SIZE\" (global $GRAIN$TABLE_SIZE)) + (func $_gmain (result i32) + (local $0 i32) + (local $1 i32) + (local $2 i32) + (local $3 i64) + (local $4 f32) + (local $5 f64) + (return + (block $cleanup_locals.5 (result i32) + (local.set $0 + (block $compile_function_preamble.4 (result i32) + (block $compile_type_metadata.2 + (local.set $0 + (i32.add + (block $allocate_string.1 (result i32) + (i32.store + (local.tee $0 + (call $malloc_0 + (global.get $GRAIN$EXPORT$malloc_0) + (i32.const 64) + ) + ) + (i32.const 1) + ) + (i32.store offset=4 + (local.get $0) + (i32.const 52) + ) + (i64.store offset=8 + (local.get $0) + (i64.const 0) + ) + (i64.store offset=16 + (local.get $0) + (i64.const 171798691841) + ) + (i64.store offset=24 + (local.get $0) + (i64.const 68719477867) + ) + (i64.store offset=32 + (local.get $0) + (i64.const 31366206292230147) + ) + (i64.store offset=40 + (local.get $0) + (i64.const 68719476736) + ) + (i64.store offset=48 + (local.get $0) + (i64.const 32195220879704067) + ) + (i64.store offset=56 + (local.get $0) + (i64.const 0) + ) + (local.get $0) + ) + (i32.const 8) + ) + ) + (i32.store + (local.get $0) + (i32.load + (i32.const 1032) + ) + ) + (i32.store offset=4 + (local.get $0) + (global.get $moduleRuntimeId_0) + ) + (i32.store + (i32.const 1032) + (local.get $0) + ) + ) + (block $compile_block.3 (result i32) + (i32.const 1879048190) + ) + ) + ) + (local.get $0) + ) + ) + ) + (func $_start + (drop + (call $_gmain) + ) + ) + ;; custom section \"cmi\", size 493 +) diff --git a/compiler/test/formatter_inputs/records.gr b/compiler/test/formatter_inputs/records.gr index bbe5106ca5..801b6278bd 100644 --- a/compiler/test/formatter_inputs/records.gr +++ b/compiler/test/formatter_inputs/records.gr @@ -94,3 +94,14 @@ let { // a comment 3 str: "" } let y = {/* comment 1 */x, /* comment 2 */longlonglongnamenamename2: 12345, /* comment 3 */ longlonglongnamenamename3: 12345 /* comment 4 */} // end line comment + +let y = { ...x, bar: 2 } + +let y = { + ...x, + bar: 2 +} + +let y = { ...x, longlonglongnamenamename2: 12345, longlonglongnamenamename3: 12345 } + +let y = {/* comment 1 */...x, /* comment 2 */longlonglongnamenamename2: 12345, /* comment 3 */ longlonglongnamenamename3: 12345 /* comment 4 */} // end line comment diff --git a/compiler/test/formatter_outputs/records.gr b/compiler/test/formatter_outputs/records.gr index 3052d7de9d..74514572cb 100644 --- a/compiler/test/formatter_outputs/records.gr +++ b/compiler/test/formatter_outputs/records.gr @@ -116,3 +116,19 @@ let y = { /* comment 1 */ longlonglongnamenamename2: 12345, /* comment 3 */ longlonglongnamenamename3: 12345, /* comment 4 */ } // end line comment + +let y = { ...x, bar: 2 } + +let y = { ...x, bar: 2 } + +let y = { + ...x, + longlonglongnamenamename2: 12345, + longlonglongnamenamename3: 12345, +} + +let y = { /* comment 1 */ + ...x, /* comment 2 */ + longlonglongnamenamename2: 12345, /* comment 3 */ + longlonglongnamenamename3: 12345, /* comment 4 */ +} // end line comment diff --git a/compiler/test/suites/records.re b/compiler/test/suites/records.re index f1e0c7b34e..ff87795d4b 100644 --- a/compiler/test/suites/records.re +++ b/compiler/test/suites/records.re @@ -1,5 +1,9 @@ open Grain_tests.TestFramework; open Grain_tests.Runner; +open Grain_utils; + +let {describe} = + describeConfig |> withCustomMatchers(customMatchers) |> build; describe("records", ({test, testSkip}) => { let test_or_skip = @@ -8,6 +12,7 @@ describe("records", ({test, testSkip}) => { let assertSnapshot = makeSnapshotRunner(test); let assertCompileError = makeCompileErrorRunner(test); let assertRun = makeRunner(test_or_skip); + let assertWarning = makeWarningRunner(test); assertRun( "record_1", @@ -183,4 +188,44 @@ describe("records", ({test, testSkip}) => { |}, "Baz()\n", ); + // record spread + assertRun( + "record_spread_1", + "record Rec {foo: Number, bar: Number, mut baz: Number}; let a = {foo: 1, bar: 2, baz: 3}; let b = {...a, bar: 3}; b.baz = 5; print(b); print(a)", + "{\n foo: 1,\n bar: 3,\n baz: 5\n}\n{\n foo: 1,\n bar: 2,\n baz: 3\n}\n", + ); + assertSnapshot( + "record_spread_2", + "record Rec {foo: Number, bar: Number}; let a = {foo: 1, bar: 2}; let b = {...a, bar: 3}", + ); + assertCompileError( + "record_spread_3", + "record Rec {foo: Number, bar: Number}; let a = {foo: 1, bar: 2}; let b = {bar: 3, ...a}", + "A record spread can only appear at the beginning of a record expression", + ); + assertCompileError( + "record_spread_4", + "record Rec {foo: Number, bar: Number}; let a = {foo: 1, bar: 2}; let b = {...a, ...a}", + "A record expression may only contain one record spread", + ); + assertCompileError( + "record_spread_5", + "record Rec {foo: Number, bar: Number}; let a = {foo: 1, bar: 2}; let b = {...a}", + "Expected a comma followed by one or more record field overrides to complete the record expression", + ); + assertCompileError( + "record_spread_6", + "record Rec {foo: Number, bar: Number}; let a = {foo: 1, bar: 2}; let b = {...a,}", + "Expected one or more record field overrides to complete the record expression", + ); + assertCompileError( + "record_spread_7", + "record Rec {foo: Number, bar: Number}; record Rec2 {baz: Number}; let a = {foo: 1, bar: 2}; let b = {...a, baz: 3}", + "The field baz does not belong to type Rec", + ); + assertWarning( + "record_spread_8", + "record Rec {foo: Number, bar: Number}; let a = {foo: 1, bar: 2}; let b = {...a, foo: 2, bar: 3}", + Warnings.UselessRecordSpread, + ); });