From 0ec00ae038a679bb15912f0a82756831bd5008aa Mon Sep 17 00:00:00 2001 From: tsnobip Date: Sat, 28 Mar 2026 10:35:02 +0100 Subject: [PATCH 01/11] destructure record rest elements - fixes #8311 --- analysis/reanalyze/src/DeadValue.ml | 2 +- analysis/src/CompletionFrontEnd.ml | 2 +- analysis/src/CompletionPatterns.ml | 4 +- analysis/src/DumpAst.ml | 2 +- analysis/src/Hint.ml | 2 +- analysis/src/ProcessCmt.ml | 2 +- analysis/src/ProcessExtra.ml | 2 +- analysis/src/SemanticTokens.ml | 2 +- analysis/src/SignatureHelp.ml | 3 +- analysis/src/Xform.ml | 2 +- compiler/common/pattern_printer.ml | 4 +- compiler/core/lam_analysis.ml | 2 +- compiler/core/lam_compile_primitive.ml | 12 ++ compiler/core/lam_convert.ml | 2 + compiler/core/lam_primitive.ml | 7 +- compiler/core/lam_primitive.mli | 1 + compiler/core/lam_print.ml | 2 + .../frontend/ast_tuple_pattern_flatten.ml | 2 +- compiler/frontend/bs_ast_mapper.ml | 6 +- compiler/ml/ast_helper.ml | 2 +- compiler/ml/ast_helper.mli | 1 + compiler/ml/ast_iterator.ml | 2 +- compiler/ml/ast_mapper.ml | 6 +- compiler/ml/ast_mapper_to0.ml | 2 +- compiler/ml/depend.ml | 2 +- compiler/ml/lambda.ml | 1 + compiler/ml/lambda.mli | 1 + compiler/ml/matching.ml | 77 ++++++-- compiler/ml/parmatch.ml | 57 +++--- compiler/ml/parsetree.ml | 7 +- compiler/ml/pprintast.ml | 2 +- compiler/ml/printast.ml | 2 +- compiler/ml/printlambda.ml | 2 + compiler/ml/printtyped.ml | 2 +- compiler/ml/rec_check.ml | 4 +- compiler/ml/tast_iterator.ml | 2 +- compiler/ml/tast_mapper.ml | 4 +- compiler/ml/typecore.ml | 176 +++++++++++++++++- compiler/ml/typecore.mli | 6 + compiler/ml/typedtree.ml | 23 ++- compiler/ml/typedtree.mli | 9 + compiler/ml/typedtreeIter.ml | 2 +- compiler/syntax/src/res_ast_debugger.ml | 2 +- compiler/syntax/src/res_comments_table.ml | 2 +- compiler/syntax/src/res_core.ml | 80 +++++++- compiler/syntax/src/res_printer.ml | 36 +++- .../errors/other/expected/spread.res.txt | 16 +- .../grammar/pattern/expected/record.res.txt | 10 +- .../data/parsing/grammar/pattern/record.res | 16 ++ .../pattern/expected/parenthesized.res.txt | 2 +- .../recovery/pattern/expected/record.res.txt | 16 +- tests/tests/src/record_rest_test.mjs | 35 ++++ tests/tests/src/record_rest_test.res | 41 ++++ 53 files changed, 576 insertions(+), 133 deletions(-) create mode 100644 tests/tests/src/record_rest_test.mjs create mode 100644 tests/tests/src/record_rest_test.res diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index 0bb26e9dca1..0d1cb00f361 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -228,7 +228,7 @@ let collectPattern ~config ~refs : fun super self pat -> let posFrom = pat.Typedtree.pat_loc.loc_start in (match pat.pat_desc with - | Typedtree.Tpat_record (cases, _clodsedFlag) -> + | Typedtree.Tpat_record (cases, _clodsedFlag, _rest) -> cases |> List.iter (fun (_loc, {Types.lbl_loc = {loc_start = posTo}}, _pat, _) -> if !Config.analyzeTypes then diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index a5c0f9ce377..7cbae4dc38b 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -514,7 +514,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor (NPolyvariantPayload {itemNum = 0; constructorName = txt} :: patternPath) ?contextPath p - | Ppat_record (fields, _) -> + | Ppat_record (fields, _, _rest) -> Ext_list.iter fields (fun {lid = fname; x = p} -> match fname with | {Location.txt = Longident.Lident fname} -> diff --git a/analysis/src/CompletionPatterns.ml b/analysis/src/CompletionPatterns.ml index 8755c48457f..8c03d0aa4c2 100644 --- a/analysis/src/CompletionPatterns.ml +++ b/analysis/src/CompletionPatterns.ml @@ -102,12 +102,12 @@ and traversePattern (pat : Parsetree.pattern) ~patternPath ~locHasCursor [Completable.NTupleItem {itemNum}] @ patternPath) ~resultFromFoundItemNum:(fun itemNum -> [Completable.NTupleItem {itemNum = itemNum + 1}] @ patternPath) - | Ppat_record ([], _) -> + | Ppat_record ([], _, _rest) -> (* Empty fields means we're in a record body `{}`. Complete for the fields. *) someIfHasCursor ("", [Completable.NRecordBody {seenFields = []}] @ patternPath) "Ppat_record(empty)" - | Ppat_record (fields, _) -> ( + | Ppat_record (fields, _, _rest) -> ( let fieldWithCursor = ref None in let fieldWithPatHole = ref None in Ext_list.iter fields (fun {lid = fname; x = f} -> diff --git a/analysis/src/DumpAst.ml b/analysis/src/DumpAst.ml index 39b05b3e6f0..af93b9a4178 100644 --- a/analysis/src/DumpAst.ml +++ b/analysis/src/DumpAst.ml @@ -99,7 +99,7 @@ let rec printPattern pattern ~pos ~indentation = | None -> "" | Some pat -> "," ^ printPattern pat ~pos ~indentation) ^ ")" - | Ppat_record (fields, _) -> + | Ppat_record (fields, _, _rest) -> "Ppat_record(\n" ^ addIndentation (indentation + 1) ^ "fields:\n" diff --git a/analysis/src/Hint.ml b/analysis/src/Hint.ml index 71b1b7cfe3a..9155065253f 100644 --- a/analysis/src/Hint.ml +++ b/analysis/src/Hint.ml @@ -43,7 +43,7 @@ let inlay ~path ~pos ~maxLength ~debug = let rec processPattern (pat : Parsetree.pattern) = match pat.ppat_desc with | Ppat_tuple pl -> pl |> List.iter processPattern - | Ppat_record (fields, _) -> + | Ppat_record (fields, _, _rest) -> Ext_list.iter fields (fun {x = p} -> processPattern p) | Ppat_array fields -> fields |> List.iter processPattern | Ppat_var {loc} -> push loc Type diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index 96601f6e3be..ca114b8189a 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -512,7 +512,7 @@ let rec forStructureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t) | Tpat_tuple pats | Tpat_array pats | Tpat_construct (_, _, pats) -> pats |> List.iter (fun p -> handlePattern [] p) | Tpat_or (p, _, _) -> handlePattern [] p - | Tpat_record (items, _) -> + | Tpat_record (items, _, _rest) -> items |> List.iter (fun (_, _, p, _) -> handlePattern [] p) | Tpat_variant (_, Some p, _) -> handlePattern [] p | Tpat_variant (_, None, _) | Tpat_any | Tpat_constant _ -> () diff --git a/analysis/src/ProcessExtra.ml b/analysis/src/ProcessExtra.ml index 75390cefbad..7f33779598f 100644 --- a/analysis/src/ProcessExtra.ml +++ b/analysis/src/ProcessExtra.ml @@ -391,7 +391,7 @@ let pat ~(file : File.t) ~env ~extra (iter : Tast_iterator.iterator) in (* Log.log("Entering pattern " ++ Utils.showLocation(pat_loc)); *) (match pattern.pat_desc with - | Tpat_record (items, _) -> + | Tpat_record (items, _, _rest) -> addForRecord ~env ~extra ~recordType:pattern.pat_type items | Tpat_construct (lident, constructor, _) -> addForConstructor ~env ~extra pattern.pat_type lident constructor diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml index ddccba9b2b1..d005236a9f3 100644 --- a/analysis/src/SemanticTokens.ml +++ b/analysis/src/SemanticTokens.ml @@ -231,7 +231,7 @@ let command ~debug ~emitter ~path = | Ppat_construct ({txt = Lident ("true" | "false")}, _) -> (* Don't emit true or false *) Ast_iterator.default_iterator.pat iterator p - | Ppat_record (cases, _) -> + | Ppat_record (cases, _, _rest) -> Ext_list.iter cases (fun {lid = label} -> emitter |> emitRecordLabel ~label ~debug); Ast_iterator.default_iterator.pat iterator p diff --git a/analysis/src/SignatureHelp.ml b/analysis/src/SignatureHelp.ml index e4c9cb11ae1..d3bbecec838 100644 --- a/analysis/src/SignatureHelp.ml +++ b/analysis/src/SignatureHelp.ml @@ -664,7 +664,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = match tupleItemWithCursor with | None -> -1 | Some i -> i) - | `ConstructorPat (_, {ppat_desc = Ppat_record (fields, _)}) -> ( + | `ConstructorPat (_, {ppat_desc = Ppat_record (fields, _, _rest)}) + -> ( let fieldNameWithCursor = fields |> List.find_map diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index ddf783c5590..50db786e223 100644 --- a/analysis/src/Xform.ml +++ b/analysis/src/Xform.ml @@ -76,7 +76,7 @@ module IfThenElse = struct in match listToPat ~itemToPat items with | None -> None - | Some patItems -> Some (mkPat (Ppat_record (patItems, Closed)))) + | Some patItems -> Some (mkPat (Ppat_record (patItems, Closed, None)))) | Pexp_record (_, Some _) -> None | _ -> None diff --git a/compiler/common/pattern_printer.ml b/compiler/common/pattern_printer.ml index 603f9808404..754eb2533c0 100644 --- a/compiler/common/pattern_printer.ml +++ b/compiler/common/pattern_printer.ml @@ -76,7 +76,7 @@ let untype typed = | Tpat_variant (label, p_opt, _row_desc) -> let arg = Option.map loop p_opt in mkpat (Ppat_variant (label, arg)) - | Tpat_record (subpatterns, closed_flag) -> + | Tpat_record (subpatterns, closed_flag, _rest) -> let fields, saw_optional_rewrite = List.fold_right (fun (_, lbl, p, opt) (fields, saw_optional_rewrite) -> @@ -97,7 +97,7 @@ let untype typed = subpatterns ([], false) in let closed_flag = if saw_optional_rewrite then Closed else closed_flag in - mkpat (Ppat_record (fields, closed_flag)) + mkpat (Ppat_record (fields, closed_flag, None)) | Tpat_array lst -> mkpat (Ppat_array (List.map loop lst)) in loop typed diff --git a/compiler/core/lam_analysis.ml b/compiler/core/lam_analysis.ml index a4b78bea0eb..941c509d41b 100644 --- a/compiler/core/lam_analysis.ml +++ b/compiler/core/lam_analysis.ml @@ -53,7 +53,7 @@ let rec no_side_effects (lam : Lam.t) : bool = (* whether it's mutable or not *) | Pfield _ | Pval_from_option | Pval_from_option_not_nest (* NOP The compiler already [t option] is the same as t *) - | Pduprecord + | Pduprecord | Precord_spread_new _ (* generic primitives *) | Pobjcomp _ | Pobjorder | Pobjmin | Pobjmax | Pobjtag | Pobjsize (* bool primitives *) diff --git a/compiler/core/lam_compile_primitive.ml b/compiler/core/lam_compile_primitive.ml index e7c377e97a7..508902704c8 100644 --- a/compiler/core/lam_compile_primitive.ml +++ b/compiler/core/lam_compile_primitive.ml @@ -603,6 +603,18 @@ let translate output_prefix loc (cxt : Lam_compile_context.t) match args with | [e1] -> E.obj ~dup:e1 [] | _ -> assert false) + | Precord_spread_new excluded -> ( + match args with + | [e1] -> + (* Generate: (({field1, field2, ...rest}) => rest)(source) + This uses JS destructuring to cleanly extract the rest *) + let excluded_str = String.concat ", " excluded in + let code = Printf.sprintf "(({%s, ...__rest}) => __rest)" excluded_str in + E.call + ~info:{arity = Full; call_info = Call_na; call_transformed_jsx = false} + (E.raw_js_code (Exp (Js_function {arity = 1; arrow = true})) code) + [e1] + | _ -> assert false) | Phash -> ( match args with | [e1; e2; e3; e4] -> E.runtime_call Primitive_modules.hash "hash" args diff --git a/compiler/core/lam_convert.ml b/compiler/core/lam_convert.ml index 2e88a3b7036..abc2f60688c 100644 --- a/compiler/core/lam_convert.ml +++ b/compiler/core/lam_convert.ml @@ -205,6 +205,8 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t = | Pfield (id, info) -> prim ~primitive:(Pfield (id, info)) ~args loc | Psetfield (id, info) -> prim ~primitive:(Psetfield (id, info)) ~args loc | Pduprecord -> prim ~primitive:Pduprecord ~args loc + | Precord_spread_new excluded -> + prim ~primitive:(Precord_spread_new excluded) ~args loc | Praise _ -> prim ~primitive:Praise ~args loc | Pobjcomp x -> prim ~primitive:(Pobjcomp x) ~args loc | Pobjorder -> prim ~primitive:Pobjorder ~args loc diff --git a/compiler/core/lam_primitive.ml b/compiler/core/lam_primitive.ml index 2135293c850..579e07fd4a0 100644 --- a/compiler/core/lam_primitive.ml +++ b/compiler/core/lam_primitive.ml @@ -40,6 +40,7 @@ type t = | Psetfield of int * Lam_compat.set_field_dbg_info (* could have field info at least for record *) | Pduprecord + | Precord_spread_new of string list (* External call *) | Pjs_call of { prim_name: string; @@ -226,9 +227,9 @@ let eq_primitive_approx (lhs : t) (rhs : t) = | Pnull_to_opt | Pnull_undefined_to_opt | Pis_null | Pis_not_none | Psome | Psome_not_nest | Pis_undefined | Pis_null_undefined | Pimport | Ptypeof | Pfn_arity | Pis_poly_var_block | Pdebugger | Pinit_mod | Pupdate_mod - | Pduprecord | Pmakearray | Parraylength | Parrayrefu | Parraysetu - | Parrayrefs | Parraysets | Pjs_fn_make_unit | Pjs_fn_method | Phash - | Phash_mixstring | Phash_mixint | Phash_finalmix -> + | Pduprecord | Precord_spread_new _ | Pmakearray | Parraylength | Parrayrefu + | Parraysetu | Parrayrefs | Parraysets | Pjs_fn_make_unit | Pjs_fn_method + | Phash | Phash_mixstring | Phash_mixint | Phash_finalmix -> rhs = lhs | Pcreate_extension a -> ( match rhs with diff --git a/compiler/core/lam_primitive.mli b/compiler/core/lam_primitive.mli index 879f03a4120..45c46bffe02 100644 --- a/compiler/core/lam_primitive.mli +++ b/compiler/core/lam_primitive.mli @@ -36,6 +36,7 @@ type t = | Pfield of int * Lambda.field_dbg_info | Psetfield of int * Lambda.set_field_dbg_info | Pduprecord + | Precord_spread_new of string list | Pjs_call of { (* Location.t * [loc] is passed down *) prim_name: string; diff --git a/compiler/core/lam_print.ml b/compiler/core/lam_print.ml index 172e219abb7..76a4d2eceef 100644 --- a/compiler/core/lam_print.ml +++ b/compiler/core/lam_print.ml @@ -81,6 +81,8 @@ let primitive ppf (prim : Lam_primitive.t) = let instr = "setfield " in fprintf ppf "%s%i" instr n | Pduprecord -> fprintf ppf "duprecord" + | Precord_spread_new excluded -> + fprintf ppf "record_spread_new(%s)" (String.concat ", " excluded) | Pjs_call {prim_name} -> fprintf ppf "%s[js]" prim_name | Pjs_object_create _ -> fprintf ppf "[js.obj]" | Praise -> fprintf ppf "raise" diff --git a/compiler/frontend/ast_tuple_pattern_flatten.ml b/compiler/frontend/ast_tuple_pattern_flatten.ml index 27fe1e73a85..1955936b99b 100644 --- a/compiler/frontend/ast_tuple_pattern_flatten.ml +++ b/compiler/frontend/ast_tuple_pattern_flatten.ml @@ -64,7 +64,7 @@ let flattern_tuple_pattern_vb (self : Bs_ast_mapper.mapper) } :: acc) | _ -> {pvb_pat; pvb_expr; pvb_loc = vb.pvb_loc; pvb_attributes} :: acc) - | Ppat_record (lid_pats, _), Pexp_pack {pmod_desc = Pmod_ident id} -> + | Ppat_record (lid_pats, _, _rest), Pexp_pack {pmod_desc = Pmod_ident id} -> Ext_list.map_append lid_pats acc (fun {lid; x = pat} -> match lid.txt with | Lident s -> diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml index 292e199b5ae..3110bef2eb6 100644 --- a/compiler/frontend/bs_ast_mapper.ml +++ b/compiler/frontend/bs_ast_mapper.ml @@ -425,8 +425,12 @@ module P = struct | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) - | Ppat_record (lpl, cf) -> + | Ppat_record (lpl, cf, rest) -> record ~loc ~attrs + ?rest: + (match rest with + | None -> None + | Some p -> Some (sub.pat sub p)) (List.map (fun {lid; x = p; opt} -> {lid = map_loc sub lid; x = sub.pat sub p; opt}) diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index 2fae640eb07..ebe2463cc9d 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -141,7 +141,7 @@ module Pat = struct let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) - let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let record ?loc ?attrs ?rest a b = mk ?loc ?attrs (Ppat_record (a, b, rest)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli index 11227b903ad..ac70088b0a8 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -102,6 +102,7 @@ module Pat : sig val record : ?loc:loc -> ?attrs:attrs -> + ?rest:pattern -> pattern record_element list -> closed_flag -> pattern diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index a430bb0b7bd..35a92edffb7 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -398,7 +398,7 @@ module P = struct iter_loc sub l; iter_opt (sub.pat sub) p | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p - | Ppat_record (lpl, _cf) -> + | Ppat_record (lpl, _cf, _rest) -> List.iter (fun {lid; x = pat} -> iter_loc sub lid; diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index 673465477bd..f45a476129c 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -389,8 +389,12 @@ module P = struct | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) - | Ppat_record (lpl, cf) -> + | Ppat_record (lpl, cf, rest) -> record ~loc ~attrs + ?rest: + (match rest with + | None -> None + | Some p -> Some (sub.pat sub p)) (List.map (fun {lid; x = pat; opt} -> {lid = map_loc sub lid; x = sub.pat sub pat; opt}) diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index d0ac43d737a..5f32ba55470 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -559,7 +559,7 @@ module P = struct | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) - | Ppat_record (lpl, cf) -> + | Ppat_record (lpl, cf, _rest) -> record ~loc ~attrs (Ext_list.map lpl (fun {lid; x = p; opt = optional} -> let lid1 = map_loc sub lid in diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index e5e39eb4b55..cf2bbe3a00d 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -183,7 +183,7 @@ let rec add_pattern bv pat = | Ppat_construct (c, op) -> add bv c; add_opt add_pattern bv op - | Ppat_record (pl, _) -> + | Ppat_record (pl, _, _rest) -> List.iter (fun {lid = lbl; x = p} -> add bv lbl; diff --git a/compiler/ml/lambda.ml b/compiler/ml/lambda.ml index db810d4f912..cb5204915ce 100644 --- a/compiler/ml/lambda.ml +++ b/compiler/ml/lambda.ml @@ -177,6 +177,7 @@ type primitive = | Pfield of int * field_dbg_info | Psetfield of int * set_field_dbg_info | Pduprecord + | Precord_spread_new of string list (* excluded field names *) (* External call *) | Pccall of Primitive.description (* Exceptions *) diff --git a/compiler/ml/lambda.mli b/compiler/ml/lambda.mli index d8eaf57be6f..5f294dd5c6f 100644 --- a/compiler/ml/lambda.mli +++ b/compiler/ml/lambda.mli @@ -146,6 +146,7 @@ type primitive = | Pfield of int * field_dbg_info | Psetfield of int * set_field_dbg_info | Pduprecord + | Precord_spread_new of string list (* excluded field names *) (* External call *) | Pccall of Primitive.description (* Exceptions *) diff --git a/compiler/ml/matching.ml b/compiler/ml/matching.ml index b84339aed94..985868c30a2 100644 --- a/compiler/ml/matching.ml +++ b/compiler/ml/matching.ml @@ -213,12 +213,12 @@ let ctx_matcher p = | Tpat_tuple args when List.length args = len -> (p, args @ rem) | Tpat_any -> (p, omegas @ rem) | _ -> raise NoMatch) - | Tpat_record (((_, lbl, _, _) :: _ as l), _) -> ( + | Tpat_record (((_, lbl, _, _) :: _ as l), _, _rest) -> ( (* Records are normalized *) let len = Array.length lbl.lbl_all in fun q rem -> match q.pat_desc with - | Tpat_record (((_, lbl', _, _) :: _ as l'), _) + | Tpat_record (((_, lbl', _, _) :: _ as l'), _, _rest') when Array.length lbl'.lbl_all = len -> let l' = all_record_args l' in (p, List.fold_right (fun (_, _, p, _) r -> p :: r) l' rem) @@ -536,9 +536,9 @@ let simplify_or p = let q2 = simpl_rec p2 in {p with pat_desc = Tpat_or (q1, q2, o)} with Var q2 -> raise (Var {p with pat_desc = Tpat_or (q1, q2, o)})) - | {pat_desc = Tpat_record (lbls, closed)} -> + | {pat_desc = Tpat_record (lbls, closed, rest)} -> let all_lbls = all_record_args lbls in - {p with pat_desc = Tpat_record (all_lbls, closed)} + {p with pat_desc = Tpat_record (all_lbls, closed, rest)} | _ -> p in try simpl_rec p with Var p -> p @@ -556,10 +556,12 @@ let simplify_cases args cls = | Tpat_any -> cl :: simplify rem | Tpat_alias (p, id, _) -> simplify ((p :: patl, bind Alias id arg action) :: rem) - | Tpat_record ([], _) -> (omega :: patl, action) :: simplify rem - | Tpat_record (lbls, closed) -> + | Tpat_record ([], _, _rest) -> (omega :: patl, action) :: simplify rem + | Tpat_record (lbls, closed, rest) -> let all_lbls = all_record_args lbls in - let full_pat = {pat with pat_desc = Tpat_record (all_lbls, closed)} in + let full_pat = + {pat with pat_desc = Tpat_record (all_lbls, closed, rest)} + in (full_pat :: patl, action) :: simplify rem | Tpat_or _ -> ( let pat_simple = simplify_or pat in @@ -615,7 +617,7 @@ let rec extract_vars r p = | Tpat_var (id, _) -> IdentSet.add id r | Tpat_alias (p, id, _) -> extract_vars (IdentSet.add id r) p | Tpat_tuple pats -> List.fold_left extract_vars r pats - | Tpat_record (lpats, _) -> + | Tpat_record (lpats, _, _rest) -> List.fold_left (fun r (_, _, p, _) -> extract_vars r p) r lpats | Tpat_construct (_, _, pats) -> List.fold_left extract_vars r pats | Tpat_array pats -> List.fold_left extract_vars r pats @@ -1422,7 +1424,7 @@ let record_matching_line num_fields lbl_pat_list = let get_args_record num_fields p rem = match p with | {pat_desc = Tpat_any} -> record_matching_line num_fields [] @ rem - | {pat_desc = Tpat_record (lbl_pat_list, _)} -> + | {pat_desc = Tpat_record (lbl_pat_list, _, _rest)} -> record_matching_line num_fields lbl_pat_list @ rem | _ -> assert false @@ -1430,8 +1432,8 @@ let matcher_record num_fields p rem = match p.pat_desc with | Tpat_or (_, _, _) -> raise OrPat | Tpat_any | Tpat_var _ -> record_matching_line num_fields [] @ rem - | Tpat_record ([], _) when num_fields = 0 -> rem - | Tpat_record (((_, lbl, _, _) :: _ as lbl_pat_list), _) + | Tpat_record ([], _, _rest) when num_fields = 0 -> rem + | Tpat_record (((_, lbl, _, _) :: _ as lbl_pat_list), _, _rest) when Array.length lbl.lbl_all = num_fields -> record_matching_line num_fields lbl_pat_list @ rem | _ -> raise NoMatch @@ -2561,7 +2563,7 @@ and do_compile_matching repr partial ctx arg pmh = compile_no_test (divide_tuple (List.length patl) (normalize_pat pat)) ctx_combine repr partial ctx pm - | Tpat_record ((_, lbl, _, _) :: _, _) -> + | Tpat_record ((_, lbl, _, _) :: _, _, _rest) -> compile_no_test (divide_record lbl.lbl_all (normalize_pat pat)) ctx_combine repr partial ctx pm @@ -2636,7 +2638,7 @@ let find_in_pat pred = | Tpat_alias (p, _, _) | Tpat_variant (_, Some p, _) -> find_rec p | Tpat_tuple ps | Tpat_construct (_, _, ps) | Tpat_array ps -> List.exists find_rec ps - | Tpat_record (lpats, _) -> + | Tpat_record (lpats, _, _rest) -> List.exists (fun (_, _, p, _) -> find_rec p) lpats | Tpat_or (p, q, _) -> find_rec p || find_rec q | Tpat_constant _ | Tpat_var _ | Tpat_any | Tpat_variant (_, None, _) -> @@ -2646,7 +2648,7 @@ let find_in_pat pred = let have_mutable_field p = match p with - | Tpat_record (lps, _) -> + | Tpat_record (lps, _, _rest) -> List.exists (fun (_, lbl, _, _) -> match lbl.Types.lbl_mut with @@ -2740,7 +2742,32 @@ let partial_function loc () = ], loc ) +(* For record patterns with rest, inject the rest binding into the action body *) +let inject_record_rest_binding param (pat, action) = + match pat.pat_desc with + | Tpat_record (_, _, Some rest) -> + let action_with_rest = + Llet + ( Strict, + Pgenval, + rest.rest_ident, + Lprim (Precord_spread_new rest.excluded_labels, [param], pat.pat_loc), + action ) + in + let pat_without_rest = + { + pat with + pat_desc = + (match pat.pat_desc with + | Tpat_record (fields, closed, _) -> Tpat_record (fields, closed, None) + | _ -> pat.pat_desc); + } + in + (pat_without_rest, action_with_rest) + | _ -> (pat, action) + let for_function loc repr param pat_act_list partial = + let pat_act_list = List.map (inject_record_rest_binding param) pat_act_list in compile_matching repr (partial_function loc) param pat_act_list partial (* In the following two cases, exhaustiveness info is not available! *) @@ -2809,6 +2836,28 @@ let for_let loc param pat body = | Tpat_var (id, _) -> (* fast path, and keep track of simple bindings to unboxable numbers *) Llet (Strict, Pgenval, id, param, body) + | Tpat_record (_, _, Some rest) -> + (* Record pattern with rest: compile the explicit field bindings normally, + then add a binding for the rest ident using Precord_spread_new *) + let body_with_rest = + Llet + ( Strict, + Pgenval, + rest.rest_ident, + Lprim (Precord_spread_new rest.excluded_labels, [param], loc), + body ) + in + (* Compile the explicit fields pattern (without rest) into the body *) + let pat_without_rest = + { + pat with + pat_desc = + (match pat.pat_desc with + | Tpat_record (fields, closed, _) -> Tpat_record (fields, closed, None) + | _ -> pat.pat_desc); + } + in + simple_for_let loc param pat_without_rest body_with_rest | _ -> simple_for_let loc param pat body (* Handling of tupled functions and matchings *) diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml index ebb6903c661..f366aae8d9a 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -158,13 +158,13 @@ let all_coherent column = _ ) -> false) | Tpat_tuple l1, Tpat_tuple l2 -> List.length l1 = List.length l2 - | ( Tpat_record ((_, lbl1, _, _) :: _, _), - Tpat_record ((_, lbl2, _, _) :: _, _) ) -> + | ( Tpat_record ((_, lbl1, _, _) :: _, _, _), + Tpat_record ((_, lbl2, _, _) :: _, _, _) ) -> Array.length lbl1.lbl_all = Array.length lbl2.lbl_all | Tpat_any, _ | _, Tpat_any - | Tpat_record ([], _), Tpat_record (_, _) - | Tpat_record (_, _), Tpat_record ([], _) + | Tpat_record ([], _, _), Tpat_record (_, _, _) + | Tpat_record (_, _, _), Tpat_record ([], _, _) | Tpat_variant _, Tpat_variant _ | Tpat_array _, Tpat_array _ -> true @@ -301,7 +301,7 @@ module Compat = struct l1 = l2 && ocompat ~equal_cd op1 op2 | Tpat_constant c1, Tpat_constant c2 -> const_compare c1 c2 = 0 | Tpat_tuple ps, Tpat_tuple qs -> compats ~equal_cd ps qs - | Tpat_record (l1, _), Tpat_record (l2, _) -> + | Tpat_record (l1, _, _), Tpat_record (l2, _, _) -> let ps, qs = records_args l1 l2 in compats ~equal_cd ps qs | Tpat_array ps, Tpat_array qs -> @@ -399,7 +399,7 @@ let rec pretty_val ppf v = | _ -> fprintf ppf "@[<2>%s@ @[(%a)@]@]" name (pretty_vals ",") vs) | Tpat_variant (l, None, _) -> fprintf ppf "#%s" l | Tpat_variant (l, Some w, _) -> fprintf ppf "@[<2>#%s(%a)@]" l pretty_arg w - | Tpat_record (lvs, _) -> ( + | Tpat_record (lvs, _, _rest) -> ( let filtered_lvs = Ext_list.filter lvs (function | _, _, {pat_desc = Tpat_any}, _ -> false (* do not show lbl=_ *) @@ -496,7 +496,7 @@ let simple_match p1 p2 = let record_arg p = match p.pat_desc with | Tpat_any -> [] - | Tpat_record (args, _) -> args + | Tpat_record (args, _, _rest) -> args | _ -> fatal_error "Parmatch.as_record" (* Raise Not_found when pos is not present in arg *) @@ -569,14 +569,14 @@ let rec simple_match_args p1 p2 = | Tpat_construct (_, _, args) -> args | Tpat_variant (_, Some arg, _) -> [arg] | Tpat_tuple args -> args - | Tpat_record (args, _) -> extract_fields (record_arg p1) args + | Tpat_record (args, _, _rest) -> extract_fields (record_arg p1) args | Tpat_array args -> args | Tpat_any | Tpat_var _ -> ( match p1.pat_desc with | Tpat_construct (_, _, args) -> omega_list args | Tpat_variant (_, Some _, _) -> [omega] | Tpat_tuple args -> omega_list args - | Tpat_record (args, _) -> omega_list args + | Tpat_record (args, _, _rest) -> omega_list args | Tpat_array args -> omega_list args | _ -> []) | _ -> [] @@ -601,11 +601,12 @@ let rec normalize_pat q = q.pat_type q.pat_env | Tpat_array args -> make_pat (Tpat_array (omega_list args)) q.pat_type q.pat_env - | Tpat_record (largs, closed) -> + | Tpat_record (largs, closed, rest) -> make_pat (Tpat_record ( List.map (fun (lid, lbl, _, opt) -> (lid, lbl, omega, opt)) largs, - closed )) + closed, + rest )) q.pat_type q.pat_env | Tpat_or _ -> fatal_error "Parmatch.normalize_pat" @@ -623,7 +624,7 @@ let discr_pat q pss = acc_pat acc ((p1 :: ps) :: (p2 :: ps) :: pss) | ({pat_desc = Tpat_any | Tpat_var _} :: _) :: pss -> acc_pat acc pss | (({pat_desc = Tpat_tuple _} as p) :: _) :: _ -> normalize_pat p - | (({pat_desc = Tpat_record (largs, closed)} as p) :: _) :: pss -> + | (({pat_desc = Tpat_record (largs, closed, rest)} as p) :: _) :: pss -> let new_omegas = List.fold_right (fun (lid, lbl, _, opt) r -> @@ -634,7 +635,7 @@ let discr_pat q pss = largs (record_arg acc) in acc_pat - (make_pat (Tpat_record (new_omegas, closed)) p.pat_type p.pat_env) + (make_pat (Tpat_record (new_omegas, closed, rest)) p.pat_type p.pat_env) pss | _ -> acc in @@ -661,7 +662,7 @@ let do_set_args erase_mutable q r = | {pat_desc = Tpat_tuple omegas} -> let args, rest = read_args omegas r in make_pat (Tpat_tuple args) q.pat_type q.pat_env :: rest - | {pat_desc = Tpat_record (omegas, closed)} -> + | {pat_desc = Tpat_record (omegas, closed, pat_rest)} -> let args, rest = read_args omegas r in make_pat (Tpat_record @@ -676,7 +677,8 @@ let do_set_args erase_mutable q r = then (lid, lbl, omega, opt) else (lid, lbl, arg, opt)) omegas args, - closed )) + closed, + pat_rest )) q.pat_type q.pat_env :: rest | {pat_desc = Tpat_construct (lid, c, omegas)} -> @@ -966,7 +968,7 @@ let pats_of_type ?(always = false) env ty = (mknoloc (Longident.Lident "?pat_of_label?"), ld, omega, false)) labels in - [make_pat (Tpat_record (fields, Closed)) ty env] + [make_pat (Tpat_record (fields, Closed, None)) ty env] | _ -> [omega] with Not_found -> [omega]) | Ttuple tl -> [make_pat (Tpat_tuple (omegas (List.length tl))) ty env] @@ -1169,7 +1171,8 @@ let rec has_instance p = | Tpat_or (p1, p2, _) -> has_instance p1 || has_instance p2 | Tpat_construct (_, _, ps) | Tpat_tuple ps | Tpat_array ps -> has_instances ps - | Tpat_record (lps, _) -> has_instances (List.map (fun (_, _, x, _) -> x) lps) + | Tpat_record (lps, _, _rest) -> + has_instances (List.map (fun (_, _, x, _) -> x) lps) and has_instances = function | [] -> true @@ -1378,7 +1381,7 @@ let print_pat pat = | Tpat_tuple list -> Printf.sprintf "(%s)" (String.concat "," (List.map string_of_pat list)) | Tpat_variant (_, _, _) -> "variant" - | Tpat_record (_, _) -> "record" + | Tpat_record (_, _, _) -> "record" | Tpat_array _ -> "array" in Printf.fprintf stderr "PAT[%s]\n%!" (string_of_pat pat) @@ -1783,7 +1786,7 @@ let rec le_pat p q = | Tpat_variant (l1, None, _r1), Tpat_variant (l2, None, _) -> l1 = l2 | Tpat_variant (_, _, _), Tpat_variant (_, _, _) -> false | Tpat_tuple ps, Tpat_tuple qs -> le_pats ps qs - | Tpat_record (l1, _), Tpat_record (l2, _) -> + | Tpat_record (l1, _, _), Tpat_record (l2, _, _) -> let ps, qs = records_args l1 l2 in le_pats ps qs | Tpat_array ps, Tpat_array qs -> Ext_list.same_length ps qs && le_pats ps qs @@ -1830,9 +1833,9 @@ let rec lub p q = let r = lub p1 p2 in make_pat (Tpat_variant (l1, Some r, row)) p.pat_type p.pat_env | Tpat_variant (l1, None, _row), Tpat_variant (l2, None, _) when l1 = l2 -> p - | Tpat_record (l1, closed), Tpat_record (l2, _) -> + | Tpat_record (l1, closed, rest), Tpat_record (l2, _, _) -> let rs = record_lubs l1 l2 in - make_pat (Tpat_record (rs, closed)) p.pat_type p.pat_env + make_pat (Tpat_record (rs, closed, rest)) p.pat_type p.pat_env | Tpat_array ps, Tpat_array qs when List.length ps = List.length qs -> let rs = lubs ps qs in make_pat (Tpat_array rs) p.pat_type p.pat_env @@ -1991,7 +1994,7 @@ module Conv = struct | Tpat_variant (label, p_opt, _row_desc) -> let arg = Misc.may_map loop p_opt in mkpat (Ppat_variant (label, arg)) - | Tpat_record (subpatterns, _closed_flag) -> + | Tpat_record (subpatterns, _closed_flag, _rest) -> let fields = List.map (fun (_, lbl, p, optional) -> @@ -2000,7 +2003,7 @@ module Conv = struct {lid = mknoloc (Longident.Lident id); x = loop p; opt = optional}) subpatterns in - mkpat (Ppat_record (fields, Open)) + mkpat (Ppat_record (fields, Open, None)) | Tpat_array lst -> mkpat (Ppat_array (List.map loop lst)) in let ps = loop typed in @@ -2133,7 +2136,7 @@ let rec collect_paths_from_pat r p = | Tpat_array ps | Tpat_construct (_, {cstr_tag = Cstr_extension _}, ps) -> List.fold_left collect_paths_from_pat r ps - | Tpat_record (lps, _) -> + | Tpat_record (lps, _, _rest) -> List.fold_left (fun r (_, _, p, _) -> collect_paths_from_pat r p) r lps | Tpat_variant (_, Some p, _) | Tpat_alias (p, _, _) -> collect_paths_from_pat r p @@ -2251,7 +2254,7 @@ let inactive ~partial pat = | Tpat_tuple ps | Tpat_construct (_, _, ps) -> List.for_all (fun p -> loop p) ps | Tpat_alias (p, _, _) | Tpat_variant (_, Some p, _) -> loop p - | Tpat_record (ldps, _) -> + | Tpat_record (ldps, _, _rest) -> List.for_all (fun (_, lbl, p, _) -> lbl.lbl_mut = Immutable && loop p) ldps @@ -2398,12 +2401,12 @@ let filter_all = a pattern *) let discr_head pat = match pat.pat_desc with - | Tpat_record (lbls, closed) -> + | Tpat_record (lbls, closed, rest) -> (* a partial record pattern { f1 = p1; f2 = p2; _ } needs to be expanded, otherwise matching against this head would drop the pattern arguments for non-mentioned fields *) let lbls = all_record_args lbls in - normalize_pat {pat with pat_desc = Tpat_record (lbls, closed)} + normalize_pat {pat with pat_desc = Tpat_record (lbls, closed, rest)} | _ -> normalize_pat pat in diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 78c9899f744..fe647e9c982 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -184,9 +184,10 @@ and pattern_desc = (* `A (None) `A P (Some P) *) - | Ppat_record of pattern record_element list * closed_flag - (* { l1=P1; ...; ln=Pn } (flag = Closed) - { l1=P1; ...; ln=Pn; _} (flag = Open) + | Ppat_record of pattern record_element list * closed_flag * pattern option + (* { l1=P1; ...; ln=Pn } (flag = Closed, rest = None) + { l1=P1; ...; ln=Pn; _} (flag = Open, rest = None) + { l1=P1; ...; ...T as r } (rest = Some pattern) Invariant: n > 0 *) diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index 585ac64b81b..90a39d5df1f 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -461,7 +461,7 @@ and simple_pattern ctxt (f : Format.formatter) (x : pattern) : unit = | Ppat_array l -> pp f "@[<2>[|%a|]@]" (list (pattern1 ctxt) ~sep:";") l | Ppat_unpack s -> pp f "(module@ %s)@ " s.txt | Ppat_type li -> pp f "#%a" longident_loc li - | Ppat_record (l, closed) -> ( + | Ppat_record (l, closed, _rest) -> ( let longident_x_pattern f {lid = li; x = p; opt} = let opt_str = if opt then "?" else "" in match (li, p) with diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 44d699eb388..f7cc3069248 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -207,7 +207,7 @@ and pattern i ppf x = | Ppat_variant (l, po) -> line i ppf "Ppat_variant \"%s\"\n" l; option i pattern ppf po - | Ppat_record (l, c) -> + | Ppat_record (l, c, _rest) -> line i ppf "Ppat_record %a\n" fmt_closed_flag c; list i longident_x_pattern ppf l | Ppat_array l -> diff --git a/compiler/ml/printlambda.ml b/compiler/ml/printlambda.ml index 0282f6e113c..116b0598ca6 100644 --- a/compiler/ml/printlambda.ml +++ b/compiler/ml/printlambda.ml @@ -116,6 +116,8 @@ let primitive ppf = function | Pfield (n, fld) -> fprintf ppf "field:%s/%i" (str_of_field_info fld) n | Psetfield (n, _) -> fprintf ppf "setfield %i" n | Pduprecord -> fprintf ppf "duprecord" + | Precord_spread_new excluded -> + fprintf ppf "record_spread_new(%s)" (String.concat ", " excluded) | Pccall p -> fprintf ppf "%s" p.prim_name | Praise k -> fprintf ppf "%s" (Lambda.raise_kind k) | Pobjcomp Ceq -> fprintf ppf "==" diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml index 6e36b4276c0..8be8bb0516c 100644 --- a/compiler/ml/printtyped.ml +++ b/compiler/ml/printtyped.ml @@ -233,7 +233,7 @@ and pattern i ppf x = | Tpat_variant (l, po, _) -> line i ppf "Tpat_variant \"%s\"\n" l; option i pattern ppf po - | Tpat_record (l, _c) -> + | Tpat_record (l, _c, _rest) -> line i ppf "Tpat_record\n"; list i longident_x_pattern ppf l | Tpat_array l -> diff --git a/compiler/ml/rec_check.ml b/compiler/ml/rec_check.ml index 3d016a74383..239c0e6ff06 100644 --- a/compiler/ml/rec_check.ml +++ b/compiler/ml/rec_check.ml @@ -156,7 +156,7 @@ let rec pattern_variables : Typedtree.pattern -> Ident.t list = | Tpat_construct (_, _, pats) -> List.concat (List.map pattern_variables pats) | Tpat_variant (_, Some pat, _) -> pattern_variables pat | Tpat_variant (_, None, _) -> [] - | Tpat_record (fields, _) -> + | Tpat_record (fields, _, _rest) -> List.concat (List.map (fun (_, _, p, _) -> pattern_variables p) fields) | Tpat_array pats -> List.concat (List.map pattern_variables pats) | Tpat_or (l, r, _) -> pattern_variables l @ pattern_variables r @@ -422,7 +422,7 @@ and is_destructuring_pattern : Typedtree.pattern -> bool = | Tpat_tuple _ -> true | Tpat_construct (_, _, _) -> true | Tpat_variant _ -> true - | Tpat_record (_, _) -> true + | Tpat_record (_, _, _) -> true | Tpat_array _ -> true | Tpat_or (l, r, _) -> is_destructuring_pattern l || is_destructuring_pattern r diff --git a/compiler/ml/tast_iterator.ml b/compiler/ml/tast_iterator.ml index 5c12d3da4d8..1b8b773bbef 100644 --- a/compiler/ml/tast_iterator.ml +++ b/compiler/ml/tast_iterator.ml @@ -129,7 +129,7 @@ let pat sub {pat_extra; pat_desc; pat_env; _} = | Tpat_tuple l -> List.iter (sub.pat sub) l | Tpat_construct (_, _, l) -> List.iter (sub.pat sub) l | Tpat_variant (_, po, _) -> Option.iter (sub.pat sub) po - | Tpat_record (l, _) -> List.iter (fun (_, _, i, _) -> sub.pat sub i) l + | Tpat_record (l, _, _rest) -> List.iter (fun (_, _, i, _) -> sub.pat sub i) l | Tpat_array l -> List.iter (sub.pat sub) l | Tpat_or (p1, p2, _) -> sub.pat sub p1; diff --git a/compiler/ml/tast_mapper.ml b/compiler/ml/tast_mapper.ml index 54eba028699..d1e8f0deb2f 100644 --- a/compiler/ml/tast_mapper.ml +++ b/compiler/ml/tast_mapper.ml @@ -171,8 +171,8 @@ let pat sub x = | Tpat_construct (loc, cd, l) -> Tpat_construct (loc, cd, List.map (sub.pat sub) l) | Tpat_variant (l, po, rd) -> Tpat_variant (l, opt (sub.pat sub) po, rd) - | Tpat_record (l, closed) -> - Tpat_record (List.map (tuple4 id id (sub.pat sub) id) l, closed) + | Tpat_record (l, closed, rest) -> + Tpat_record (List.map (tuple4 id id (sub.pat sub) id) l, closed, rest) | Tpat_array l -> Tpat_array (List.map (sub.pat sub) l) | Tpat_or (p1, p2, rd) -> Tpat_or (sub.pat sub p1, sub.pat sub p2, rd) | Tpat_alias (p, id, s) -> Tpat_alias (sub.pat sub p, id, s) diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index ee304dff7d7..aed65eac130 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -95,6 +95,12 @@ type error = | Type_params_not_supported of Longident.t | Field_access_on_dict_type | Jsx_not_enabled + | Record_rest_invalid_type + | Record_rest_requires_type_annotation of string + | Record_rest_not_record of Longident.t + | Record_rest_field_not_optional of string * Longident.t + | Record_rest_field_missing of string * Longident.t + | Record_rest_extra_field of string * Longident.t exception Error of Location.t * Env.t * error exception Error_forward of Location.error @@ -496,7 +502,7 @@ let rec build_as_type env p = row_fixed = false; row_closed = false; }) - | Tpat_record (lpl, _) -> + | Tpat_record (lpl, _, _rest) -> let lbl = snd4 (List.hd lpl) in if lbl.lbl_private = Private then p.pat_type else @@ -1478,7 +1484,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp match (sarg, arg_type) with | Some p, [ty] -> type_pat p ty (fun p -> k (Some p)) | _ -> k None) - | Ppat_record (lid_sp_list, closed) -> + | Ppat_record (lid_sp_list, closed, rest) -> let has_dict_pattern_attr = Dict_type_helpers.has_dict_pattern_attribute sp.ppat_attributes in @@ -1537,12 +1543,146 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp k (label_lid, label, arg, opt)) in let k' k lbl_pat_list = + (* When there's a rest pattern, use Open to suppress missing-field warnings *) + let effective_closed = + match rest with + | Some _ -> Asttypes.Open + | None -> closed + in check_recordpat_labels ~get_jsx_component_error_info loc lbl_pat_list - closed; + effective_closed; unify_pat_types loc !env record_ty expected_ty; + (* Resolve the rest pattern info *) + let typed_rest = + match rest with + | None -> None + | Some rest_pat -> + (* Extract type annotation and binding name from rest pattern *) + let rest_type_lid, rest_name = + match rest_pat.ppat_desc with + | Ppat_constraint ({ppat_desc = Ppat_var name}, cty) -> ( + match cty.ptyp_desc with + | Ptyp_constr (lid, []) -> (lid, name) + | _ -> + raise + (Error (rest_pat.ppat_loc, !env, Record_rest_invalid_type))) + | Ppat_var name -> + (* No type annotation — try to infer from context *) + (* For now, require type annotation *) + raise + (Error + ( rest_pat.ppat_loc, + !env, + Record_rest_requires_type_annotation name.txt )) + | _ -> + raise (Error (rest_pat.ppat_loc, !env, Record_rest_invalid_type)) + in + (* Look up the rest record type *) + let rest_path, rest_decl = + Typetexp.find_type !env rest_type_lid.loc rest_type_lid.txt + in + let rest_labels = + match rest_decl with + | {type_kind = Type_record (labels, _)} -> labels + | _ -> + raise + (Error + ( rest_type_lid.loc, + !env, + Record_rest_not_record rest_type_lid.txt )) + in + (* Get explicit field names *) + let explicit_fields = + List.map (fun (_, label, _, _) -> label.lbl_name) lbl_pat_list + in + (* Get explicit optional fields *) + let explicit_optional_fields = + List.filter_map + (fun (_, label, _, opt) -> + if opt then Some label.lbl_name else None) + lbl_pat_list + in + (* Get rest field names *) + let rest_field_names = + List.map + (fun (l : Types.label_declaration) -> Ident.name l.ld_id) + rest_labels + in + (* Validate: fields in both explicit and rest must be optional in the explicit pattern *) + List.iter + (fun rest_field -> + if + List.mem rest_field explicit_fields + && not (List.mem rest_field explicit_optional_fields) + then + raise + (Error + ( rest_pat.ppat_loc, + !env, + Record_rest_field_not_optional + (rest_field, rest_type_lid.txt) ))) + rest_field_names; + (* Validate: all source fields must be in explicit or rest *) + (match lbl_pat_list with + | (_, label1, _, _) :: _ -> + let all_source = label1.lbl_all in + Array.iter + (fun source_label -> + let name = source_label.lbl_name in + if + (not (List.mem name explicit_fields)) + && not (List.mem name rest_field_names) + then + raise + (Error + ( rest_pat.ppat_loc, + !env, + Record_rest_field_missing (name, rest_type_lid.txt) ))) + all_source + | [] -> ()); + (* Validate: rest type fields must all exist in source *) + (match lbl_pat_list with + | (_, label1, _, _) :: _ -> + let all_source = label1.lbl_all in + let source_field_names = + Array.to_list (Array.map (fun l -> l.lbl_name) all_source) + in + List.iter + (fun (rest_label : Types.label_declaration) -> + if + not + (List.mem (Ident.name rest_label.ld_id) source_field_names) + then + raise + (Error + ( rest_type_lid.loc, + !env, + Record_rest_extra_field + (Ident.name rest_label.ld_id, rest_type_lid.txt) ))) + rest_labels + | [] -> ()); + let rest_type_expr = + newgenty + (Tconstr + ( rest_path, + List.map (fun _ -> newvar ()) rest_decl.type_params, + ref Mnil )) + in + let rest_ident = + enter_variable rest_pat.ppat_loc rest_name rest_type_expr + in + Some + { + Typedtree.rest_ident; + rest_type = rest_type_expr; + rest_path; + rest_labels; + excluded_labels = explicit_fields; + } + in rp k { - pat_desc = Tpat_record (lbl_pat_list, closed); + pat_desc = Tpat_record (lbl_pat_list, closed, typed_rest); pat_loc = loc; pat_extra = []; pat_type = expected_ty; @@ -2066,7 +2206,7 @@ let iter_ppat f p = | Ppat_open (_, p) | Ppat_constraint (p, _) -> f p - | Ppat_record (args, _flag) -> List.iter (fun {x = p} -> f p) args + | Ppat_record (args, _flag, _rest) -> List.iter (fun {x = p} -> f p) args let contains_polymorphic_variant p = let rec loop p = @@ -4788,6 +4928,32 @@ let report_error env loc ppf error = fprintf ppf "Cannot compile JSX expression because JSX support is not enabled. Add \ \"jsx\" settings to rescript.json to enable JSX support." + | Record_rest_invalid_type -> + fprintf ppf "Record rest pattern must have the form: ...Type.t as name" + | Record_rest_requires_type_annotation name -> + fprintf ppf + "Record rest pattern `...%s` requires a type annotation. Use `...Type.t \ + as %s`." + name name + | Record_rest_not_record lid -> + fprintf ppf + "Type %a is not a record type and cannot be used as a record rest \ + pattern." + longident lid + | Record_rest_field_not_optional (field, lid) -> + fprintf ppf + "Field `%s` appears in both the explicit pattern and the rest type `%a`. \ + It must be marked as optional (`?%s`) in the explicit pattern." + field longident lid field + | Record_rest_field_missing (field, lid) -> + fprintf ppf + "Field `%s` is not covered by the explicit pattern or the rest type `%a`." + field longident lid + | Record_rest_extra_field (field, lid) -> + fprintf ppf + "Field `%s` in the rest type `%a` does not exist in the source record \ + type." + field longident lid let report_error env loc ppf err = Printtyp.wrap_printing_env env (fun () -> report_error env loc ppf err) diff --git a/compiler/ml/typecore.mli b/compiler/ml/typecore.mli index eef17d05a84..907a1f3e7c7 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -128,6 +128,12 @@ type error = | Type_params_not_supported of Longident.t | Field_access_on_dict_type | Jsx_not_enabled + | Record_rest_invalid_type + | Record_rest_requires_type_annotation of string + | Record_rest_not_record of Longident.t + | Record_rest_field_not_optional of string * Longident.t + | Record_rest_field_missing of string * Longident.t + | Record_rest_extra_field of string * Longident.t exception Error of Location.t * Env.t * error exception Error_forward of Location.error diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml index e7274f12456..8f7c9a298d8 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -35,6 +35,14 @@ type pattern = { pat_attributes: attribute list; } +and record_pat_rest = { + rest_ident: Ident.t; + rest_type: type_expr; + rest_path: Path.t; + rest_labels: Types.label_declaration list; + excluded_labels: string list; +} + and pat_extra = | Tpat_constraint of core_type | Tpat_type of Path.t * Longident.t loc @@ -52,6 +60,7 @@ and pattern_desc = | Tpat_record of (Longident.t loc * label_description * pattern * bool (* optional *)) list * closed_flag + * record_pat_rest option | Tpat_array of pattern list | Tpat_or of pattern * pattern * row_desc option @@ -413,7 +422,7 @@ let iter_pattern_desc f = function | Tpat_tuple patl -> List.iter f patl | Tpat_construct (_, _, patl) -> List.iter f patl | Tpat_variant (_, pat, _) -> may f pat - | Tpat_record (lbl_pat_list, _) -> + | Tpat_record (lbl_pat_list, _, _rest) -> List.iter (fun (_, _, pat, _) -> f pat) lbl_pat_list | Tpat_array patl -> List.iter f patl | Tpat_or (p1, p2, _) -> @@ -425,8 +434,9 @@ let map_pattern_desc f d = match d with | Tpat_alias (p1, id, s) -> Tpat_alias (f p1, id, s) | Tpat_tuple pats -> Tpat_tuple (List.map f pats) - | Tpat_record (lpats, closed) -> - Tpat_record (List.map (fun (lid, l, p, o) -> (lid, l, f p, o)) lpats, closed) + | Tpat_record (lpats, closed, rest) -> + Tpat_record + (List.map (fun (lid, l, p, o) -> (lid, l, f p, o)) lpats, closed, rest) | Tpat_construct (lid, c, pats) -> Tpat_construct (lid, c, List.map f pats) | Tpat_array pats -> Tpat_array (List.map f pats) | Tpat_variant (x1, Some p1, x2) -> Tpat_variant (x1, Some (f p1), x2) @@ -446,6 +456,13 @@ let rec bound_idents pat = | Tpat_or (p1, _, _) -> (* Invariant : both arguments binds the same variables *) bound_idents p1 + | Tpat_record (_, _, Some rest) -> + (* Rest ident is added via enter_variable during type checking, + but we also need it in bound_idents for Lambda compilation *) + idents := + (rest.rest_ident, Location.mknoloc (Ident.name rest.rest_ident)) + :: !idents; + iter_pattern_desc bound_idents pat.pat_desc | d -> iter_pattern_desc bound_idents d let pat_bound_idents pat = diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli index b1e7083fc75..b4d81f1b71f 100644 --- a/compiler/ml/typedtree.mli +++ b/compiler/ml/typedtree.mli @@ -43,6 +43,14 @@ type pattern = { pat_attributes: attributes; } +and record_pat_rest = { + rest_ident: Ident.t; + rest_type: type_expr; + rest_path: Path.t; + rest_labels: Types.label_declaration list; + excluded_labels: string list; +} + and pat_extra = | Tpat_constraint of core_type (** P : T { pat_desc = P @@ -85,6 +93,7 @@ and pattern_desc = | Tpat_record of (Longident.t loc * label_description * pattern * bool (* optional *)) list * closed_flag + * record_pat_rest option (** { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) diff --git a/compiler/ml/typedtreeIter.ml b/compiler/ml/typedtreeIter.ml index 9a31b9b5b96..559095836d9 100644 --- a/compiler/ml/typedtreeIter.ml +++ b/compiler/ml/typedtreeIter.ml @@ -196,7 +196,7 @@ end = struct match pato with | None -> () | Some pat -> iter_pattern pat) - | Tpat_record (list, _closed) -> + | Tpat_record (list, _closed, _rest) -> List.iter (fun (_, _, pat, _) -> iter_pattern pat) list | Tpat_array list -> List.iter iter_pattern list | Tpat_or (p1, p2, _) -> diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index 52a57b89c55..7662305773f 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -787,7 +787,7 @@ module SexpAst = struct | None -> Sexp.atom "None" | Some p -> Sexp.list [Sexp.atom "Some"; pattern p]); ] - | Ppat_record (rows, flag) -> + | Ppat_record (rows, flag, _rest) -> Sexp.list [ Sexp.atom "Ppat_record"; diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml index 6774b2bc2b1..228e183f1e1 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -2094,7 +2094,7 @@ and walk_pattern pat t comments = | Ppat_variant (_label, None) -> () | Ppat_variant (_label, Some pat) -> walk_pattern pat t comments | Ppat_type _ -> () - | Ppat_record (record_rows, _) -> + | Ppat_record (record_rows, _, _rest) -> walk_list (Ext_list.map record_rows (fun {lid; x = p} -> PatternRecordRow (lid, p))) t comments diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index aab15e930fa..9dfb0dc307e 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -271,6 +271,7 @@ type fundef_parameter = type record_pattern_item = | PatUnderscore | PatField of Parsetree.pattern Parsetree.record_element + | PatRest of Parsetree.pattern type context = OrdinaryExpr | TernaryTrueBranchExpr | WhenExpr @@ -1452,9 +1453,71 @@ and parse_record_pattern_row_field ~attrs p = and parse_record_pattern_row p = let attrs = parse_attributes p in match p.Parser.token with - | DotDotDot -> + | DotDotDot -> ( Parser.next p; - Some (true, PatField (parse_record_pattern_row_field ~attrs p)) + let start_pos = p.Parser.start_pos in + match p.Parser.token with + | Uident _ -> + (* ...ModulePath.t as name *) + let type_path = parse_value_path p in + let type_loc = type_path.loc in + let core_type = Ast_helper.Typ.constr ~loc:type_loc type_path [] in + Parser.expect As p; + let name_start = p.start_pos in + let name = + match p.token with + | Lident ident -> + Parser.next p; + Location.mkloc ident (mk_loc name_start p.prev_end_pos) + | _ -> + Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); + Location.mkloc "_" (mk_loc name_start p.prev_end_pos) + in + let rest_loc = mk_loc start_pos p.prev_end_pos in + let rest_pat = + Ast_helper.Pat.constraint_ ~loc:rest_loc ~attrs + (Ast_helper.Pat.var ~loc:name.loc name) + core_type + in + Some (false, PatRest rest_pat) + | Lident ident -> + Parser.next p; + if p.Parser.token = As then ( + (* ...typeName as name *) + let type_path = + Location.mkloc (Longident.Lident ident) + (mk_loc start_pos p.prev_end_pos) + in + let type_loc = type_path.loc in + let core_type = Ast_helper.Typ.constr ~loc:type_loc type_path [] in + Parser.expect As p; + let name_start = p.start_pos in + let name = + match p.token with + | Lident id -> + Parser.next p; + Location.mkloc id (mk_loc name_start p.prev_end_pos) + | _ -> + Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); + Location.mkloc "_" (mk_loc name_start p.prev_end_pos) + in + let rest_loc = mk_loc start_pos p.prev_end_pos in + let rest_pat = + Ast_helper.Pat.constraint_ ~loc:rest_loc ~attrs + (Ast_helper.Pat.var ~loc:name.loc name) + core_type + in + Some (false, PatRest rest_pat)) + else + (* ...name (no type annotation) *) + let loc = mk_loc start_pos p.prev_end_pos in + let rest_pat = + Ast_helper.Pat.var ~loc ~attrs (Location.mkloc ident loc) + in + Some (false, PatRest rest_pat) + | _ -> + (* Fallback: treat as old-style spread (error) *) + Some (true, PatField (parse_record_pattern_row_field ~attrs p))) | Uident _ | Lident _ -> Some (false, PatField (parse_record_pattern_row_field ~attrs p)) | Question -> ( @@ -1495,14 +1558,14 @@ and parse_record_pattern ~attrs p = ~f:parse_record_pattern_row in Parser.expect Rbrace p; - let fields, closed_flag = + let fields, closed_flag, rest = let raw_fields, flag = match raw_fields with | (_hasSpread, PatUnderscore) :: rest -> (rest, Asttypes.Open) | raw_fields -> (raw_fields, Asttypes.Closed) in List.fold_left - (fun (fields, flag) curr -> + (fun (fields, flag, rest) curr -> let has_spread, field = curr in match field with | PatField field -> @@ -1510,12 +1573,13 @@ and parse_record_pattern ~attrs p = let pattern = field.x in Parser.err ~start_pos:pattern.Parsetree.ppat_loc.loc_start p (Diagnostics.message ErrorMessages.record_pattern_spread)); - (field :: fields, flag) - | PatUnderscore -> (fields, flag)) - ([], flag) raw_fields + (field :: fields, flag, rest) + | PatRest rest_pat -> (fields, flag, Some rest_pat) + | PatUnderscore -> (fields, flag, rest)) + ([], flag, None) raw_fields in let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Pat.record ~loc ~attrs fields closed_flag + Ast_helper.Pat.record ~loc ~attrs ?rest fields closed_flag and parse_tuple_pattern ~attrs ~first ~start_pos p = let patterns = diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 2010d23f6dd..ed95e598abf 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -2579,7 +2579,7 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = Doc.concat [Doc.text "..."; print_ident_path ident cmt_tbl] | Ppat_type ident -> Doc.concat [Doc.text "#..."; print_ident_path ident cmt_tbl] - | Ppat_record (rows, _) + | Ppat_record (rows, _, _rest) when ParsetreeViewer.has_dict_pattern_attribute p.ppat_attributes -> Doc.concat [ @@ -2597,9 +2597,23 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = Doc.soft_line; Doc.rbrace; ] - | Ppat_record ([], Open) -> + | Ppat_record ([], Open, None) -> Doc.concat [Doc.lbrace; Doc.text "_"; Doc.rbrace] - | Ppat_record (rows, open_flag) -> + | Ppat_record (rows, open_flag, rest) -> + let print_rest_pattern rest_pat = + match rest_pat.Parsetree.ppat_desc with + | Ppat_constraint ({ppat_desc = Ppat_var name}, typ) -> + Doc.concat + [ + Doc.text "..."; + print_typ_expr ~state typ cmt_tbl; + Doc.text " as "; + Doc.text name.txt; + ] + | Ppat_var name -> Doc.concat [Doc.text "..."; Doc.text name.txt] + | _ -> + Doc.concat [Doc.text "..."; print_pattern ~state rest_pat cmt_tbl] + in Doc.group (Doc.concat [ @@ -2614,9 +2628,19 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = (fun row -> print_pattern_record_row ~state row cmt_tbl) rows); - (match open_flag with - | Open -> Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] - | Closed -> Doc.nil); + (match rest with + | Some rest_pat -> + Doc.concat + [ + (if rows <> [] then Doc.concat [Doc.text ","; Doc.line] + else Doc.nil); + print_rest_pattern rest_pat; + ] + | None -> ( + match open_flag with + | Open -> + Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] + | Closed -> Doc.nil)); ]); Doc.if_breaks (Doc.text ",") Doc.nil; Doc.soft_line; diff --git a/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt b/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt index 2b33d97dbce..9384f6d2ff3 100644 --- a/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt +++ b/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt @@ -28,20 +28,6 @@ Possible solutions: Explanation: since records have a known, fixed shape, a spread like `{a, ...b}` wouldn't make sense, as `b` would override every field of `a` anyway. - Syntax error! - syntax_tests/data/parsing/errors/other/spread.res:4:15-18 - - 2 │ - 3 │ let record = {...x, ...y} - 4 │ let {...x, ...y} = myRecord - 5 │ - 6 │ let list{...x, ...y} = myList - - Record spread (`...`) is not supported in pattern matches. -Explanation: you can't collect a subset of a record's field into its own record, since a record needs an explicit declaration and that subset wouldn't have one. -Solution: you need to pull out each field you want explicitly. - - Syntax error! syntax_tests/data/parsing/errors/other/spread.res:6:13-22 @@ -56,7 +42,7 @@ Explanation: a list spread at the tail is efficient, but a spread in the middle let [|arr;_|] = [|1;2;3|] let record = { x with y } -let { x; y } = myRecord +let { } = myRecord let x::y = myList type nonrec t = { ...: a } diff --git a/tests/syntax_tests/data/parsing/grammar/pattern/expected/record.res.txt b/tests/syntax_tests/data/parsing/grammar/pattern/expected/record.res.txt index 8560cd48a21..b1f54e398fb 100644 --- a/tests/syntax_tests/data/parsing/grammar/pattern/expected/record.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/pattern/expected/record.res.txt @@ -80,4 +80,12 @@ let f [arity:1](({ a } : myRecord) as p) = () ;;for { a;_} = 0 to 10 do () done ;;for { a;_} = 0 to 10 do () done ;;for { a;_} = 0 to 10 do () done -;;for ({ a } : myRecord) = 0 to 10 do () done \ No newline at end of file +;;for ({ a } : myRecord) = 0 to 10 do () done +let { a } = x +let { a } = x +let { a } = x +let { a; b } = x +;;match x with | { a } -> () | { a } -> () | { a } -> () +let f [arity:1]{ a } = () +let f [arity:1]{ a } = () +let f [arity:1]{ a } = () \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/pattern/record.res b/tests/syntax_tests/data/parsing/grammar/pattern/record.res index 424baffc8e6..644c2e17a79 100644 --- a/tests/syntax_tests/data/parsing/grammar/pattern/record.res +++ b/tests/syntax_tests/data/parsing/grammar/pattern/record.res @@ -88,3 +88,19 @@ for {a, _} in 0 to 10 { () } for (({a, _}) in 0 to 10) { () } for ({a, _} in 0 to 10) { () } for (({a} : myRecord) in 0 to 10) { () } + +// Record rest patterns +let {a, ...rest} = x +let {a, ...b as rest} = x +let {a, ...M.t as rest} = x +let {a, b, ...M.Sub.t as rest} = x + +switch x { +| {a, ...rest} => () +| {a, ...b as rest} => () +| {a, ...M.t as rest} => () +} + +let f = ({a, ...rest}) => () +let f = ({a, ...b as rest}) => () +let f = ({a, ...M.t as rest}) => () diff --git a/tests/syntax_tests/data/parsing/recovery/pattern/expected/parenthesized.res.txt b/tests/syntax_tests/data/parsing/recovery/pattern/expected/parenthesized.res.txt index ca5a43ff607..62c41decb2f 100644 --- a/tests/syntax_tests/data/parsing/recovery/pattern/expected/parenthesized.res.txt +++ b/tests/syntax_tests/data/parsing/recovery/pattern/expected/parenthesized.res.txt @@ -60,6 +60,6 @@ ;;match x with | a -> () | [|a;b|] -> () - | { a; b } -> () + | { a } -> () | 1::[] -> () | (1, 2) -> () \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/recovery/pattern/expected/record.res.txt b/tests/syntax_tests/data/parsing/recovery/pattern/expected/record.res.txt index 68b19a38259..2cc87429258 100644 --- a/tests/syntax_tests/data/parsing/recovery/pattern/expected/record.res.txt +++ b/tests/syntax_tests/data/parsing/recovery/pattern/expected/record.res.txt @@ -9,18 +9,4 @@ Did you forget a `}` here? - - Syntax error! - syntax_tests/data/parsing/recovery/pattern/record.res:3:7-14 - - 1 │ switch x { - 2 │ | {a, b: {x, y => () - 3 │ | {...x, y} => () - 4 │ | {a, _, b} => () - 5 │ } - - Record spread (`...`) is not supported in pattern matches. -Explanation: you can't collect a subset of a record's field into its own record, since a record needs an explicit declaration and that subset wouldn't have one. -Solution: you need to pull out each field you want explicitly. - -;;match x with | { a; b = { x; y } } -> () | { x; y } -> () | { a; b } -> () \ No newline at end of file +;;match x with | { a; b = { x; y } } -> () | { y } -> () | { a; b } -> () \ No newline at end of file diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs new file mode 100644 index 00000000000..8635475f183 --- /dev/null +++ b/tests/tests/src/record_rest_test.mjs @@ -0,0 +1,35 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + + +let rest = ((({name, ...__rest}) => __rest))({ + name: "test", + version: "1.0", + debug: true +}); + +function describe(c) { + let rest = ((({name, ...__rest}) => __rest))(c); + return [ + c.name, + rest + ]; +} + +function getName(param) { + return param.name; +} + +function extractClassName(param) { + return ((({className, ...__rest}) => __rest))(param); +} + +let name = "test"; + +export { + rest, + name, + describe, + getName, + extractClassName, +} +/* No side effect */ diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res new file mode 100644 index 00000000000..74c66872761 --- /dev/null +++ b/tests/tests/src/record_rest_test.res @@ -0,0 +1,41 @@ +type config = { + name: string, + version: string, + debug: bool, +} + +type subConfig = { + version: string, + debug: bool, +} + +// Basic rest pattern in let binding +let {name, ...subConfig as rest} = ({name: "test", version: "1.0", debug: true}: config) +let _ = (name, rest) + +// Rest pattern in match arm +let describe = (c: config) => + switch c { + | {name, ...subConfig as rest} => (name, rest) + } + +// Rest pattern in function parameter +let getName = ({name, ...subConfig as _rest}: config) => name + +// Optional field overlap: className is in both explicit (as optional) and rest type +type fullProps = { + className?: string, + style?: string, + onClick: unit => unit, +} + +type baseProps = { + className?: string, + style?: string, + onClick: unit => unit, +} + +let extractClassName = ({?className, ...baseProps as rest}: fullProps) => { + let _ = className + rest +} From 8ecb9f6e410ec269d3800a46f923a001ac149135 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 10:57:30 +0200 Subject: [PATCH 02/11] support type with parameter for record rest --- compiler/ml/typecore.ml | 32 +++++++++++++++---- compiler/syntax/src/res_core.ml | 14 +++++--- .../grammar/pattern/expected/record.res.txt | 6 +++- .../data/parsing/grammar/pattern/record.res | 6 ++++ .../printer/pattern/expected/record.res.txt | 7 ++++ .../data/printer/pattern/record.res | 9 +++++- tests/tests/src/record_rest_test.mjs | 14 ++++++++ tests/tests/src/record_rest_test.res | 16 ++++++++++ 8 files changed, 90 insertions(+), 14 deletions(-) diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index aed65eac130..c356ee7acbb 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1558,11 +1558,11 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp | None -> None | Some rest_pat -> (* Extract type annotation and binding name from rest pattern *) - let rest_type_lid, rest_name = + let rest_type_lid, rest_name, rest_type_args_syntax = match rest_pat.ppat_desc with | Ppat_constraint ({ppat_desc = Ppat_var name}, cty) -> ( match cty.ptyp_desc with - | Ptyp_constr (lid, []) -> (lid, name) + | Ptyp_constr (lid, type_args) -> (lid, name, type_args) | _ -> raise (Error (rest_pat.ppat_loc, !env, Record_rest_invalid_type))) @@ -1661,12 +1661,30 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp (Ident.name rest_label.ld_id, rest_type_lid.txt) ))) rest_labels | [] -> ()); + let rest_type_args = + match rest_type_args_syntax with + | [] -> List.map (fun _ -> newvar ()) rest_decl.type_params + | args -> + let n_args = List.length args in + let n_params = List.length rest_decl.type_params in + if n_args <> n_params then + raise + (Typetexp.Error + ( rest_type_lid.loc, + !env, + Typetexp.Type_arity_mismatch + (rest_type_lid.txt, n_params, n_args) )); + List.map + (fun sty -> + let cty, force = + Typetexp.transl_simple_type_delayed !env sty + in + pattern_force := force :: !pattern_force; + cty.ctyp_type) + args + in let rest_type_expr = - newgenty - (Tconstr - ( rest_path, - List.map (fun _ -> newvar ()) rest_decl.type_params, - ref Mnil )) + newgenty (Tconstr (rest_path, rest_type_args, ref Mnil)) in let rest_ident = enter_variable rest_pat.ppat_loc rest_name rest_type_expr diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 9dfb0dc307e..3a5d1b65aef 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -1458,10 +1458,11 @@ and parse_record_pattern_row p = let start_pos = p.Parser.start_pos in match p.Parser.token with | Uident _ -> - (* ...ModulePath.t as name *) + (* ...ModulePath.t<'a> as name *) let type_path = parse_value_path p in let type_loc = type_path.loc in - let core_type = Ast_helper.Typ.constr ~loc:type_loc type_path [] in + let type_args = parse_type_constructor_args ~constr_name:type_path p in + let core_type = Ast_helper.Typ.constr ~loc:type_loc type_path type_args in Parser.expect As p; let name_start = p.start_pos in let name = @@ -1482,14 +1483,17 @@ and parse_record_pattern_row p = Some (false, PatRest rest_pat) | Lident ident -> Parser.next p; - if p.Parser.token = As then ( - (* ...typeName as name *) + if p.Parser.token = As || p.Parser.token = Token.LessThan then ( + (* ...typeName<'a> as name *) let type_path = Location.mkloc (Longident.Lident ident) (mk_loc start_pos p.prev_end_pos) in let type_loc = type_path.loc in - let core_type = Ast_helper.Typ.constr ~loc:type_loc type_path [] in + let type_args = parse_type_constructor_args ~constr_name:type_path p in + let core_type = + Ast_helper.Typ.constr ~loc:type_loc type_path type_args + in Parser.expect As p; let name_start = p.start_pos in let name = diff --git a/tests/syntax_tests/data/parsing/grammar/pattern/expected/record.res.txt b/tests/syntax_tests/data/parsing/grammar/pattern/expected/record.res.txt index b1f54e398fb..5a18bd3fa1a 100644 --- a/tests/syntax_tests/data/parsing/grammar/pattern/expected/record.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/pattern/expected/record.res.txt @@ -88,4 +88,8 @@ let { a; b } = x ;;match x with | { a } -> () | { a } -> () | { a } -> () let f [arity:1]{ a } = () let f [arity:1]{ a } = () -let f [arity:1]{ a } = () \ No newline at end of file +let f [arity:1]{ a } = () +let { a } = x +let { a } = x +let { a } = x +let { a } = x \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/pattern/record.res b/tests/syntax_tests/data/parsing/grammar/pattern/record.res index 644c2e17a79..9dc155b1343 100644 --- a/tests/syntax_tests/data/parsing/grammar/pattern/record.res +++ b/tests/syntax_tests/data/parsing/grammar/pattern/record.res @@ -104,3 +104,9 @@ switch x { let f = ({a, ...rest}) => () let f = ({a, ...b as rest}) => () let f = ({a, ...M.t as rest}) => () + +// Polymorphic rest type args +let {a, ...t<'v> as rest} = x +let {a, ...M.t<'v> as rest} = x +let {a, ...M.t as rest} = x +let {a, ...M.t<'a, 'b> as rest} = x diff --git a/tests/syntax_tests/data/printer/pattern/expected/record.res.txt b/tests/syntax_tests/data/printer/pattern/expected/record.res.txt index f2c669ccf15..b1861d258b0 100644 --- a/tests/syntax_tests/data/printer/pattern/expected/record.res.txt +++ b/tests/syntax_tests/data/printer/pattern/expected/record.res.txt @@ -125,3 +125,10 @@ let get_age3 = () => switch x { | {_} => "" } + +// Record rest with polymorphic type args +let {a, ...rest} = x +let {a, ...t<'v> as rest} = x +let {a, ...M.t<'v> as rest} = x +let {a, ...M.t as rest} = x +let {a, ...M.t<'a, 'b> as rest} = x diff --git a/tests/syntax_tests/data/printer/pattern/record.res b/tests/syntax_tests/data/printer/pattern/record.res index b9021af252c..1f389be93db 100644 --- a/tests/syntax_tests/data/printer/pattern/record.res +++ b/tests/syntax_tests/data/printer/pattern/record.res @@ -65,7 +65,14 @@ let get_age3 = () => switch x { | {age, _} => age } -let get_age3 = () => +let get_age3 = () => switch x { | {_} => "" } + +// Record rest with polymorphic type args +let {a, ...rest} = x +let {a, ...t<'v> as rest} = x +let {a, ...M.t<'v> as rest} = x +let {a, ...M.t as rest} = x +let {a, ...M.t<'a, 'b> as rest} = x diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 8635475f183..267acd804f1 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -23,13 +23,27 @@ function extractClassName(param) { return ((({className, ...__rest}) => __rest))(param); } +let intRest = ((({id, ...__rest}) => __rest))({ + id: "1", + value: 42 +}); + +function getValue(param) { + return ((({id, ...__rest}) => __rest))(param); +} + let name = "test"; +let id = "1"; + export { rest, name, describe, getName, extractClassName, + intRest, + id, + getValue, } /* No side effect */ diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index 74c66872761..204948823bf 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -39,3 +39,19 @@ let extractClassName = ({?className, ...baseProps as rest}: fullProps) => { let _ = className rest } + +// Polymorphic rest type +type container<'a> = { + id: string, + value: 'a, +} + +type valueContainer<'a> = { + value: 'a, +} + +let {id, ...valueContainer as intRest} = ({id: "1", value: 42}: container) +let _ = (id, intRest) + +// Polymorphic rest in function parameter +let getValue = ({id: _, ...valueContainer<'a> as rest}: container<'a>) => rest From 73f8379fb81b3ff5a35a9596425efd524453bfd8 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 11:12:33 +0200 Subject: [PATCH 03/11] simplify parsing of record rest --- compiler/syntax/src/res_core.ml | 59 +++++++++------------------------ 1 file changed, 16 insertions(+), 43 deletions(-) diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 3a5d1b65aef..a3c552120be 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -1456,13 +1456,14 @@ and parse_record_pattern_row p = | DotDotDot -> ( Parser.next p; let start_pos = p.Parser.start_pos in - match p.Parser.token with - | Uident _ -> - (* ...ModulePath.t<'a> as name *) - let type_path = parse_value_path p in - let type_loc = type_path.loc in - let type_args = parse_type_constructor_args ~constr_name:type_path p in - let core_type = Ast_helper.Typ.constr ~loc:type_loc type_path type_args in + let has_type_annotation = + Parser.lookahead p (fun p -> + ignore (parse_atomic_typ_expr ~attrs:[] p); + p.token = As) + in + if has_type_annotation then ( + (* ...TypeAnnotation<'a> as name *) + let core_type = parse_atomic_typ_expr ~attrs:[] p in Parser.expect As p; let name_start = p.start_pos in let name = @@ -1480,48 +1481,20 @@ and parse_record_pattern_row p = (Ast_helper.Pat.var ~loc:name.loc name) core_type in - Some (false, PatRest rest_pat) - | Lident ident -> - Parser.next p; - if p.Parser.token = As || p.Parser.token = Token.LessThan then ( - (* ...typeName<'a> as name *) - let type_path = - Location.mkloc (Longident.Lident ident) - (mk_loc start_pos p.prev_end_pos) - in - let type_loc = type_path.loc in - let type_args = parse_type_constructor_args ~constr_name:type_path p in - let core_type = - Ast_helper.Typ.constr ~loc:type_loc type_path type_args - in - Parser.expect As p; - let name_start = p.start_pos in - let name = - match p.token with - | Lident id -> - Parser.next p; - Location.mkloc id (mk_loc name_start p.prev_end_pos) - | _ -> - Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); - Location.mkloc "_" (mk_loc name_start p.prev_end_pos) - in - let rest_loc = mk_loc start_pos p.prev_end_pos in - let rest_pat = - Ast_helper.Pat.constraint_ ~loc:rest_loc ~attrs - (Ast_helper.Pat.var ~loc:name.loc name) - core_type - in - Some (false, PatRest rest_pat)) - else + Some (false, PatRest rest_pat)) + else + match p.Parser.token with + | Lident ident -> (* ...name (no type annotation) *) + Parser.next p; let loc = mk_loc start_pos p.prev_end_pos in let rest_pat = Ast_helper.Pat.var ~loc ~attrs (Location.mkloc ident loc) in Some (false, PatRest rest_pat) - | _ -> - (* Fallback: treat as old-style spread (error) *) - Some (true, PatField (parse_record_pattern_row_field ~attrs p))) + | _ -> + (* Fallback: treat as old-style spread (error) *) + Some (true, PatField (parse_record_pattern_row_field ~attrs p))) | Uident _ | Lident _ -> Some (false, PatField (parse_record_pattern_row_field ~attrs p)) | Question -> ( From ad170f668259912215ff671444744bda1694d337 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 11:19:33 +0200 Subject: [PATCH 04/11] update record spread error message --- compiler/syntax/src/res_core.ml | 8 +++--- .../errors/other/expected/spread.res.txt | 27 ++++++++++++++----- .../data/parsing/errors/other/spread.res | 1 + 3 files changed, 25 insertions(+), 11 deletions(-) diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index a3c552120be..b9c2cce7c78 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -73,11 +73,9 @@ module ErrorMessages = struct matching currently guarantees to never create new intermediate data." let record_pattern_spread = - "Record spread (`...`) is not supported in pattern matches.\n\ - Explanation: you can't collect a subset of a record's field into its own \ - record, since a record needs an explicit declaration and that subset \ - wouldn't have one.\n\ - Solution: you need to pull out each field you want explicitly." + "Record rest patterns require a type annotation and a binding name.\n\ + Correct syntax: `...typeName as bindingName`\n\ + Example: `let {name, ...Config.t as rest} = myRecord`" (* let recordPatternUnderscore = "Record patterns only support one `_`, at the end." *) [@@live] diff --git a/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt b/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt index 9384f6d2ff3..fa0445fe0b1 100644 --- a/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt +++ b/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt @@ -22,20 +22,34 @@ Possible solutions: 2 │ 3 │ let record = {...x, ...y} 4 │ let {...x, ...y} = myRecord - 5 │ + 5 │ let {...M.t} = myRecord Records can only have one `...` spread, at the beginning. Explanation: since records have a known, fixed shape, a spread like `{a, ...b}` wouldn't make sense, as `b` would override every field of `a` anyway. Syntax error! - syntax_tests/data/parsing/errors/other/spread.res:6:13-22 + syntax_tests/data/parsing/errors/other/spread.res:5:9-14 + 3 │ let record = {...x, ...y} 4 │ let {...x, ...y} = myRecord - 5 │ - 6 │ let list{...x, ...y} = myList - 7 │ - 8 │ type t = {...a} + 5 │ let {...M.t} = myRecord + 6 │ + 7 │ let list{...x, ...y} = myList + + Record rest patterns require a type annotation and a binding name. +Correct syntax: `...typeName as bindingName` +Example: `let {name, ...Config.t as rest} = myRecord` + + + Syntax error! + syntax_tests/data/parsing/errors/other/spread.res:7:13-22 + + 5 │ let {...M.t} = myRecord + 6 │ + 7 │ let list{...x, ...y} = myList + 8 │ + 9 │ type t = {...a} List pattern matches only supports one `...` spread, at the end. Explanation: a list spread at the tail is efficient, but a spread in the middle would create new lists; out of performance concern, our pattern matching currently guarantees to never create new intermediate data. @@ -43,6 +57,7 @@ Explanation: a list spread at the tail is efficient, but a spread in the middle let [|arr;_|] = [|1;2;3|] let record = { x with y } let { } = myRecord +let { M.t = t } = myRecord let x::y = myList type nonrec t = { ...: a } diff --git a/tests/syntax_tests/data/parsing/errors/other/spread.res b/tests/syntax_tests/data/parsing/errors/other/spread.res index b6fa643f1f6..06619b39127 100644 --- a/tests/syntax_tests/data/parsing/errors/other/spread.res +++ b/tests/syntax_tests/data/parsing/errors/other/spread.res @@ -2,6 +2,7 @@ let [...arr, _] = [1, 2, 3] let record = {...x, ...y} let {...x, ...y} = myRecord +let {...M.t} = myRecord let list{...x, ...y} = myList From 259263cb30445e5bd2dd6a2381d270b1e60c67d1 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 12:03:22 +0200 Subject: [PATCH 05/11] improve error message of superfluous fields in rest --- compiler/ml/typecore.ml | 52 ++++++++++++++++++++++++++-------------- compiler/ml/typecore.mli | 2 +- 2 files changed, 35 insertions(+), 19 deletions(-) diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index c356ee7acbb..f17b2cd724a 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -99,7 +99,7 @@ type error = | Record_rest_requires_type_annotation of string | Record_rest_not_record of Longident.t | Record_rest_field_not_optional of string * Longident.t - | Record_rest_field_missing of string * Longident.t + | Record_rest_field_missing of string list * Longident.t | Record_rest_extra_field of string * Longident.t exception Error of Location.t * Env.t * error @@ -1626,19 +1626,22 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp (match lbl_pat_list with | (_, label1, _, _) :: _ -> let all_source = label1.lbl_all in - Array.iter - (fun source_label -> - let name = source_label.lbl_name in - if - (not (List.mem name explicit_fields)) - && not (List.mem name rest_field_names) - then - raise - (Error - ( rest_pat.ppat_loc, - !env, - Record_rest_field_missing (name, rest_type_lid.txt) ))) - all_source + let missing = + Array.to_list all_source + |> List.filter_map (fun source_label -> + let name = source_label.lbl_name in + if + (not (List.mem name explicit_fields)) + && not (List.mem name rest_field_names) + then Some name + else None) + in + if missing <> [] then + raise + (Error + ( rest_pat.ppat_loc, + !env, + Record_rest_field_missing (missing, rest_type_lid.txt) )) | [] -> ()); (* Validate: rest type fields must all exist in source *) (match lbl_pat_list with @@ -4963,10 +4966,23 @@ let report_error env loc ppf error = "Field `%s` appears in both the explicit pattern and the rest type `%a`. \ It must be marked as optional (`?%s`) in the explicit pattern." field longident lid field - | Record_rest_field_missing (field, lid) -> - fprintf ppf - "Field `%s` is not covered by the explicit pattern or the rest type `%a`." - field longident lid + | Record_rest_field_missing (fields, lid) -> ( + let field_list = + fields |> List.map (fun f -> "\n- " ^ f) |> String.concat "" + in + match fields with + | [_] -> + fprintf ppf + "The following field is not part of the rest type `%a`:%s\n\n\ + List this field in the record pattern before the spread so it's not \ + present in the rest record." + longident lid field_list + | _ -> + fprintf ppf + "The following fields are not part of the rest type `%a`:%s\n\n\ + List these fields in the record pattern before the spread so they're \ + not present in the rest record." + longident lid field_list) | Record_rest_extra_field (field, lid) -> fprintf ppf "Field `%s` in the rest type `%a` does not exist in the source record \ diff --git a/compiler/ml/typecore.mli b/compiler/ml/typecore.mli index 907a1f3e7c7..ed022fd0d47 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -132,7 +132,7 @@ type error = | Record_rest_requires_type_annotation of string | Record_rest_not_record of Longident.t | Record_rest_field_not_optional of string * Longident.t - | Record_rest_field_missing of string * Longident.t + | Record_rest_field_missing of string list * Longident.t | Record_rest_extra_field of string * Longident.t exception Error of Location.t * Env.t * error From 60267ffd9eb73411c645f69c83a910fc1340a3c4 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 12:27:53 +0200 Subject: [PATCH 06/11] improve error message of non optional rest field already matched --- compiler/ml/typecore.ml | 49 +++++++++++++++++++++++++--------------- compiler/ml/typecore.mli | 2 +- 2 files changed, 32 insertions(+), 19 deletions(-) diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index f17b2cd724a..ab3946037e4 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -98,7 +98,7 @@ type error = | Record_rest_invalid_type | Record_rest_requires_type_annotation of string | Record_rest_not_record of Longident.t - | Record_rest_field_not_optional of string * Longident.t + | Record_rest_field_not_optional of string list * Longident.t | Record_rest_field_missing of string list * Longident.t | Record_rest_extra_field of string * Longident.t @@ -1609,19 +1609,20 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp rest_labels in (* Validate: fields in both explicit and rest must be optional in the explicit pattern *) - List.iter - (fun rest_field -> - if + let not_optional = + List.filter + (fun rest_field -> List.mem rest_field explicit_fields - && not (List.mem rest_field explicit_optional_fields) - then - raise - (Error - ( rest_pat.ppat_loc, - !env, - Record_rest_field_not_optional - (rest_field, rest_type_lid.txt) ))) - rest_field_names; + && not (List.mem rest_field explicit_optional_fields)) + rest_field_names + in + if not_optional <> [] then + raise + (Error + ( rest_pat.ppat_loc, + !env, + Record_rest_field_not_optional + (not_optional, rest_type_lid.txt) )); (* Validate: all source fields must be in explicit or rest *) (match lbl_pat_list with | (_, label1, _, _) :: _ -> @@ -4961,11 +4962,23 @@ let report_error env loc ppf error = "Type %a is not a record type and cannot be used as a record rest \ pattern." longident lid - | Record_rest_field_not_optional (field, lid) -> - fprintf ppf - "Field `%s` appears in both the explicit pattern and the rest type `%a`. \ - It must be marked as optional (`?%s`) in the explicit pattern." - field longident lid field + | Record_rest_field_not_optional (fields, lid) -> ( + let field_list = + fields |> List.map (fun f -> "\n- " ^ f) |> String.concat "" + in + match fields with + | [field] -> + fprintf ppf + "The following field appears in both the explicit pattern and the rest \ + type `%a`:%s\n\n\ + Mark it as optional (`?%s`) in the explicit pattern." + longident lid field_list field + | _ -> + fprintf ppf + "The following fields appear in both the explicit pattern and the rest \ + type `%a`:%s\n\n\ + Mark them as optional (e.g. `?fieldName`) in the explicit pattern." + longident lid field_list) | Record_rest_field_missing (fields, lid) -> ( let field_list = fields |> List.map (fun f -> "\n- " ^ f) |> String.concat "" diff --git a/compiler/ml/typecore.mli b/compiler/ml/typecore.mli index ed022fd0d47..85154a5ec2f 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -131,7 +131,7 @@ type error = | Record_rest_invalid_type | Record_rest_requires_type_annotation of string | Record_rest_not_record of Longident.t - | Record_rest_field_not_optional of string * Longident.t + | Record_rest_field_not_optional of string list * Longident.t | Record_rest_field_missing of string list * Longident.t | Record_rest_extra_field of string * Longident.t From cb0ab836d2bd6c49aaa53b61170e991c67a0eb77 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 12:31:30 +0200 Subject: [PATCH 07/11] add a warning when rest record would be empty --- compiler/ext/warnings.ml | 7 ++++++- compiler/ext/warnings.mli | 1 + compiler/ml/typecore.ml | 9 +++++++++ 3 files changed, 16 insertions(+), 1 deletion(-) diff --git a/compiler/ext/warnings.ml b/compiler/ext/warnings.ml index f25b91b4f89..239fbd32592 100644 --- a/compiler/ext/warnings.ml +++ b/compiler/ext/warnings.ml @@ -88,6 +88,7 @@ type t = | Bs_toplevel_expression_unit of (string * top_level_unit_help) option (* 109 *) | Bs_todo of string option (* 110 *) + | Bs_record_rest_empty (* 111 *) (* If you remove a warning, leave a hole in the numbering. NEVER change the numbers of existing warnings. @@ -154,8 +155,9 @@ let number = function | Bs_uninterpreted_delimiters _ -> 108 | Bs_toplevel_expression_unit _ -> 109 | Bs_todo _ -> 110 + | Bs_record_rest_empty -> 111 -let last_warning_number = 110 +let last_warning_number = 111 let letter_all = let rec loop i = if i = 0 then [] else i :: loop (i - 1) in @@ -532,6 +534,9 @@ let message = function `%s->ignore`" help_text help_text | _ -> "") + | Bs_record_rest_empty -> + "All fields of the rest type are already present in the explicit pattern. \ + The rest record will always be empty." | Bs_todo maybe_text -> (match maybe_text with | None -> "Todo found." diff --git a/compiler/ext/warnings.mli b/compiler/ext/warnings.mli index ba1a03ceec5..0fcb4df39e1 100644 --- a/compiler/ext/warnings.mli +++ b/compiler/ext/warnings.mli @@ -81,6 +81,7 @@ type t = | Bs_toplevel_expression_unit of (string * top_level_unit_help) option (* 109 *) | Bs_todo of string option (* 110 *) + | Bs_record_rest_empty (* 111 *) val parse_options : bool -> string -> unit diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index ab3946037e4..a65400351c4 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1608,6 +1608,15 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp (fun (l : Types.label_declaration) -> Ident.name l.ld_id) rest_labels in + (* Warn if all rest fields are already explicit — the rest record will be empty *) + if + rest_field_names <> [] + && List.for_all + (fun f -> List.mem f explicit_fields) + rest_field_names + then + Location.prerr_warning rest_pat.ppat_loc + Warnings.Bs_record_rest_empty; (* Validate: fields in both explicit and rest must be optional in the explicit pattern *) let not_optional = List.filter From 1ae640b8fcfe7b5220d720469331daf9e1a769fc Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 12:48:42 +0200 Subject: [PATCH 08/11] add fixture tests for error/warning messages --- compiler/ml/typecore.ml | 18 +++++++++--------- .../record_rest_empty_warning.res.expected | 10 ++++++++++ .../record_rest_extra_field.res.expected | 10 ++++++++++ .../record_rest_field_missing.res.expected | 14 ++++++++++++++ ...record_rest_field_not_optional.res.expected | 13 +++++++++++++ .../record_rest_invalid_type.res.expected | 9 +++++++++ .../record_rest_not_record.res.expected | 10 ++++++++++ ..._rest_requires_type_annotation.res.expected | 9 +++++++++ .../fixtures/record_rest_empty_warning.res | 3 +++ .../fixtures/record_rest_extra_field.res | 3 +++ .../fixtures/record_rest_field_missing.res | 3 +++ .../record_rest_field_not_optional.res | 3 +++ .../fixtures/record_rest_invalid_type.res | 2 ++ .../fixtures/record_rest_not_record.res | 3 +++ .../record_rest_requires_type_annotation.res | 2 ++ 15 files changed, 103 insertions(+), 9 deletions(-) create mode 100644 tests/build_tests/super_errors/expected/record_rest_empty_warning.res.expected create mode 100644 tests/build_tests/super_errors/expected/record_rest_extra_field.res.expected create mode 100644 tests/build_tests/super_errors/expected/record_rest_field_missing.res.expected create mode 100644 tests/build_tests/super_errors/expected/record_rest_field_not_optional.res.expected create mode 100644 tests/build_tests/super_errors/expected/record_rest_invalid_type.res.expected create mode 100644 tests/build_tests/super_errors/expected/record_rest_not_record.res.expected create mode 100644 tests/build_tests/super_errors/expected/record_rest_requires_type_annotation.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_empty_warning.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_extra_field.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_field_missing.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_field_not_optional.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_invalid_type.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_not_record.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_requires_type_annotation.res diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index a65400351c4..1a416395eb9 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1608,15 +1608,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp (fun (l : Types.label_declaration) -> Ident.name l.ld_id) rest_labels in - (* Warn if all rest fields are already explicit — the rest record will be empty *) - if - rest_field_names <> [] - && List.for_all - (fun f -> List.mem f explicit_fields) - rest_field_names - then - Location.prerr_warning rest_pat.ppat_loc - Warnings.Bs_record_rest_empty; (* Validate: fields in both explicit and rest must be optional in the explicit pattern *) let not_optional = List.filter @@ -1674,6 +1665,15 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp (Ident.name rest_label.ld_id, rest_type_lid.txt) ))) rest_labels | [] -> ()); + (* Warn if all rest fields are already explicit — the rest record will be empty *) + if + rest_field_names <> [] + && List.for_all + (fun f -> List.mem f explicit_fields) + rest_field_names + then + Location.prerr_warning rest_pat.ppat_loc + Warnings.Bs_record_rest_empty; let rest_type_args = match rest_type_args_syntax with | [] -> List.map (fun _ -> newvar ()) rest_decl.type_params diff --git a/tests/build_tests/super_errors/expected/record_rest_empty_warning.res.expected b/tests/build_tests/super_errors/expected/record_rest_empty_warning.res.expected new file mode 100644 index 00000000000..30d52282aef --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_empty_warning.res.expected @@ -0,0 +1,10 @@ + + Warning number 111 + /.../fixtures/record_rest_empty_warning.res:3:16-26 + + 1 │ type source = {a: int, b?: string} + 2 │ type sub = {b?: string} + 3 │ let {a, ?b, ...sub as rest} = ({a: 1}: source) + 4 │ + + All fields of the rest type are already present in the explicit pattern. The rest record will always be empty. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_extra_field.res.expected b/tests/build_tests/super_errors/expected/record_rest_extra_field.res.expected new file mode 100644 index 00000000000..5250f826e70 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_extra_field.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/record_rest_extra_field.res:3:12-14 + + 1 │ type source = {a: int, x: int} + 2 │ type sub = {a: int, b: string} + 3 │ let {x, ...sub as rest} = ({a: 1, x: 2}: source) + 4 │ + + Field `b` in the rest type `sub` does not exist in the source record type. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_field_missing.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_missing.res.expected new file mode 100644 index 00000000000..aafee7f85e0 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_field_missing.res.expected @@ -0,0 +1,14 @@ + + We've found a bug for you! + /.../fixtures/record_rest_field_missing.res:3:12-22 + + 1 │ type source = {a: int, b: string, c: bool, d: float} + 2 │ type sub = {b: string} + 3 │ let {a, ...sub as rest} = ({a: 1, b: "x", c: true, d: 1.0}: source) + 4 │ + + The following fields are not part of the rest type `sub`: +- c +- d + +List these fields in the record pattern before the spread so they're not present in the rest record. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_field_not_optional.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_not_optional.res.expected new file mode 100644 index 00000000000..458da763631 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_field_not_optional.res.expected @@ -0,0 +1,13 @@ + + We've found a bug for you! + /.../fixtures/record_rest_field_not_optional.res:3:12-22 + + 1 │ type source = {a?: int, b?: string, c: bool} + 2 │ type sub = {a?: int, b?: string} + 3 │ let {a, ...sub as rest}: source = {c: true} + 4 │ + + The following field appears in both the explicit pattern and the rest type `sub`: +- a + +Mark it as optional (`?a`) in the explicit pattern. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_invalid_type.res.expected b/tests/build_tests/super_errors/expected/record_rest_invalid_type.res.expected new file mode 100644 index 00000000000..98047fce9cd --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_invalid_type.res.expected @@ -0,0 +1,9 @@ + + We've found a bug for you! + /.../fixtures/record_rest_invalid_type.res:2:12-21 + + 1 │ type source = {a: int, b: string} + 2 │ let {a, ...'a as rest} = ({a: 1, b: "x"}: source) + 3 │ + + Record rest pattern must have the form: ...Type.t as name \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_not_record.res.expected b/tests/build_tests/super_errors/expected/record_rest_not_record.res.expected new file mode 100644 index 00000000000..a2c34a5ace0 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_not_record.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/record_rest_not_record.res:3:12-20 + + 1 │ type source = {a: int, b: string} + 2 │ type notRecord = One | Two + 3 │ let {a, ...notRecord as rest} = ({a: 1, b: "x"}: source) + 4 │ + + Type notRecord is not a record type and cannot be used as a record rest pattern. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_requires_type_annotation.res.expected b/tests/build_tests/super_errors/expected/record_rest_requires_type_annotation.res.expected new file mode 100644 index 00000000000..49483d2c99e --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_requires_type_annotation.res.expected @@ -0,0 +1,9 @@ + + We've found a bug for you! + /.../fixtures/record_rest_requires_type_annotation.res:2:12-18 + + 1 │ type source = {a: int, b: string} + 2 │ let {a, ...theRest} = ({a: 1, b: "x"}: source) + 3 │ + + Record rest pattern `...theRest` requires a type annotation. Use `...Type.t as theRest`. \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/record_rest_empty_warning.res b/tests/build_tests/super_errors/fixtures/record_rest_empty_warning.res new file mode 100644 index 00000000000..817b139276c --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_empty_warning.res @@ -0,0 +1,3 @@ +type source = {a: int, b?: string} +type sub = {b?: string} +let {a, ?b, ...sub as rest} = ({a: 1}: source) diff --git a/tests/build_tests/super_errors/fixtures/record_rest_extra_field.res b/tests/build_tests/super_errors/fixtures/record_rest_extra_field.res new file mode 100644 index 00000000000..d7c8f59eb92 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_extra_field.res @@ -0,0 +1,3 @@ +type source = {a: int, x: int} +type sub = {a: int, b: string} +let {x, ...sub as rest} = ({a: 1, x: 2}: source) diff --git a/tests/build_tests/super_errors/fixtures/record_rest_field_missing.res b/tests/build_tests/super_errors/fixtures/record_rest_field_missing.res new file mode 100644 index 00000000000..8a7fadc14ce --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_field_missing.res @@ -0,0 +1,3 @@ +type source = {a: int, b: string, c: bool, d: float} +type sub = {b: string} +let {a, ...sub as rest} = ({a: 1, b: "x", c: true, d: 1.0}: source) diff --git a/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional.res b/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional.res new file mode 100644 index 00000000000..d5bffdb282f --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional.res @@ -0,0 +1,3 @@ +type source = {a?: int, b?: string, c: bool} +type sub = {a?: int, b?: string} +let {a, ...sub as rest}: source = {c: true} diff --git a/tests/build_tests/super_errors/fixtures/record_rest_invalid_type.res b/tests/build_tests/super_errors/fixtures/record_rest_invalid_type.res new file mode 100644 index 00000000000..42dc2a4615d --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_invalid_type.res @@ -0,0 +1,2 @@ +type source = {a: int, b: string} +let {a, ...'a as rest} = ({a: 1, b: "x"}: source) diff --git a/tests/build_tests/super_errors/fixtures/record_rest_not_record.res b/tests/build_tests/super_errors/fixtures/record_rest_not_record.res new file mode 100644 index 00000000000..e7563ab2c02 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_not_record.res @@ -0,0 +1,3 @@ +type source = {a: int, b: string} +type notRecord = One | Two +let {a, ...notRecord as rest} = ({a: 1, b: "x"}: source) diff --git a/tests/build_tests/super_errors/fixtures/record_rest_requires_type_annotation.res b/tests/build_tests/super_errors/fixtures/record_rest_requires_type_annotation.res new file mode 100644 index 00000000000..fbbb66df80a --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_requires_type_annotation.res @@ -0,0 +1,2 @@ +type source = {a: int, b: string} +let {a, ...theRest} = ({a: 1, b: "x"}: source) From 224576540e8c8e8c153e80d4c9c6f6287eb475fe Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 12:50:20 +0200 Subject: [PATCH 09/11] add changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index e9fa571287a..774edf6b7c6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,6 +22,7 @@ - Reanalyze: add glob pattern support for suppress/unsuppress configurations (e.g., `"src/generated/**"`). https://github.com/rescript-lang/rescript/pull/8277 - Add optional `~locales` and `~options` parameters to `String.localeCompare`. https://github.com/rescript-lang/rescript/pull/8287 +- Add support for pattern matching/destructuring of record rest. https://github.com/rescript-lang/rescript/pull/8317 #### :bug: Bug fix From d634e1ec1c8e0cf58949ab1576bd75d06f597f4a Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Apr 2026 12:54:05 +0200 Subject: [PATCH 10/11] address comments (parsetree0 PPX roundtrips, nested rest, etc) --- compiler/ml/ast_iterator.ml | 5 +- compiler/ml/ast_mapper_from0.ml | 3 +- compiler/ml/ast_mapper_to0.ml | 8 ++- compiler/ml/depend.ml | 3 +- compiler/ml/matching.ml | 69 +++++-------------- compiler/ml/parsetree0.ml | 14 ++++ compiler/ml/typecore.ml | 4 +- compiler/ml/typedtree.ml | 10 +++ compiler/syntax/src/res_core.ml | 13 +++- .../expected/record_rest_duplicate.res.txt | 11 +++ .../errors/other/expected/spread.res.txt | 13 ++++ .../errors/other/record_rest_duplicate.res | 1 + tests/tests/src/record_rest_test.mjs | 32 ++++++++- tests/tests/src/record_rest_test.res | 18 +++++ tests/tools_tests/ppx/ZRecordRest.res | 14 ++++ .../src/expected/ZRecordRest.res.jsout | 14 ++++ 16 files changed, 174 insertions(+), 58 deletions(-) create mode 100644 tests/syntax_tests/data/parsing/errors/other/expected/record_rest_duplicate.res.txt create mode 100644 tests/syntax_tests/data/parsing/errors/other/record_rest_duplicate.res create mode 100644 tests/tools_tests/ppx/ZRecordRest.res create mode 100644 tests/tools_tests/src/expected/ZRecordRest.res.jsout diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index 35a92edffb7..17a55245644 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -398,12 +398,13 @@ module P = struct iter_loc sub l; iter_opt (sub.pat sub) p | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p - | Ppat_record (lpl, _cf, _rest) -> + | Ppat_record (lpl, _cf, rest) -> List.iter (fun {lid; x = pat} -> iter_loc sub lid; sub.pat sub pat) - lpl + lpl; + iter_opt (sub.pat sub) rest | Ppat_array pl -> List.iter (sub.pat sub) pl | Ppat_or (p1, p2) -> sub.pat sub p1; diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index 3f91d6ac1ee..46bef562b6a 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -576,7 +576,8 @@ module P = struct construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> - record ~loc ~attrs + let rest, attrs = Parsetree0.get_record_rest_attr attrs in + record ~loc ~attrs ?rest (Ext_list.map lpl (fun (lid, p) -> let lid1 = map_loc sub lid in let p1 = sub.pat sub p in diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 5f32ba55470..443d9a6d8e7 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -559,7 +559,13 @@ module P = struct | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) - | Ppat_record (lpl, cf, _rest) -> + | Ppat_record (lpl, cf, rest) -> + let attrs = + match rest with + | None -> attrs + | Some rest_pat -> + Parsetree0.add_record_rest_attr ~rest:(sub.pat sub rest_pat) attrs + in record ~loc ~attrs (Ext_list.map lpl (fun {lid; x = p; opt = optional} -> let lid1 = map_loc sub lid in diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index cf2bbe3a00d..9c99e63fa42 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -188,7 +188,8 @@ let rec add_pattern bv pat = (fun {lid = lbl; x = p} -> add bv lbl; add_pattern bv p) - pl + pl; + add_opt add_pattern bv _rest | Ppat_array pl -> List.iter (add_pattern bv) pl | Ppat_or (p1, p2) -> add_pattern bv p1; diff --git a/compiler/ml/matching.ml b/compiler/ml/matching.ml index 985868c30a2..6c12de4fec8 100644 --- a/compiler/ml/matching.ml +++ b/compiler/ml/matching.ml @@ -543,6 +543,14 @@ let simplify_or p = in try simpl_rec p with Var p -> p +let bind_record_rest loc arg rest action = + Llet + ( Strict, + Pgenval, + rest.rest_ident, + Lprim (Precord_spread_new rest.excluded_labels, [arg], loc), + action ) + let simplify_cases args cls = match args with | [] -> assert false @@ -560,7 +568,12 @@ let simplify_cases args cls = | Tpat_record (lbls, closed, rest) -> let all_lbls = all_record_args lbls in let full_pat = - {pat with pat_desc = Tpat_record (all_lbls, closed, rest)} + {pat with pat_desc = Tpat_record (all_lbls, closed, None)} + in + let action = + match rest with + | None -> action + | Some rest -> bind_record_rest pat.pat_loc arg rest action in (full_pat :: patl, action) :: simplify rem | Tpat_or _ -> ( @@ -617,8 +630,11 @@ let rec extract_vars r p = | Tpat_var (id, _) -> IdentSet.add id r | Tpat_alias (p, id, _) -> extract_vars (IdentSet.add id r) p | Tpat_tuple pats -> List.fold_left extract_vars r pats - | Tpat_record (lpats, _, _rest) -> - List.fold_left (fun r (_, _, p, _) -> extract_vars r p) r lpats + | Tpat_record (lpats, _, rest) -> ( + let r = List.fold_left (fun r (_, _, p, _) -> extract_vars r p) r lpats in + match rest with + | None -> r + | Some rest -> IdentSet.add rest.rest_ident r) | Tpat_construct (_, _, pats) -> List.fold_left extract_vars r pats | Tpat_array pats -> List.fold_left extract_vars r pats | Tpat_variant (_, Some p, _) -> extract_vars r p @@ -2742,32 +2758,7 @@ let partial_function loc () = ], loc ) -(* For record patterns with rest, inject the rest binding into the action body *) -let inject_record_rest_binding param (pat, action) = - match pat.pat_desc with - | Tpat_record (_, _, Some rest) -> - let action_with_rest = - Llet - ( Strict, - Pgenval, - rest.rest_ident, - Lprim (Precord_spread_new rest.excluded_labels, [param], pat.pat_loc), - action ) - in - let pat_without_rest = - { - pat with - pat_desc = - (match pat.pat_desc with - | Tpat_record (fields, closed, _) -> Tpat_record (fields, closed, None) - | _ -> pat.pat_desc); - } - in - (pat_without_rest, action_with_rest) - | _ -> (pat, action) - let for_function loc repr param pat_act_list partial = - let pat_act_list = List.map (inject_record_rest_binding param) pat_act_list in compile_matching repr (partial_function loc) param pat_act_list partial (* In the following two cases, exhaustiveness info is not available! *) @@ -2836,28 +2827,6 @@ let for_let loc param pat body = | Tpat_var (id, _) -> (* fast path, and keep track of simple bindings to unboxable numbers *) Llet (Strict, Pgenval, id, param, body) - | Tpat_record (_, _, Some rest) -> - (* Record pattern with rest: compile the explicit field bindings normally, - then add a binding for the rest ident using Precord_spread_new *) - let body_with_rest = - Llet - ( Strict, - Pgenval, - rest.rest_ident, - Lprim (Precord_spread_new rest.excluded_labels, [param], loc), - body ) - in - (* Compile the explicit fields pattern (without rest) into the body *) - let pat_without_rest = - { - pat with - pat_desc = - (match pat.pat_desc with - | Tpat_record (fields, closed, _) -> Tpat_record (fields, closed, None) - | _ -> pat.pat_desc); - } - in - simple_for_let loc param pat_without_rest body_with_rest | _ -> simple_for_let loc param pat body (* Handling of tupled functions and matchings *) diff --git a/compiler/ml/parsetree0.ml b/compiler/ml/parsetree0.ml index ef786dfd25d..db5d75ee1a9 100644 --- a/compiler/ml/parsetree0.ml +++ b/compiler/ml/parsetree0.ml @@ -597,6 +597,7 @@ and module_binding = { let optional_attr = (Location.mknoloc "res.optional", Parsetree.PStr []) let optional_attr0 = (Location.mknoloc "res.optional", PStr []) +let record_rest_attr_name = "res.record_rest" let add_optional_attr ~optional attrs = if optional then optional_attr0 :: attrs else attrs @@ -608,3 +609,16 @@ let get_optional_attr attrs_ = let attrs = remove_optional_attr attrs_ in let optional = List.length attrs <> List.length attrs_ in (optional, attrs) + +let add_record_rest_attr ~rest attrs = + (Location.mknoloc record_rest_attr_name, PPat (rest, None)) :: attrs + +let get_record_rest_attr attrs_ = + let rec remove_record_rest_attr acc = function + | ({Location.txt = attr_name; _}, Parsetree.PPat (rest, None)) :: attrs + when attr_name = record_rest_attr_name -> + (Some rest, List.rev_append acc attrs) + | attr :: attrs -> remove_record_rest_attr (attr :: acc) attrs + | [] -> (None, List.rev acc) + in + remove_record_rest_attr [] attrs_ diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 1a416395eb9..14b99d0d787 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -2237,7 +2237,9 @@ let iter_ppat f p = | Ppat_open (_, p) | Ppat_constraint (p, _) -> f p - | Ppat_record (args, _flag, _rest) -> List.iter (fun {x = p} -> f p) args + | Ppat_record (args, _flag, rest) -> + List.iter (fun {x = p} -> f p) args; + may f rest let contains_polymorphic_variant p = let rec loop p = diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml index 8f7c9a298d8..290f9e8f1c9 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -500,6 +500,16 @@ let rec alpha_pat env p = let new_p = alpha_pat env p1 in try {p with pat_desc = Tpat_alias (new_p, alpha_var env id, s)} with Not_found -> new_p) + | Tpat_record (lpats, closed, Some rest) -> + let rest_ident = + try alpha_var env rest.rest_ident with Not_found -> rest.rest_ident + in + let lpats = + List.map + (fun (lid, lbl, pat, opt) -> (lid, lbl, alpha_pat env pat, opt)) + lpats + in + {p with pat_desc = Tpat_record (lpats, closed, Some {rest with rest_ident})} | d -> {p with pat_desc = map_pattern_desc (alpha_pat env) d} let mkloc = Location.mkloc diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index b9c2cce7c78..1a4f919ef19 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -76,6 +76,11 @@ module ErrorMessages = struct "Record rest patterns require a type annotation and a binding name.\n\ Correct syntax: `...typeName as bindingName`\n\ Example: `let {name, ...Config.t as rest} = myRecord`" + + let record_pattern_multiple_rest = + "Record patterns can only have one `...` rest clause.\n\ + Use a single `...typeName as bindingName` clause to capture the remaining \ + fields." (* let recordPatternUnderscore = "Record patterns only support one `_`, at the end." *) [@@live] @@ -1549,7 +1554,13 @@ and parse_record_pattern ~attrs p = Parser.err ~start_pos:pattern.Parsetree.ppat_loc.loc_start p (Diagnostics.message ErrorMessages.record_pattern_spread)); (field :: fields, flag, rest) - | PatRest rest_pat -> (fields, flag, Some rest_pat) + | PatRest rest_pat -> ( + match rest with + | None -> (fields, flag, Some rest_pat) + | Some _ -> + Parser.err ~start_pos:rest_pat.Parsetree.ppat_loc.loc_start p + (Diagnostics.message ErrorMessages.record_pattern_multiple_rest); + (fields, flag, rest)) | PatUnderscore -> (fields, flag, rest)) ([], flag, None) raw_fields in diff --git a/tests/syntax_tests/data/parsing/errors/other/expected/record_rest_duplicate.res.txt b/tests/syntax_tests/data/parsing/errors/other/expected/record_rest_duplicate.res.txt new file mode 100644 index 00000000000..c4c210586f3 --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/other/expected/record_rest_duplicate.res.txt @@ -0,0 +1,11 @@ + + Syntax error! + syntax_tests/data/parsing/errors/other/record_rest_duplicate.res:1:9-51 + + 1 │ let {...Config.t as first, ...Config.t as second} = myRecord + 2 │ + + Record patterns can only have one `...` rest clause. +Use a single `...typeName as bindingName` clause to capture the remaining fields. + +let { } = myRecord \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt b/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt index fa0445fe0b1..c75eaef1117 100644 --- a/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt +++ b/tests/syntax_tests/data/parsing/errors/other/expected/spread.res.txt @@ -28,6 +28,19 @@ Possible solutions: Explanation: since records have a known, fixed shape, a spread like `{a, ...b}` wouldn't make sense, as `b` would override every field of `a` anyway. + Syntax error! + syntax_tests/data/parsing/errors/other/spread.res:4:9-18 + + 2 │ + 3 │ let record = {...x, ...y} + 4 │ let {...x, ...y} = myRecord + 5 │ let {...M.t} = myRecord + 6 │ + + Record patterns can only have one `...` rest clause. +Use a single `...typeName as bindingName` clause to capture the remaining fields. + + Syntax error! syntax_tests/data/parsing/errors/other/spread.res:5:9-14 diff --git a/tests/syntax_tests/data/parsing/errors/other/record_rest_duplicate.res b/tests/syntax_tests/data/parsing/errors/other/record_rest_duplicate.res new file mode 100644 index 00000000000..ac10357c3a6 --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/other/record_rest_duplicate.res @@ -0,0 +1 @@ +let {...Config.t as first, ...Config.t as second} = myRecord diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 267acd804f1..a83523f5cbf 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -32,6 +32,32 @@ function getValue(param) { return ((({id, ...__rest}) => __rest))(param); } +function getTupleRest(param) { + return ((({name, ...__rest}) => __rest))(param[0]); +} + +let tupleRest = getTupleRest([ + { + name: "tuple", + version: "2.0", + debug: false + }, + 1 +]); + +function getWrappedRest(wrapped) { + return ((({name, ...__rest}) => __rest))(wrapped._0); +} + +let wrappedRest = getWrappedRest({ + TAG: "Wrap", + _0: { + name: "wrapped", + version: "3.0", + debug: true + } +}); + let name = "test"; let id = "1"; @@ -45,5 +71,9 @@ export { intRest, id, getValue, + getTupleRest, + tupleRest, + getWrappedRest, + wrappedRest, } -/* No side effect */ +/* tupleRest Not a pure module */ diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index 204948823bf..73bc8b1c531 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -55,3 +55,21 @@ let _ = (id, intRest) // Polymorphic rest in function parameter let getValue = ({id: _, ...valueContainer<'a> as rest}: container<'a>) => rest + +type wrapped = + | Wrap(config) + | Mirror(config) + +// Nested record rest in a tuple pattern +let getTupleRest = (({name: _, ...subConfig as rest}, _): (config, int)) => rest + +let tupleRest = getTupleRest((({name: "tuple", version: "2.0", debug: false}: config), 1)) + +// Nested record rest in constructor and or-pattern matches +let getWrappedRest = wrapped => + switch wrapped { + | Wrap({name: _, ...subConfig as rest}) + | Mirror({name: _, ...subConfig as rest}) => rest + } + +let wrappedRest = getWrappedRest(Wrap({name: "wrapped", version: "3.0", debug: true})) diff --git a/tests/tools_tests/ppx/ZRecordRest.res b/tests/tools_tests/ppx/ZRecordRest.res new file mode 100644 index 00000000000..d70c12df4cb --- /dev/null +++ b/tests/tools_tests/ppx/ZRecordRest.res @@ -0,0 +1,14 @@ +let _ = 0 + +type config = { + name: string, + version: string, + debug: bool, +} + +type subConfig = { + version: string, + debug: bool, +} + +let extract = ({name, ...subConfig as rest}: config) => (name, rest) diff --git a/tests/tools_tests/src/expected/ZRecordRest.res.jsout b/tests/tools_tests/src/expected/ZRecordRest.res.jsout new file mode 100644 index 00000000000..acc2f53a8e2 --- /dev/null +++ b/tests/tools_tests/src/expected/ZRecordRest.res.jsout @@ -0,0 +1,14 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE +'use strict'; + + +function extract(param) { + let rest = ((({name, ...__rest}) => __rest))(param); + return [ + param.name, + rest + ]; +} + +exports.extract = extract; +/* No side effect */ From f835e3f28eaf4b875b65555e570f1155a20316a0 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Apr 2026 13:40:01 +0200 Subject: [PATCH 11/11] support rest of inline record --- compiler/ml/typecore.ml | 18 ++- tests/tests/src/record_rest_test.mjs | 183 +++++++++++++++++++++------ tests/tests/src/record_rest_test.res | 131 +++++++++++++++---- 3 files changed, 271 insertions(+), 61 deletions(-) diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 14b99d0d787..72a2bfeb17f 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1602,6 +1602,22 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp if opt then Some label.lbl_name else None) lbl_pat_list in + let runtime_excluded_fields = + match lbl_pat_list with + | (_, label1, _, _) :: _ -> ( + match label1.lbl_repres with + | Record_inlined {attrs; _} + when not (Ast_untagged_variants.process_untagged attrs) -> + let tag_name = + match Ast_untagged_variants.process_tag_name attrs with + | Some s -> s + | None -> "TAG" + in + if List.mem tag_name explicit_fields then explicit_fields + else tag_name :: explicit_fields + | _ -> explicit_fields) + | [] -> explicit_fields + in (* Get rest field names *) let rest_field_names = List.map @@ -1708,7 +1724,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp rest_type = rest_type_expr; rest_path; rest_labels; - excluded_labels = explicit_fields; + excluded_labels = runtime_excluded_fields; } in rp k diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index a83523f5cbf..1ee94ebf2fc 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -1,13 +1,9 @@ // Generated by ReScript, PLEASE EDIT WITH CARE +import * as Mocha from "mocha"; +import * as Test_utils from "./test_utils.mjs"; -let rest = ((({name, ...__rest}) => __rest))({ - name: "test", - version: "1.0", - debug: true -}); - -function describe(c) { +function describeConfig(c) { let rest = ((({name, ...__rest}) => __rest))(c); return [ c.name, @@ -23,11 +19,6 @@ function extractClassName(param) { return ((({className, ...__rest}) => __rest))(param); } -let intRest = ((({id, ...__rest}) => __rest))({ - id: "1", - value: 42 -}); - function getValue(param) { return ((({id, ...__rest}) => __rest))(param); } @@ -36,44 +27,160 @@ function getTupleRest(param) { return ((({name, ...__rest}) => __rest))(param[0]); } -let tupleRest = getTupleRest([ - { - name: "tuple", - version: "2.0", - debug: false - }, - 1 -]); - function getWrappedRest(wrapped) { return ((({name, ...__rest}) => __rest))(wrapped._0); } -let wrappedRest = getWrappedRest({ - TAG: "Wrap", - _0: { - name: "wrapped", +function getInlineWrappedRest(wrapped) { + return ((({TAG, name, ...__rest}) => __rest))(wrapped); +} + +function getCustomTaggedInlineWrappedRest(wrapped) { + return ((({kind, name, ...__rest}) => __rest))(wrapped); +} + +Mocha.describe("Record_rest_test", () => { + Mocha.test("let binding captures record rest value", () => { + let rest = ((({name, ...__rest}) => __rest))({ + name: "test", + version: "1.0", + debug: true + }); + Test_utils.eq("File \"record_rest_test.res\", line 83, characters 7-14", "test", "test"); + Test_utils.eq("File \"record_rest_test.res\", line 84, characters 7-14", rest, { + version: "1.0", + debug: true + }); + }); + Mocha.test("match arm returns the named field and the rest record", () => Test_utils.eq("File \"record_rest_test.res\", line 89, characters 6-13", describeConfig({ + name: "match", + version: "2.0", + debug: false + }), [ + "match", + { + version: "2.0", + debug: false + } + ])); + Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 96, characters 7-14", getName({ + name: "param", version: "3.0", debug: true - } + }), "param")); + Mocha.test("optional overlap keeps the remaining fields in the rest object", () => { + let onClick = () => {}; + let rest = extractClassName({ + className: "btn", + style: "bold", + onClick: onClick + }); + Test_utils.eq("File \"record_rest_test.res\", line 102, characters 7-14", rest, { + style: "bold", + onClick: onClick + }); + }); + Mocha.test("polymorphic rest captures the value field", () => { + let intRest = ((({id, ...__rest}) => __rest))({ + id: "1", + value: 42 + }); + Test_utils.eq("File \"record_rest_test.res\", line 107, characters 7-14", "1", "1"); + Test_utils.eq("File \"record_rest_test.res\", line 108, characters 7-14", intRest, { + value: 42 + }); + Test_utils.eq("File \"record_rest_test.res\", line 109, characters 7-14", ((({id, ...__rest}) => __rest))({ + id: "2", + value: "hello" + }), { + value: "hello" + }); + }); + Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 114, characters 6-13", getTupleRest([ + { + name: "tuple", + version: "4.0", + debug: false + }, + 1 + ]), { + version: "4.0", + debug: false + })); + Mocha.test("variant payload rest works through the or-pattern path", () => { + Test_utils.eq("File \"record_rest_test.res\", line 122, characters 6-13", getWrappedRest({ + TAG: "Wrap", + _0: { + name: "wrapped", + version: "5.0", + debug: true + } + }), { + version: "5.0", + debug: true + }); + Test_utils.eq("File \"record_rest_test.res\", line 127, characters 6-13", getWrappedRest({ + TAG: "Mirror", + _0: { + name: "mirror", + version: "6.0", + debug: false + } + }), { + version: "6.0", + debug: false + }); + }); + Mocha.test("inline record variant rest removes the runtime tag field", () => { + Test_utils.eq("File \"record_rest_test.res\", line 135, characters 6-13", getInlineWrappedRest({ + TAG: "InlineWrap", + name: "inline", + version: "7.0", + debug: true + }), { + version: "7.0", + debug: true + }); + Test_utils.eq("File \"record_rest_test.res\", line 140, characters 6-13", getInlineWrappedRest({ + TAG: "InlineMirror", + name: "inlineMirror", + version: "8.0", + debug: false + }), { + version: "8.0", + debug: false + }); + }); + Mocha.test("inline record variant rest removes a custom runtime tag field", () => { + Test_utils.eq("File \"record_rest_test.res\", line 148, characters 6-13", getCustomTaggedInlineWrappedRest({ + kind: "CustomInlineWrap", + name: "customInline", + version: "9.0", + debug: true + }), { + version: "9.0", + debug: true + }); + Test_utils.eq("File \"record_rest_test.res\", line 155, characters 6-13", getCustomTaggedInlineWrappedRest({ + kind: "CustomInlineMirror", + name: "customInlineMirror", + version: "10.0", + debug: false + }), { + version: "10.0", + debug: false + }); + }); }); -let name = "test"; - -let id = "1"; - export { - rest, - name, - describe, + describeConfig, getName, extractClassName, - intRest, - id, getValue, getTupleRest, - tupleRest, getWrappedRest, - wrappedRest, + getInlineWrappedRest, + getCustomTaggedInlineWrappedRest, } -/* tupleRest Not a pure module */ +/* Not a pure module */ diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index 73bc8b1c531..57007d85be8 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -1,3 +1,6 @@ +open Mocha +open Test_utils + type config = { name: string, version: string, @@ -9,20 +12,13 @@ type subConfig = { debug: bool, } -// Basic rest pattern in let binding -let {name, ...subConfig as rest} = ({name: "test", version: "1.0", debug: true}: config) -let _ = (name, rest) - -// Rest pattern in match arm -let describe = (c: config) => +let describeConfig = (c: config) => switch c { | {name, ...subConfig as rest} => (name, rest) } -// Rest pattern in function parameter let getName = ({name, ...subConfig as _rest}: config) => name -// Optional field overlap: className is in both explicit (as optional) and rest type type fullProps = { className?: string, style?: string, @@ -35,12 +31,8 @@ type baseProps = { onClick: unit => unit, } -let extractClassName = ({?className, ...baseProps as rest}: fullProps) => { - let _ = className - rest -} +let extractClassName = ({className: ?_, ...baseProps as rest}: fullProps) => rest -// Polymorphic rest type type container<'a> = { id: string, value: 'a, @@ -50,26 +42,121 @@ type valueContainer<'a> = { value: 'a, } -let {id, ...valueContainer as intRest} = ({id: "1", value: 42}: container) -let _ = (id, intRest) - -// Polymorphic rest in function parameter let getValue = ({id: _, ...valueContainer<'a> as rest}: container<'a>) => rest type wrapped = | Wrap(config) | Mirror(config) -// Nested record rest in a tuple pattern let getTupleRest = (({name: _, ...subConfig as rest}, _): (config, int)) => rest -let tupleRest = getTupleRest((({name: "tuple", version: "2.0", debug: false}: config), 1)) - -// Nested record rest in constructor and or-pattern matches let getWrappedRest = wrapped => switch wrapped { | Wrap({name: _, ...subConfig as rest}) | Mirror({name: _, ...subConfig as rest}) => rest } -let wrappedRest = getWrappedRest(Wrap({name: "wrapped", version: "3.0", debug: true})) +type inlineWrapped = + | InlineWrap({name: string, version: string, debug: bool}) + | InlineMirror({name: string, version: string, debug: bool}) + +let getInlineWrappedRest = wrapped => + switch wrapped { + | InlineWrap({name: _, ...subConfig as rest}) + | InlineMirror({name: _, ...subConfig as rest}) => rest + } + +@tag("kind") +type customTaggedInlineWrapped = + | CustomInlineWrap({name: string, version: string, debug: bool}) + | CustomInlineMirror({name: string, version: string, debug: bool}) + +let getCustomTaggedInlineWrappedRest = wrapped => + switch wrapped { + | CustomInlineWrap({name: _, ...subConfig as rest}) + | CustomInlineMirror({name: _, ...subConfig as rest}) => rest + } + +describe(__MODULE__, () => { + test("let binding captures record rest value", () => { + let {name, ...subConfig as rest} = ({name: "test", version: "1.0", debug: true}: config) + eq(__LOC__, name, "test") + eq(__LOC__, rest, {version: "1.0", debug: true}) + }) + + test("match arm returns the named field and the rest record", () => { + eq( + __LOC__, + describeConfig({name: "match", version: "2.0", debug: false}), + ("match", {version: "2.0", debug: false}), + ) + }) + + test("function parameter destructuring keeps the named field", () => { + eq(__LOC__, getName({name: "param", version: "3.0", debug: true}), "param") + }) + + test("optional overlap keeps the remaining fields in the rest object", () => { + let onClick = () => () + let rest = extractClassName({className: "btn", style: "bold", onClick}) + eq(__LOC__, rest, {style: "bold", onClick}) + }) + + test("polymorphic rest captures the value field", () => { + let {id, ...valueContainer as intRest} = ({id: "1", value: 42}: container) + eq(__LOC__, id, "1") + eq(__LOC__, intRest, {value: 42}) + eq(__LOC__, getValue({id: "2", value: "hello"}), {value: "hello"}) + }) + + test("tuple nested record rest is initialized", () => { + eq( + __LOC__, + getTupleRest((({name: "tuple", version: "4.0", debug: false}: config), 1)), + {version: "4.0", debug: false}, + ) + }) + + test("variant payload rest works through the or-pattern path", () => { + eq( + __LOC__, + getWrappedRest(Wrap({name: "wrapped", version: "5.0", debug: true})), + {version: "5.0", debug: true}, + ) + eq( + __LOC__, + getWrappedRest(Mirror({name: "mirror", version: "6.0", debug: false})), + {version: "6.0", debug: false}, + ) + }) + + test("inline record variant rest removes the runtime tag field", () => { + eq( + __LOC__, + getInlineWrappedRest(InlineWrap({name: "inline", version: "7.0", debug: true})), + {version: "7.0", debug: true}, + ) + eq( + __LOC__, + getInlineWrappedRest(InlineMirror({name: "inlineMirror", version: "8.0", debug: false})), + {version: "8.0", debug: false}, + ) + }) + + test("inline record variant rest removes a custom runtime tag field", () => { + eq( + __LOC__, + getCustomTaggedInlineWrappedRest( + CustomInlineWrap({name: "customInline", version: "9.0", debug: true}), + ), + {version: "9.0", debug: true}, + ) + eq( + __LOC__, + getCustomTaggedInlineWrappedRest( + CustomInlineMirror({name: "customInlineMirror", version: "10.0", debug: false}), + ), + {version: "10.0", debug: false}, + ) + }) +})