From 01b10abf52cfd0886100f13496c9300aea87e186 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Sat, 28 Mar 2026 10:35:02 +0100 Subject: [PATCH 01/47] destructure record rest elements - fixes #8311 --- analysis/reanalyze/src/dead_value.ml | 2 +- analysis/src/completion_front_end.ml | 2 +- analysis/src/completion_patterns.ml | 4 +- analysis/src/dump_ast.ml | 2 +- analysis/src/hint.ml | 2 +- analysis/src/process_cmt.ml | 2 +- analysis/src/process_extra.ml | 2 +- analysis/src/semantic_tokens.ml | 2 +- analysis/src/signature_help.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 | 178 +++++++++++++++++- compiler/ml/typecore.mli | 6 + compiler/ml/typedtree.ml | 23 ++- compiler/ml/typedtree.mli | 9 + compiler/ml/typedtree_iter.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, 577 insertions(+), 134 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/dead_value.ml b/analysis/reanalyze/src/dead_value.ml index aa82de7f77d..a10a3f8d909 100644 --- a/analysis/reanalyze/src/dead_value.ml +++ b/analysis/reanalyze/src/dead_value.ml @@ -235,7 +235,7 @@ let collect_pattern ~config ~refs : fun super self pat -> let pos_from = 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 = pos_to}}, _pat, _) -> if !Config.analyze_types then diff --git a/analysis/src/completion_front_end.ml b/analysis/src/completion_front_end.ml index aeaf7657903..e0bc67bce69 100644 --- a/analysis/src/completion_front_end.ml +++ b/analysis/src/completion_front_end.ml @@ -517,7 +517,7 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file (NPolyvariantPayload {item_num = 0; constructor_name = txt} :: pattern_path) ?context_path 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/completion_patterns.ml b/analysis/src/completion_patterns.ml index cc1a270cab7..16b6ae886df 100644 --- a/analysis/src/completion_patterns.ml +++ b/analysis/src/completion_patterns.ml @@ -106,12 +106,12 @@ and traverse_pattern (pat : Parsetree.pattern) ~pattern_path ~loc_has_cursor [Completable.NTupleItem {item_num}] @ pattern_path) ~result_from_found_item_num:(fun item_num -> [Completable.NTupleItem {item_num = item_num + 1}] @ pattern_path) - | Ppat_record ([], _) -> + | Ppat_record ([], _, _rest) -> (* Empty fields means we're in a record body `{}`. Complete for the fields. *) some_if_has_cursor ("", [Completable.NRecordBody {seen_fields = []}] @ pattern_path) "Ppat_record(empty)" - | Ppat_record (fields, _) -> ( + | Ppat_record (fields, _, _rest) -> ( let field_with_cursor = ref None in let field_with_pat_hole = ref None in Ext_list.iter fields (fun {lid = fname; x = f} -> diff --git a/analysis/src/dump_ast.ml b/analysis/src/dump_ast.ml index 0ebb44c0d5a..6301af8f897 100644 --- a/analysis/src/dump_ast.ml +++ b/analysis/src/dump_ast.ml @@ -101,7 +101,7 @@ let rec print_pattern pattern ~pos ~indentation = | None -> "" | Some pat -> "," ^ print_pattern pat ~pos ~indentation) ^ ")" - | Ppat_record (fields, _) -> + | Ppat_record (fields, _, _rest) -> "Ppat_record(\n" ^ add_indentation (indentation + 1) ^ "fields:\n" diff --git a/analysis/src/hint.ml b/analysis/src/hint.ml index 7206a6beb8f..3f9f8e98ff2 100644 --- a/analysis/src/hint.ml +++ b/analysis/src/hint.ml @@ -42,7 +42,7 @@ let inlay ~source ~kind_file ~pos ~max_length ~full ~state ~debug = let rec process_pattern (pat : Parsetree.pattern) = match pat.ppat_desc with | Ppat_tuple pl -> pl |> List.iter process_pattern - | Ppat_record (fields, _) -> + | Ppat_record (fields, _, _rest) -> Ext_list.iter fields (fun {x = p} -> process_pattern p) | Ppat_array fields -> fields |> List.iter process_pattern | Ppat_var {loc} -> push loc Type diff --git a/analysis/src/process_cmt.ml b/analysis/src/process_cmt.ml index 4e6cca03bf5..ab7aa7d46f7 100644 --- a/analysis/src/process_cmt.ml +++ b/analysis/src/process_cmt.ml @@ -517,7 +517,7 @@ let rec for_structure_item ~(env : Shared_types.Env.t) ~(exported : Exported.t) | Tpat_tuple pats | Tpat_array pats | Tpat_construct (_, _, pats) -> pats |> List.iter (fun p -> handle_pattern [] p) | Tpat_or (p, _, _) -> handle_pattern [] p - | Tpat_record (items, _) -> + | Tpat_record (items, _, _rest) -> items |> List.iter (fun (_, _, p, _) -> handle_pattern [] p) | Tpat_variant (_, Some p, _) -> handle_pattern [] p | Tpat_variant (_, None, _) | Tpat_any | Tpat_constant _ -> () diff --git a/analysis/src/process_extra.ml b/analysis/src/process_extra.ml index fcd5c8e1f1d..c2a7bd24508 100644 --- a/analysis/src/process_extra.ml +++ b/analysis/src/process_extra.ml @@ -392,7 +392,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) -> add_for_record ~env ~extra ~record_type:pattern.pat_type items | Tpat_construct (lident, constructor, _) -> add_for_constructor ~env ~extra pattern.pat_type lident constructor diff --git a/analysis/src/semantic_tokens.ml b/analysis/src/semantic_tokens.ml index 92b3afe8369..bb230f1c7a2 100644 --- a/analysis/src/semantic_tokens.ml +++ b/analysis/src/semantic_tokens.ml @@ -233,7 +233,7 @@ let command ~debug ~emitter ~source ~kind_file = | 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 |> emit_record_label ~label ~debug); Ast_iterator.default_iterator.pat iterator p diff --git a/analysis/src/signature_help.ml b/analysis/src/signature_help.ml index 493ce3490fa..aca9539536e 100644 --- a/analysis/src/signature_help.ml +++ b/analysis/src/signature_help.ml @@ -685,7 +685,8 @@ let signature_help ~debug ~source ~kind_file ~pos match tuple_item_with_cursor with | None -> -1 | Some i -> i) - | `ConstructorPat (_, {ppat_desc = Ppat_record (fields, _)}) -> ( + | `ConstructorPat (_, {ppat_desc = Ppat_record (fields, _, _rest)}) + -> ( let field_name_with_cursor = fields |> List.find_map diff --git a/analysis/src/xform.ml b/analysis/src/xform.ml index ac12e160357..d5c59eba513 100644 --- a/analysis/src/xform.ml +++ b/analysis/src/xform.ml @@ -78,7 +78,7 @@ module If_then_else = struct in match list_to_pat ~item_to_pat items with | None -> None - | Some pat_items -> Some (mk_pat (Ppat_record (pat_items, Closed)))) + | Some pat_items -> Some (mk_pat (Ppat_record (pat_items, 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 29a8d3a1602..8ffc3ea8795 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 e6a7a86a6e3..5c1f131f958 100644 --- a/compiler/core/lam_compile_primitive.ml +++ b/compiler/core/lam_compile_primitive.ml @@ -609,6 +609,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 9e0bccdaa93..1da0c23109e 100644 --- a/compiler/core/lam_convert.ml +++ b/compiler/core/lam_convert.ml @@ -208,6 +208,8 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t = | Psetfield (id, info) -> prim ~primitive:(Psetfield (id, info)) ~args loc | Pduprecord -> prim ~primitive:Pduprecord ~args loc | Ptagged_template -> prim ~primitive:Ptagged_template ~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 974aff095b0..73fad3d2538 100644 --- a/compiler/core/lam_primitive.ml +++ b/compiler/core/lam_primitive.ml @@ -42,6 +42,7 @@ type t = | Pduprecord (* Tagged template literal: [tag; strings_array; values_array] *) | Ptagged_template + | Precord_spread_new of string list (* External call *) | Pjs_call of { prim_name: string; @@ -228,9 +229,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 (* Reachable only via the optimizer's term-equality comparison, which the test suite doesn't exercise for tagged templates. *) diff --git a/compiler/core/lam_primitive.mli b/compiler/core/lam_primitive.mli index 8c0d26a89e1..8a355cc4791 100644 --- a/compiler/core/lam_primitive.mli +++ b/compiler/core/lam_primitive.mli @@ -37,6 +37,7 @@ type t = | Psetfield of int * Lambda.set_field_dbg_info | Pduprecord | Ptagged_template + | 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 9408b11aea4..c8e7f29deb7 100644 --- a/compiler/core/lam_print.ml +++ b/compiler/core/lam_print.ml @@ -83,6 +83,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 7144cc776a5..31696129001 100644 --- a/compiler/frontend/bs_ast_mapper.ml +++ b/compiler/frontend/bs_ast_mapper.ml @@ -433,8 +433,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 d8d3b350cb4..da26d2ba637 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 6538c50419f..05282cd49fe 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 474fec12d68..75a55d88d0d 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -407,7 +407,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 7953771b4c8..f7c9b8031cb 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -397,8 +397,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 c204651070e..a5773871577 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -601,7 +601,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 3a13d4ac003..49c5463b124 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -179,7 +179,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 e078a2a28f8..5324f00aa23 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 99f399aa0ac..16fe7036d2d 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 916646ea08a..8d3912a90c7 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, _) -> Ident_set.add id r | Tpat_alias (p, id, _) -> extract_vars (Ident_set.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 4ae23724fb4..047a71b2f0d 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)} -> @@ -967,7 +969,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] @@ -1170,7 +1172,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 @@ -1379,7 +1382,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) @@ -1784,7 +1787,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 @@ -1831,9 +1834,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 @@ -1992,7 +1995,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) -> @@ -2001,7 +2004,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 @@ -2153,7 +2156,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 @@ -2284,7 +2287,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 @@ -2432,12 +2435,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 29207d0150b..fc4709b4efb 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 10025b0e0e7..b079c5579ca 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -460,7 +460,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 5aae8263738..3f4cad224a3 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -205,7 +205,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 e30f3c867f2..aac5010d326 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 f8bfaa170f2..57a56b052a7 100644 --- a/compiler/ml/printtyped.ml +++ b/compiler/ml/printtyped.ml @@ -231,7 +231,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 61f55114e97..bd3cddf1b1e 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 @@ -438,7 +438,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 86f77420bd2..077837d2af6 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 1d0e49efd35..fd2e57baee5 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 37bbf81b60a..47f4e6b8753 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -96,6 +96,12 @@ type error = | Field_access_on_dict_type | Jsx_not_enabled | Tagged_template_non_tag of type_expr + | 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 @@ -512,7 +518,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 @@ -1494,7 +1500,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 @@ -1550,12 +1556,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; @@ -2121,7 +2261,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 = @@ -5072,8 +5212,34 @@ let report_error env loc ppf error = with @{taggedTemplate<...>@} instead of using the removed \ @{@@taggedTemplate@} decorator.@,\ \ - To use a ReScript function as a tag, lift it with \ - @{TaggedTemplate.make@}.@]" + @{TaggedTemplate.make@}.@]" type_expr typ + | 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 cba37060eb6..13129276c10 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -129,6 +129,12 @@ type error = | Field_access_on_dict_type | Jsx_not_enabled | Tagged_template_non_tag of type_expr + | 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 f772a0eb64b..cbabf20ffd7 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 @@ -417,7 +426,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, _) -> @@ -429,8 +438,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) @@ -450,6 +460,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 538405a7691..3dbeb96d7f3 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/typedtree_iter.ml b/compiler/ml/typedtree_iter.ml index 6f48bcd620a..a177d6aed7e 100644 --- a/compiler/ml/typedtree_iter.ml +++ b/compiler/ml/typedtree_iter.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 6749355ea3e..0436254c07a 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -804,7 +804,7 @@ module Sexp_ast = 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 9741d3ece62..aef9ee4959a 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -2135,7 +2135,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 2d3eabd3944..05e5f157e10 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -336,6 +336,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 @@ -1517,9 +1518,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 -> ( @@ -1560,14 +1623,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 -> @@ -1575,12 +1638,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 Error_messages.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 6c47f99bfb2..857404064e5 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -2785,7 +2785,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 Parsetree_viewer.has_dict_pattern_attribute p.ppat_attributes -> Doc.concat [ @@ -2803,9 +2803,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 [ @@ -2820,9 +2834,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 f353016cc1dc4e919cbc58ac41ad7ee4e26ce276 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 10:57:30 +0200 Subject: [PATCH 02/47] 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 47f4e6b8753..9c0ea49ebc6 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1571,11 +1571,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))) @@ -1674,12 +1674,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 05e5f157e10..8151acf7bd4 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -1523,10 +1523,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 = @@ -1547,14 +1548,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 61082160d70bbfa534d66068bbe168a1e32bf108 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 11:12:33 +0200 Subject: [PATCH 03/47] 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 8151acf7bd4..ad389295d33 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -1521,13 +1521,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 = @@ -1545,48 +1546,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 f9c6325c666c194647b8a8be851138ae34e3bd66 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 11:19:33 +0200 Subject: [PATCH 04/47] 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 ad389295d33..fcfc49b7a53 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -126,11 +126,9 @@ module Error_messages = 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 906df32cd5d4543e1315ed8d419b211f77a9295f Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 12:03:22 +0200 Subject: [PATCH 05/47] 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 9c0ea49ebc6..a9ffcb9542e 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -100,7 +100,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 @@ -1639,19 +1639,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 @@ -5249,10 +5252,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 13129276c10..c7e57c8af04 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -133,7 +133,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 77ccbcf7c6ce42c75a901aafba5767e3926b163c Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 12:27:53 +0200 Subject: [PATCH 06/47] 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 a9ffcb9542e..d5089daecfa 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -99,7 +99,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 @@ -1622,19 +1622,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, _, _) :: _ -> @@ -5247,11 +5248,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 c7e57c8af04..7d1ac112903 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -132,7 +132,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 453d89f4e572ae5528b0d344fe5df069305ef9b3 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 12:31:30 +0200 Subject: [PATCH 07/47] add a warning when rest record would be empty --- compiler/ext/warnings.ml | 8 +++++++- compiler/ext/warnings.mli | 1 + compiler/ml/typecore.ml | 9 +++++++++ 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/compiler/ext/warnings.ml b/compiler/ext/warnings.ml index c768ae4537c..629a4ca759a 100644 --- a/compiler/ext/warnings.ml +++ b/compiler/ext/warnings.ml @@ -75,6 +75,7 @@ type t = (string * top_level_unit_help) option (* 109 *) | Bs_todo of string option (* 110 *) | Bs_private_record_mutation of string (* 111 *) + | Bs_record_rest_empty (* 112 *) (* If you remove a warning, leave a hole in the numbering. NEVER change the numbers of existing warnings. @@ -128,8 +129,9 @@ let number = function | Bs_toplevel_expression_unit _ -> 109 | Bs_todo _ -> 110 | Bs_private_record_mutation _ -> 111 + | Bs_record_rest_empty -> 112 -let last_warning_number = 111 +let last_warning_number = 112 let letter_all = let rec loop i = if i = 0 then [] else i :: loop (i - 1) in @@ -448,6 +450,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." @@ -569,6 +574,7 @@ let descriptions = (109, "Toplevel expression has unit type"); (110, "Todo found"); (111, "Mutation of private record field"); + (112, "Record rest pattern will always be empty"); ] let help_warnings () = diff --git a/compiler/ext/warnings.mli b/compiler/ext/warnings.mli index 46cba811ad7..e7be69baf32 100644 --- a/compiler/ext/warnings.mli +++ b/compiler/ext/warnings.mli @@ -68,6 +68,7 @@ type t = (string * top_level_unit_help) option (* 109 *) | Bs_todo of string option (* 110 *) | Bs_private_record_mutation of string (* 111 *) + | Bs_record_rest_empty (* 112 *) val parse_options : bool -> string -> unit diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index d5089daecfa..63d5f274657 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1621,6 +1621,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 23ea968a6a09c18bb27989d48a72b7c5777838aa Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 12:48:42 +0200 Subject: [PATCH 08/47] 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 63d5f274657..4e4144cf352 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1621,15 +1621,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 @@ -1687,6 +1678,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 0841f1d4cb3d2795d5deaa047805772b9e253300 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 31 Mar 2026 12:50:20 +0200 Subject: [PATCH 09/47] add changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 070c866edc8..1b29e9179d2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -118,6 +118,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 - Support inline records in external definitions. https://github.com/rescript-lang/rescript/pull/8304 +- Add support for pattern matching/destructuring of record rest. https://github.com/rescript-lang/rescript/pull/8317 #### :bug: Bug fix From aaecac9b2aef20e167d52c0b235838f939224511 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Apr 2026 12:54:05 +0200 Subject: [PATCH 10/47] 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 75a55d88d0d..66be16cf836 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -407,12 +407,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 c4e8f80bb35..e565cda05b5 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -656,7 +656,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 a5773871577..73aea1625f5 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -601,7 +601,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 49c5463b124..dc5442cdc6a 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -184,7 +184,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 8d3912a90c7..ac7b952aeac 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, _) -> Ident_set.add id r | Tpat_alias (p, id, _) -> extract_vars (Ident_set.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 4e4144cf352..057760118b3 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -2292,7 +2292,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 cbabf20ffd7..5557c2beefe 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -504,6 +504,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 fcfc49b7a53..8b989be7b1c 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -129,6 +129,11 @@ module Error_messages = 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] @@ -1614,7 +1619,13 @@ and parse_record_pattern ~attrs p = Parser.err ~start_pos:pattern.Parsetree.ppat_loc.loc_start p (Diagnostics.message Error_messages.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 ca77e9cab21e8a1add21f99c62ebd3c76f973f3f Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Apr 2026 13:40:01 +0200 Subject: [PATCH 11/47] 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 057760118b3..0cbdee25d3c 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1615,6 +1615,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 @@ -1721,7 +1737,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}, + ) + }) +}) From 42c6f9c51b85869e7e16f754a8eafcbbbb1edee0 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Apr 2026 15:52:22 +0200 Subject: [PATCH 12/47] check rest field types, fix matching & invalid field identifier --- compiler/core/lam_compile_primitive.ml | 20 +- compiler/ml/matching.ml | 8 +- compiler/ml/typecore.ml | 198 ++++++++++-------- ...cord_rest_field_type_mismatch.res.expected | 11 + .../record_rest_field_type_mismatch.res | 4 + tests/tests/src/record_rest_test.mjs | 87 +++++--- tests/tests/src/record_rest_test.res | 37 ++++ .../src/expected/ZRecordRest.res.jsout | 2 +- 8 files changed, 254 insertions(+), 113 deletions(-) create mode 100644 tests/build_tests/super_errors/expected/record_rest_field_type_mismatch.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_field_type_mismatch.res diff --git a/compiler/core/lam_compile_primitive.ml b/compiler/core/lam_compile_primitive.ml index 5c1f131f958..499619e057e 100644 --- a/compiler/core/lam_compile_primitive.ml +++ b/compiler/core/lam_compile_primitive.ml @@ -612,10 +612,22 @@ let translate output_prefix loc (cxt : Lam_compile_context.t) | 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 + (* Generate: (({field1: __unused0, ...__rest}) => __rest)(source) + This uses JS destructuring to cleanly extract the rest while + safely handling quoted property names and the empty-exclusion case. *) + let excluded_bindings = + List.mapi + (fun i field -> + let field = Js_dump_property.property_key (Js_op.Lit field) in + Printf.sprintf "%s: __unused%d" field i) + excluded + in + let destructured = + match excluded_bindings with + | [] -> "...__rest" + | _ -> String.concat ", " excluded_bindings ^ ", ...__rest" + in + let code = Printf.sprintf "(({%s}) => __rest)" destructured 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) diff --git a/compiler/ml/matching.ml b/compiler/ml/matching.ml index ac7b952aeac..53a78238182 100644 --- a/compiler/ml/matching.ml +++ b/compiler/ml/matching.ml @@ -564,7 +564,13 @@ 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 ([], _, _rest) -> (omega :: patl, action) :: simplify rem + | Tpat_record ([], _, rest) -> + let action = + match rest with + | None -> action + | Some rest -> bind_record_rest pat.pat_loc arg rest action + in + (omega :: patl, action) :: simplify rem | Tpat_record (lbls, closed, rest) -> let all_lbls = all_record_args lbls in let full_pat = diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 0cbdee25d3c..c8ccb73c72e 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1594,9 +1594,9 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp 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 + let rest_decl = + match rest_decl.type_kind with + | Type_record _ -> instance_declaration rest_decl | _ -> raise (Error @@ -1608,6 +1608,77 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp let explicit_fields = List.map (fun (_, label, _, _) -> label.lbl_name) lbl_pat_list in + 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, rest_type_args, ref Mnil)) + in + List.iter2 + (fun param arg -> unify_pat_types rest_type_lid.loc !env param arg) + rest_decl.type_params rest_type_args; + let source_fields, source_repr = + match + try + let _, _, source_decl = + extract_concrete_typedecl !env record_ty + in + let source_decl = instance_declaration source_decl in + let source_type_args = + match expand_head !env record_ty with + | {desc = Tconstr (_, args, _)} -> args + | _ -> assert false + in + Some (source_decl, source_type_args) + with Not_found -> None + with + | Some (source_decl, source_type_args) -> ( + List.iter2 + (fun param arg -> unify_pat_types loc !env param arg) + source_decl.type_params source_type_args; + match source_decl.type_kind with + | Type_record (fields, repr) -> + ( List.map + (fun (l : Types.label_declaration) -> + (Ident.name l.ld_id, l.ld_type)) + fields, + repr ) + | _ -> assert false) + | None -> ( + unify_pat_types rest_type_lid.loc !env record_ty rest_type_expr; + match rest_decl.type_kind with + | Type_record (fields, repr) -> + ( List.map + (fun (l : Types.label_declaration) -> + (Ident.name l.ld_id, l.ld_type)) + fields, + repr ) + | _ -> assert false) + in + let rest_labels = + match rest_decl.type_kind with + | Type_record (labels, _) -> labels + | _ -> assert false + in (* Get explicit optional fields *) let explicit_optional_fields = List.filter_map @@ -1616,20 +1687,17 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp 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 + match source_repr 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 in (* Get rest field names *) let rest_field_names = @@ -1653,47 +1721,36 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp 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, _, _) :: _ -> - let all_source = label1.lbl_all in - 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 - | (_, 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 source_field_names = List.map fst source_fields in + let missing = + List.filter + (fun source_field -> + (not (List.mem source_field explicit_fields)) + && not (List.mem source_field rest_field_names)) + source_field_names + 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 and use compatible types *) + List.iter + (fun (rest_label : Types.label_declaration) -> + let rest_field = Ident.name rest_label.ld_id in + match List.assoc_opt rest_field source_fields with + | None -> + raise + (Error + ( rest_type_lid.loc, + !env, + Record_rest_extra_field (rest_field, rest_type_lid.txt) + )) + | Some source_type -> + unify_pat_types rest_type_lid.loc !env rest_label.ld_type + source_type) + rest_labels; (* Warn if all rest fields are already explicit — the rest record will be empty *) if rest_field_names <> [] @@ -1703,31 +1760,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp 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 - | 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, rest_type_args, ref Mnil)) - in let rest_ident = enter_variable rest_pat.ppat_loc rest_name rest_type_expr in diff --git a/tests/build_tests/super_errors/expected/record_rest_field_type_mismatch.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_type_mismatch.res.expected new file mode 100644 index 00000000000..4454b137c57 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_field_type_mismatch.res.expected @@ -0,0 +1,11 @@ + + We've found a bug for you! + /.../fixtures/record_rest_field_type_mismatch.res:4:12-16 + + 2 │ type wrong = {b: int} + 3 │ + 4 │ let {a, ...wrong as rest} = ({a: 1, b: "x"}: source) + 5 │ + + This pattern matches values of type int + but a pattern was expected which matches values of type string \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/record_rest_field_type_mismatch.res b/tests/build_tests/super_errors/fixtures/record_rest_field_type_mismatch.res new file mode 100644 index 00000000000..d42513e6aff --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_field_type_mismatch.res @@ -0,0 +1,4 @@ +type source = {a: int, b: string} +type wrong = {b: int} + +let {a, ...wrong as rest} = ({a: 1, b: "x"}: source) diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 1ee94ebf2fc..d08838c14b6 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -4,7 +4,7 @@ import * as Mocha from "mocha"; import * as Test_utils from "./test_utils.mjs"; function describeConfig(c) { - let rest = ((({name, ...__rest}) => __rest))(c); + let rest = ((({name: __unused0, ...__rest}) => __rest))(c); return [ c.name, rest @@ -15,44 +15,52 @@ function getName(param) { return param.name; } +function getWholeConfig(param) { + return ((({...__rest}) => __rest))(param); +} + function extractClassName(param) { - return ((({className, ...__rest}) => __rest))(param); + return ((({className: __unused0, ...__rest}) => __rest))(param); } function getValue(param) { - return ((({id, ...__rest}) => __rest))(param); + return ((({id: __unused0, ...__rest}) => __rest))(param); } function getTupleRest(param) { - return ((({name, ...__rest}) => __rest))(param[0]); + return ((({name: __unused0, ...__rest}) => __rest))(param[0]); } function getWrappedRest(wrapped) { - return ((({name, ...__rest}) => __rest))(wrapped._0); + return ((({name: __unused0, ...__rest}) => __rest))(wrapped._0); } function getInlineWrappedRest(wrapped) { - return ((({TAG, name, ...__rest}) => __rest))(wrapped); + return ((({TAG: __unused0, name: __unused1, ...__rest}) => __rest))(wrapped); } function getCustomTaggedInlineWrappedRest(wrapped) { - return ((({kind, name, ...__rest}) => __rest))(wrapped); + return ((({kind: __unused0, name: __unused1, ...__rest}) => __rest))(wrapped); +} + +function getDashedTaggedInlineWrappedRest(wrapped) { + return ((({"custom-tag": __unused0, name: __unused1, ...__rest}) => __rest))(wrapped); } Mocha.describe("Record_rest_test", () => { Mocha.test("let binding captures record rest value", () => { - let rest = ((({name, ...__rest}) => __rest))({ + let rest = ((({name: __unused0, ...__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, { + Test_utils.eq("File \"record_rest_test.res\", line 95, characters 7-14", "test", "test"); + Test_utils.eq("File \"record_rest_test.res\", line 96, 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({ + Mocha.test("match arm returns the named field and the rest record", () => Test_utils.eq("File \"record_rest_test.res\", line 101, characters 6-13", describeConfig({ name: "match", version: "2.0", debug: false @@ -63,11 +71,20 @@ Mocha.describe("Record_rest_test", () => { 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({ + Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 108, characters 7-14", getName({ name: "param", version: "3.0", debug: true }), "param")); + Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 113, characters 6-13", ((({...__rest}) => __rest))({ + name: "whole", + version: "3.5", + debug: false + }), { + name: "whole", + version: "3.5", + debug: false + })); Mocha.test("optional overlap keeps the remaining fields in the rest object", () => { let onClick = () => {}; let rest = extractClassName({ @@ -75,28 +92,28 @@ Mocha.describe("Record_rest_test", () => { style: "bold", onClick: onClick }); - Test_utils.eq("File \"record_rest_test.res\", line 102, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 122, characters 7-14", rest, { style: "bold", onClick: onClick }); }); Mocha.test("polymorphic rest captures the value field", () => { - let intRest = ((({id, ...__rest}) => __rest))({ + let intRest = ((({id: __unused0, ...__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, { + Test_utils.eq("File \"record_rest_test.res\", line 127, characters 7-14", "1", "1"); + Test_utils.eq("File \"record_rest_test.res\", line 128, characters 7-14", intRest, { value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 109, characters 7-14", ((({id, ...__rest}) => __rest))({ + Test_utils.eq("File \"record_rest_test.res\", line 129, characters 7-14", ((({id: __unused0, ...__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([ + Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 134, characters 6-13", getTupleRest([ { name: "tuple", version: "4.0", @@ -108,7 +125,7 @@ Mocha.describe("Record_rest_test", () => { 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({ + Test_utils.eq("File \"record_rest_test.res\", line 142, characters 6-13", getWrappedRest({ TAG: "Wrap", _0: { name: "wrapped", @@ -119,7 +136,7 @@ Mocha.describe("Record_rest_test", () => { version: "5.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 127, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 147, characters 6-13", getWrappedRest({ TAG: "Mirror", _0: { name: "mirror", @@ -132,7 +149,7 @@ Mocha.describe("Record_rest_test", () => { }); }); 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({ + Test_utils.eq("File \"record_rest_test.res\", line 155, characters 6-13", getInlineWrappedRest({ TAG: "InlineWrap", name: "inline", version: "7.0", @@ -141,7 +158,7 @@ Mocha.describe("Record_rest_test", () => { version: "7.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 140, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 160, characters 6-13", getInlineWrappedRest({ TAG: "InlineMirror", name: "inlineMirror", version: "8.0", @@ -152,7 +169,7 @@ Mocha.describe("Record_rest_test", () => { }); }); 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({ + Test_utils.eq("File \"record_rest_test.res\", line 168, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineWrap", name: "customInline", version: "9.0", @@ -161,7 +178,7 @@ Mocha.describe("Record_rest_test", () => { version: "9.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 155, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 175, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineMirror", name: "customInlineMirror", version: "10.0", @@ -171,16 +188,38 @@ Mocha.describe("Record_rest_test", () => { debug: false }); }); + Mocha.test("inline record rest works with a non-identifier custom tag name", () => { + Test_utils.eq("File \"record_rest_test.res\", line 185, characters 6-13", getDashedTaggedInlineWrappedRest({ + "custom-tag": "DashedInlineWrap", + name: "dashedInline", + version: "11.0", + debug: true + }), { + version: "11.0", + debug: true + }); + Test_utils.eq("File \"record_rest_test.res\", line 192, characters 6-13", getDashedTaggedInlineWrappedRest({ + "custom-tag": "DashedInlineMirror", + name: "dashedInlineMirror", + version: "12.0", + debug: false + }), { + version: "12.0", + debug: false + }); + }); }); export { describeConfig, getName, + getWholeConfig, extractClassName, getValue, getTupleRest, getWrappedRest, getInlineWrappedRest, getCustomTaggedInlineWrappedRest, + getDashedTaggedInlineWrappedRest, } /* Not a pure module */ diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index 57007d85be8..fa014dd561b 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -18,6 +18,7 @@ let describeConfig = (c: config) => } let getName = ({name, ...subConfig as _rest}: config) => name +let getWholeConfig = ({...config as rest}: config) => rest type fullProps = { className?: string, @@ -77,6 +78,17 @@ let getCustomTaggedInlineWrappedRest = wrapped => | CustomInlineMirror({name: _, ...subConfig as rest}) => rest } +@tag("custom-tag") +type dashedTaggedInlineWrapped = + | DashedInlineWrap({name: string, version: string, debug: bool}) + | DashedInlineMirror({name: string, version: string, debug: bool}) + +let getDashedTaggedInlineWrappedRest = wrapped => + switch wrapped { + | DashedInlineWrap({name: _, ...subConfig as rest}) + | DashedInlineMirror({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) @@ -96,6 +108,14 @@ describe(__MODULE__, () => { eq(__LOC__, getName({name: "param", version: "3.0", debug: true}), "param") }) + test("empty-field rest pattern still binds the whole record", () => { + eq( + __LOC__, + getWholeConfig({name: "whole", version: "3.5", debug: false}), + {name: "whole", version: "3.5", debug: false}, + ) + }) + test("optional overlap keeps the remaining fields in the rest object", () => { let onClick = () => () let rest = extractClassName({className: "btn", style: "bold", onClick}) @@ -159,4 +179,21 @@ describe(__MODULE__, () => { {version: "10.0", debug: false}, ) }) + + test("inline record rest works with a non-identifier custom tag name", () => { + eq( + __LOC__, + getDashedTaggedInlineWrappedRest( + DashedInlineWrap({name: "dashedInline", version: "11.0", debug: true}), + ), + {version: "11.0", debug: true}, + ) + eq( + __LOC__, + getDashedTaggedInlineWrappedRest( + DashedInlineMirror({name: "dashedInlineMirror", version: "12.0", debug: false}), + ), + {version: "12.0", debug: false}, + ) + }) }) diff --git a/tests/tools_tests/src/expected/ZRecordRest.res.jsout b/tests/tools_tests/src/expected/ZRecordRest.res.jsout index acc2f53a8e2..d5248cb5beb 100644 --- a/tests/tools_tests/src/expected/ZRecordRest.res.jsout +++ b/tests/tools_tests/src/expected/ZRecordRest.res.jsout @@ -3,7 +3,7 @@ function extract(param) { - let rest = ((({name, ...__rest}) => __rest))(param); + let rest = ((({name: __unused0, ...__rest}) => __rest))(param); return [ param.name, rest From 68e0ebbc0ed8e8c6a3d28f7cb5902fa7780f118a Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Apr 2026 17:24:38 +0200 Subject: [PATCH 13/47] fix rest of private type and analysis --- analysis/src/process_cmt.ml | 23 +++++++++++++++++-- analysis/src/process_extra.ml | 22 +++++++++++++----- compiler/ml/matching.ml | 2 +- compiler/ml/typecore.ml | 3 +++ compiler/ml/typedtree.ml | 5 ++-- compiler/ml/typedtree.mli | 1 + compiler/syntax/src/res_core.ml | 2 +- tests/analysis_tests/tests/src/RecordRest.res | 9 ++++++++ .../tests/src/expected/RecordRest.res.txt | 2 ++ .../record_rest_private_type.res.expected | 10 ++++++++ .../fixtures/record_rest_private_type.res | 9 ++++++++ 11 files changed, 75 insertions(+), 13 deletions(-) create mode 100644 tests/analysis_tests/tests/src/RecordRest.res create mode 100644 tests/analysis_tests/tests/src/expected/RecordRest.res.txt create mode 100644 tests/build_tests/super_errors/expected/record_rest_private_type.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_private_type.res diff --git a/analysis/src/process_cmt.ml b/analysis/src/process_cmt.ml index ab7aa7d46f7..81e9a6817a6 100644 --- a/analysis/src/process_cmt.ml +++ b/analysis/src/process_cmt.ml @@ -517,8 +517,27 @@ let rec for_structure_item ~(env : Shared_types.Env.t) ~(exported : Exported.t) | Tpat_tuple pats | Tpat_array pats | Tpat_construct (_, _, pats) -> pats |> List.iter (fun p -> handle_pattern [] p) | Tpat_or (p, _, _) -> handle_pattern [] p - | Tpat_record (items, _, _rest) -> - items |> List.iter (fun (_, _, p, _) -> handle_pattern [] p) + | Tpat_record (record_items, _, rest) -> ( + record_items |> List.iter (fun (_, _, p, _) -> handle_pattern [] p); + match rest with + | None -> () + | Some rest -> + let declared = + add_declared ~name:rest.rest_name + ~stamp:(Ident.binding_time rest.rest_ident) + ~env ~extent:rest.rest_name.loc ~item:rest.rest_type [] + (Exported.add exported Exported.Value) + Stamps.add_value + in + items := + { + Module.kind = Module.Value declared.item; + name = declared.name.txt; + docstring = declared.docstring; + deprecated = declared.deprecated; + loc = declared.extent_loc; + } + :: !items) | Tpat_variant (_, Some p, _) -> handle_pattern [] p | Tpat_variant (_, None, _) | Tpat_any | Tpat_constant _ -> () in diff --git a/analysis/src/process_extra.ml b/analysis/src/process_extra.ml index c2a7bd24508..2cd5782b578 100644 --- a/analysis/src/process_extra.ml +++ b/analysis/src/process_extra.ml @@ -378,22 +378,32 @@ let pat ~(file : File.t) ~env ~extra (iter : Tast_iterator.iterator) | Tpackage (path, _, _) -> Some path | _ -> None in - let add_for_pattern stamp name = + let add_for_declared_pattern ~stamp ~name ~extent ~item ~attributes = if Stamps.find_value file.stamps stamp = None then ( let declared = Process_attributes.new_declared ~name ~stamp ~module_path:NotVisible - ~extent:pattern.pat_loc ~item:pattern.pat_type false - pattern.pat_attributes + ~extent ~item false attributes in Stamps.add_value file.stamps stamp declared; add_reference ~extra stamp name.loc; add_loc_item extra name.loc - (Typed (name.txt, pattern.pat_type, Definition (stamp, Value)))) + (Typed (name.txt, item, Definition (stamp, Value)))) + in + let add_for_pattern stamp name = + add_for_declared_pattern ~stamp ~name ~extent:pattern.pat_loc + ~item:pattern.pat_type ~attributes:pattern.pat_attributes in (* Log.log("Entering pattern " ++ Utils.showLocation(pat_loc)); *) (match pattern.pat_desc with - | Tpat_record (items, _, _rest) -> - add_for_record ~env ~extra ~record_type:pattern.pat_type items + | Tpat_record (items, _, rest) -> ( + add_for_record ~env ~extra ~record_type:pattern.pat_type items; + match rest with + | None -> () + | Some rest -> + add_for_declared_pattern + ~stamp:(Ident.binding_time rest.rest_ident) + ~name:rest.rest_name ~extent:rest.rest_name.loc ~item:rest.rest_type + ~attributes:pattern.pat_attributes) | Tpat_construct (lident, constructor, _) -> add_for_constructor ~env ~extra pattern.pat_type lident constructor | Tpat_alias (_inner, ident, name) -> ( diff --git a/compiler/ml/matching.ml b/compiler/ml/matching.ml index 53a78238182..61b6b0766ba 100644 --- a/compiler/ml/matching.ml +++ b/compiler/ml/matching.ml @@ -640,7 +640,7 @@ let rec extract_vars r p = 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) + | Some rest -> Ident_set.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 diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index c8ccb73c72e..3421de73075 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1633,6 +1633,8 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp let rest_type_expr = newgenty (Tconstr (rest_path, rest_type_args, ref Mnil)) in + if rest_decl.type_private = Private then + raise (Error (rest_type_lid.loc, !env, Private_type rest_type_expr)); List.iter2 (fun param arg -> unify_pat_types rest_type_lid.loc !env param arg) rest_decl.type_params rest_type_args; @@ -1766,6 +1768,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp Some { Typedtree.rest_ident; + rest_name; rest_type = rest_type_expr; rest_path; rest_labels; diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml index 5557c2beefe..74813efe3cb 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -37,6 +37,7 @@ type pattern = { and record_pat_rest = { rest_ident: Ident.t; + rest_name: string loc; rest_type: type_expr; rest_path: Path.t; rest_labels: Types.label_declaration list; @@ -463,9 +464,7 @@ let rec bound_idents pat = | 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; + idents := (rest.rest_ident, rest.rest_name) :: !idents; iter_pattern_desc bound_idents pat.pat_desc | d -> iter_pattern_desc bound_idents d diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli index 3dbeb96d7f3..345badc805c 100644 --- a/compiler/ml/typedtree.mli +++ b/compiler/ml/typedtree.mli @@ -45,6 +45,7 @@ type pattern = { and record_pat_rest = { rest_ident: Ident.t; + rest_name: string loc; rest_type: type_expr; rest_path: Path.t; rest_labels: Types.label_declaration list; diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 8b989be7b1c..3afb0cb5800 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -1624,7 +1624,7 @@ and parse_record_pattern ~attrs p = | 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); + (Diagnostics.message Error_messages.record_pattern_multiple_rest); (fields, flag, rest)) | PatUnderscore -> (fields, flag, rest)) ([], flag, None) raw_fields diff --git a/tests/analysis_tests/tests/src/RecordRest.res b/tests/analysis_tests/tests/src/RecordRest.res new file mode 100644 index 00000000000..cca4d605c92 --- /dev/null +++ b/tests/analysis_tests/tests/src/RecordRest.res @@ -0,0 +1,9 @@ +type config = {name: string, version: string} +type subConfig = {version: string} + +let getVersion = (config: config) => + switch config { + | {name: _, ...subConfig as rest} => + rest.version +// ^def + } diff --git a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt new file mode 100644 index 00000000000..1677d82115c --- /dev/null +++ b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt @@ -0,0 +1,2 @@ +Definition src/RecordRest.res 6:4 +{"uri": "RecordRest.res", "range": {"start": {"line": 5, "character": 30}, "end": {"line": 5, "character": 34}}} diff --git a/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected b/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected new file mode 100644 index 00000000000..3058651a5cc --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/record_rest_private_type.res:9:12-14 + + 7 │ type source = {a: int, b: string} + 8 │ + 9 │ let {a, ...M.t as rest} = ({a: 1, b: "x"}: source) + 10 │ + + Cannot create values of the private type M.t \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/record_rest_private_type.res b/tests/build_tests/super_errors/fixtures/record_rest_private_type.res new file mode 100644 index 00000000000..39ffbbf8c2f --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_private_type.res @@ -0,0 +1,9 @@ +module M: { + type t = private {b: string} +} = { + type t = {b: string} +} + +type source = {a: int, b: string} + +let {a, ...M.t as rest} = ({a: 1, b: "x"}: source) From 83a70068c74b8c1ab1696a93e093d383f82ab1a7 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Apr 2026 23:09:05 +0200 Subject: [PATCH 14/47] use runtime field names for rest --- compiler/ml/typecore.ml | 68 +++++++++++++++-- compiler/ml/typecore.mli | 6 ++ ...t_field_runtime_name_mismatch.res.expected | 10 +++ ...ecord_rest_field_runtime_name_mismatch.res | 12 +++ tests/tests/src/record_rest_test.mjs | 74 ++++++++++++++----- tests/tests/src/record_rest_test.res | 54 ++++++++++++++ 6 files changed, 198 insertions(+), 26 deletions(-) create mode 100644 tests/build_tests/super_errors/expected/record_rest_field_runtime_name_mismatch.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_field_runtime_name_mismatch.res diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 3421de73075..ba9ff1020d1 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -102,6 +102,12 @@ type error = | 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 + | Record_rest_field_runtime_name_mismatch of { + field: string; + rest_type: Longident.t; + source_runtime_name: string; + rest_runtime_name: string; + } exception Error of Location.t * Env.t * error exception Error_forward of Location.error @@ -334,6 +340,15 @@ let extract_concrete_variant env ty = | p0, p, {type_kind = Type_open} -> (p0, p, []) | _ -> raise Not_found +let runtime_label_name name attrs = + Ext_list.find_def attrs Lambda.find_name name + +let runtime_label_description_name (lbl : Types.label_description) = + runtime_label_name lbl.lbl_name lbl.lbl_attributes + +let runtime_label_declaration_name (lbl : Types.label_declaration) = + runtime_label_name (Ident.name lbl.ld_id) lbl.ld_attributes + let label_is_optional ld = ld.lbl_optional let check_optional_attr env ld optional loc = @@ -1608,6 +1623,11 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp let explicit_fields = List.map (fun (_, label, _, _) -> label.lbl_name) lbl_pat_list in + let explicit_runtime_fields = + List.map + (fun (_, label, _, _) -> runtime_label_description_name label) + lbl_pat_list + in let rest_type_args = match rest_type_args_syntax with | [] -> List.map (fun _ -> newvar ()) rest_decl.type_params @@ -1661,7 +1681,9 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp | Type_record (fields, repr) -> ( List.map (fun (l : Types.label_declaration) -> - (Ident.name l.ld_id, l.ld_type)) + ( Ident.name l.ld_id, + runtime_label_declaration_name l, + l.ld_type )) fields, repr ) | _ -> assert false) @@ -1671,7 +1693,9 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp | Type_record (fields, repr) -> ( List.map (fun (l : Types.label_declaration) -> - (Ident.name l.ld_id, l.ld_type)) + ( Ident.name l.ld_id, + runtime_label_declaration_name l, + l.ld_type )) fields, repr ) | _ -> assert false) @@ -1697,9 +1721,10 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp | Some s -> s | None -> "TAG" in - if List.mem tag_name explicit_fields then explicit_fields - else tag_name :: explicit_fields - | _ -> explicit_fields + if List.mem tag_name explicit_runtime_fields then + explicit_runtime_fields + else tag_name :: explicit_runtime_fields + | _ -> explicit_runtime_fields in (* Get rest field names *) let rest_field_names = @@ -1723,7 +1748,9 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp Record_rest_field_not_optional (not_optional, rest_type_lid.txt) )); (* Validate: all source fields must be in explicit or rest *) - let source_field_names = List.map fst source_fields in + let source_field_names = + List.map (fun (name, _, _) -> name) source_fields + in let missing = List.filter (fun source_field -> @@ -1741,7 +1768,13 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp List.iter (fun (rest_label : Types.label_declaration) -> let rest_field = Ident.name rest_label.ld_id in - match List.assoc_opt rest_field source_fields with + let rest_runtime_field = + runtime_label_declaration_name rest_label + in + match + Ext_list.find_first source_fields (fun (field, _, _) -> + field = rest_field) + with | None -> raise (Error @@ -1749,7 +1782,19 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp !env, Record_rest_extra_field (rest_field, rest_type_lid.txt) )) - | Some source_type -> + | Some (_, source_runtime_field, source_type) -> + if source_runtime_field <> rest_runtime_field then + raise + (Error + ( rest_type_lid.loc, + !env, + Record_rest_field_runtime_name_mismatch + { + field = rest_field; + rest_type = rest_type_lid.txt; + source_runtime_name = source_runtime_field; + rest_runtime_name = rest_runtime_field; + } )); unify_pat_types rest_type_lid.loc !env rest_label.ld_type source_type) rest_labels; @@ -5349,6 +5394,13 @@ let report_error env loc ppf error = "Field `%s` in the rest type `%a` does not exist in the source record \ type." field longident lid + | Record_rest_field_runtime_name_mismatch + {field; rest_type; source_runtime_name; rest_runtime_name} -> + fprintf ppf + "Field `%s` in the rest type `%a` has runtime representation `%s`, but \ + in the source record type it is `%s`. Runtime representations must \ + match." + field longident rest_type rest_runtime_name source_runtime_name 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 7d1ac112903..03a878e302d 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -135,6 +135,12 @@ type error = | 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 + | Record_rest_field_runtime_name_mismatch of { + field: string; + rest_type: Longident.t; + source_runtime_name: string; + rest_runtime_name: string; + } exception Error of Location.t * Env.t * error exception Error_forward of Location.error diff --git a/tests/build_tests/super_errors/expected/record_rest_field_runtime_name_mismatch.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_runtime_name_mismatch.res.expected new file mode 100644 index 00000000000..8e1066345d2 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_field_runtime_name_mismatch.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/record_rest_field_runtime_name_mismatch.res:12:12-16 + + 10 │ } + 11 │ + 12 │ let {a, ...wrong as rest} = ({a: 1, b: "x"}: source) + 13 │ + + Field `b` in the rest type `wrong` has runtime representation `other-b`, but in the source record type it is `runtime-b`. Runtime representations must match. \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/record_rest_field_runtime_name_mismatch.res b/tests/build_tests/super_errors/fixtures/record_rest_field_runtime_name_mismatch.res new file mode 100644 index 00000000000..9c0d20dee06 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_field_runtime_name_mismatch.res @@ -0,0 +1,12 @@ +type source = { + a: int, + @as("runtime-b") + b: string, +} + +type wrong = { + @as("other-b") + b: string, +} + +let {a, ...wrong as rest} = ({a: 1, b: "x"}: source) diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index d08838c14b6..694fbf2f7fd 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -11,6 +11,10 @@ function describeConfig(c) { ]; } +function getRenamedRest(param) { + return ((({"user-name": __unused0, ...__rest}) => __rest))(param); +} + function getName(param) { return param.name; } @@ -39,6 +43,10 @@ function getInlineWrappedRest(wrapped) { return ((({TAG: __unused0, name: __unused1, ...__rest}) => __rest))(wrapped); } +function getRenamedInlineWrappedRest(wrapped) { + return ((({TAG: __unused0, "user-name": __unused1, ...__rest}) => __rest))(wrapped); +} + function getCustomTaggedInlineWrappedRest(wrapped) { return ((({kind: __unused0, name: __unused1, ...__rest}) => __rest))(wrapped); } @@ -54,13 +62,13 @@ Mocha.describe("Record_rest_test", () => { version: "1.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 95, characters 7-14", "test", "test"); - Test_utils.eq("File \"record_rest_test.res\", line 96, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 124, characters 7-14", "test", "test"); + Test_utils.eq("File \"record_rest_test.res\", line 125, 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 101, characters 6-13", describeConfig({ + Mocha.test("match arm returns the named field and the rest record", () => Test_utils.eq("File \"record_rest_test.res\", line 130, characters 6-13", describeConfig({ name: "match", version: "2.0", debug: false @@ -71,12 +79,20 @@ Mocha.describe("Record_rest_test", () => { debug: false } ])); - Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 108, characters 7-14", getName({ + Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 137, characters 7-14", getName({ name: "param", version: "3.0", debug: true }), "param")); - Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 113, characters 6-13", ((({...__rest}) => __rest))({ + Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 142, characters 6-13", getRenamedRest({ + "user-name": "renamed", + version: "3.2", + debug: true + }), { + version: "3.2", + debug: true + })); + Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 150, characters 6-13", ((({...__rest}) => __rest))({ name: "whole", version: "3.5", debug: false @@ -92,7 +108,7 @@ Mocha.describe("Record_rest_test", () => { style: "bold", onClick: onClick }); - Test_utils.eq("File \"record_rest_test.res\", line 122, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 159, characters 7-14", rest, { style: "bold", onClick: onClick }); @@ -102,18 +118,18 @@ Mocha.describe("Record_rest_test", () => { id: "1", value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 127, characters 7-14", "1", "1"); - Test_utils.eq("File \"record_rest_test.res\", line 128, characters 7-14", intRest, { + Test_utils.eq("File \"record_rest_test.res\", line 164, characters 7-14", "1", "1"); + Test_utils.eq("File \"record_rest_test.res\", line 165, characters 7-14", intRest, { value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 129, characters 7-14", ((({id: __unused0, ...__rest}) => __rest))({ + Test_utils.eq("File \"record_rest_test.res\", line 166, characters 7-14", ((({id: __unused0, ...__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 134, characters 6-13", getTupleRest([ + Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 171, characters 6-13", getTupleRest([ { name: "tuple", version: "4.0", @@ -125,7 +141,7 @@ Mocha.describe("Record_rest_test", () => { debug: false })); Mocha.test("variant payload rest works through the or-pattern path", () => { - Test_utils.eq("File \"record_rest_test.res\", line 142, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 179, characters 6-13", getWrappedRest({ TAG: "Wrap", _0: { name: "wrapped", @@ -136,7 +152,7 @@ Mocha.describe("Record_rest_test", () => { version: "5.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 147, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 184, characters 6-13", getWrappedRest({ TAG: "Mirror", _0: { name: "mirror", @@ -149,7 +165,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes the runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 155, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 192, characters 6-13", getInlineWrappedRest({ TAG: "InlineWrap", name: "inline", version: "7.0", @@ -158,7 +174,7 @@ Mocha.describe("Record_rest_test", () => { version: "7.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 160, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 197, characters 6-13", getInlineWrappedRest({ TAG: "InlineMirror", name: "inlineMirror", version: "8.0", @@ -168,8 +184,28 @@ Mocha.describe("Record_rest_test", () => { debug: false }); }); + Mocha.test("inline record variant rest excludes fields renamed with @as", () => { + Test_utils.eq("File \"record_rest_test.res\", line 205, characters 6-13", getRenamedInlineWrappedRest({ + TAG: "RenamedInlineWrap", + "user-name": "inlineRenamed", + version: "8.5", + debug: true + }), { + version: "8.5", + debug: true + }); + Test_utils.eq("File \"record_rest_test.res\", line 212, characters 6-13", getRenamedInlineWrappedRest({ + TAG: "RenamedInlineMirror", + "user-name": "inlineRenamed2", + version: "8.6", + debug: false + }), { + version: "8.6", + debug: false + }); + }); Mocha.test("inline record variant rest removes a custom runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 168, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 222, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineWrap", name: "customInline", version: "9.0", @@ -178,7 +214,7 @@ Mocha.describe("Record_rest_test", () => { version: "9.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 175, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 229, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineMirror", name: "customInlineMirror", version: "10.0", @@ -189,7 +225,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record rest works with a non-identifier custom tag name", () => { - Test_utils.eq("File \"record_rest_test.res\", line 185, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 239, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineWrap", name: "dashedInline", version: "11.0", @@ -198,7 +234,7 @@ Mocha.describe("Record_rest_test", () => { version: "11.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 192, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 246, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineMirror", name: "dashedInlineMirror", version: "12.0", @@ -212,6 +248,7 @@ Mocha.describe("Record_rest_test", () => { export { describeConfig, + getRenamedRest, getName, getWholeConfig, extractClassName, @@ -219,6 +256,7 @@ export { getTupleRest, getWrappedRest, getInlineWrappedRest, + getRenamedInlineWrappedRest, getCustomTaggedInlineWrappedRest, getDashedTaggedInlineWrappedRest, } diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index fa014dd561b..ca9d22a571e 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -12,11 +12,20 @@ type subConfig = { debug: bool, } +type renamedConfig = { + @as("user-name") + name: string, + version: string, + debug: bool, +} + let describeConfig = (c: config) => switch c { | {name, ...subConfig as rest} => (name, rest) } +let getRenamedRest = ({name: _, ...subConfig as rest}: renamedConfig) => rest + let getName = ({name, ...subConfig as _rest}: config) => name let getWholeConfig = ({...config as rest}: config) => rest @@ -67,6 +76,26 @@ let getInlineWrappedRest = wrapped => | InlineMirror({name: _, ...subConfig as rest}) => rest } +type renamedInlineWrapped = + | RenamedInlineWrap({ + @as("user-name") + name: string, + version: string, + debug: bool, + }) + | RenamedInlineMirror({ + @as("user-name") + name: string, + version: string, + debug: bool, + }) + +let getRenamedInlineWrappedRest = wrapped => + switch wrapped { + | RenamedInlineWrap({name: _, ...subConfig as rest}) + | RenamedInlineMirror({name: _, ...subConfig as rest}) => rest + } + @tag("kind") type customTaggedInlineWrapped = | CustomInlineWrap({name: string, version: string, debug: bool}) @@ -108,6 +137,14 @@ describe(__MODULE__, () => { eq(__LOC__, getName({name: "param", version: "3.0", debug: true}), "param") }) + test("record rest excludes fields renamed with @as", () => { + eq( + __LOC__, + getRenamedRest({name: "renamed", version: "3.2", debug: true}), + {version: "3.2", debug: true}, + ) + }) + test("empty-field rest pattern still binds the whole record", () => { eq( __LOC__, @@ -163,6 +200,23 @@ describe(__MODULE__, () => { ) }) + test("inline record variant rest excludes fields renamed with @as", () => { + eq( + __LOC__, + getRenamedInlineWrappedRest( + RenamedInlineWrap({name: "inlineRenamed", version: "8.5", debug: true}), + ), + {version: "8.5", debug: true}, + ) + eq( + __LOC__, + getRenamedInlineWrappedRest( + RenamedInlineMirror({name: "inlineRenamed2", version: "8.6", debug: false}), + ), + {version: "8.6", debug: false}, + ) + }) + test("inline record variant rest removes a custom runtime tag field", () => { eq( __LOC__, From e6673826dec564a02b07e58d32c5d9aa98c93d08 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 2 Apr 2026 18:17:50 +0200 Subject: [PATCH 15/47] support record type alias in rest --- compiler/ml/ast_mapper_from0.ml | 14 ++++- compiler/ml/ast_mapper_to0.ml | 7 ++- compiler/ml/parsetree0.ml | 14 ----- compiler/ml/typecore.ml | 78 ++++++++++++++++++---------- tests/tests/src/record_rest_test.mjs | 55 ++++++++++++-------- tests/tests/src/record_rest_test.res | 12 +++++ 6 files changed, 115 insertions(+), 65 deletions(-) diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index e565cda05b5..4f9412f146d 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -93,6 +93,18 @@ let for_await_of_attr_name = "_res.for_await_of" let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} +let record_rest_attr_name = "res.record_rest" + +let get_record_rest_attr attrs_ = + let rec remove_record_rest_attr acc = function + | ({Location.txt = attr_name; _}, Pt.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_ + module T = struct (* Type expressions for the core language *) @@ -656,7 +668,7 @@ 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) -> - let rest, attrs = Parsetree0.get_record_rest_attr attrs in + let rest, attrs = get_record_rest_attr attrs in record ~loc ~attrs ?rest (Ext_list.map lpl (fun (lid, p) -> let lid1 = map_loc sub lid in diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 73aea1625f5..6ce4b7e80d2 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -87,6 +87,11 @@ let for_await_of_attr_name = "_res.for_await_of" let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} +let record_rest_attr_name = "res.record_rest" + +let add_record_rest_attr ~rest attrs = + (Location.mknoloc record_rest_attr_name, Pt.PPat (rest, None)) :: attrs + module T = struct (* Type expressions for the core language *) @@ -606,7 +611,7 @@ module P = struct match rest with | None -> attrs | Some rest_pat -> - Parsetree0.add_record_rest_attr ~rest:(sub.pat sub rest_pat) attrs + 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} -> diff --git a/compiler/ml/parsetree0.ml b/compiler/ml/parsetree0.ml index db5d75ee1a9..ef786dfd25d 100644 --- a/compiler/ml/parsetree0.ml +++ b/compiler/ml/parsetree0.ml @@ -597,7 +597,6 @@ 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 @@ -609,16 +608,3 @@ 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 ba9ff1020d1..a3c7de9faa2 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -364,6 +364,19 @@ let unify_pat_types loc env ty ty' = try unify env ty ty' with Unify trace -> raise (Error (loc, env, Pattern_type_clash trace)) +let extract_instantiated_concrete_typedecl env loc ty = + let _, _, decl = extract_concrete_typedecl env ty in + let decl = instance_declaration decl in + let args = + match expand_head env ty with + | {desc = Tconstr (_, args, _)} -> args + | _ -> assert false + in + List.iter2 + (fun param arg -> unify_pat_types loc env param arg) + decl.type_params args; + decl + (* unification inside type_exp and type_expect *) let unify_exp_types ~context loc env ty expected_ty = try unify env ty expected_ty @@ -1606,18 +1619,11 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp raise (Error (rest_pat.ppat_loc, !env, Record_rest_invalid_type)) in (* Look up the rest record type *) - let rest_path, rest_decl = + let rest_path, rest_annotation_decl = Typetexp.find_type !env rest_type_lid.loc rest_type_lid.txt in - let rest_decl = - match rest_decl.type_kind with - | Type_record _ -> instance_declaration rest_decl - | _ -> - raise - (Error - ( rest_type_lid.loc, - !env, - Record_rest_not_record rest_type_lid.txt )) + let rest_annotation_decl = + instance_declaration rest_annotation_decl in (* Get explicit field names *) let explicit_fields = @@ -1630,10 +1636,11 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp in let rest_type_args = match rest_type_args_syntax with - | [] -> List.map (fun _ -> newvar ()) rest_decl.type_params + | [] -> + List.map (fun _ -> newvar ()) rest_annotation_decl.type_params | args -> let n_args = List.length args in - let n_params = List.length rest_decl.type_params in + let n_params = List.length rest_annotation_decl.type_params in if n_args <> n_params then raise (Typetexp.Error @@ -1653,30 +1660,45 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp let rest_type_expr = newgenty (Tconstr (rest_path, rest_type_args, ref Mnil)) in - if rest_decl.type_private = Private then + if rest_annotation_decl.type_private = Private then raise (Error (rest_type_lid.loc, !env, Private_type rest_type_expr)); List.iter2 (fun param arg -> unify_pat_types rest_type_lid.loc !env param arg) - rest_decl.type_params rest_type_args; + rest_annotation_decl.type_params rest_type_args; + let rest_decl = + match + try + Some + (extract_instantiated_concrete_typedecl !env rest_type_lid.loc + rest_type_expr) + with Not_found -> None + with + | Some rest_decl -> ( + if rest_decl.type_private = Private then + raise + (Error (rest_type_lid.loc, !env, Private_type rest_type_expr)); + match rest_decl.type_kind with + | Type_record _ -> rest_decl + | _ -> + raise + (Error + ( rest_type_lid.loc, + !env, + Record_rest_not_record rest_type_lid.txt ))) + | None -> + raise + (Error + ( rest_type_lid.loc, + !env, + Record_rest_not_record rest_type_lid.txt )) + in let source_fields, source_repr = match try - let _, _, source_decl = - extract_concrete_typedecl !env record_ty - in - let source_decl = instance_declaration source_decl in - let source_type_args = - match expand_head !env record_ty with - | {desc = Tconstr (_, args, _)} -> args - | _ -> assert false - in - Some (source_decl, source_type_args) + Some (extract_instantiated_concrete_typedecl !env loc record_ty) with Not_found -> None with - | Some (source_decl, source_type_args) -> ( - List.iter2 - (fun param arg -> unify_pat_types loc !env param arg) - source_decl.type_params source_type_args; + | Some source_decl -> ( match source_decl.type_kind with | Type_record (fields, repr) -> ( List.map diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 694fbf2f7fd..515094a26bb 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -11,6 +11,10 @@ function describeConfig(c) { ]; } +function getAliasedRest(param) { + return ((({name: __unused0, ...__rest}) => __rest))(param); +} + function getRenamedRest(param) { return ((({"user-name": __unused0, ...__rest}) => __rest))(param); } @@ -62,13 +66,13 @@ Mocha.describe("Record_rest_test", () => { version: "1.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 124, characters 7-14", "test", "test"); - Test_utils.eq("File \"record_rest_test.res\", line 125, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 128, characters 7-14", "test", "test"); + Test_utils.eq("File \"record_rest_test.res\", line 129, 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 130, characters 6-13", describeConfig({ + Mocha.test("match arm returns the named field and the rest record", () => Test_utils.eq("File \"record_rest_test.res\", line 134, characters 6-13", describeConfig({ name: "match", version: "2.0", debug: false @@ -79,12 +83,20 @@ Mocha.describe("Record_rest_test", () => { debug: false } ])); - Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 137, characters 7-14", getName({ + Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 141, characters 7-14", getName({ name: "param", version: "3.0", debug: true }), "param")); - Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 142, characters 6-13", getRenamedRest({ + Mocha.test("record rest accepts type aliases to record shapes", () => Test_utils.eq("File \"record_rest_test.res\", line 146, characters 6-13", getAliasedRest({ + name: "aliased", + version: "3.1", + debug: false + }), { + version: "3.1", + debug: false + })); + Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 154, characters 6-13", getRenamedRest({ "user-name": "renamed", version: "3.2", debug: true @@ -92,7 +104,7 @@ Mocha.describe("Record_rest_test", () => { version: "3.2", debug: true })); - Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 150, characters 6-13", ((({...__rest}) => __rest))({ + Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 162, characters 6-13", ((({...__rest}) => __rest))({ name: "whole", version: "3.5", debug: false @@ -108,7 +120,7 @@ Mocha.describe("Record_rest_test", () => { style: "bold", onClick: onClick }); - Test_utils.eq("File \"record_rest_test.res\", line 159, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 171, characters 7-14", rest, { style: "bold", onClick: onClick }); @@ -118,18 +130,18 @@ Mocha.describe("Record_rest_test", () => { id: "1", value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 164, characters 7-14", "1", "1"); - Test_utils.eq("File \"record_rest_test.res\", line 165, characters 7-14", intRest, { + Test_utils.eq("File \"record_rest_test.res\", line 176, characters 7-14", "1", "1"); + Test_utils.eq("File \"record_rest_test.res\", line 177, characters 7-14", intRest, { value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 166, characters 7-14", ((({id: __unused0, ...__rest}) => __rest))({ + Test_utils.eq("File \"record_rest_test.res\", line 178, characters 7-14", ((({id: __unused0, ...__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 171, characters 6-13", getTupleRest([ + Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 183, characters 6-13", getTupleRest([ { name: "tuple", version: "4.0", @@ -141,7 +153,7 @@ Mocha.describe("Record_rest_test", () => { debug: false })); Mocha.test("variant payload rest works through the or-pattern path", () => { - Test_utils.eq("File \"record_rest_test.res\", line 179, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 191, characters 6-13", getWrappedRest({ TAG: "Wrap", _0: { name: "wrapped", @@ -152,7 +164,7 @@ Mocha.describe("Record_rest_test", () => { version: "5.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 184, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 196, characters 6-13", getWrappedRest({ TAG: "Mirror", _0: { name: "mirror", @@ -165,7 +177,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes the runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 192, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 204, characters 6-13", getInlineWrappedRest({ TAG: "InlineWrap", name: "inline", version: "7.0", @@ -174,7 +186,7 @@ Mocha.describe("Record_rest_test", () => { version: "7.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 197, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 209, characters 6-13", getInlineWrappedRest({ TAG: "InlineMirror", name: "inlineMirror", version: "8.0", @@ -185,7 +197,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest excludes fields renamed with @as", () => { - Test_utils.eq("File \"record_rest_test.res\", line 205, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 217, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineWrap", "user-name": "inlineRenamed", version: "8.5", @@ -194,7 +206,7 @@ Mocha.describe("Record_rest_test", () => { version: "8.5", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 212, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 224, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineMirror", "user-name": "inlineRenamed2", version: "8.6", @@ -205,7 +217,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes a custom runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 222, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 234, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineWrap", name: "customInline", version: "9.0", @@ -214,7 +226,7 @@ Mocha.describe("Record_rest_test", () => { version: "9.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 229, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 241, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineMirror", name: "customInlineMirror", version: "10.0", @@ -225,7 +237,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record rest works with a non-identifier custom tag name", () => { - Test_utils.eq("File \"record_rest_test.res\", line 239, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 251, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineWrap", name: "dashedInline", version: "11.0", @@ -234,7 +246,7 @@ Mocha.describe("Record_rest_test", () => { version: "11.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 246, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 258, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineMirror", name: "dashedInlineMirror", version: "12.0", @@ -248,6 +260,7 @@ Mocha.describe("Record_rest_test", () => { export { describeConfig, + getAliasedRest, getRenamedRest, getName, getWholeConfig, diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index ca9d22a571e..207e4aa15f4 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -12,6 +12,8 @@ type subConfig = { debug: bool, } +type aliasedSubConfig = subConfig + type renamedConfig = { @as("user-name") name: string, @@ -24,6 +26,8 @@ let describeConfig = (c: config) => | {name, ...subConfig as rest} => (name, rest) } +let getAliasedRest = ({name: _, ...aliasedSubConfig as rest}: config) => rest + let getRenamedRest = ({name: _, ...subConfig as rest}: renamedConfig) => rest let getName = ({name, ...subConfig as _rest}: config) => name @@ -137,6 +141,14 @@ describe(__MODULE__, () => { eq(__LOC__, getName({name: "param", version: "3.0", debug: true}), "param") }) + test("record rest accepts type aliases to record shapes", () => { + eq( + __LOC__, + getAliasedRest({name: "aliased", version: "3.1", debug: false}), + {version: "3.1", debug: false}, + ) + }) + test("record rest excludes fields renamed with @as", () => { eq( __LOC__, From 049aaed4a016ec46819b8737abbc21b96e1ff5eb Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 7 Apr 2026 09:51:27 +0200 Subject: [PATCH 16/47] fix compiler crash when spreading the whole record --- compiler/ml/typecore.ml | 6 ++-- compiler/ml/typedtree.mli | 2 +- tests/tests/src/record_rest_test.mjs | 48 +++++++++++++++++++--------- tests/tests/src/record_rest_test.res | 6 ++++ 4 files changed, 44 insertions(+), 18 deletions(-) diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index a3c7de9faa2..134987e77e5 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -546,8 +546,10 @@ let rec build_as_type env p = row_fixed = false; row_closed = false; }) - | Tpat_record (lpl, _, _rest) -> - let lbl = snd4 (List.hd lpl) in + | Tpat_record ([], _, _rest) -> + (* Rest-only record patterns already carry the source record type. *) + p.pat_type + | Tpat_record (((_, lbl, _, _) :: _ as lpl), _, _rest) -> if lbl.lbl_private = Private then p.pat_type else let ty = newvar () in diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli index 345badc805c..939e46d1db6 100644 --- a/compiler/ml/typedtree.mli +++ b/compiler/ml/typedtree.mli @@ -98,7 +98,7 @@ and pattern_desc = (** { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) - Invariant: n > 0 + Invariant: n > 0 unless this is a rest-only record pattern *) | Tpat_array of pattern list (** [| P1; ...; Pn |] *) | Tpat_or of pattern * pattern * row_desc option diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 515094a26bb..8a293aa6975 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -113,6 +113,24 @@ Mocha.describe("Record_rest_test", () => { version: "3.5", debug: false })); + Mocha.test("rest-only record patterns can also bind the whole alias", () => { + let whole = { + name: "wholeAlias", + version: "3.6", + debug: true + }; + let rest = ((({...__rest}) => __rest))(whole); + Test_utils.eq("File \"record_rest_test.res\", line 170, characters 7-14", whole, { + name: "wholeAlias", + version: "3.6", + debug: true + }); + Test_utils.eq("File \"record_rest_test.res\", line 171, characters 7-14", rest, { + name: "wholeAlias", + version: "3.6", + debug: true + }); + }); Mocha.test("optional overlap keeps the remaining fields in the rest object", () => { let onClick = () => {}; let rest = extractClassName({ @@ -120,7 +138,7 @@ Mocha.describe("Record_rest_test", () => { style: "bold", onClick: onClick }); - Test_utils.eq("File \"record_rest_test.res\", line 171, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 177, characters 7-14", rest, { style: "bold", onClick: onClick }); @@ -130,18 +148,18 @@ Mocha.describe("Record_rest_test", () => { id: "1", value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 176, characters 7-14", "1", "1"); - Test_utils.eq("File \"record_rest_test.res\", line 177, characters 7-14", intRest, { + Test_utils.eq("File \"record_rest_test.res\", line 182, characters 7-14", "1", "1"); + Test_utils.eq("File \"record_rest_test.res\", line 183, characters 7-14", intRest, { value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 178, characters 7-14", ((({id: __unused0, ...__rest}) => __rest))({ + Test_utils.eq("File \"record_rest_test.res\", line 184, characters 7-14", ((({id: __unused0, ...__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 183, characters 6-13", getTupleRest([ + Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 189, characters 6-13", getTupleRest([ { name: "tuple", version: "4.0", @@ -153,7 +171,7 @@ Mocha.describe("Record_rest_test", () => { debug: false })); Mocha.test("variant payload rest works through the or-pattern path", () => { - Test_utils.eq("File \"record_rest_test.res\", line 191, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 197, characters 6-13", getWrappedRest({ TAG: "Wrap", _0: { name: "wrapped", @@ -164,7 +182,7 @@ Mocha.describe("Record_rest_test", () => { version: "5.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 196, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 202, characters 6-13", getWrappedRest({ TAG: "Mirror", _0: { name: "mirror", @@ -177,7 +195,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes the runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 204, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 210, characters 6-13", getInlineWrappedRest({ TAG: "InlineWrap", name: "inline", version: "7.0", @@ -186,7 +204,7 @@ Mocha.describe("Record_rest_test", () => { version: "7.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 209, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 215, characters 6-13", getInlineWrappedRest({ TAG: "InlineMirror", name: "inlineMirror", version: "8.0", @@ -197,7 +215,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest excludes fields renamed with @as", () => { - Test_utils.eq("File \"record_rest_test.res\", line 217, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 223, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineWrap", "user-name": "inlineRenamed", version: "8.5", @@ -206,7 +224,7 @@ Mocha.describe("Record_rest_test", () => { version: "8.5", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 224, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 230, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineMirror", "user-name": "inlineRenamed2", version: "8.6", @@ -217,7 +235,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes a custom runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 234, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 240, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineWrap", name: "customInline", version: "9.0", @@ -226,7 +244,7 @@ Mocha.describe("Record_rest_test", () => { version: "9.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 241, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 247, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineMirror", name: "customInlineMirror", version: "10.0", @@ -237,7 +255,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record rest works with a non-identifier custom tag name", () => { - Test_utils.eq("File \"record_rest_test.res\", line 251, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 257, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineWrap", name: "dashedInline", version: "11.0", @@ -246,7 +264,7 @@ Mocha.describe("Record_rest_test", () => { version: "11.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 258, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 264, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineMirror", name: "dashedInlineMirror", version: "12.0", diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index 207e4aa15f4..5c8d304853b 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -165,6 +165,12 @@ describe(__MODULE__, () => { ) }) + test("rest-only record patterns can also bind the whole alias", () => { + let {...config as rest} as whole = ({name: "wholeAlias", version: "3.6", debug: true}: config) + eq(__LOC__, whole, {name: "wholeAlias", version: "3.6", debug: true}) + eq(__LOC__, rest, {name: "wholeAlias", version: "3.6", debug: true}) + }) + test("optional overlap keeps the remaining fields in the rest object", () => { let onClick = () => () let rest = extractClassName({className: "btn", style: "bold", onClick}) From b47e43cb4306f9d9c7649207962f6cb65da45fac Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 7 Apr 2026 10:41:53 +0200 Subject: [PATCH 17/47] disallow rest spreading on packed modules --- compiler/frontend/ast_tuple_pattern_flatten.ml | 6 +++++- .../record_rest_module_destructure.res.expected | 10 ++++++++++ .../fixtures/record_rest_module_destructure.res | 3 +++ 3 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 tests/build_tests/super_errors/expected/record_rest_module_destructure.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_module_destructure.res diff --git a/compiler/frontend/ast_tuple_pattern_flatten.ml b/compiler/frontend/ast_tuple_pattern_flatten.ml index 1955936b99b..7b9d3e3da39 100644 --- a/compiler/frontend/ast_tuple_pattern_flatten.ml +++ b/compiler/frontend/ast_tuple_pattern_flatten.ml @@ -64,7 +64,11 @@ 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, _, _rest), Pexp_pack {pmod_desc = Pmod_ident id} -> + | Ppat_record (_, _, Some rest), Pexp_pack {pmod_desc = Pmod_ident _} -> + Location.raise_errorf ~loc:rest.ppat_loc + "Record rest patterns are not supported when destructuring modules. Bind \ + the module fields explicitly." + | Ppat_record (lid_pats, _, None), 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/tests/build_tests/super_errors/expected/record_rest_module_destructure.res.expected b/tests/build_tests/super_errors/expected/record_rest_module_destructure.res.expected new file mode 100644 index 00000000000..185c334b1f0 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_module_destructure.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/record_rest_module_destructure.res:3:15-34 + + 1 │ module A = Belt.Array + 2 │ + 3 │ let {push, ...arrayMethods as rest} = module(A) + 4 │ + + Record rest patterns are not supported when destructuring modules. Bind the module fields explicitly. \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/record_rest_module_destructure.res b/tests/build_tests/super_errors/fixtures/record_rest_module_destructure.res new file mode 100644 index 00000000000..7fc1a00fb5e --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_module_destructure.res @@ -0,0 +1,3 @@ +module A = Belt.Array + +let {push, ...arrayMethods as rest} = module(A) From b092cb893716d6e14021aae1ce0ade4a3ff37b23 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Fri, 10 Apr 2026 12:12:51 +0200 Subject: [PATCH 18/47] add tests for record rest with namespaced type --- tests/analysis_tests/tests/src/RecordRest.res | 6 +- .../tests/src/expected/RecordRest.res.txt | 4 +- tests/tests/src/record_rest_test.mjs | 75 +++++++++++++------ tests/tests/src/record_rest_test.res | 25 +++++++ 4 files changed, 82 insertions(+), 28 deletions(-) diff --git a/tests/analysis_tests/tests/src/RecordRest.res b/tests/analysis_tests/tests/src/RecordRest.res index cca4d605c92..6e7dd0d2a52 100644 --- a/tests/analysis_tests/tests/src/RecordRest.res +++ b/tests/analysis_tests/tests/src/RecordRest.res @@ -1,9 +1,11 @@ type config = {name: string, version: string} -type subConfig = {version: string} +module SubConfig = { + type t = {version: string} +} let getVersion = (config: config) => switch config { - | {name: _, ...subConfig as rest} => + | {name: _, ...SubConfig.t as rest} => rest.version // ^def } diff --git a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt index 1677d82115c..67434a6c3f2 100644 --- a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt +++ b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt @@ -1,2 +1,2 @@ -Definition src/RecordRest.res 6:4 -{"uri": "RecordRest.res", "range": {"start": {"line": 5, "character": 30}, "end": {"line": 5, "character": 34}}} +Definition src/RecordRest.res 8:4 +{"uri": "RecordRest.res", "range": {"start": {"line": 7, "character": 32}, "end": {"line": 7, "character": 36}}} diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 8a293aa6975..afdcfc397a7 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -3,6 +3,8 @@ import * as Mocha from "mocha"; import * as Test_utils from "./test_utils.mjs"; +let SubConfig = {}; + function describeConfig(c) { let rest = ((({name: __unused0, ...__rest}) => __rest))(c); return [ @@ -15,6 +17,10 @@ function getAliasedRest(param) { return ((({name: __unused0, ...__rest}) => __rest))(param); } +function getNamespacedRest(param) { + return ((({name: __unused0, ...__rest}) => __rest))(param); +} + function getRenamedRest(param) { return ((({"user-name": __unused0, ...__rest}) => __rest))(param); } @@ -66,13 +72,13 @@ Mocha.describe("Record_rest_test", () => { version: "1.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 128, characters 7-14", "test", "test"); - Test_utils.eq("File \"record_rest_test.res\", line 129, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 136, characters 7-14", "test", "test"); + Test_utils.eq("File \"record_rest_test.res\", line 137, 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 134, characters 6-13", describeConfig({ + Mocha.test("match arm returns the named field and the rest record", () => Test_utils.eq("File \"record_rest_test.res\", line 142, characters 6-13", describeConfig({ name: "match", version: "2.0", debug: false @@ -83,12 +89,12 @@ Mocha.describe("Record_rest_test", () => { debug: false } ])); - Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 141, characters 7-14", getName({ + Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 149, characters 7-14", getName({ name: "param", version: "3.0", debug: true }), "param")); - Mocha.test("record rest accepts type aliases to record shapes", () => Test_utils.eq("File \"record_rest_test.res\", line 146, characters 6-13", getAliasedRest({ + Mocha.test("record rest accepts type aliases to record shapes", () => Test_utils.eq("File \"record_rest_test.res\", line 154, characters 6-13", getAliasedRest({ name: "aliased", version: "3.1", debug: false @@ -96,7 +102,26 @@ Mocha.describe("Record_rest_test", () => { version: "3.1", debug: false })); - Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 154, characters 6-13", getRenamedRest({ + Mocha.test("record rest accepts namespaced record types", () => { + Test_utils.eq("File \"record_rest_test.res\", line 162, characters 6-13", getNamespacedRest({ + name: "namespaced", + version: "3.15", + debug: true + }), { + version: "3.15", + debug: true + }); + let rest = ((({name: __unused0, ...__rest}) => __rest))({ + name: "namespaced-let", + version: "3.16", + debug: false + }); + Test_utils.eq("File \"record_rest_test.res\", line 174, characters 7-14", rest, { + version: "3.16", + debug: false + }); + }); + Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 179, characters 6-13", getRenamedRest({ "user-name": "renamed", version: "3.2", debug: true @@ -104,7 +129,7 @@ Mocha.describe("Record_rest_test", () => { version: "3.2", debug: true })); - Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 162, characters 6-13", ((({...__rest}) => __rest))({ + Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 187, characters 6-13", ((({...__rest}) => __rest))({ name: "whole", version: "3.5", debug: false @@ -120,12 +145,12 @@ Mocha.describe("Record_rest_test", () => { debug: true }; let rest = ((({...__rest}) => __rest))(whole); - Test_utils.eq("File \"record_rest_test.res\", line 170, characters 7-14", whole, { + Test_utils.eq("File \"record_rest_test.res\", line 195, characters 7-14", whole, { name: "wholeAlias", version: "3.6", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 171, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 196, characters 7-14", rest, { name: "wholeAlias", version: "3.6", debug: true @@ -138,7 +163,7 @@ Mocha.describe("Record_rest_test", () => { style: "bold", onClick: onClick }); - Test_utils.eq("File \"record_rest_test.res\", line 177, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 202, characters 7-14", rest, { style: "bold", onClick: onClick }); @@ -148,18 +173,18 @@ Mocha.describe("Record_rest_test", () => { id: "1", value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 182, characters 7-14", "1", "1"); - Test_utils.eq("File \"record_rest_test.res\", line 183, characters 7-14", intRest, { + Test_utils.eq("File \"record_rest_test.res\", line 207, characters 7-14", "1", "1"); + Test_utils.eq("File \"record_rest_test.res\", line 208, characters 7-14", intRest, { value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 184, characters 7-14", ((({id: __unused0, ...__rest}) => __rest))({ + Test_utils.eq("File \"record_rest_test.res\", line 209, characters 7-14", ((({id: __unused0, ...__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 189, characters 6-13", getTupleRest([ + Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 214, characters 6-13", getTupleRest([ { name: "tuple", version: "4.0", @@ -171,7 +196,7 @@ Mocha.describe("Record_rest_test", () => { debug: false })); Mocha.test("variant payload rest works through the or-pattern path", () => { - Test_utils.eq("File \"record_rest_test.res\", line 197, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 222, characters 6-13", getWrappedRest({ TAG: "Wrap", _0: { name: "wrapped", @@ -182,7 +207,7 @@ Mocha.describe("Record_rest_test", () => { version: "5.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 202, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 227, characters 6-13", getWrappedRest({ TAG: "Mirror", _0: { name: "mirror", @@ -195,7 +220,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes the runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 210, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 235, characters 6-13", getInlineWrappedRest({ TAG: "InlineWrap", name: "inline", version: "7.0", @@ -204,7 +229,7 @@ Mocha.describe("Record_rest_test", () => { version: "7.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 215, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 240, characters 6-13", getInlineWrappedRest({ TAG: "InlineMirror", name: "inlineMirror", version: "8.0", @@ -215,7 +240,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest excludes fields renamed with @as", () => { - Test_utils.eq("File \"record_rest_test.res\", line 223, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 248, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineWrap", "user-name": "inlineRenamed", version: "8.5", @@ -224,7 +249,7 @@ Mocha.describe("Record_rest_test", () => { version: "8.5", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 230, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 255, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineMirror", "user-name": "inlineRenamed2", version: "8.6", @@ -235,7 +260,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes a custom runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 240, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 265, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineWrap", name: "customInline", version: "9.0", @@ -244,7 +269,7 @@ Mocha.describe("Record_rest_test", () => { version: "9.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 247, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 272, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineMirror", name: "customInlineMirror", version: "10.0", @@ -255,7 +280,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record rest works with a non-identifier custom tag name", () => { - Test_utils.eq("File \"record_rest_test.res\", line 257, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 282, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineWrap", name: "dashedInline", version: "11.0", @@ -264,7 +289,7 @@ Mocha.describe("Record_rest_test", () => { version: "11.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 264, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 289, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineMirror", name: "dashedInlineMirror", version: "12.0", @@ -277,8 +302,10 @@ Mocha.describe("Record_rest_test", () => { }); export { + SubConfig, describeConfig, getAliasedRest, + getNamespacedRest, getRenamedRest, getName, getWholeConfig, diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index 5c8d304853b..68bd07c8aa3 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -12,6 +12,13 @@ type subConfig = { debug: bool, } +module SubConfig = { + type t = { + version: string, + debug: bool, + } +} + type aliasedSubConfig = subConfig type renamedConfig = { @@ -27,6 +34,7 @@ let describeConfig = (c: config) => } let getAliasedRest = ({name: _, ...aliasedSubConfig as rest}: config) => rest +let getNamespacedRest = ({name: _, ...SubConfig.t as rest}: config) => rest let getRenamedRest = ({name: _, ...subConfig as rest}: renamedConfig) => rest @@ -149,6 +157,23 @@ describe(__MODULE__, () => { ) }) + test("record rest accepts namespaced record types", () => { + eq( + __LOC__, + getNamespacedRest({name: "namespaced", version: "3.15", debug: true}), + {version: "3.15", debug: true}, + ) + + let {name: _, ...SubConfig.t as rest} = ( + { + name: "namespaced-let", + version: "3.16", + debug: false, + }: config + ) + eq(__LOC__, rest, {version: "3.16", debug: false}) + }) + test("record rest excludes fields renamed with @as", () => { eq( __LOC__, From fbc17350a9bb01df0510dfd2433c2a2c20ffa547 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Fri, 10 Apr 2026 14:34:44 +0200 Subject: [PATCH 19/47] make sure rest is used and move logic to its own files --- compiler/core/lam_analysis.ml | 2 +- compiler/core/lam_compile_primitive.ml | 2 +- compiler/core/lam_convert.ml | 3 +- compiler/core/lam_primitive.ml | 4 +- compiler/core/lam_primitive.mli | 2 +- compiler/core/lam_print.ml | 4 +- .../frontend/ast_tuple_pattern_flatten.ml | 2 +- compiler/frontend/bs_ast_mapper.ml | 8 +- compiler/ml/ast_helper.mli | 2 +- compiler/ml/ast_iterator.ml | 6 +- compiler/ml/ast_mapper.ml | 8 +- compiler/ml/ast_mapper_from0.ml | 10 +- compiler/ml/ast_mapper_to0.ml | 10 +- compiler/ml/depend.ml | 2 +- compiler/ml/lambda.ml | 2 +- compiler/ml/lambda.mli | 2 +- compiler/ml/matching.ml | 2 +- compiler/ml/parsetree.ml | 16 +- compiler/ml/pprintast.ml | 19 +- compiler/ml/printast.ml | 9 +- compiler/ml/printlambda.ml | 4 +- compiler/ml/typecore.ml | 354 +----------------- compiler/ml/typecore.mli | 13 +- compiler/ml/typecore_record_rest.ml | 299 +++++++++++++++ compiler/ml/typecore_record_rest.mli | 33 ++ compiler/ml/typedtree.ml | 4 +- compiler/ml/typedtree.mli | 4 +- compiler/syntax/src/res_ast_debugger.ml | 17 +- compiler/syntax/src/res_core.ml | 27 +- compiler/syntax/src/res_printer.ml | 10 +- .../expected/record_rest_duplicate.res.txt | 2 +- .../errors/other/expected/spread.res.txt | 2 +- .../grammar/pattern/expected/record.res.txt | 27 +- .../pattern/expected/parenthesized.res.txt | 2 +- .../recovery/pattern/expected/record.res.txt | 5 +- 35 files changed, 494 insertions(+), 424 deletions(-) create mode 100644 compiler/ml/typecore_record_rest.ml create mode 100644 compiler/ml/typecore_record_rest.mli diff --git a/compiler/core/lam_analysis.ml b/compiler/core/lam_analysis.ml index 8ffc3ea8795..54dac1787b8 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 | Precord_spread_new _ + | Pduprecord | Precord_rest _ (* 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 499619e057e..9dfffa9fc08 100644 --- a/compiler/core/lam_compile_primitive.ml +++ b/compiler/core/lam_compile_primitive.ml @@ -609,7 +609,7 @@ let translate output_prefix loc (cxt : Lam_compile_context.t) match args with | [e1] -> E.obj ~dup:e1 [] | _ -> assert false) - | Precord_spread_new excluded -> ( + | Precord_rest excluded -> ( match args with | [e1] -> (* Generate: (({field1: __unused0, ...__rest}) => __rest)(source) diff --git a/compiler/core/lam_convert.ml b/compiler/core/lam_convert.ml index 1da0c23109e..95ae9d94ae5 100644 --- a/compiler/core/lam_convert.ml +++ b/compiler/core/lam_convert.ml @@ -208,8 +208,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t = | Psetfield (id, info) -> prim ~primitive:(Psetfield (id, info)) ~args loc | Pduprecord -> prim ~primitive:Pduprecord ~args loc | Ptagged_template -> prim ~primitive:Ptagged_template ~args loc - | Precord_spread_new excluded -> - prim ~primitive:(Precord_spread_new excluded) ~args loc + | Precord_rest excluded -> prim ~primitive:(Precord_rest 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 73fad3d2538..118094da64a 100644 --- a/compiler/core/lam_primitive.ml +++ b/compiler/core/lam_primitive.ml @@ -42,7 +42,7 @@ type t = | Pduprecord (* Tagged template literal: [tag; strings_array; values_array] *) | Ptagged_template - | Precord_spread_new of string list + | Precord_rest of string list (* External call *) | Pjs_call of { prim_name: string; @@ -229,7 +229,7 @@ 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 | Precord_spread_new _ | Pmakearray | Parraylength | Parrayrefu + | Pduprecord | Precord_rest _ | Pmakearray | Parraylength | Parrayrefu | Parraysetu | Parrayrefs | Parraysets | Pjs_fn_make_unit | Pjs_fn_method | Phash | Phash_mixstring | Phash_mixint | Phash_finalmix -> rhs = lhs diff --git a/compiler/core/lam_primitive.mli b/compiler/core/lam_primitive.mli index 8a355cc4791..561c9e31255 100644 --- a/compiler/core/lam_primitive.mli +++ b/compiler/core/lam_primitive.mli @@ -37,7 +37,7 @@ type t = | Psetfield of int * Lambda.set_field_dbg_info | Pduprecord | Ptagged_template - | Precord_spread_new of string list + | Precord_rest 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 c8e7f29deb7..446c28e28db 100644 --- a/compiler/core/lam_print.ml +++ b/compiler/core/lam_print.ml @@ -83,8 +83,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) + | Precord_rest excluded -> + fprintf ppf "record_rest(%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 7b9d3e3da39..165dede4478 100644 --- a/compiler/frontend/ast_tuple_pattern_flatten.ml +++ b/compiler/frontend/ast_tuple_pattern_flatten.ml @@ -65,7 +65,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 (_, _, Some rest), Pexp_pack {pmod_desc = Pmod_ident _} -> - Location.raise_errorf ~loc:rest.ppat_loc + Location.raise_errorf ~loc:rest.rest_loc "Record rest patterns are not supported when destructuring modules. Bind \ the module fields explicitly." | Ppat_record (lid_pats, _, None), Pexp_pack {pmod_desc = Pmod_ident id} -> diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml index 31696129001..332ac5b57a2 100644 --- a/compiler/frontend/bs_ast_mapper.ml +++ b/compiler/frontend/bs_ast_mapper.ml @@ -438,7 +438,13 @@ module P = struct ?rest: (match rest with | None -> None - | Some p -> Some (sub.pat sub p)) + | Some {rest_loc; rest_name; rest_type} -> + Some + { + rest_loc = sub.location sub rest_loc; + rest_name = map_loc sub rest_name; + rest_type = map_opt (sub.typ sub) rest_type; + }) (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.mli b/compiler/ml/ast_helper.mli index 05282cd49fe..ed16a6f9d12 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -102,7 +102,7 @@ module Pat : sig val record : ?loc:loc -> ?attrs:attrs -> - ?rest:pattern -> + ?rest:record_pat_rest -> pattern record_element list -> closed_flag -> pattern diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index 66be16cf836..f1421d518e7 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -413,7 +413,11 @@ module P = struct iter_loc sub lid; sub.pat sub pat) lpl; - iter_opt (sub.pat sub) rest + iter_opt + (fun {rest_name; rest_type; _} -> + iter_loc sub rest_name; + iter_opt (sub.typ sub) rest_type) + 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.ml b/compiler/ml/ast_mapper.ml index f7c9b8031cb..8e06c7729eb 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -402,7 +402,13 @@ module P = struct ?rest: (match rest with | None -> None - | Some p -> Some (sub.pat sub p)) + | Some {rest_loc; rest_name; rest_type} -> + Some + { + rest_loc = sub.location sub rest_loc; + rest_name = map_loc sub rest_name; + rest_type = map_opt (sub.typ sub) rest_type; + }) (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_from0.ml b/compiler/ml/ast_mapper_from0.ml index 4f9412f146d..080b42b31b0 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -95,11 +95,19 @@ let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} let record_rest_attr_name = "res.record_rest" +let record_rest_of_pattern (rest : Pt.pattern) = + match rest.Pt.ppat_desc with + | Pt.Ppat_constraint ({ppat_desc = Pt.Ppat_var rest_name; _}, rest_type) -> + Some {Pt.rest_loc = rest.ppat_loc; rest_name; rest_type = Some rest_type} + | Pt.Ppat_var rest_name -> + Some {Pt.rest_loc = rest.ppat_loc; rest_name; rest_type = None} + | _ -> None + let get_record_rest_attr attrs_ = let rec remove_record_rest_attr acc = function | ({Location.txt = attr_name; _}, Pt.PPat (rest, None)) :: attrs when attr_name = record_rest_attr_name -> - (Some rest, List.rev_append acc attrs) + (record_rest_of_pattern rest, List.rev_append acc attrs) | attr :: attrs -> remove_record_rest_attr (attr :: acc) attrs | [] -> (None, List.rev acc) in diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 6ce4b7e80d2..1b05477b169 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -92,6 +92,14 @@ let record_rest_attr_name = "res.record_rest" let add_record_rest_attr ~rest attrs = (Location.mknoloc record_rest_attr_name, Pt.PPat (rest, None)) :: attrs +let record_rest_to_pattern sub (rest : record_pat_rest) = + let loc = sub.location sub rest.rest_loc in + let name = map_loc sub rest.rest_name in + let pat = Ast_helper0.Pat.var ~loc name in + match rest.rest_type with + | None -> pat + | Some typ -> Ast_helper0.Pat.constraint_ ~loc pat (sub.typ sub typ) + module T = struct (* Type expressions for the core language *) @@ -611,7 +619,7 @@ module P = struct match rest with | None -> attrs | Some rest_pat -> - add_record_rest_attr ~rest:(sub.pat sub rest_pat) attrs + add_record_rest_attr ~rest:(record_rest_to_pattern sub rest_pat) attrs in record ~loc ~attrs (Ext_list.map lpl (fun {lid; x = p; opt = optional} -> diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index dc5442cdc6a..d89fb0a0b63 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -185,7 +185,7 @@ let rec add_pattern bv pat = add bv lbl; add_pattern bv p) pl; - add_opt add_pattern bv _rest + add_opt (fun bv {rest_type; _} -> add_opt add_type bv rest_type) bv _rest | Ppat_array pl -> List.iter (add_pattern bv) pl | Ppat_or (p1, p2) -> add_pattern bv p1; diff --git a/compiler/ml/lambda.ml b/compiler/ml/lambda.ml index 5324f00aa23..ea759e2a506 100644 --- a/compiler/ml/lambda.ml +++ b/compiler/ml/lambda.ml @@ -177,7 +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 *) + | Precord_rest of string list (* excluded runtime field names *) (* External call *) | Pccall of Primitive.description (* Exceptions *) diff --git a/compiler/ml/lambda.mli b/compiler/ml/lambda.mli index 16fe7036d2d..43b42c58498 100644 --- a/compiler/ml/lambda.mli +++ b/compiler/ml/lambda.mli @@ -146,7 +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 *) + | Precord_rest of string list (* excluded runtime field names *) (* External call *) | Pccall of Primitive.description (* Exceptions *) diff --git a/compiler/ml/matching.ml b/compiler/ml/matching.ml index 61b6b0766ba..eccb49475a0 100644 --- a/compiler/ml/matching.ml +++ b/compiler/ml/matching.ml @@ -548,7 +548,7 @@ let bind_record_rest loc arg rest action = ( Strict, Pgenval, rest.rest_ident, - Lprim (Precord_spread_new rest.excluded_labels, [arg], loc), + Lprim (Precord_rest rest.excluded_runtime_labels, [arg], loc), action ) let simplify_cases args cls = diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index fc4709b4efb..8190983e48f 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -161,6 +161,12 @@ and pattern = { ppat_attributes: attributes; (* ... [@id1] [@id2] *) } +and record_pat_rest = { + rest_loc: Location.t; + rest_name: string loc; + rest_type: core_type option; +} + and pattern_desc = | Ppat_any (* _ *) | Ppat_var of string loc (* x *) @@ -184,10 +190,12 @@ and pattern_desc = (* `A (None) `A P (Some P) *) - | 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) + | Ppat_record of + pattern record_element list * closed_flag * record_pat_rest option + (* { l1=P1; ...; ln=Pn } (flag = Closed, rest = None) + { l1=P1; ...; ln=Pn; _} (flag = Open, rest = None) + { l1=P1; ...; ...T as r } (rest = Some {rest_type = Some T; _}) + { l1=P1; ...; ...restName } (rest = Some {rest_type = None; _}) Invariant: n > 0 *) diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index b079c5579ca..4e9d81ae716 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -460,7 +460,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, _rest) -> ( + | 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 @@ -471,9 +471,20 @@ and simple_pattern ctxt (f : Format.formatter) (x : pattern) : unit = | _ -> pp f "@[<2>%a%s@;=@;%a@]" longident_loc li opt_str (pattern1 ctxt) p in - match closed with - | Closed -> pp f "@[<2>{@;%a@;}@]" (list longident_x_pattern ~sep:";@;") l - | _ -> pp f "@[<2>{@;%a;_}@]" (list longident_x_pattern ~sep:";@;") l) + let pp_rest f = function + | {rest_name; rest_type = Some rest_type; _} -> + pp f "...%a as %s" (core_type ctxt) rest_type rest_name.txt + | {rest_name; rest_type = None; _} -> pp f "...%s" rest_name.txt + in + match (closed, rest) with + | Closed, None -> + pp f "@[<2>{@;%a@;}@]" (list longident_x_pattern ~sep:";@;") l + | Open, None -> + pp f "@[<2>{@;%a;_}@]" (list longident_x_pattern ~sep:";@;") l + | _, Some rest_pat -> + let pp_fields = list longident_x_pattern ~sep:";@;" in + if l = [] then pp f "@[<2>{@;%a@;}@]" pp_rest rest_pat + else pp f "@[<2>{@;%a;@;%a@;}@]" pp_fields l pp_rest rest_pat) | Ppat_tuple l -> pp f "@[<1>(%a)@]" (list ~sep:",@;" (pattern1 ctxt)) l (* level1*) | Ppat_constant c -> pp f "%a" constant c diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 3f4cad224a3..4c99c77e433 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -205,9 +205,14 @@ 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, _rest) -> + | Ppat_record (l, c, rest) -> ( line i ppf "Ppat_record %a\n" fmt_closed_flag c; - list i longident_x_pattern ppf l + list i longident_x_pattern ppf l; + match rest with + | None -> () + | Some {rest_name; rest_type; _} -> + line (i + 1) ppf "rest %a\n" fmt_string_loc rest_name; + option (i + 2) core_type ppf rest_type) | Ppat_array l -> line i ppf "Ppat_array\n"; list i pattern ppf l diff --git a/compiler/ml/printlambda.ml b/compiler/ml/printlambda.ml index aac5010d326..bb5c8832d34 100644 --- a/compiler/ml/printlambda.ml +++ b/compiler/ml/printlambda.ml @@ -116,8 +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) + | Precord_rest excluded -> + fprintf ppf "record_rest(%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/typecore.ml b/compiler/ml/typecore.ml index 134987e77e5..f70e3159037 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -96,18 +96,7 @@ type error = | Field_access_on_dict_type | Jsx_not_enabled | Tagged_template_non_tag of type_expr - | 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 list * Longident.t - | Record_rest_field_missing of string list * Longident.t - | Record_rest_extra_field of string * Longident.t - | Record_rest_field_runtime_name_mismatch of { - field: string; - rest_type: Longident.t; - source_runtime_name: string; - rest_runtime_name: string; - } + | Record_rest of Typecore_record_rest.error exception Error of Location.t * Env.t * error exception Error_forward of Location.error @@ -340,15 +329,6 @@ let extract_concrete_variant env ty = | p0, p, {type_kind = Type_open} -> (p0, p, []) | _ -> raise Not_found -let runtime_label_name name attrs = - Ext_list.find_def attrs Lambda.find_name name - -let runtime_label_description_name (lbl : Types.label_description) = - runtime_label_name lbl.lbl_name lbl.lbl_attributes - -let runtime_label_declaration_name (lbl : Types.label_declaration) = - runtime_label_name (Ident.name lbl.ld_id) lbl.ld_attributes - let label_is_optional ld = ld.lbl_optional let check_optional_attr env ld optional loc = @@ -364,19 +344,6 @@ let unify_pat_types loc env ty ty' = try unify env ty ty' with Unify trace -> raise (Error (loc, env, Pattern_type_clash trace)) -let extract_instantiated_concrete_typedecl env loc ty = - let _, _, decl = extract_concrete_typedecl env ty in - let decl = instance_declaration decl in - let args = - match expand_head env ty with - | {desc = Tconstr (_, args, _)} -> args - | _ -> assert false - in - List.iter2 - (fun param arg -> unify_pat_types loc env param arg) - decl.type_params args; - decl - (* unification inside type_exp and type_expect *) let unify_exp_types ~context loc env ty expected_ty = try unify env ty expected_ty @@ -1595,254 +1562,22 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp check_recordpat_labels ~get_jsx_component_error_info loc lbl_pat_list 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, 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, type_args) -> (lid, name, type_args) - | _ -> - 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_annotation_decl = - Typetexp.find_type !env rest_type_lid.loc rest_type_lid.txt - in - let rest_annotation_decl = - instance_declaration rest_annotation_decl - in - (* Get explicit field names *) - let explicit_fields = - List.map (fun (_, label, _, _) -> label.lbl_name) lbl_pat_list - in - let explicit_runtime_fields = - List.map - (fun (_, label, _, _) -> runtime_label_description_name label) - lbl_pat_list - in - let rest_type_args = - match rest_type_args_syntax with - | [] -> - List.map (fun _ -> newvar ()) rest_annotation_decl.type_params - | args -> - let n_args = List.length args in - let n_params = List.length rest_annotation_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, rest_type_args, ref Mnil)) - in - if rest_annotation_decl.type_private = Private then - raise (Error (rest_type_lid.loc, !env, Private_type rest_type_expr)); - List.iter2 - (fun param arg -> unify_pat_types rest_type_lid.loc !env param arg) - rest_annotation_decl.type_params rest_type_args; - let rest_decl = - match - try - Some - (extract_instantiated_concrete_typedecl !env rest_type_lid.loc - rest_type_expr) - with Not_found -> None - with - | Some rest_decl -> ( - if rest_decl.type_private = Private then - raise - (Error (rest_type_lid.loc, !env, Private_type rest_type_expr)); - match rest_decl.type_kind with - | Type_record _ -> rest_decl - | _ -> - raise - (Error - ( rest_type_lid.loc, - !env, - Record_rest_not_record rest_type_lid.txt ))) - | None -> - raise - (Error - ( rest_type_lid.loc, - !env, - Record_rest_not_record rest_type_lid.txt )) - in - let source_fields, source_repr = - match - try - Some (extract_instantiated_concrete_typedecl !env loc record_ty) - with Not_found -> None - with - | Some source_decl -> ( - match source_decl.type_kind with - | Type_record (fields, repr) -> - ( List.map - (fun (l : Types.label_declaration) -> - ( Ident.name l.ld_id, - runtime_label_declaration_name l, - l.ld_type )) - fields, - repr ) - | _ -> assert false) - | None -> ( - unify_pat_types rest_type_lid.loc !env record_ty rest_type_expr; - match rest_decl.type_kind with - | Type_record (fields, repr) -> - ( List.map - (fun (l : Types.label_declaration) -> - ( Ident.name l.ld_id, - runtime_label_declaration_name l, - l.ld_type )) - fields, - repr ) - | _ -> assert false) - in - let rest_labels = - match rest_decl.type_kind with - | Type_record (labels, _) -> labels - | _ -> assert false - 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 - let runtime_excluded_fields = - match source_repr 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_runtime_fields then - explicit_runtime_fields - else tag_name :: explicit_runtime_fields - | _ -> explicit_runtime_fields - in - (* Get rest field names *) - let rest_field_names = - List.map - (fun (l : Types.label_declaration) -> Ident.name l.ld_id) - rest_labels + | Some rest -> ( + let check_not_private loc ty decl = + if decl.type_private = Private then + raise (Error (loc, !env, Private_type ty)) in - (* Validate: fields in both explicit and rest must be optional in the explicit pattern *) - let not_optional = - List.filter - (fun rest_field -> - List.mem rest_field explicit_fields - && 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 *) - let source_field_names = - List.map (fun (name, _, _) -> name) source_fields - in - let missing = - List.filter - (fun source_field -> - (not (List.mem source_field explicit_fields)) - && not (List.mem source_field rest_field_names)) - source_field_names - 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 and use compatible types *) - List.iter - (fun (rest_label : Types.label_declaration) -> - let rest_field = Ident.name rest_label.ld_id in - let rest_runtime_field = - runtime_label_declaration_name rest_label - in - match - Ext_list.find_first source_fields (fun (field, _, _) -> - field = rest_field) - with - | None -> - raise - (Error - ( rest_type_lid.loc, - !env, - Record_rest_extra_field (rest_field, rest_type_lid.txt) - )) - | Some (_, source_runtime_field, source_type) -> - if source_runtime_field <> rest_runtime_field then - raise - (Error - ( rest_type_lid.loc, - !env, - Record_rest_field_runtime_name_mismatch - { - field = rest_field; - rest_type = rest_type_lid.txt; - source_runtime_name = source_runtime_field; - rest_runtime_name = rest_runtime_field; - } )); - unify_pat_types rest_type_lid.loc !env rest_label.ld_type - source_type) - 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_ident = - enter_variable rest_pat.ppat_loc rest_name rest_type_expr - in - Some - { - Typedtree.rest_ident; - rest_name; - rest_type = rest_type_expr; - rest_path; - rest_labels; - excluded_labels = runtime_excluded_fields; - } + try + Some + (Typecore_record_rest.type_record_pat_rest ~env:!env + ~pattern_force ~loc ~record_ty ~lbl_pat_list ~rest + ~enter_variable:(fun loc name ty -> enter_variable loc name ty) + ~unify_pat_types ~check_not_private) + with Typecore_record_rest.Error (loc, env, err) -> + raise (Error (loc, env, Record_rest err))) in rp k { @@ -2412,9 +2147,7 @@ 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; - may f rest + | Ppat_record (args, _flag, _rest) -> List.iter (fun {x = p} -> f p) args let contains_polymorphic_variant p = let rec loop p = @@ -5367,64 +5100,7 @@ let report_error env loc ppf error = \ - To use a ReScript function as a tag, lift it with \ @{TaggedTemplate.make@}.@]" type_expr typ - | 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 (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 "" - 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 \ - type." - field longident lid - | Record_rest_field_runtime_name_mismatch - {field; rest_type; source_runtime_name; rest_runtime_name} -> - fprintf ppf - "Field `%s` in the rest type `%a` has runtime representation `%s`, but \ - in the source record type it is `%s`. Runtime representations must \ - match." - field longident rest_type rest_runtime_name source_runtime_name + | Record_rest err -> Typecore_record_rest.report_error ppf err 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 03a878e302d..c82b7d2f944 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -129,18 +129,7 @@ type error = | Field_access_on_dict_type | Jsx_not_enabled | Tagged_template_non_tag of type_expr - | 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 list * Longident.t - | Record_rest_field_missing of string list * Longident.t - | Record_rest_extra_field of string * Longident.t - | Record_rest_field_runtime_name_mismatch of { - field: string; - rest_type: Longident.t; - source_runtime_name: string; - rest_runtime_name: string; - } + | Record_rest of Typecore_record_rest.error exception Error of Location.t * Env.t * error exception Error_forward of Location.error diff --git a/compiler/ml/typecore_record_rest.ml b/compiler/ml/typecore_record_rest.ml new file mode 100644 index 00000000000..1a74562408e --- /dev/null +++ b/compiler/ml/typecore_record_rest.ml @@ -0,0 +1,299 @@ +open Types +open Format + +type error = + | Invalid_type + | Requires_type_annotation of string + | Not_record of Longident.t + | Field_not_optional of string list * Longident.t + | Field_missing of string list * Longident.t + | Extra_field of string * Longident.t + | Field_runtime_name_mismatch of { + field: string; + rest_type: Longident.t; + source_runtime_name: string; + rest_runtime_name: string; + } + +exception Error of Location.t * Env.t * error + +type source_field = { + source_name: string; + source_runtime_name: string; + source_type: type_expr; +} + +let raise_error loc env err = raise (Error (loc, env, err)) + +let runtime_label_name name attrs = + Ext_list.find_def attrs Lambda.find_name name + +let runtime_label_description_name (lbl : label_description) = + runtime_label_name lbl.lbl_name lbl.lbl_attributes + +let runtime_label_declaration_name (lbl : label_declaration) = + runtime_label_name (Ident.name lbl.ld_id) lbl.ld_attributes + +let extract_instantiated_concrete_typedecl ~unify_pat_types env loc ty = + let _, _, decl = Ctype.extract_concrete_typedecl env ty in + let decl = Ctype.instance_declaration decl in + let args = + match Ctype.expand_head env ty with + | {desc = Tconstr (_, args, _)} -> args + | _ -> assert false + in + List.iter2 + (fun param arg -> unify_pat_types loc env param arg) + decl.type_params args; + decl + +let type_args_from_annotation ~env ~pattern_force + ~(rest_type_lid : Longident.t Location.loc) rest_decl rest_type_args_syntax + = + match rest_type_args_syntax with + | [] -> List.map (fun _ -> Ctype.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 + +let source_fields_of_decl (fields : label_declaration list) = + List.map + (fun (field : label_declaration) -> + { + source_name = Ident.name field.ld_id; + source_runtime_name = runtime_label_declaration_name field; + source_type = field.ld_type; + }) + fields + +let resolve_source_record ~env ~unify_pat_types ~loc ~record_ty + ~(rest_type_lid : Longident.t Location.loc) ~rest_type_expr ~rest_decl = + match + try + Some + (extract_instantiated_concrete_typedecl ~unify_pat_types env loc + record_ty) + with Not_found -> None + with + | Some source_decl -> ( + match source_decl.type_kind with + | Type_record (fields, repr) -> (source_fields_of_decl fields, repr) + | _ -> assert false) + | None -> ( + unify_pat_types rest_type_lid.loc env record_ty rest_type_expr; + match rest_decl.type_kind with + | Type_record (fields, repr) -> (source_fields_of_decl fields, repr) + | _ -> assert false) + +let runtime_excluded_labels ~explicit_runtime_labels source_repr = + match source_repr 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_runtime_labels then explicit_runtime_labels + else tag_name :: explicit_runtime_labels + | _ -> explicit_runtime_labels + +let type_record_pat_rest ~env ~pattern_force ~loc ~record_ty ~lbl_pat_list ~rest + ~enter_variable ~unify_pat_types ~check_not_private = + let rest_type_lid, rest_type_args_syntax = + match rest.Parsetree.rest_type with + | None -> + raise_error rest.rest_loc env + (Requires_type_annotation rest.rest_name.txt) + | Some {ptyp_desc = Ptyp_constr (lid, type_args); _} -> (lid, type_args) + | Some _ -> raise_error rest.rest_loc env Invalid_type + in + let rest_path, rest_annotation_decl = + Typetexp.find_type env rest_type_lid.loc rest_type_lid.txt + in + let rest_annotation_decl = Ctype.instance_declaration rest_annotation_decl in + let rest_type_args = + type_args_from_annotation ~env ~pattern_force ~rest_type_lid + rest_annotation_decl rest_type_args_syntax + in + let rest_type_expr = + Btype.newgenty (Tconstr (rest_path, rest_type_args, ref Mnil)) + in + check_not_private rest_type_lid.loc rest_type_expr rest_annotation_decl; + List.iter2 + (fun param arg -> unify_pat_types rest_type_lid.loc env param arg) + rest_annotation_decl.type_params rest_type_args; + let rest_decl = + match + try + Some + (extract_instantiated_concrete_typedecl ~unify_pat_types env + rest_type_lid.loc rest_type_expr) + with Not_found -> None + with + | Some rest_decl -> ( + check_not_private rest_type_lid.loc rest_type_expr rest_decl; + match rest_decl.type_kind with + | Type_record _ -> rest_decl + | _ -> raise_error rest_type_lid.loc env (Not_record rest_type_lid.txt)) + | None -> raise_error rest_type_lid.loc env (Not_record rest_type_lid.txt) + in + let explicit_fields = + List.map (fun (_, label, _, _) -> label.lbl_name) lbl_pat_list + in + let explicit_runtime_labels = + List.map + (fun (_, label, _, _) -> runtime_label_description_name label) + lbl_pat_list + in + let explicit_optional_fields = + List.filter_map + (fun (_, label, _, optional) -> + if optional then Some label.lbl_name else None) + lbl_pat_list + in + let rest_labels = + match rest_decl.type_kind with + | Type_record (labels, _) -> labels + | _ -> assert false + in + let rest_field_names = + List.map (fun label -> Ident.name label.ld_id) rest_labels + in + let source_fields, source_repr = + resolve_source_record ~env ~unify_pat_types ~loc ~record_ty ~rest_type_lid + ~rest_type_expr ~rest_decl + in + let not_optional = + List.filter + (fun rest_field -> + List.mem rest_field explicit_fields + && not (List.mem rest_field explicit_optional_fields)) + rest_field_names + in + if not_optional <> [] then + raise_error rest.rest_loc env + (Field_not_optional (not_optional, rest_type_lid.txt)); + let source_field_names = + List.map (fun field -> field.source_name) source_fields + in + let missing = + List.filter + (fun source_field -> + (not (List.mem source_field explicit_fields)) + && not (List.mem source_field rest_field_names)) + source_field_names + in + if missing <> [] then + raise_error rest.rest_loc env (Field_missing (missing, rest_type_lid.txt)); + List.iter + (fun (rest_label : label_declaration) -> + let rest_field = Ident.name rest_label.ld_id in + let rest_runtime_name = runtime_label_declaration_name rest_label in + match + Ext_list.find_first source_fields (fun field -> + field.source_name = rest_field) + with + | None -> + raise_error rest_type_lid.loc env + (Extra_field (rest_field, rest_type_lid.txt)) + | Some source_field -> + if source_field.source_runtime_name <> rest_runtime_name then + raise_error rest_type_lid.loc env + (Field_runtime_name_mismatch + { + field = rest_field; + rest_type = rest_type_lid.txt; + source_runtime_name = source_field.source_runtime_name; + rest_runtime_name; + }); + unify_pat_types rest_type_lid.loc env rest_label.ld_type + source_field.source_type) + rest_labels; + if + rest_field_names <> [] + && List.for_all + (fun field -> List.mem field explicit_fields) + rest_field_names + then Location.prerr_warning rest.rest_loc Warnings.Bs_record_rest_empty; + let rest_ident = enter_variable rest.rest_loc rest.rest_name rest_type_expr in + { + Typedtree.rest_ident; + rest_name = rest.rest_name; + rest_type = rest_type_expr; + excluded_runtime_labels = + runtime_excluded_labels ~explicit_runtime_labels source_repr; + } + +let report_error ppf = function + | Invalid_type -> + fprintf ppf "Record rest pattern must have the form: ...Type.t as name" + | Requires_type_annotation name -> + fprintf ppf + "Record rest pattern `...%s` requires a type annotation. Use `...Type.t \ + as %s`." + name name + | Not_record lid -> + fprintf ppf + "Type %a is not a record type and cannot be used as a record rest \ + pattern." + Printtyp.longident lid + | Field_not_optional (fields, lid) -> ( + let field_list = + fields |> List.map (fun field -> "\n- " ^ field) |> 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." + Printtyp.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." + Printtyp.longident lid field_list) + | Field_missing (fields, lid) -> ( + let field_list = + fields |> List.map (fun field -> "\n- " ^ field) |> 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." + Printtyp.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." + Printtyp.longident lid field_list) + | Extra_field (field, lid) -> + fprintf ppf + "Field `%s` in the rest type `%a` does not exist in the source record \ + type." + field Printtyp.longident lid + | Field_runtime_name_mismatch + {field; rest_type; source_runtime_name; rest_runtime_name} -> + fprintf ppf + "Field `%s` in the rest type `%a` has runtime representation `%s`, but \ + in the source record type it is `%s`. Runtime representations must \ + match." + field Printtyp.longident rest_type rest_runtime_name source_runtime_name diff --git a/compiler/ml/typecore_record_rest.mli b/compiler/ml/typecore_record_rest.mli new file mode 100644 index 00000000000..2a235a7078a --- /dev/null +++ b/compiler/ml/typecore_record_rest.mli @@ -0,0 +1,33 @@ +open Types + +type error = + | Invalid_type + | Requires_type_annotation of string + | Not_record of Longident.t + | Field_not_optional of string list * Longident.t + | Field_missing of string list * Longident.t + | Extra_field of string * Longident.t + | Field_runtime_name_mismatch of { + field: string; + rest_type: Longident.t; + source_runtime_name: string; + rest_runtime_name: string; + } + +exception Error of Location.t * Env.t * error + +val type_record_pat_rest : + env:Env.t -> + pattern_force:(unit -> unit) list ref -> + loc:Location.t -> + record_ty:type_expr -> + lbl_pat_list: + (Longident.t Location.loc * label_description * Typedtree.pattern * bool) + list -> + rest:Parsetree.record_pat_rest -> + enter_variable:(Location.t -> string Location.loc -> type_expr -> Ident.t) -> + unify_pat_types:(Location.t -> Env.t -> type_expr -> type_expr -> unit) -> + check_not_private:(Location.t -> type_expr -> type_declaration -> unit) -> + Typedtree.record_pat_rest + +val report_error : Format.formatter -> error -> unit diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml index 74813efe3cb..5131e15f1d4 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -39,9 +39,7 @@ and record_pat_rest = { rest_ident: Ident.t; rest_name: string loc; rest_type: type_expr; - rest_path: Path.t; - rest_labels: Types.label_declaration list; - excluded_labels: string list; + excluded_runtime_labels: string list; } and pat_extra = diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli index 939e46d1db6..61c4e6863c7 100644 --- a/compiler/ml/typedtree.mli +++ b/compiler/ml/typedtree.mli @@ -47,9 +47,7 @@ and record_pat_rest = { rest_ident: Ident.t; rest_name: string loc; rest_type: type_expr; - rest_path: Path.t; - rest_labels: Types.label_declaration list; - excluded_labels: string list; + excluded_runtime_labels: string list; } and pat_extra = diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index 0436254c07a..ab18be2a1df 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -804,7 +804,7 @@ module Sexp_ast = struct | None -> Sexp.atom "None" | Some p -> Sexp.list [Sexp.atom "Some"; pattern p]); ] - | Ppat_record (rows, flag, _rest) -> + | Ppat_record (rows, flag, rest) -> Sexp.list [ Sexp.atom "Ppat_record"; @@ -814,6 +814,21 @@ module Sexp_ast = struct ~f:(fun {lid = longident_loc; x = p} -> Sexp.list [longident longident_loc.Location.txt; pattern p]) rows); + (match rest with + | None -> Sexp.atom "None" + | Some {rest_name; rest_type; _} -> + Sexp.list + [ + Sexp.atom "Some"; + Sexp.list + [ + Sexp.atom rest_name.txt; + (match rest_type with + | None -> Sexp.atom "None" + | Some type_expr -> + Sexp.list [Sexp.atom "Some"; core_type type_expr]); + ]; + ]); ] | Ppat_array patterns -> Sexp.list diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 3afb0cb5800..93a340af8fb 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -339,7 +339,7 @@ type fundef_parameter = type record_pattern_item = | PatUnderscore | PatField of Parsetree.pattern Parsetree.record_element - | PatRest of Parsetree.pattern + | PatRest of Parsetree.record_pat_rest type context = OrdinaryExpr | TernaryTrueBranchExpr | WhenExpr @@ -1544,22 +1544,25 @@ and parse_record_pattern_row p = 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)) + Some + ( false, + PatRest + {Parsetree.rest_loc; rest_name = name; rest_type = Some core_type} + )) 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) + Some + ( false, + PatRest + { + Parsetree.rest_loc = loc; + rest_name = Location.mkloc ident loc; + rest_type = None; + } ) | _ -> (* Fallback: treat as old-style spread (error) *) Some (true, PatField (parse_record_pattern_row_field ~attrs p))) @@ -1623,7 +1626,7 @@ and parse_record_pattern ~attrs p = match rest with | None -> (fields, flag, Some rest_pat) | Some _ -> - Parser.err ~start_pos:rest_pat.Parsetree.ppat_loc.loc_start p + Parser.err ~start_pos:rest_pat.Parsetree.rest_loc.loc_start p (Diagnostics.message Error_messages.record_pattern_multiple_rest); (fields, flag, rest)) | PatUnderscore -> (fields, flag, rest)) diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 857404064e5..a1c1c631667 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -2807,18 +2807,16 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = Doc.concat [Doc.lbrace; Doc.text "_"; Doc.rbrace] | 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) -> + match rest_pat.Parsetree.rest_type with + | Some typ -> Doc.concat [ Doc.text "..."; print_typ_expr ~state typ cmt_tbl; Doc.text " as "; - Doc.text name.txt; + Doc.text rest_pat.rest_name.txt; ] - | Ppat_var name -> Doc.concat [Doc.text "..."; Doc.text name.txt] - | _ -> - Doc.concat [Doc.text "..."; print_pattern ~state rest_pat cmt_tbl] + | None -> Doc.concat [Doc.text "..."; Doc.text rest_pat.rest_name.txt] in Doc.group (Doc.concat 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 index c4c210586f3..dce00643948 100644 --- 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 @@ -8,4 +8,4 @@ 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 +let { ...Config.t as second } = 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 c75eaef1117..93a3f65fa05 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 @@ -69,7 +69,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 { ...y } = myRecord let { M.t = t } = myRecord let x::y = myList type nonrec t = { 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 5a18bd3fa1a..833c0bef89f 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 @@ -81,15 +81,18 @@ let f [arity:1](({ a } : myRecord) as p) = () ;;for { a;_} = 0 to 10 do () done ;;for { a;_} = 0 to 10 do () done ;;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 } = () -let { a } = x -let { a } = x -let { a } = x -let { a } = x \ No newline at end of file +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 +;;match x with + | { a; ...rest } -> () + | { a; ...b as rest } -> () + | { a; ...M.t as rest } -> () +let f [arity:1]{ a; ...rest } = () +let f [arity:1]{ a; ...b as rest } = () +let f [arity:1]{ a; ...M.t as rest } = () +let { a; ...'v t as rest } = x +let { a; ...'v M.t as rest } = x +let { a; ...int M.t as rest } = x +let { a; ...('a, 'b) M.t as rest } = x \ No newline at end of file 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 62c41decb2f..426f716d65a 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 } -> () + | { a; ...b } -> () | 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 2cc87429258..8b332214d2b 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,4 +9,7 @@ Did you forget a `}` here? -;;match x with | { a; b = { x; y } } -> () | { y } -> () | { a; b } -> () \ No newline at end of file +;;match x with + | { a; b = { x; y } } -> () + | { y; ...x } -> () + | { a; b } -> () \ No newline at end of file From 53f864ca93d7ece84ab733eb05da29427b8a7134 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Sun, 19 Apr 2026 10:58:12 +0200 Subject: [PATCH 20/47] stop ignoring _rest in a few more places --- analysis/src/dump_ast.ml | 19 ++++++- analysis/src/hint.ml | 7 ++- analysis/src/semantic_tokens.ml | 10 +++- tests/analysis_tests/tests/src/RecordRest.res | 5 ++ .../tests/src/expected/Highlight.res.txt | 2 +- .../tests/src/expected/RecordRest.res.txt | 55 ++++++++++++++++++- 6 files changed, 90 insertions(+), 8 deletions(-) diff --git a/analysis/src/dump_ast.ml b/analysis/src/dump_ast.ml index 6301af8f897..042c2be83f2 100644 --- a/analysis/src/dump_ast.ml +++ b/analysis/src/dump_ast.ml @@ -67,6 +67,14 @@ let print_core_type typ ~pos = | Ptyp_variant _ -> "Ptyp_variant()" | _ -> "" +let print_record_pattern_rest rest ~pos = + (rest.Parsetree.rest_name |> print_loc_denominator_loc ~pos) + ^ rest.rest_name.txt + ^ + match rest.rest_type with + | Some core_type -> " as " ^ print_core_type core_type ~pos + | None -> "" + let rec print_pattern pattern ~pos ~indentation = print_attributes pattern.Parsetree.ppat_attributes ^ (pattern.ppat_loc |> print_loc_denominator ~pos) @@ -101,7 +109,7 @@ let rec print_pattern pattern ~pos ~indentation = | None -> "" | Some pat -> "," ^ print_pattern pat ~pos ~indentation) ^ ")" - | Ppat_record (fields, _, _rest) -> + | Ppat_record (fields, _, rest) -> "Ppat_record(\n" ^ add_indentation (indentation + 1) ^ "fields:\n" @@ -112,6 +120,15 @@ let rec print_pattern pattern ~pos ~indentation = ^ ": " ^ print_pattern pat ~pos ~indentation:(indentation + 2)) |> String.concat "\n") + ^ + (match rest with + | None -> "" + | Some rest -> + "\n" + ^ add_indentation (indentation + 1) + ^ "rest:\n" + ^ add_indentation (indentation + 2) + ^ print_record_pattern_rest rest ~pos) ^ "\n" ^ add_indentation indentation ^ ")" diff --git a/analysis/src/hint.ml b/analysis/src/hint.ml index 3f9f8e98ff2..d8a7610d4d6 100644 --- a/analysis/src/hint.ml +++ b/analysis/src/hint.ml @@ -42,8 +42,11 @@ let inlay ~source ~kind_file ~pos ~max_length ~full ~state ~debug = let rec process_pattern (pat : Parsetree.pattern) = match pat.ppat_desc with | Ppat_tuple pl -> pl |> List.iter process_pattern - | Ppat_record (fields, _, _rest) -> - Ext_list.iter fields (fun {x = p} -> process_pattern p) + | Ppat_record (fields, _, rest) -> + Ext_list.iter fields (fun {x = p} -> process_pattern p); + (match rest with + | Some {rest_name; _} -> push rest_name.loc Type + | None -> ()) | Ppat_array fields -> fields |> List.iter process_pattern | Ppat_var {loc} -> push loc Type | _ -> () diff --git a/analysis/src/semantic_tokens.ml b/analysis/src/semantic_tokens.ml index bb230f1c7a2..8a0bda9dc82 100644 --- a/analysis/src/semantic_tokens.ml +++ b/analysis/src/semantic_tokens.ml @@ -233,9 +233,13 @@ let command ~debug ~emitter ~source ~kind_file = | Ppat_construct ({txt = Lident ("true" | "false")}, _) -> (* Don't emit true or false *) Ast_iterator.default_iterator.pat iterator p - | Ppat_record (cases, _, _rest) -> + | Ppat_record (cases, _, rest) -> Ext_list.iter cases (fun {lid = label} -> emitter |> emit_record_label ~label ~debug); + (match rest with + | Some {rest_name = {txt = id; loc}; _} when is_lowercase_id id -> + emitter |> emit_variable ~id ~debug ~loc + | _ -> ()); Ast_iterator.default_iterator.pat iterator p | Ppat_construct (name, _) -> emitter |> emit_variant ~name ~debug; @@ -490,7 +494,7 @@ let command ~debug ~emitter ~source ~kind_file = in let {Res_driver.parsetree = structure; diagnostics} = parser ~source in if debug then - Printf.printf "structure items:%d diagnostics:%d \n" + Printf.printf "structure items:%d diagnostics:%d\n" (List.length structure) (List.length diagnostics); iterator.structure iterator structure |> ignore) else @@ -499,7 +503,7 @@ let command ~debug ~emitter ~source ~kind_file = in let {Res_driver.parsetree = signature; diagnostics} = parser ~source in if debug then - Printf.printf "signature items:%d diagnostics:%d \n" + Printf.printf "signature items:%d diagnostics:%d\n" (List.length signature) (List.length diagnostics); iterator.signature iterator signature |> ignore diff --git a/tests/analysis_tests/tests/src/RecordRest.res b/tests/analysis_tests/tests/src/RecordRest.res index 6e7dd0d2a52..54e3eb86b43 100644 --- a/tests/analysis_tests/tests/src/RecordRest.res +++ b/tests/analysis_tests/tests/src/RecordRest.res @@ -9,3 +9,8 @@ let getVersion = (config: config) => rest.version // ^def } + +let {name: _, ...SubConfig.t as localRest} = {name: "v", version: "1"} + +//^hin +//^hig diff --git a/tests/analysis_tests/tests/src/expected/Highlight.res.txt b/tests/analysis_tests/tests/src/expected/Highlight.res.txt index 6ee7e2e8005..e5d7089af19 100644 --- a/tests/analysis_tests/tests/src/expected/Highlight.res.txt +++ b/tests/analysis_tests/tests/src/expected/Highlight.res.txt @@ -1,5 +1,5 @@ Highlight src/Highlight.res -structure items:39 diagnostics:0 +structure items:39 diagnostics:0 Lident: M 0:7 Namespace Lident: C 1:9 Namespace Lident: Component 1:13 Namespace diff --git a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt index 67434a6c3f2..ead063dceda 100644 --- a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt +++ b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt @@ -1,2 +1,55 @@ Definition src/RecordRest.res 8:4 -{"uri": "RecordRest.res", "range": {"start": {"line": 7, "character": 32}, "end": {"line": 7, "character": 36}}} +{ + "range": { + "end": { "character": 36, "line": 7 }, + "start": { "character": 32, "line": 7 } + }, + "uri": "file:///RecordRest.res" +} + +Inlay Hint src/RecordRest.res 1:34 +[ + { + "kind": 1, + "label": ": SubConfig.t", + "paddingLeft": true, + "paddingRight": false, + "position": { "character": 41, "line": 12 } + }, + { + "kind": 1, + "label": ": config => string", + "paddingLeft": true, + "paddingRight": false, + "position": { "character": 14, "line": 5 } + } +] + +Highlight src/RecordRest.res +structure items:4 diagnostics:0 +Lident: config 0:5 Type +Lident: name 0:15 Property +Lident: string 0:21 Type +Lident: version 0:29 Property +Lident: string 0:38 Type +Lident: SubConfig 1:7 Namespace +Lident: t 2:7 Type +Lident: version 2:12 Property +Lident: string 2:21 Type +Variable: getVersion [5:4->5:14] +Variable: config [5:18->5:24] +Lident: config 5:26 Type +Lident: config 6:9 Variable +Lident: name 7:5 Property +Variable: rest [7:32->7:36] +Ldot: SubConfig 7:17 Namespace +Lident: t 7:27 Type +Lident: version 8:9 Property +Lident: rest 8:4 Variable +Lident: name 12:5 Property +Variable: localRest [12:32->12:41] +Ldot: SubConfig 12:17 Namespace +Lident: t 12:27 Type +Lident: name 12:46 Property +Lident: version 12:57 Property + From e0c41c83174dac3f1b871f47ac10c5de699e057b Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 16 Jun 2026 17:49:29 +0200 Subject: [PATCH 21/47] format Signed-off-by: tsnobip --- analysis/src/dump_ast.ml | 17 ++++++++--------- analysis/src/hint.ml | 4 ++-- compiler/ml/typecore.ml | 2 +- 3 files changed, 11 insertions(+), 12 deletions(-) diff --git a/analysis/src/dump_ast.ml b/analysis/src/dump_ast.ml index 042c2be83f2..19b45e07f2a 100644 --- a/analysis/src/dump_ast.ml +++ b/analysis/src/dump_ast.ml @@ -120,15 +120,14 @@ let rec print_pattern pattern ~pos ~indentation = ^ ": " ^ print_pattern pat ~pos ~indentation:(indentation + 2)) |> String.concat "\n") - ^ - (match rest with - | None -> "" - | Some rest -> - "\n" - ^ add_indentation (indentation + 1) - ^ "rest:\n" - ^ add_indentation (indentation + 2) - ^ print_record_pattern_rest rest ~pos) + ^ (match rest with + | None -> "" + | Some rest -> + "\n" + ^ add_indentation (indentation + 1) + ^ "rest:\n" + ^ add_indentation (indentation + 2) + ^ print_record_pattern_rest rest ~pos) ^ "\n" ^ add_indentation indentation ^ ")" diff --git a/analysis/src/hint.ml b/analysis/src/hint.ml index d8a7610d4d6..49b290089bc 100644 --- a/analysis/src/hint.ml +++ b/analysis/src/hint.ml @@ -42,9 +42,9 @@ let inlay ~source ~kind_file ~pos ~max_length ~full ~state ~debug = let rec process_pattern (pat : Parsetree.pattern) = match pat.ppat_desc with | Ppat_tuple pl -> pl |> List.iter process_pattern - | Ppat_record (fields, _, rest) -> + | Ppat_record (fields, _, rest) -> ( Ext_list.iter fields (fun {x = p} -> process_pattern p); - (match rest with + match rest with | Some {rest_name; _} -> push rest_name.loc Type | None -> ()) | Ppat_array fields -> fields |> List.iter process_pattern diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index f70e3159037..8bb9c672ddc 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -5098,7 +5098,7 @@ let report_error env loc ppf error = with @{taggedTemplate<...>@} instead of using the removed \ @{@@taggedTemplate@} decorator.@,\ \ - To use a ReScript function as a tag, lift it with \ - @{TaggedTemplate.make@}.@]" + @{TaggedTemplate.make@}.@]" type_expr typ | Record_rest err -> Typecore_record_rest.report_error ppf err From bcc6c80187868b208122c51a9c55583bd3c6b960 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Tue, 16 Jun 2026 18:00:46 +0200 Subject: [PATCH 22/47] improve output (compile to JS destructuring) --- compiler/core/j.ml | 38 +++- compiler/core/js_analyzer.ml | 15 +- compiler/core/js_dump.ml | 105 ++++++++-- compiler/core/js_exp_make.ml | 6 + compiler/core/js_exp_make.mli | 2 + compiler/core/js_fold.ml | 25 ++- .../core/js_pass_flatten_and_mark_dead.ml | 49 +++-- compiler/core/js_pass_record_rest.ml | 193 ++++++++++++++++++ compiler/core/js_pass_scope.ml | 93 +++++---- compiler/core/js_pass_tailcall_inline.ml | 15 +- compiler/core/js_record_fold.ml | 20 +- compiler/core/js_record_iter.ml | 16 +- compiler/core/js_record_map.ml | 25 ++- compiler/core/lam_compile_main.cppo.ml | 2 + compiler/core/lam_compile_primitive.ml | 26 +-- .../record_rest_empty_warning.res.expected | 4 +- .../record_rest_private_type.res.expected | 6 +- tests/tests/src/record_rest_test.mjs | 114 ++++++----- tests/tests/src/record_rest_test.res | 2 + .../src/expected/ZRecordRest.res.jsout | 5 +- 20 files changed, 603 insertions(+), 158 deletions(-) create mode 100644 compiler/core/js_pass_record_rest.ml diff --git a/compiler/core/j.ml b/compiler/core/j.ml index f20b22ec727..644756665fe 100644 --- a/compiler/core/j.ml +++ b/compiler/core/j.ml @@ -77,6 +77,18 @@ and property_map = (property_name * expression) list and length_object = Js_op.length_object and delim = External_arg_spec.delim = DNone | DStarJ | DNoQuotes | DBackQuotes +and record_rest_field = { + record_rest_label: string; + record_rest_ident: ident option; +} + +and object_rest_param = { + object_rest_fields: record_rest_field list; + object_rest_rest: ident; +} + +and param = Ident_param of ident | Object_rest_param of object_rest_param + and expression_desc = | Length of expression * length_object | Is_null_or_undefined of expression (** where we use a trick [== null ] *) @@ -132,7 +144,7 @@ and expression_desc = | Var of vident | Fun of { is_method: bool; - params: ident list; + params: param list; body: block; env: Js_fun_env.t; return_unit: bool; @@ -165,6 +177,7 @@ and expression_desc = | Null | Await of expression | Spread of expression + | Record_rest of record_rest_field list * expression and for_ident_expression = expression (* pure*) @@ -327,6 +340,9 @@ and deps_program = { finish_ident_expression; property_map; length_object; + record_rest_field; + object_rest_param; + param; (* for_ident; *) required_modules; case_clause; @@ -337,3 +353,23 @@ FIXME: customize for each code generator for each code generator, we can provide a white-list so that we can achieve the optimal *) + +let record_rest_field_idents fields = + List.filter_map (fun {record_rest_ident} -> record_rest_ident) fields + +let object_rest_param_idents {object_rest_fields; object_rest_rest} = + object_rest_rest :: record_rest_field_idents object_rest_fields + +let param_idents = function + | Ident_param id -> [id] + | Object_rest_param param -> object_rest_param_idents param + +let params_idents params = List.concat_map param_idents params + +let params_as_idents params = + let rec aux acc = function + | [] -> Some (List.rev acc) + | Ident_param id :: rest -> aux (id :: acc) rest + | Object_rest_param _ :: _ -> None + in + aux [] params diff --git a/compiler/core/js_analyzer.ml b/compiler/core/js_analyzer.ml index 25852412667..e51552d772d 100644 --- a/compiler/core/js_analyzer.ml +++ b/compiler/core/js_analyzer.ml @@ -30,6 +30,14 @@ type idents_stats = { let add_defined_idents (x : idents_stats) ident = x.defined_idents <- Set_ident.add x.defined_idents ident +let add_record_rest_field_idents stats fields = + List.iter + (fun (field : J.record_rest_field) -> + match field.record_rest_ident with + | None -> () + | Some ident -> add_defined_idents stats ident) + fields + (* Assume that functions already calculated closure correctly Maybe in the future, we should add a dirty flag, to mark the calcuated closure is correct or not @@ -46,6 +54,9 @@ let free_variables (stats : idents_stats) = (fun self st -> add_defined_idents stats st.ident; match st.value with + | Some {expression_desc = Record_rest (fields, source)} -> + add_record_rest_field_idents stats fields; + self.expression self source | None -> () | Some v -> self.expression self v); ident = @@ -118,6 +129,7 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) = | FlatCall _ | Call _ | New _ | Raw_js_code _ (* actually true? *) -> false | Await _ -> false | Spread _ -> false + | Record_rest _ -> false and no_side_effect (x : J.expression) = no_side_effect_expression_desc x.expression_desc @@ -230,7 +242,8 @@ let rec eq_expression ({expression_desc = x0} : J.expression) | _ -> false) | Length _ | Is_null_or_undefined _ | String_append _ | Typeof _ | Js_not _ | Js_bnot _ | In _ | Cond _ | FlatCall _ | New _ | Fun _ | Raw_js_code _ - | Array _ | Caml_block_tag _ | Object _ | Tagged_template _ | Await _ -> + | Array _ | Caml_block_tag _ | Object _ | Tagged_template _ | Await _ + | Record_rest _ -> false | Spread _ -> false diff --git a/compiler/core/js_dump.ml b/compiler/core/js_dump.ml index 6f6da8b605c..1ceb8615867 100644 --- a/compiler/core/js_dump.ml +++ b/compiler/core/js_dump.ml @@ -172,6 +172,7 @@ let rec exp_need_paren ?(arrow = false) (e : J.expression) = | Await _ -> false | Spread _ -> false | Tagged_template _ -> false + | Record_rest _ -> false | Optional_block (e, true) when arrow -> exp_need_paren ~arrow e | Optional_block _ -> false @@ -237,7 +238,43 @@ let debugger_nl f = semi f; P.newline f -let formal_parameter_list cxt f l = iter_lst cxt f l Ext_pp_scope.ident comma_sp +let rec record_rest_field cxt f + ({record_rest_label; record_rest_ident} : J.record_rest_field) = + let key = Js_dump_property.property_key (Lit record_rest_label) in + match record_rest_ident with + | None -> + P.string f key; + cxt + | Some id -> + let str, cxt = Ext_pp_scope.str_of_ident cxt id in + if key = str then P.string f key + else ( + P.string f key; + P.string f L.colon_space; + P.string f str); + cxt + +and record_rest_pattern cxt f fields rest = + P.string f "{"; + let cxt = + match fields with + | [] -> cxt + | _ -> + let cxt = iter_lst cxt f fields record_rest_field comma_sp in + comma_sp f; + cxt + in + P.string f "..."; + let cxt = Ext_pp_scope.ident cxt f rest in + P.string f "}"; + cxt + +and param cxt f = function + | J.Ident_param id -> Ext_pp_scope.ident cxt f id + | Object_rest_param {object_rest_fields; object_rest_rest} -> + record_rest_pattern cxt f object_rest_fields object_rest_rest + +and formal_parameter_list cxt f l = iter_lst cxt f l param comma_sp (* IdentMap *) (* @@ -269,6 +306,20 @@ let is_var (b : J.expression) a = | Var (Id i) -> Ident.same i a | _ -> false +let params_match_call params args fn = + match J.params_as_idents params with + | Some params -> ( + Ext_list.for_all2_no_exn args params is_var + && + match fn with + (* This check is needed to avoid some edge cases + {[function(x){return x(x)}]} + here the function is also called `x` + *) + | J.Id id -> not (Ext_list.exists params (fun x -> Ident.same x id)) + | Qualified _ -> true) + | None -> false + type fn_exp_state = | Is_return (* for sure no name *) | Name_top of Ident.t @@ -286,7 +337,7 @@ let rec try_optimize_curry cxt f len function_id = P.paren_group f 1 (fun _ -> expression ~level:1 cxt f function_id) and pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t) - ~fn_state (l : Ident.t list) (b : J.block) (env : Js_fun_env.t) : cxt = + ~fn_state (l : J.param list) (b : J.block) (env : Js_fun_env.t) : cxt = match b with | [ { @@ -309,16 +360,7 @@ and pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t) {[ function(x,y){ return u(x,y) } ]} it can be optimized in to either [u] or [Curry.__n(u)] *) - (not is_method) - && Ext_list.for_all2_no_exn ls l is_var - && - match v with - (* This check is needed to avoid some edge cases - {[function(x){return x(x)}]} - here the function is also called `x` - *) - | Id id -> not (Ext_list.exists l (fun x -> Ident.same x id)) - | Qualified _ -> true -> ( + (not is_method) && params_match_call l ls v -> ( let optimize len ~p cxt f v = if p then try_optimize_curry cxt f len function_id else vident cxt f v in @@ -359,10 +401,10 @@ and pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t) *) let inner_cxt = Ext_pp_scope.sub_scope outer_cxt set_env in let param_body () : unit = - if is_method then ( + if is_method then match l with | [] -> assert false - | this :: arguments -> + | Ident_param this :: arguments -> let cxt = P.paren_group f 1 (fun _ -> formal_parameter_list inner_cxt f arguments) @@ -373,11 +415,13 @@ and pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t) if Js_fun_env.get_unused env 0 then cxt else pp_var_assign_this cxt f this in - function_body ?directive ~return_unit cxt f b)) + function_body ?directive ~return_unit cxt f b) + | Object_rest_param _ :: _ -> assert false else let cxt = match l with - | [single] when arrow -> Ext_pp_scope.ident inner_cxt f single + | [Ident_param single] when arrow -> + Ext_pp_scope.ident inner_cxt f single | l -> P.paren_group f 1 (fun _ -> formal_parameter_list inner_cxt f l) in @@ -494,6 +538,25 @@ and expression_desc cxt ~(level : int) f x : cxt = P.string f L.undefined; cxt | Var v -> vident cxt f v + | Record_rest (fields, source) -> + P.cond_paren_group f (level > 15) (fun _ -> + P.string f "(({"; + fields + |> List.iteri (fun i ({record_rest_label; _} : J.record_rest_field) -> + if i > 0 then comma_sp f; + let key = + Js_dump_property.property_key (Lit record_rest_label) + in + P.string f key; + P.string f L.colon_space; + P.string f ("__unused" ^ string_of_int i)); + (match fields with + | [] -> () + | _ -> comma_sp f); + P.string f "...__rest}) => __rest)("; + let cxt = expression ~level:0 cxt f source in + P.string f ")"; + cxt) | Bool b -> bool f b; cxt @@ -1294,6 +1357,16 @@ and variable_declaration top cxt f (variable : J.variable_declaration) : cxt = pp_function ?directive ~is_method ~return_unit ~async ~fn_state:(if top then Name_top name else Name_non_top name) cxt f params body env + | Record_rest (fields, source) -> + P.string f L.let_; + P.space f; + let cxt = record_rest_pattern cxt f fields name in + P.space f; + P.string f L.eq; + P.space f; + let cxt = expression ~level:1 cxt f source in + semi f; + cxt | _ -> let cxt = pp_var_assign cxt f name in let cxt = expression ~level:1 cxt f e in diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml index 530765477ed..711ce215e4b 100644 --- a/compiler/core/js_exp_make.ml +++ b/compiler/core/js_exp_make.ml @@ -166,6 +166,10 @@ let raw_js_code ?comment info s : t = } let array ?comment mt es : t = {expression_desc = Array (es, mt); comment} + +let record_rest ?comment fields source : t = + {expression_desc = Record_rest (fields, source); comment} + let some_comment = None let optional_block e : J.expression = @@ -239,6 +243,7 @@ let ocaml_fun ?comment ?immutable_mask ?directive ~return_unit ~async ~one_unit_arg params body : t = let params = if one_unit_arg then [] else params in let len = List.length params in + let params = List.map (fun id -> J.Ident_param id) params in { expression_desc = Fun @@ -256,6 +261,7 @@ let ocaml_fun ?comment ?immutable_mask ?directive ~return_unit ~async let method_ ?comment ?immutable_mask ~async ~return_unit params body : t = let len = List.length params in + let params = List.map (fun id -> J.Ident_param id) params in { expression_desc = Fun diff --git a/compiler/core/js_exp_make.mli b/compiler/core/js_exp_make.mli index d37d55ea9a8..84ffed98d61 100644 --- a/compiler/core/js_exp_make.mli +++ b/compiler/core/js_exp_make.mli @@ -97,6 +97,8 @@ val runtime_ref : string -> string -> t val str : ?delim:J.delim -> ?comment:string -> string -> t +val record_rest : ?comment:string -> J.record_rest_field list -> t -> t + val ocaml_fun : ?comment:string -> ?immutable_mask:bool array -> diff --git a/compiler/core/js_fold.ml b/compiler/core/js_fold.ml index e080f501196..25280fa0e7e 100644 --- a/compiler/core/js_fold.ml +++ b/compiler/core/js_fold.ml @@ -83,6 +83,26 @@ class fold = method length_object : length_object -> 'self_type = unknown _self + method record_rest_field : record_rest_field -> 'self_type = + fun {record_rest_ident = _x0; _} -> + let _self = option (fun _self -> _self#ident) _self _x0 in + _self + + method object_rest_param : object_rest_param -> 'self_type = + fun {object_rest_fields = _x0; object_rest_rest = _x1} -> + let _self = list (fun _self -> _self#record_rest_field) _self _x0 in + let _self = _self#ident _x1 in + _self + + method param : param -> 'self_type = + function + | Ident_param _x0 -> + let _self = _self#ident _x0 in + _self + | Object_rest_param _x0 -> + let _self = _self#object_rest_param _x0 in + _self + method expression_desc : expression_desc -> 'self_type = function | Length (_x0, _x1) -> @@ -159,7 +179,7 @@ class fold = let _self = _self#vident _x0 in _self | Fun {params = x1; body = x2} -> - let _self = list (fun _self -> _self#ident) _self x1 in + let _self = list (fun _self -> _self#param) _self x1 in let _self = _self#block x2 in _self | Str _ -> _self @@ -190,6 +210,9 @@ class fold = | Spread _x0 -> let _self = _self#expression _x0 in _self + | Record_rest (_x0, _x1) -> + let _self = _self#expression _x1 in + _self method for_ident_expression : for_ident_expression -> 'self_type = _self#expression diff --git a/compiler/core/js_pass_flatten_and_mark_dead.ml b/compiler/core/js_pass_flatten_and_mark_dead.ml index 30424e68abd..22c0592e346 100644 --- a/compiler/core/js_pass_flatten_and_mark_dead.ml +++ b/compiler/core/js_pass_flatten_and_mark_dead.ml @@ -29,6 +29,14 @@ type meta_info = Info of J.ident_info | Recursive let super = Js_record_iter.super +let add_binding_info ident_use_stats ident_info ident = + match Hash_ident.find_opt ident_use_stats ident with + | Some Recursive -> + Js_op_util.update_used_stats ident_info Used; + Hash_ident.replace ident_use_stats ident (Info ident_info) + | Some (Info _) -> () + | None -> Hash_ident.add ident_use_stats ident (Info ident_info) + let mark_dead_code (js : J.program) : J.program = let ident_use_stats : meta_info Hash_ident.t = Hash_ident.create 17 in let mark_dead = @@ -64,21 +72,32 @@ let mark_dead_code (js : J.program) : J.program = if Set_ident.mem js.export_set ident then Js_op_util.update_used_stats ident_info Exported in - match Hash_ident.find_opt ident_use_stats ident with - | Some Recursive -> - Js_op_util.update_used_stats ident_info Used; - Hash_ident.replace ident_use_stats ident (Info ident_info) - | Some (Info _) -> - (* check [camlinternlFormat,box_type] inlined twice - FIXME: seems we have redeclared identifiers - *) - () - (* assert false *) - | None -> - (* First time *) - Hash_ident.add ident_use_stats ident (Info ident_info); - Js_op_util.update_used_stats ident_info - (if pure then Scanning_pure else Scanning_non_pure))); + let () = + match Hash_ident.find_opt ident_use_stats ident with + | Some Recursive -> + Js_op_util.update_used_stats ident_info Used; + Hash_ident.replace ident_use_stats ident (Info ident_info) + | Some (Info _) -> + (* check [camlinternlFormat,box_type] inlined twice + FIXME: seems we have redeclared identifiers + *) + () + (* assert false *) + | None -> + (* First time *) + Hash_ident.add ident_use_stats ident (Info ident_info); + Js_op_util.update_used_stats ident_info + (if pure then Scanning_pure else Scanning_non_pure) + in + match value with + | Some {expression_desc = Record_rest (fields, _)} -> + fields + |> List.iter (fun (field : J.record_rest_field) -> + match field.record_rest_ident with + | None -> () + | Some ident -> + add_binding_info ident_use_stats ident_info ident) + | _ -> ())); } in mark_dead.program mark_dead js; diff --git a/compiler/core/js_pass_record_rest.ml b/compiler/core/js_pass_record_rest.ml new file mode 100644 index 00000000000..2d5a60c30e9 --- /dev/null +++ b/compiler/core/js_pass_record_rest.ml @@ -0,0 +1,193 @@ +module E = Js_exp_make +open J + +let field_ident_name i label = + if Js_dump_property.property_key (Lit label) = label then label + else "__rest_field" ^ string_of_int i + +let ignored_ident i = Ext_ident.create ("__unused" ^ string_of_int i) + +let uses_ident ident block = + let found = ref false in + let obj = + { + Js_record_iter.super with + ident = + (fun _ candidate -> if Ident.same ident candidate then found := true); + } + in + obj.block obj block; + !found + +let materialize_fields source fields tail = + match source.J.expression_desc with + | Var (Id source_ident) -> + let used_fields = Hashtbl.create 7 in + let field_names = + List.mapi (fun i field -> (field.J.record_rest_label, i)) fields + in + let find_field_index label = List.assoc_opt label field_names in + let get_field_ident label = + match Hashtbl.find_opt used_fields label with + | Some ident -> ident + | None -> + let i = + match find_field_index label with + | Some i -> i + | None -> assert false + in + let ident = Ext_ident.create (field_ident_name i label) in + Hashtbl.add used_fields label ident; + ident + in + let replace = + { + Js_record_map.super with + expression = + (fun self expr -> + match expr.expression_desc with + | Static_index ({expression_desc = Var (Id ident); _}, label, _) + when Ident.same ident source_ident + && find_field_index label <> None -> + E.var (get_field_ident label) + | _ -> Js_record_map.super.expression self expr); + } + in + let tail = replace.block replace tail in + let fields = + List.mapi + (fun i field -> + match field.J.record_rest_ident with + | Some _ -> field + | None -> + let ident = + match Hashtbl.find_opt used_fields field.record_rest_label with + | Some ident -> ident + | None -> ignored_ident i + in + {field with record_rest_ident = Some ident}) + fields + in + (fields, tail) + | _ -> + let fields = + List.mapi + (fun i field -> + match field.J.record_rest_ident with + | Some _ -> field + | None -> {field with record_rest_ident = Some (ignored_ident i)}) + fields + in + (fields, tail) + +let pass = + let super = Js_record_map.super in + let block (self : Js_record_map.iter) = function + | ({ + statement_desc = + Variable + ({ + value = + Some + ({expression_desc = Record_rest (fields, source); _} as + value); + _; + } as variable); + _; + } as statement) + :: tail -> + let source = self.expression self source in + let tail = self.block self tail in + let fields, tail = materialize_fields source fields tail in + { + statement with + statement_desc = + Variable + { + variable with + value = + Some {value with expression_desc = Record_rest (fields, source)}; + }; + } + :: tail + | statement :: tail -> self.statement self statement :: self.block self tail + | [] -> [] + in + { + super with + block; + expression = + (fun self expr -> + match expr.expression_desc with + | Fun ({is_method = false; params = [Ident_param param]; body} as fun_) + -> + let body = self.block self body in + let params, body = + match body with + | { + statement_desc = + Variable + { + ident = rest; + value = + Some + { + expression_desc = + Record_rest + (fields, {expression_desc = Var (Id source); _}); + _; + }; + _; + }; + _; + } + :: tail + when Ident.name param = "param" + && Ident.same param source + && not (uses_ident param tail) -> + ( [ + Object_rest_param + {object_rest_fields = fields; object_rest_rest = rest}; + ], + tail ) + | [ + { + statement_desc = + Return + ({ + expression_desc = + Record_rest + ( fields, + ({expression_desc = Var (Id source); _} as + source_expr) ); + _; + } as rest_expr); + _; + }; + ] + when Ident.name param = "param" && Ident.same param source -> + let rest = Ext_ident.create "rest" in + let fields, body = + materialize_fields source_expr fields + [ + { + statement_desc = Return (E.var rest); + comment = rest_expr.comment; + }; + ] + in + ( [ + Object_rest_param + {object_rest_fields = fields; object_rest_rest = rest}; + ], + body ) + | _ -> (fun_.params, body) + in + {expr with expression_desc = Fun {fun_ with params; body}} + | Fun ({body} as fun_) -> + let body = self.block self body in + {expr with expression_desc = Fun {fun_ with body}} + | _ -> super.expression self expr); + } + +let program program = pass.program pass program diff --git a/compiler/core/js_pass_scope.ml b/compiler/core/js_pass_scope.ml index 004f3e5b040..b246e43fbc0 100644 --- a/compiler/core/js_pass_scope.ml +++ b/compiler/core/js_pass_scope.ml @@ -129,6 +129,8 @@ let add_defined_ident (st : state) id = let add_used_ident (st : state) id = {st with used_idents = Set_ident.add st.used_idents id} +let add_defined_idents st ids = List.fold_left add_defined_ident st ids + let super = Js_record_fold.super let record_scope_pass = @@ -146,14 +148,17 @@ let record_scope_pass = *) (* Note that [used_idents] is not complete it ignores some locally defined idents *) - let param_set = Set_ident.of_list params in + let param_idents = J.params_idents params in + let param_set = Set_ident.of_list param_idents in let {defined_idents = defined_idents'; used_idents = used_idents'} = + let mutable_params = + match J.params_as_idents params with + | None -> Set_ident.empty + | Some params -> + Set_ident.of_list (Js_fun_env.get_mutable_params params env) + in self.block self - { - init_state with - mutable_values = - Set_ident.of_list (Js_fun_env.get_mutable_params params env); - } + {init_state with mutable_values = mutable_params} body in (* let defined_idents', used_idents' = @@ -161,8 +166,12 @@ let record_scope_pass = (* mark which param is used *) params |> List.iteri (fun i v -> - if not (Set_ident.mem used_idents' v) then - Js_fun_env.mark_unused env i); + if + not + (List.exists + (fun ident -> Set_ident.mem used_idents' ident) + (J.param_idents v)) + then Js_fun_env.mark_unused env i); let closured_idents' = (* pass param_set down *) Set_ident.(diff used_idents' (union defined_idents' param_set)) @@ -189,25 +198,32 @@ let record_scope_pass = (fun self state x -> match x with | {ident; value; property} -> ( + let record_rest_idents = + match value with + | Some {expression_desc = Record_rest (fields, _)} -> + J.record_rest_field_idents fields + | _ -> [] + in let obj = - add_defined_ident - (match (state.in_loop, property) with - | true, Variable -> add_loop_mutable_variable state ident - | true, (Strict | StrictOpt | Alias) - (* Not real true immutable in javascript + add_defined_idents + (add_defined_ident + (match (state.in_loop, property) with + | true, Variable -> add_loop_mutable_variable state ident + | true, (Strict | StrictOpt | Alias) + (* Not real true immutable in javascript since it's in the loop TODO: we should also *) - -> ( - match value with - | None -> - add_loop_mutable_variable state ident - (* TODO: Check why assertion failure *) - (* self#add_loop_mutable_variable ident *) - (* assert false *) - | Some x -> ( - (* + -> ( + match value with + | None -> + add_loop_mutable_variable state ident + (* TODO: Check why assertion failure *) + (* self#add_loop_mutable_variable ident *) + (* assert false *) + | Some x -> ( + (* when x is an immediate immutable value, (like integer .. ) not a reference, it should be Immutable @@ -215,22 +231,23 @@ let record_scope_pass = type system might help here TODO: *) - match x.expression_desc with - | Fun _ | Number _ | Str _ -> state - | _ -> - (* if Set_ident.(is_empty @@ *) - (* inter self#get_mutable_values *) - (* ( ({< *) - (* defined_idents = Set_ident.empty; *) - (* used_idents = Set_ident.empty; *) - (* >} # expression x) # get_used_idents)) then *) - (* (\* FIXME: still need to check expression is pure or not*\) *) - (* self *) - (* else *) - add_loop_mutable_variable state ident)) - | false, Variable -> add_mutable_variable state ident - | false, (Strict | StrictOpt | Alias) -> state) - ident + match x.expression_desc with + | Fun _ | Number _ | Str _ -> state + | _ -> + (* if Set_ident.(is_empty @@ *) + (* inter self#get_mutable_values *) + (* ( ({< *) + (* defined_idents = Set_ident.empty; *) + (* used_idents = Set_ident.empty; *) + (* >} # expression x) # get_used_idents)) then *) + (* (\* FIXME: still need to check expression is pure or not*\) *) + (* self *) + (* else *) + add_loop_mutable_variable state ident)) + | false, Variable -> add_mutable_variable state ident + | false, (Strict | StrictOpt | Alias) -> state) + ident) + record_rest_idents in match value with | None -> obj diff --git a/compiler/core/js_pass_tailcall_inline.ml b/compiler/core/js_pass_tailcall_inline.ml index 5a92b05cac1..b60b4cf8919 100644 --- a/compiler/core/js_pass_tailcall_inline.ml +++ b/compiler/core/js_pass_tailcall_inline.ml @@ -78,6 +78,11 @@ let inline_call (immutable_list : bool list) params (args : J.expression list) let obj = substitue_variables map in obj.block obj block +let simple_params_exn params = + match J.params_as_idents params with + | Some params -> params + | None -> assert false + (** There is a side effect when traversing dead code, since we assume that substitue a node would mark a node as dead node, @@ -182,13 +187,16 @@ let subst (export_set : Set_ident.t) stats = ident_info = {used_stats = Once_pure}; ident = _; } as v) - when Ext_list.same_length params args -> + when match J.params_as_idents params with + | Some params -> Ext_list.same_length params args + | None -> false -> Js_op_util.update_used_stats v.ident_info Dead_pure; let no_tailcall = Js_fun_env.no_tailcall env in let processed_blocks = self.block self body (* see #278 before changes*) in + let params = simple_params_exn params in inline_call no_tailcall params args processed_blocks (* Ext_list.fold_right2 params args processed_blocks @@ -222,12 +230,15 @@ let subst (export_set : Set_ident.t) stats = }; }; ] - when Ext_list.same_length params args -> + when match J.params_as_idents params with + | Some params -> Ext_list.same_length params args + | None -> false -> let no_tailcall = Js_fun_env.no_tailcall env in let processed_blocks = self.block self body (* see #278 before changes*) in + let params = simple_params_exn params in inline_call no_tailcall params args processed_blocks | x :: xs -> self.statement self x :: self.block self xs | [] -> []); diff --git a/compiler/core/js_record_fold.ml b/compiler/core/js_record_fold.ml index d3e0de74358..994ca79b177 100644 --- a/compiler/core/js_record_fold.ml +++ b/compiler/core/js_record_fold.ml @@ -89,6 +89,21 @@ let property_map : 'a. ('a, property_map) fn = let length_object : 'a. ('a, length_object) fn = unknown +let record_rest_field : 'a. ('a, record_rest_field) fn = + fun _self st {record_rest_ident; _} -> + option _self.ident _self st record_rest_ident + +let object_rest_param : 'a. ('a, object_rest_param) fn = + fun _self st {object_rest_fields; object_rest_rest} -> + let st = list record_rest_field _self st object_rest_fields in + let st = _self.ident _self st object_rest_rest in + st + +let param : 'a. ('a, param) fn = + fun _self st -> function + | Ident_param id -> _self.ident _self st id + | Object_rest_param rest -> object_rest_param _self st rest + let expression_desc : 'a. ('a, expression_desc) fn = fun _self st -> function | Length (_x0, _x1) -> @@ -165,7 +180,7 @@ let expression_desc : 'a. ('a, expression_desc) fn = let st = _self.vident _self st _x0 in st | Fun {params; body} -> - let st = list _self.ident _self st params in + let st = list param _self st params in let st = _self.block _self st body in st | Str _ -> st @@ -196,6 +211,9 @@ let expression_desc : 'a. ('a, expression_desc) fn = | Spread _x0 -> let st = _self.expression _self st _x0 in st + | Record_rest (_x0, _x1) -> + let st = _self.expression _self st _x1 in + st let for_ident_expression : 'a. ('a, for_ident_expression) fn = fun _self arg -> _self.expression _self arg diff --git a/compiler/core/js_record_iter.ml b/compiler/core/js_record_iter.ml index da86618ae3c..f925e5ab370 100644 --- a/compiler/core/js_record_iter.ml +++ b/compiler/core/js_record_iter.ml @@ -79,6 +79,19 @@ let property_map : property_map fn = let length_object : length_object fn = unknown +let record_rest_field : record_rest_field fn = + fun _self {record_rest_ident; _} -> option _self.ident _self record_rest_ident + +let object_rest_param : object_rest_param fn = + fun _self {object_rest_fields; object_rest_rest} -> + list record_rest_field _self object_rest_fields; + _self.ident _self object_rest_rest + +let param : param fn = + fun _self -> function + | Ident_param id -> _self.ident _self id + | Object_rest_param rest -> object_rest_param _self rest + let expression_desc : expression_desc fn = fun _self -> function | Length (_x0, _x1) -> @@ -127,7 +140,7 @@ let expression_desc : expression_desc fn = option (fun _self arg -> list _self.expression _self arg) _self _x1 | Var _x0 -> _self.vident _self _x0 | Fun {params; body} -> - list _self.ident _self params; + list param _self params; _self.block _self body | Str _ -> () | Raw_js_code _ -> () @@ -145,6 +158,7 @@ let expression_desc : expression_desc fn = | Null -> () | Await _x0 -> _self.expression _self _x0 | Spread _x0 -> _self.expression _self _x0 + | Record_rest (_x0, _x1) -> _self.expression _self _x1 let for_ident_expression : for_ident_expression fn = fun _self arg -> _self.expression _self arg diff --git a/compiler/core/js_record_map.ml b/compiler/core/js_record_map.ml index 26551861718..4e1d19deb62 100644 --- a/compiler/core/js_record_map.ml +++ b/compiler/core/js_record_map.ml @@ -89,6 +89,26 @@ let property_map : property_map fn = let length_object : length_object fn = unknown +let record_rest_field : record_rest_field fn = + fun _self ({record_rest_ident} as field) -> + let record_rest_ident = option _self.ident _self record_rest_ident in + {field with record_rest_ident} + +let object_rest_param : object_rest_param fn = + fun _self {object_rest_fields; object_rest_rest} -> + let object_rest_fields = list record_rest_field _self object_rest_fields in + let object_rest_rest = _self.ident _self object_rest_rest in + {object_rest_fields; object_rest_rest} + +let param : param fn = + fun _self -> function + | Ident_param id -> + let id = _self.ident _self id in + Ident_param id + | Object_rest_param rest -> + let rest = object_rest_param _self rest in + Object_rest_param rest + let expression_desc : expression_desc fn = fun _self -> function | Length (_x0, _x1) -> @@ -163,7 +183,7 @@ let expression_desc : expression_desc fn = let _x0 = _self.vident _self _x0 in Var _x0 | Fun ({params; body} as fun_) -> - let params = list _self.ident _self params in + let params = list param _self params in let body = _self.block _self body in Fun {fun_ with params; body} | Str _ as v -> v @@ -194,6 +214,9 @@ let expression_desc : expression_desc fn = | Spread _x0 -> let _x0 = _self.expression _self _x0 in Spread _x0 + | Record_rest (_x0, _x1) -> + let _x1 = _self.expression _self _x1 in + Record_rest (_x0, _x1) let for_ident_expression : for_ident_expression fn = fun _self arg -> _self.expression _self arg diff --git a/compiler/core/lam_compile_main.cppo.ml b/compiler/core/lam_compile_main.cppo.ml index cdecf32ef8e..115b2bc5248 100644 --- a/compiler/core/lam_compile_main.cppo.ml +++ b/compiler/core/lam_compile_main.cppo.ml @@ -256,6 +256,8 @@ js |> _j "external_shadow" |> Js_pass_tailcall_inline.tailcall_inline |> _j "inline_and_shake" +|> Js_pass_record_rest.program +|> _j "record_rest" |> Js_pass_flatten_and_mark_dead.program |> _j "flatten_and_mark_dead" (* |> Js_inline_and_eliminate.inline_and_shake *) diff --git a/compiler/core/lam_compile_primitive.ml b/compiler/core/lam_compile_primitive.ml index 9dfffa9fc08..13f1fe9fa5c 100644 --- a/compiler/core/lam_compile_primitive.ml +++ b/compiler/core/lam_compile_primitive.ml @@ -612,26 +612,12 @@ let translate output_prefix loc (cxt : Lam_compile_context.t) | Precord_rest excluded -> ( match args with | [e1] -> - (* Generate: (({field1: __unused0, ...__rest}) => __rest)(source) - This uses JS destructuring to cleanly extract the rest while - safely handling quoted property names and the empty-exclusion case. *) - let excluded_bindings = - List.mapi - (fun i field -> - let field = Js_dump_property.property_key (Js_op.Lit field) in - Printf.sprintf "%s: __unused%d" field i) - excluded - in - let destructured = - match excluded_bindings with - | [] -> "...__rest" - | _ -> String.concat ", " excluded_bindings ^ ", ...__rest" - in - let code = Printf.sprintf "(({%s}) => __rest)" destructured 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] + E.record_rest + (List.map + (fun record_rest_label -> + {J.record_rest_label; record_rest_ident = None}) + excluded) + e1 | _ -> assert false) | Phash -> ( match args with 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 index 30d52282aef..f3343bc01d8 100644 --- 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 @@ -1,5 +1,5 @@ - Warning number 111 + Warning number 112 /.../fixtures/record_rest_empty_warning.res:3:16-26 1 │ type source = {a: int, b?: string} @@ -7,4 +7,4 @@ 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 + All fields of the rest type are already present in the explicit pattern. The rest record will always be empty. diff --git a/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected b/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected index 3058651a5cc..36391ac4e88 100644 --- a/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected +++ b/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected @@ -3,8 +3,8 @@ /.../fixtures/record_rest_private_type.res:9:12-14 7 │ type source = {a: int, b: string} - 8 │ + 8 │ 9 │ let {a, ...M.t as rest} = ({a: 1, b: "x"}: source) - 10 │ + 10 │ - Cannot create values of the private type M.t \ No newline at end of file + Cannot create values of the private type M.t diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index afdcfc397a7..7320eb231cc 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -6,79 +6,86 @@ import * as Test_utils from "./test_utils.mjs"; let SubConfig = {}; function describeConfig(c) { - let rest = ((({name: __unused0, ...__rest}) => __rest))(c); + let {name, ...rest} = c; return [ - c.name, + name, rest ]; } -function getAliasedRest(param) { - return ((({name: __unused0, ...__rest}) => __rest))(param); +function getNameAndSubConfig({name, ...subConfig}) { + return [ + name, + subConfig + ]; } -function getNamespacedRest(param) { - return ((({name: __unused0, ...__rest}) => __rest))(param); +function getAliasedRest({name: __unused0, ...rest}) { + return rest; } -function getRenamedRest(param) { - return ((({"user-name": __unused0, ...__rest}) => __rest))(param); +function getNamespacedRest({name: __unused0, ...rest}) { + return rest; +} + +function getRenamedRest({"user-name": __unused0, ...rest}) { + return rest; } function getName(param) { return param.name; } -function getWholeConfig(param) { - return ((({...__rest}) => __rest))(param); +function getWholeConfig({...rest}) { + return rest; } -function extractClassName(param) { - return ((({className: __unused0, ...__rest}) => __rest))(param); +function extractClassName({className: __unused0, ...rest}) { + return rest; } -function getValue(param) { - return ((({id: __unused0, ...__rest}) => __rest))(param); +function getValue({id: __unused0, ...rest}) { + return rest; } function getTupleRest(param) { - return ((({name: __unused0, ...__rest}) => __rest))(param[0]); + return (({name: __unused0, ...__rest}) => __rest)(param[0]); } function getWrappedRest(wrapped) { - return ((({name: __unused0, ...__rest}) => __rest))(wrapped._0); + return (({name: __unused0, ...__rest}) => __rest)(wrapped._0); } function getInlineWrappedRest(wrapped) { - return ((({TAG: __unused0, name: __unused1, ...__rest}) => __rest))(wrapped); + return (({TAG: __unused0, name: __unused1, ...__rest}) => __rest)(wrapped); } function getRenamedInlineWrappedRest(wrapped) { - return ((({TAG: __unused0, "user-name": __unused1, ...__rest}) => __rest))(wrapped); + return (({TAG: __unused0, "user-name": __unused1, ...__rest}) => __rest)(wrapped); } function getCustomTaggedInlineWrappedRest(wrapped) { - return ((({kind: __unused0, name: __unused1, ...__rest}) => __rest))(wrapped); + return (({kind: __unused0, name: __unused1, ...__rest}) => __rest)(wrapped); } function getDashedTaggedInlineWrappedRest(wrapped) { - return ((({"custom-tag": __unused0, name: __unused1, ...__rest}) => __rest))(wrapped); + return (({"custom-tag": __unused0, name: __unused1, ...__rest}) => __rest)(wrapped); } Mocha.describe("Record_rest_test", () => { Mocha.test("let binding captures record rest value", () => { - let rest = ((({name: __unused0, ...__rest}) => __rest))({ + let {name: __unused0, ...rest} = { name: "test", version: "1.0", debug: true - }); - Test_utils.eq("File \"record_rest_test.res\", line 136, characters 7-14", "test", "test"); - Test_utils.eq("File \"record_rest_test.res\", line 137, characters 7-14", rest, { + }; + Test_utils.eq("File \"record_rest_test.res\", line 138, characters 7-14", "test", "test"); + Test_utils.eq("File \"record_rest_test.res\", line 139, 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 142, characters 6-13", describeConfig({ + Mocha.test("match arm returns the named field and the rest record", () => Test_utils.eq("File \"record_rest_test.res\", line 144, characters 6-13", describeConfig({ name: "match", version: "2.0", debug: false @@ -89,12 +96,12 @@ Mocha.describe("Record_rest_test", () => { debug: false } ])); - Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 149, characters 7-14", getName({ + Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 151, characters 7-14", getName({ name: "param", version: "3.0", debug: true }), "param")); - Mocha.test("record rest accepts type aliases to record shapes", () => Test_utils.eq("File \"record_rest_test.res\", line 154, characters 6-13", getAliasedRest({ + Mocha.test("record rest accepts type aliases to record shapes", () => Test_utils.eq("File \"record_rest_test.res\", line 156, characters 6-13", getAliasedRest({ name: "aliased", version: "3.1", debug: false @@ -103,7 +110,7 @@ Mocha.describe("Record_rest_test", () => { debug: false })); Mocha.test("record rest accepts namespaced record types", () => { - Test_utils.eq("File \"record_rest_test.res\", line 162, characters 6-13", getNamespacedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 164, characters 6-13", getNamespacedRest({ name: "namespaced", version: "3.15", debug: true @@ -111,17 +118,17 @@ Mocha.describe("Record_rest_test", () => { version: "3.15", debug: true }); - let rest = ((({name: __unused0, ...__rest}) => __rest))({ + let {name: __unused0, ...rest} = { name: "namespaced-let", version: "3.16", debug: false - }); - Test_utils.eq("File \"record_rest_test.res\", line 174, characters 7-14", rest, { + }; + Test_utils.eq("File \"record_rest_test.res\", line 176, characters 7-14", rest, { version: "3.16", debug: false }); }); - Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 179, characters 6-13", getRenamedRest({ + Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 181, characters 6-13", getRenamedRest({ "user-name": "renamed", version: "3.2", debug: true @@ -129,7 +136,7 @@ Mocha.describe("Record_rest_test", () => { version: "3.2", debug: true })); - Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 187, characters 6-13", ((({...__rest}) => __rest))({ + Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 189, characters 6-13", (({...__rest}) => __rest)({ name: "whole", version: "3.5", debug: false @@ -144,13 +151,13 @@ Mocha.describe("Record_rest_test", () => { version: "3.6", debug: true }; - let rest = ((({...__rest}) => __rest))(whole); - Test_utils.eq("File \"record_rest_test.res\", line 195, characters 7-14", whole, { + let {...rest} = whole; + Test_utils.eq("File \"record_rest_test.res\", line 197, characters 7-14", whole, { name: "wholeAlias", version: "3.6", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 196, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 198, characters 7-14", rest, { name: "wholeAlias", version: "3.6", debug: true @@ -163,28 +170,28 @@ Mocha.describe("Record_rest_test", () => { style: "bold", onClick: onClick }); - Test_utils.eq("File \"record_rest_test.res\", line 202, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 204, characters 7-14", rest, { style: "bold", onClick: onClick }); }); Mocha.test("polymorphic rest captures the value field", () => { - let intRest = ((({id: __unused0, ...__rest}) => __rest))({ + let {id: __unused0, ...intRest} = { id: "1", value: 42 - }); - Test_utils.eq("File \"record_rest_test.res\", line 207, characters 7-14", "1", "1"); - Test_utils.eq("File \"record_rest_test.res\", line 208, characters 7-14", intRest, { + }; + Test_utils.eq("File \"record_rest_test.res\", line 209, characters 7-14", "1", "1"); + Test_utils.eq("File \"record_rest_test.res\", line 210, characters 7-14", intRest, { value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 209, characters 7-14", ((({id: __unused0, ...__rest}) => __rest))({ + Test_utils.eq("File \"record_rest_test.res\", line 211, characters 7-14", (({id: __unused0, ...__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 214, characters 6-13", getTupleRest([ + Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 216, characters 6-13", getTupleRest([ { name: "tuple", version: "4.0", @@ -196,7 +203,7 @@ Mocha.describe("Record_rest_test", () => { debug: false })); Mocha.test("variant payload rest works through the or-pattern path", () => { - Test_utils.eq("File \"record_rest_test.res\", line 222, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 224, characters 6-13", getWrappedRest({ TAG: "Wrap", _0: { name: "wrapped", @@ -207,7 +214,7 @@ Mocha.describe("Record_rest_test", () => { version: "5.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 227, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 229, characters 6-13", getWrappedRest({ TAG: "Mirror", _0: { name: "mirror", @@ -220,7 +227,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes the runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 235, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 237, characters 6-13", getInlineWrappedRest({ TAG: "InlineWrap", name: "inline", version: "7.0", @@ -229,7 +236,7 @@ Mocha.describe("Record_rest_test", () => { version: "7.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 240, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 242, characters 6-13", getInlineWrappedRest({ TAG: "InlineMirror", name: "inlineMirror", version: "8.0", @@ -240,7 +247,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest excludes fields renamed with @as", () => { - Test_utils.eq("File \"record_rest_test.res\", line 248, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 250, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineWrap", "user-name": "inlineRenamed", version: "8.5", @@ -249,7 +256,7 @@ Mocha.describe("Record_rest_test", () => { version: "8.5", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 255, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 257, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineMirror", "user-name": "inlineRenamed2", version: "8.6", @@ -260,7 +267,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes a custom runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 265, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 267, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineWrap", name: "customInline", version: "9.0", @@ -269,7 +276,7 @@ Mocha.describe("Record_rest_test", () => { version: "9.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 272, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 274, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineMirror", name: "customInlineMirror", version: "10.0", @@ -280,7 +287,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record rest works with a non-identifier custom tag name", () => { - Test_utils.eq("File \"record_rest_test.res\", line 282, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 284, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineWrap", name: "dashedInline", version: "11.0", @@ -289,7 +296,7 @@ Mocha.describe("Record_rest_test", () => { version: "11.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 289, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 291, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineMirror", name: "dashedInlineMirror", version: "12.0", @@ -304,6 +311,7 @@ Mocha.describe("Record_rest_test", () => { export { SubConfig, describeConfig, + getNameAndSubConfig, getAliasedRest, getNamespacedRest, getRenamedRest, diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index 68bd07c8aa3..c58d714900b 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -33,6 +33,8 @@ let describeConfig = (c: config) => | {name, ...subConfig as rest} => (name, rest) } +let getNameAndSubConfig = ({name, ...subConfig as subConfig}: config) => (name, subConfig) + let getAliasedRest = ({name: _, ...aliasedSubConfig as rest}: config) => rest let getNamespacedRest = ({name: _, ...SubConfig.t as rest}: config) => rest diff --git a/tests/tools_tests/src/expected/ZRecordRest.res.jsout b/tests/tools_tests/src/expected/ZRecordRest.res.jsout index d5248cb5beb..75da4bbdf89 100644 --- a/tests/tools_tests/src/expected/ZRecordRest.res.jsout +++ b/tests/tools_tests/src/expected/ZRecordRest.res.jsout @@ -2,10 +2,9 @@ 'use strict'; -function extract(param) { - let rest = ((({name: __unused0, ...__rest}) => __rest))(param); +function extract({name, ...rest}) { return [ - param.name, + name, rest ]; } From 88378e1fe27361a3a9a2903d270ccf7dcd192c82 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 17 Jun 2026 11:33:31 +0200 Subject: [PATCH 23/47] update changelog --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1b29e9179d2..bd6bd8940da 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -24,6 +24,7 @@ - Add a first-class `taggedTemplate<'param, 'output>` builtin type and the `TaggedTemplate` stdlib module (`TaggedTemplate.make`). Tagged-template tags are now tracked through the type system, so they emit real JS tagged-template syntax across module boundaries, when passed as first-class values, and when constructed at runtime by a factory (e.g. `postgres`). https://github.com/rescript-lang/rescript/pull/8461 - Make mutation of private record mutable fields a configurable warning instead of a hard error. https://github.com/rescript-lang/rescript/pull/8366 +- Add support for pattern matching/destructuring of record rest. https://github.com/rescript-lang/rescript/pull/8317 #### :bug: Bug fix @@ -118,7 +119,6 @@ - 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 - Support inline records in external definitions. https://github.com/rescript-lang/rescript/pull/8304 -- Add support for pattern matching/destructuring of record rest. https://github.com/rescript-lang/rescript/pull/8317 #### :bug: Bug fix From ef5a66a833d1230f3524a0a345166337e8ed20a7 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 17 Jun 2026 16:35:25 +0200 Subject: [PATCH 24/47] remove leading _ of used variable --- compiler/ml/depend.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index d89fb0a0b63..8a3680bb183 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -179,13 +179,13 @@ let rec add_pattern bv pat = | Ppat_construct (c, op) -> add bv c; add_opt add_pattern bv op - | Ppat_record (pl, _, _rest) -> + | Ppat_record (pl, _, rest) -> List.iter (fun {lid = lbl; x = p} -> add bv lbl; add_pattern bv p) pl; - add_opt (fun bv {rest_type; _} -> add_opt add_type bv rest_type) bv _rest + add_opt (fun bv {rest_type; _} -> add_opt add_type bv rest_type) bv rest | Ppat_array pl -> List.iter (add_pattern bv) pl | Ppat_or (p1, p2) -> add_pattern bv p1; From 0029c8382cc4073536b0bb24688b91f2dc81177f Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 17 Jun 2026 16:36:10 +0200 Subject: [PATCH 25/47] add more tests --- tests/ERROR_VARIANTS.md | 3 +- tests/analysis_tests/tests/src/RecordRest.res | 1 + .../tests/src/expected/RecordRest.res.txt | 22 ++ ...d_rest_field_missing_singular.res.expected | 13 ++ ...est_field_not_optional_plural.res.expected | 14 ++ ...cord_rest_type_arity_mismatch.res.expected | 11 + ...ord_rest_unresolved_rest_type.res.expected | 10 + .../record_rest_field_missing_singular.res | 3 + .../record_rest_field_not_optional_plural.res | 3 + .../record_rest_type_arity_mismatch.res | 3 + .../record_rest_unresolved_rest_type.res | 3 + tests/ounit_tests/ounit_js_analyzer_tests.ml | 193 ++++++++++++++++++ tests/tests/src/record_rest_test.mjs | 115 ++++++++--- tests/tests/src/record_rest_test.res | 32 +++ 14 files changed, 399 insertions(+), 27 deletions(-) create mode 100644 tests/build_tests/super_errors/expected/record_rest_field_missing_singular.res.expected create mode 100644 tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected create mode 100644 tests/build_tests/super_errors/expected/record_rest_type_arity_mismatch.res.expected create mode 100644 tests/build_tests/super_errors/expected/record_rest_unresolved_rest_type.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_field_missing_singular.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_field_not_optional_plural.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_type_arity_mismatch.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_unresolved_rest_type.res diff --git a/tests/ERROR_VARIANTS.md b/tests/ERROR_VARIANTS.md index 5a4b068e55b..514275260c8 100644 --- a/tests/ERROR_VARIANTS.md +++ b/tests/ERROR_VARIANTS.md @@ -241,6 +241,7 @@ Source: [typecore.ml:27](../compiler/ml/typecore.ml). | `Empty_record_literal` | ✓ | `empty_record_literal.res` | | | `Uncurried_arity_mismatch` | ✓ | `arity_mismatch3.res` etc. | | | `Field_not_optional` | ✓ | `fieldNotOptional.res` | | +| `Record_rest` | ✓ | `record_rest_*.res` | Wrapper for record-rest validation errors reported by `typecore_record_rest.ml`; fixtures cover missing annotation, invalid rest type, non-record and unresolved rest types, private rest type, field mismatch/missing/extra cases, runtime-name mismatch, empty-rest warning, module destructure rejection, and singular/plural missing and overlap messages. | | `Type_params_not_supported` | ✓ | `variant_spread_pattern_type_params.res` | Pattern-level variant spread (`| ...a as v`) where `a` has type params; typedecl path covered by `variant_spread_type_parameters.res`. | | `Field_access_on_dict_type` | ✓ | `field_access_on_dict_type.res` | | | `Jsx_not_enabled` | ☐ (needs harness flag) | — | typecore.ml:218/3470. Fires when JSX is used without `-bs-jsx N`. The `super_errors` runner hard-codes `-bs-jsx 4` in `bscFlags`; adding a per-fixture opt-out (e.g. a `.opts` sidecar) would expose this. Until then, it's reachable in real code but blocked at the harness level. | @@ -327,7 +328,7 @@ Type-expression errors. Source: [typetexp.ml:28](../compiler/ml/typetexp.ml). | `Unbound_type_variable` | ✓ | (covered indirectly via many fixtures) | | | `Unbound_type_constructor` | ✓ | `typetexp_unbound_type_constructor.res` | | | `Unbound_type_constructor_2` | ✓ | `incomplete_type_constructor_polyvariant.res`, `incomplete_type_constructor_object.res` | Identity alias `type t<'a> = 'a` used in an inherit position with a type-variable arg; `expand_head` collapses `t<'b>` to a bare `Tvar` while the repr stays `Tconstr`. Reachable from poly-variant inherit and object spread. | -| `Type_arity_mismatch` | ✓ | `type_arity_mismatch.res` | | +| `Type_arity_mismatch` | ✓ | `type_arity_mismatch.res`, `record_rest_type_arity_mismatch.res` | | | `Type_mismatch` | ✓ | `typetexp_type_mismatch.res` | Type-constructor application that violates a `constraint 'a = …` on the declaration. | | `Alias_type_mismatch` | ✓ | `typetexp_alias_type_mismatch.res` | | | `Present_has_conjunction` | ✓ | `polyvariant_present_has_conjunction.res` | `[< #A(int) & (string) > #A]` — `<` syntax marks `#A` as a "present" tag, and the body has both `(int)` and `& (string)` types, so the conjunctive payload triggers the check at line 451. | diff --git a/tests/analysis_tests/tests/src/RecordRest.res b/tests/analysis_tests/tests/src/RecordRest.res index 54e3eb86b43..a0e2a5373cc 100644 --- a/tests/analysis_tests/tests/src/RecordRest.res +++ b/tests/analysis_tests/tests/src/RecordRest.res @@ -11,6 +11,7 @@ let getVersion = (config: config) => } let {name: _, ...SubConfig.t as localRest} = {name: "v", version: "1"} +// ^ast //^hin //^hig diff --git a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt index ead063dceda..6d7cadcec09 100644 --- a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt +++ b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt @@ -7,6 +7,28 @@ Definition src/RecordRest.res 8:4 "uri": "file:///RecordRest.res" } +Dump AST src/RecordRest.res 12:19 + +Source: +// let {name: _, ...SubConfig.t as localRest} = {name: "v", version: "1"} +// ^ast + +<*>Pstr_value( + value: + <*>Ppat_record( + fields: + name: Ppat_any + rest: + localRest as <*>Ptyp_constr(<*>SubConfig.t) + ) + expr: + Pexp_record( + fields: + name: Pexp_constant(Pconst_string(v)) + version: Pexp_constant(Pconst_string(1)) + ) +) + Inlay Hint src/RecordRest.res 1:34 [ { diff --git a/tests/build_tests/super_errors/expected/record_rest_field_missing_singular.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_missing_singular.res.expected new file mode 100644 index 00000000000..8531afb9f01 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_field_missing_singular.res.expected @@ -0,0 +1,13 @@ + + We've found a bug for you! + /.../fixtures/record_rest_field_missing_singular.res:3:12-22 + + 1 │ type source = {a: int, b: string, c: bool} + 2 │ type sub = {b: string} + 3 │ let {a, ...sub as rest} = ({a: 1, b: "x", c: true}: source) + 4 │ + + The following field is not part of the rest type `sub`: +- c + +List this field in the record pattern before the spread so it's 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_plural.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected new file mode 100644 index 00000000000..573f87e46b7 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected @@ -0,0 +1,14 @@ + + We've found a bug for you! + /.../fixtures/record_rest_field_not_optional_plural.res:3:15-25 + + 1 │ type source = {a?: int, b?: string, c: bool} + 2 │ type sub = {a?: int, b?: string} + 3 │ let {a, b, ...sub as rest}: source = {c: true} + 4 │ + + The following fields appear in both the explicit pattern and the rest type `sub`: +- a +- b + +Mark them as optional (e.g. `?fieldName`) in the explicit pattern. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_type_arity_mismatch.res.expected b/tests/build_tests/super_errors/expected/record_rest_type_arity_mismatch.res.expected new file mode 100644 index 00000000000..578d7b874e3 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_type_arity_mismatch.res.expected @@ -0,0 +1,11 @@ + + We've found a bug for you! + /.../fixtures/record_rest_type_arity_mismatch.res:3:16-19 + + 1 │ type source<'a> = {id: string, value: 'a} + 2 │ type rest<'a> = {value: 'a} + 3 │ let {id: _, ...rest as value} = ({id: "x", value: 1}: sourc + │ e) + 4 │ + + The type constructor `rest` expects 1 type argument, but is given 2 \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_unresolved_rest_type.res.expected b/tests/build_tests/super_errors/expected/record_rest_unresolved_rest_type.res.expected new file mode 100644 index 00000000000..eeaa9882dc2 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_unresolved_rest_type.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/record_rest_unresolved_rest_type.res:3:12-15 + + 1 │ type source = {a: int, b: string} + 2 │ type rest + 3 │ let {a, ...rest as value} = ({a: 1, b: "x"}: source) + 4 │ + + Type rest 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/fixtures/record_rest_field_missing_singular.res b/tests/build_tests/super_errors/fixtures/record_rest_field_missing_singular.res new file mode 100644 index 00000000000..da285704e4c --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_field_missing_singular.res @@ -0,0 +1,3 @@ +type source = {a: int, b: string, c: bool} +type sub = {b: string} +let {a, ...sub as rest} = ({a: 1, b: "x", c: true}: source) diff --git a/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional_plural.res b/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional_plural.res new file mode 100644 index 00000000000..a52ca15b596 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional_plural.res @@ -0,0 +1,3 @@ +type source = {a?: int, b?: string, c: bool} +type sub = {a?: int, b?: string} +let {a, b, ...sub as rest}: source = {c: true} diff --git a/tests/build_tests/super_errors/fixtures/record_rest_type_arity_mismatch.res b/tests/build_tests/super_errors/fixtures/record_rest_type_arity_mismatch.res new file mode 100644 index 00000000000..52667f6265d --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_type_arity_mismatch.res @@ -0,0 +1,3 @@ +type source<'a> = {id: string, value: 'a} +type rest<'a> = {value: 'a} +let {id: _, ...rest as value} = ({id: "x", value: 1}: source) diff --git a/tests/build_tests/super_errors/fixtures/record_rest_unresolved_rest_type.res b/tests/build_tests/super_errors/fixtures/record_rest_unresolved_rest_type.res new file mode 100644 index 00000000000..d6617a043e3 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_unresolved_rest_type.res @@ -0,0 +1,3 @@ +type source = {a: int, b: string} +type rest +let {a, ...rest as value} = ({a: 1, b: "x"}: source) diff --git a/tests/ounit_tests/ounit_js_analyzer_tests.ml b/tests/ounit_tests/ounit_js_analyzer_tests.ml index 6a595cfd1a0..8e8ea239e6b 100644 --- a/tests/ounit_tests/ounit_js_analyzer_tests.ml +++ b/tests/ounit_tests/ounit_js_analyzer_tests.ml @@ -3,6 +3,16 @@ let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: )) let pure_iterable = Js_exp_make.var (Ident.create "iterable") let empty_body = [] +let record_rest_expression source field = + Js_exp_make.record_rest + [{J.record_rest_label = "name"; record_rest_ident = Some field}] + (Js_exp_make.var source) + +let record_rest_expression_without_idents source = + Js_exp_make.record_rest + [{J.record_rest_label = "name"; record_rest_ident = None}] + (Js_exp_make.var source) + let for_of_statement = { J.statement_desc = @@ -17,6 +27,48 @@ let for_await_of_statement = comment = None; } +let record_rest_statement ~source ~field ~rest = + Js_stmt_make.define_variable ~kind:Lam_compat.Strict rest + (record_rest_expression source field) + +let function_expression param body = + { + J.expression_desc = + Fun + { + is_method = false; + params = [Ident_param param]; + body; + env = Js_fun_env.make 1; + return_unit = false; + async = false; + directive = None; + }; + comment = None; + } + +let transform_expression expression = + let fn = Ident.create "fn" in + let program = + Js_pass_record_rest.program + { + J.block = + [Js_stmt_make.define_variable ~kind:Lam_compat.Strict fn expression]; + exports = []; + export_set = Set_ident.empty; + } + in + match program.block with + | [ + { + statement_desc = + Variable {value = Some ({expression_desc = Fun _; _} as expression); _}; + _; + }; + ] -> + expression + | _ -> OUnit.assert_failure __LOC__ + let suites = __FILE__ >::: [ @@ -27,4 +79,145 @@ let suites = OUnit.assert_bool __LOC__ (not (Js_analyzer.no_side_effect_statement for_await_of_statement)) ); + ( __LOC__ >:: fun _ -> + let source = Ident.create "source" in + let field = Ident.create "name" in + OUnit.assert_bool __LOC__ + (not + (Js_analyzer.no_side_effect_expression + (record_rest_expression source field))) ); + ( __LOC__ >:: fun _ -> + let source = Ident.create "source" in + let field = Ident.create "name" in + OUnit.assert_bool __LOC__ + (not + (Js_analyzer.eq_expression + (record_rest_expression source field) + (record_rest_expression source field))) ); + ( __LOC__ >:: fun _ -> + let source = Ident.create "source" in + let field = Ident.create "name" in + let rest = Ident.create "rest" in + let free = + Js_analyzer.free_variables_of_statement + (record_rest_statement ~source ~field ~rest) + in + OUnit.assert_bool __LOC__ (Set_ident.mem free source); + OUnit.assert_bool __LOC__ (not (Set_ident.mem free field)); + OUnit.assert_bool __LOC__ (not (Set_ident.mem free rest)) ); + ( __LOC__ >:: fun _ -> + let field = Ident.create "name" in + let rest = Ident.create "rest" in + let folder = + { + Js_record_fold.super with + ident = (fun _ names ident -> Ident.name ident :: names); + } + in + let names = + Js_record_fold.param folder [] + (Object_rest_param + { + object_rest_fields = + [ + { + record_rest_label = "name"; + record_rest_ident = Some field; + }; + ]; + object_rest_rest = rest; + }) + in + OUnit.assert_equal ["rest"; "name"] names; + OUnit.assert_equal ["name"] + (Js_record_fold.param folder [] (Ident_param field)) ); + ( __LOC__ >:: fun _ -> + let param = Ident.create "param" in + let transformed = + transform_expression + (function_expression param + [ + Js_stmt_make.return_stmt + (record_rest_expression_without_idents param); + ]) + in + match transformed.expression_desc with + | Fun + { + params = + [ + Object_rest_param + { + object_rest_fields = + [ + { + record_rest_label = "name"; + record_rest_ident = Some ignored; + }; + ]; + object_rest_rest = rest; + }; + ]; + body = + [ + { + statement_desc = + Return {expression_desc = Var (Id returned); _}; + _; + }; + ]; + _; + } -> + OUnit.assert_equal "__unused0" (Ident.name ignored); + OUnit.assert_equal "rest" (Ident.name rest); + OUnit.assert_bool __LOC__ (Ident.same rest returned) + | _ -> OUnit.assert_failure __LOC__ ); + ( __LOC__ >:: fun _ -> + let rest = Ident.create "rest" in + let program = + Js_pass_record_rest.program + { + J.block = + [ + Js_stmt_make.define_variable ~kind:Lam_compat.Strict rest + (Js_exp_make.record_rest + [ + { + record_rest_label = "name"; + record_rest_ident = None; + }; + ] + {expression_desc = Object (None, []); comment = None}); + ]; + exports = []; + export_set = Set_ident.empty; + } + in + match program.block with + | [ + { + statement_desc = + Variable + { + value = + Some + { + expression_desc = + Record_rest + ( [ + { + record_rest_label = "name"; + record_rest_ident = Some ignored; + }; + ], + _ ); + _; + }; + _; + }; + _; + }; + ] -> + OUnit.assert_equal "__unused0" (Ident.name ignored) + | _ -> OUnit.assert_failure __LOC__ ); ] diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 7320eb231cc..16c1bb54f33 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -32,6 +32,13 @@ function getRenamedRest({"user-name": __unused0, ...rest}) { return rest; } +function getRenamedNameAndRest({"user-name": __rest_field0, ...rest}) { + return [ + __rest_field0, + rest + ]; +} + function getName(param) { return param.name; } @@ -40,6 +47,31 @@ function getWholeConfig({...rest}) { return rest; } +function makeConfig() { + return { + name: "call", + version: "4.5", + debug: true + }; +} + +function getCallResultRest() { + return (({name: __unused0, ...__rest}) => __rest)({ + name: "call", + version: "4.5", + debug: true + }); +} + +function getNameRestAndOriginalVersion(original) { + let {name, ...rest} = original; + return [ + name, + rest, + original.version + ]; +} + function extractClassName({className: __unused0, ...rest}) { return rest; } @@ -79,13 +111,13 @@ Mocha.describe("Record_rest_test", () => { version: "1.0", debug: true }; - Test_utils.eq("File \"record_rest_test.res\", line 138, characters 7-14", "test", "test"); - Test_utils.eq("File \"record_rest_test.res\", line 139, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 150, characters 7-14", "test", "test"); + Test_utils.eq("File \"record_rest_test.res\", line 151, 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 144, characters 6-13", describeConfig({ + Mocha.test("match arm returns the named field and the rest record", () => Test_utils.eq("File \"record_rest_test.res\", line 156, characters 6-13", describeConfig({ name: "match", version: "2.0", debug: false @@ -96,12 +128,12 @@ Mocha.describe("Record_rest_test", () => { debug: false } ])); - Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 151, characters 7-14", getName({ + Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 163, characters 7-14", getName({ name: "param", version: "3.0", debug: true }), "param")); - Mocha.test("record rest accepts type aliases to record shapes", () => Test_utils.eq("File \"record_rest_test.res\", line 156, characters 6-13", getAliasedRest({ + Mocha.test("record rest accepts type aliases to record shapes", () => Test_utils.eq("File \"record_rest_test.res\", line 168, characters 6-13", getAliasedRest({ name: "aliased", version: "3.1", debug: false @@ -110,7 +142,7 @@ Mocha.describe("Record_rest_test", () => { debug: false })); Mocha.test("record rest accepts namespaced record types", () => { - Test_utils.eq("File \"record_rest_test.res\", line 164, characters 6-13", getNamespacedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 176, characters 6-13", getNamespacedRest({ name: "namespaced", version: "3.15", debug: true @@ -123,12 +155,12 @@ Mocha.describe("Record_rest_test", () => { version: "3.16", debug: false }; - Test_utils.eq("File \"record_rest_test.res\", line 176, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 188, characters 7-14", rest, { version: "3.16", debug: false }); }); - Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 181, characters 6-13", getRenamedRest({ + Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 193, characters 6-13", getRenamedRest({ "user-name": "renamed", version: "3.2", debug: true @@ -136,7 +168,18 @@ Mocha.describe("Record_rest_test", () => { version: "3.2", debug: true })); - Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 189, characters 6-13", (({...__rest}) => __rest)({ + Mocha.test("record rest can return a field renamed with @as alongside the rest", () => Test_utils.eq("File \"record_rest_test.res\", line 201, characters 6-13", getRenamedNameAndRest({ + "user-name": "renamed", + version: "3.25", + debug: false + }), [ + "renamed", + { + version: "3.25", + debug: false + } + ])); + Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 209, characters 6-13", (({...__rest}) => __rest)({ name: "whole", version: "3.5", debug: false @@ -152,12 +195,12 @@ Mocha.describe("Record_rest_test", () => { debug: true }; let {...rest} = whole; - Test_utils.eq("File \"record_rest_test.res\", line 197, characters 7-14", whole, { + Test_utils.eq("File \"record_rest_test.res\", line 217, characters 7-14", whole, { name: "wholeAlias", version: "3.6", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 198, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 218, characters 7-14", rest, { name: "wholeAlias", version: "3.6", debug: true @@ -170,7 +213,7 @@ Mocha.describe("Record_rest_test", () => { style: "bold", onClick: onClick }); - Test_utils.eq("File \"record_rest_test.res\", line 204, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 224, characters 7-14", rest, { style: "bold", onClick: onClick }); @@ -180,18 +223,18 @@ Mocha.describe("Record_rest_test", () => { id: "1", value: 42 }; - Test_utils.eq("File \"record_rest_test.res\", line 209, characters 7-14", "1", "1"); - Test_utils.eq("File \"record_rest_test.res\", line 210, characters 7-14", intRest, { + Test_utils.eq("File \"record_rest_test.res\", line 229, characters 7-14", "1", "1"); + Test_utils.eq("File \"record_rest_test.res\", line 230, characters 7-14", intRest, { value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 211, characters 7-14", (({id: __unused0, ...__rest}) => __rest)({ + Test_utils.eq("File \"record_rest_test.res\", line 231, characters 7-14", (({id: __unused0, ...__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 216, characters 6-13", getTupleRest([ + Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 236, characters 6-13", getTupleRest([ { name: "tuple", version: "4.0", @@ -202,8 +245,24 @@ Mocha.describe("Record_rest_test", () => { version: "4.0", debug: false })); + Mocha.test("record rest works when the source is not a bare identifier", () => Test_utils.eq("File \"record_rest_test.res\", line 243, characters 7-14", getCallResultRest(), { + version: "4.5", + debug: true + })); + Mocha.test("record rest keeps the original parameter alias usable", () => Test_utils.eq("File \"record_rest_test.res\", line 248, characters 6-13", getNameRestAndOriginalVersion({ + name: "original", + version: "4.75", + debug: false + }), [ + "original", + { + version: "4.75", + debug: false + }, + "4.75" + ])); Mocha.test("variant payload rest works through the or-pattern path", () => { - Test_utils.eq("File \"record_rest_test.res\", line 224, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 256, characters 6-13", getWrappedRest({ TAG: "Wrap", _0: { name: "wrapped", @@ -214,7 +273,7 @@ Mocha.describe("Record_rest_test", () => { version: "5.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 229, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 261, characters 6-13", getWrappedRest({ TAG: "Mirror", _0: { name: "mirror", @@ -227,7 +286,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes the runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 237, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 269, characters 6-13", getInlineWrappedRest({ TAG: "InlineWrap", name: "inline", version: "7.0", @@ -236,7 +295,7 @@ Mocha.describe("Record_rest_test", () => { version: "7.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 242, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 274, characters 6-13", getInlineWrappedRest({ TAG: "InlineMirror", name: "inlineMirror", version: "8.0", @@ -247,7 +306,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest excludes fields renamed with @as", () => { - Test_utils.eq("File \"record_rest_test.res\", line 250, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 282, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineWrap", "user-name": "inlineRenamed", version: "8.5", @@ -256,7 +315,7 @@ Mocha.describe("Record_rest_test", () => { version: "8.5", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 257, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 289, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineMirror", "user-name": "inlineRenamed2", version: "8.6", @@ -267,7 +326,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes a custom runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 267, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 299, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineWrap", name: "customInline", version: "9.0", @@ -276,7 +335,7 @@ Mocha.describe("Record_rest_test", () => { version: "9.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 274, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 306, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineMirror", name: "customInlineMirror", version: "10.0", @@ -287,7 +346,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record rest works with a non-identifier custom tag name", () => { - Test_utils.eq("File \"record_rest_test.res\", line 284, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 316, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineWrap", name: "dashedInline", version: "11.0", @@ -296,7 +355,7 @@ Mocha.describe("Record_rest_test", () => { version: "11.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 291, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 323, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineMirror", name: "dashedInlineMirror", version: "12.0", @@ -315,8 +374,12 @@ export { getAliasedRest, getNamespacedRest, getRenamedRest, + getRenamedNameAndRest, getName, getWholeConfig, + makeConfig, + getCallResultRest, + getNameRestAndOriginalVersion, extractClassName, getValue, getTupleRest, diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index c58d714900b..d444f09d71d 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -39,9 +39,21 @@ let getAliasedRest = ({name: _, ...aliasedSubConfig as rest}: config) => rest let getNamespacedRest = ({name: _, ...SubConfig.t as rest}: config) => rest let getRenamedRest = ({name: _, ...subConfig as rest}: renamedConfig) => rest +let getRenamedNameAndRest = ({name, ...subConfig as rest}: renamedConfig) => (name, rest) let getName = ({name, ...subConfig as _rest}: config) => name let getWholeConfig = ({...config as rest}: config) => rest +let makeConfig = (): config => {name: "call", version: "4.5", debug: true} +let getCallResultRest = () => { + let {name: _, ...subConfig as rest} = makeConfig() + rest +} + +let getNameRestAndOriginalVersion = ({name, ...subConfig as rest} as original: config) => ( + name, + rest, + original.version, +) type fullProps = { className?: string, @@ -184,6 +196,14 @@ describe(__MODULE__, () => { ) }) + test("record rest can return a field renamed with @as alongside the rest", () => { + eq( + __LOC__, + getRenamedNameAndRest({name: "renamed", version: "3.25", debug: false}), + ("renamed", {version: "3.25", debug: false}), + ) + }) + test("empty-field rest pattern still binds the whole record", () => { eq( __LOC__, @@ -219,6 +239,18 @@ describe(__MODULE__, () => { ) }) + test("record rest works when the source is not a bare identifier", () => { + eq(__LOC__, getCallResultRest(), {version: "4.5", debug: true}) + }) + + test("record rest keeps the original parameter alias usable", () => { + eq( + __LOC__, + getNameRestAndOriginalVersion({name: "original", version: "4.75", debug: false}), + ("original", {version: "4.75", debug: false}, "4.75"), + ) + }) + test("variant payload rest works through the or-pattern path", () => { eq( __LOC__, From 19a5c97bbf152f73ed8c5bd8d8be462a48c37e63 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 17 Jun 2026 18:02:15 +0200 Subject: [PATCH 26/47] disallow spreading rest to unboxed record --- compiler/ml/typecore_record_rest.ml | 22 ++++++++++++------- compiler/ml/typecore_record_rest.mli | 1 + tests/ERROR_VARIANTS.md | 2 +- ...record_rest_unboxed_rest_type.res.expected | 10 +++++++++ ...cord_rest_unboxed_source_type.res.expected | 10 +++++++++ .../record_rest_unboxed_rest_type.res | 4 ++++ .../record_rest_unboxed_source_type.res | 4 ++++ 7 files changed, 44 insertions(+), 9 deletions(-) create mode 100644 tests/build_tests/super_errors/expected/record_rest_unboxed_rest_type.res.expected create mode 100644 tests/build_tests/super_errors/expected/record_rest_unboxed_source_type.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_unboxed_rest_type.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_unboxed_source_type.res diff --git a/compiler/ml/typecore_record_rest.ml b/compiler/ml/typecore_record_rest.ml index 1a74562408e..fc43d3ed808 100644 --- a/compiler/ml/typecore_record_rest.ml +++ b/compiler/ml/typecore_record_rest.ml @@ -14,6 +14,7 @@ type error = source_runtime_name: string; rest_runtime_name: string; } + | Unboxed_record exception Error of Location.t * Env.t * error @@ -79,6 +80,12 @@ let source_fields_of_decl (fields : label_declaration list) = }) fields +let source_fields_and_repr ~env ~loc decl = + match decl.type_kind with + | Type_record (_, Record_unboxed _) -> raise_error loc env Unboxed_record + | Type_record (fields, repr) -> (source_fields_of_decl fields, repr) + | _ -> assert false + let resolve_source_record ~env ~unify_pat_types ~loc ~record_ty ~(rest_type_lid : Longident.t Location.loc) ~rest_type_expr ~rest_decl = match @@ -88,15 +95,10 @@ let resolve_source_record ~env ~unify_pat_types ~loc ~record_ty record_ty) with Not_found -> None with - | Some source_decl -> ( - match source_decl.type_kind with - | Type_record (fields, repr) -> (source_fields_of_decl fields, repr) - | _ -> assert false) - | None -> ( + | Some source_decl -> source_fields_and_repr ~env ~loc source_decl + | None -> unify_pat_types rest_type_lid.loc env record_ty rest_type_expr; - match rest_decl.type_kind with - | Type_record (fields, repr) -> (source_fields_of_decl fields, repr) - | _ -> assert false) + source_fields_and_repr ~env ~loc:rest_type_lid.loc rest_decl let runtime_excluded_labels ~explicit_runtime_labels source_repr = match source_repr with @@ -147,6 +149,8 @@ let type_record_pat_rest ~env ~pattern_force ~loc ~record_ty ~lbl_pat_list ~rest | Some rest_decl -> ( check_not_private rest_type_lid.loc rest_type_expr rest_decl; match rest_decl.type_kind with + | Type_record (_, Record_unboxed _) -> + raise_error rest_type_lid.loc env Unboxed_record | Type_record _ -> rest_decl | _ -> raise_error rest_type_lid.loc env (Not_record rest_type_lid.txt)) | None -> raise_error rest_type_lid.loc env (Not_record rest_type_lid.txt) @@ -297,3 +301,5 @@ let report_error ppf = function in the source record type it is `%s`. Runtime representations must \ match." field Printtyp.longident rest_type rest_runtime_name source_runtime_name + | Unboxed_record -> + fprintf ppf "Record rest patterns cannot be used with unboxed record types." diff --git a/compiler/ml/typecore_record_rest.mli b/compiler/ml/typecore_record_rest.mli index 2a235a7078a..26aea184599 100644 --- a/compiler/ml/typecore_record_rest.mli +++ b/compiler/ml/typecore_record_rest.mli @@ -13,6 +13,7 @@ type error = source_runtime_name: string; rest_runtime_name: string; } + | Unboxed_record exception Error of Location.t * Env.t * error diff --git a/tests/ERROR_VARIANTS.md b/tests/ERROR_VARIANTS.md index 514275260c8..1096e006524 100644 --- a/tests/ERROR_VARIANTS.md +++ b/tests/ERROR_VARIANTS.md @@ -241,7 +241,7 @@ Source: [typecore.ml:27](../compiler/ml/typecore.ml). | `Empty_record_literal` | ✓ | `empty_record_literal.res` | | | `Uncurried_arity_mismatch` | ✓ | `arity_mismatch3.res` etc. | | | `Field_not_optional` | ✓ | `fieldNotOptional.res` | | -| `Record_rest` | ✓ | `record_rest_*.res` | Wrapper for record-rest validation errors reported by `typecore_record_rest.ml`; fixtures cover missing annotation, invalid rest type, non-record and unresolved rest types, private rest type, field mismatch/missing/extra cases, runtime-name mismatch, empty-rest warning, module destructure rejection, and singular/plural missing and overlap messages. | +| `Record_rest` | ✓ | `record_rest_*.res` | Wrapper for record-rest validation errors reported by `typecore_record_rest.ml`; fixtures cover missing annotation, invalid rest type, non-record and unresolved rest types, private and unboxed record types, field mismatch/missing/extra cases, runtime-name mismatch, empty-rest warning, module destructure rejection, and singular/plural missing and overlap messages. | | `Type_params_not_supported` | ✓ | `variant_spread_pattern_type_params.res` | Pattern-level variant spread (`| ...a as v`) where `a` has type params; typedecl path covered by `variant_spread_type_parameters.res`. | | `Field_access_on_dict_type` | ✓ | `field_access_on_dict_type.res` | | | `Jsx_not_enabled` | ☐ (needs harness flag) | — | typecore.ml:218/3470. Fires when JSX is used without `-bs-jsx N`. The `super_errors` runner hard-codes `-bs-jsx 4` in `bscFlags`; adding a per-fixture opt-out (e.g. a `.opts` sidecar) would expose this. Until then, it's reachable in real code but blocked at the harness level. | diff --git a/tests/build_tests/super_errors/expected/record_rest_unboxed_rest_type.res.expected b/tests/build_tests/super_errors/expected/record_rest_unboxed_rest_type.res.expected new file mode 100644 index 00000000000..b756afccc83 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_unboxed_rest_type.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/record_rest_unboxed_rest_type.res:4:18-22 + + 2 │ @unboxed type value = {value: int} + 3 │ + 4 │ let {name: _, ...value as rest} = ({name: "x", value: 1}: source) + 5 │ + + Record rest patterns cannot be used with unboxed record types. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_unboxed_source_type.res.expected b/tests/build_tests/super_errors/expected/record_rest_unboxed_source_type.res.expected new file mode 100644 index 00000000000..4aedcdec32f --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_unboxed_source_type.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/record_rest_unboxed_source_type.res:4:5-32 + + 2 │ type empty = {} + 3 │ + 4 │ let {value: _, ...empty as rest} = ({value: 1}: source) + 5 │ + + Record rest patterns cannot be used with unboxed record types. \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/record_rest_unboxed_rest_type.res b/tests/build_tests/super_errors/fixtures/record_rest_unboxed_rest_type.res new file mode 100644 index 00000000000..b5692385fa8 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_unboxed_rest_type.res @@ -0,0 +1,4 @@ +type source = {name: string, value: int} +@unboxed type value = {value: int} + +let {name: _, ...value as rest} = ({name: "x", value: 1}: source) diff --git a/tests/build_tests/super_errors/fixtures/record_rest_unboxed_source_type.res b/tests/build_tests/super_errors/fixtures/record_rest_unboxed_source_type.res new file mode 100644 index 00000000000..1ece901fa16 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_unboxed_source_type.res @@ -0,0 +1,4 @@ +@unboxed type source = {value: int} +type empty = {} + +let {value: _, ...empty as rest} = ({value: 1}: source) From 30fcfbf82408b98ddb8a2102f47836f526fd68f3 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 17 Jun 2026 18:19:20 +0200 Subject: [PATCH 27/47] address https://github.com/rescript-lang/rescript/pull/8317#discussion_r3065349644 --- compiler/core/lam_primitive.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/core/lam_primitive.ml b/compiler/core/lam_primitive.ml index 118094da64a..18467698ad6 100644 --- a/compiler/core/lam_primitive.ml +++ b/compiler/core/lam_primitive.ml @@ -229,9 +229,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 | Precord_rest _ | Pmakearray | Parraylength | Parrayrefu - | Parraysetu | Parrayrefs | Parraysets | Pjs_fn_make_unit | Pjs_fn_method - | Phash | Phash_mixstring | Phash_mixint | Phash_finalmix -> + | Pduprecord | Pmakearray | Parraylength | Parrayrefu | Parraysetu + | Parrayrefs | Parraysets | Pjs_fn_make_unit | Pjs_fn_method | Phash + | Phash_mixstring | Phash_mixint | Phash_finalmix | Precord_rest _ -> rhs = lhs (* Reachable only via the optimizer's term-equality comparison, which the test suite doesn't exercise for tagged templates. *) From 633c6ad6f9c0d42f96c055502a5076dc42b028f2 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 17 Jun 2026 18:35:31 +0200 Subject: [PATCH 28/47] document type_record_pat_rest function --- compiler/ml/typecore_record_rest.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/ml/typecore_record_rest.ml b/compiler/ml/typecore_record_rest.ml index fc43d3ed808..60304f3336c 100644 --- a/compiler/ml/typecore_record_rest.ml +++ b/compiler/ml/typecore_record_rest.ml @@ -113,6 +113,9 @@ let runtime_excluded_labels ~explicit_runtime_labels source_repr = else tag_name :: explicit_runtime_labels | _ -> explicit_runtime_labels +(* Type a record-rest pattern by resolving its annotation, checking that the + rest record can be formed from the source record, and returning the typed + rest binding plus the runtime labels to remove from the generated object. *) let type_record_pat_rest ~env ~pattern_force ~loc ~record_ty ~lbl_pat_list ~rest ~enter_variable ~unify_pat_types ~check_not_private = let rest_type_lid, rest_type_args_syntax = From 95022a93520af6596589960f979210c0563c390c Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 17 Jun 2026 18:51:06 +0200 Subject: [PATCH 29/47] add comment about Tpat_record rest --- compiler/ml/typedtree.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml index 5131e15f1d4..7af0d7d7ec9 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -460,8 +460,9 @@ let rec bound_idents pat = (* 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 *) + (* Record rest is stored on Tpat_record, not as a child Tpat_var that + iter_pattern_desc can visit. Add it here so Lambda compilation sees the + binding. *) idents := (rest.rest_ident, rest.rest_name) :: !idents; iter_pattern_desc bound_idents pat.pat_desc | d -> iter_pattern_desc bound_idents d From fe82b90d2651edf6b138711112887a3bdf4d8bc0 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 17 Jun 2026 19:27:01 +0200 Subject: [PATCH 30/47] forbid destructure to rest of record with mutable fields --- compiler/ml/typecore_record_rest.ml | 12 +++++++++++- compiler/ml/typecore_record_rest.mli | 1 + tests/ERROR_VARIANTS.md | 2 +- .../expected/record_rest_mutable_source.res.expected | 10 ++++++++++ .../fixtures/record_rest_mutable_source.res | 4 ++++ 5 files changed, 27 insertions(+), 2 deletions(-) create mode 100644 tests/build_tests/super_errors/expected/record_rest_mutable_source.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_mutable_source.res diff --git a/compiler/ml/typecore_record_rest.ml b/compiler/ml/typecore_record_rest.ml index 60304f3336c..085735b3b2a 100644 --- a/compiler/ml/typecore_record_rest.ml +++ b/compiler/ml/typecore_record_rest.ml @@ -15,6 +15,7 @@ type error = rest_runtime_name: string; } | Unboxed_record + | Mutable_source_record exception Error of Location.t * Env.t * error @@ -80,10 +81,16 @@ let source_fields_of_decl (fields : label_declaration list) = }) fields +let has_mutable_field fields = + Ext_list.exists fields (fun (field : label_declaration) -> + field.ld_mutable = Mutable) + let source_fields_and_repr ~env ~loc decl = match decl.type_kind with | Type_record (_, Record_unboxed _) -> raise_error loc env Unboxed_record - | Type_record (fields, repr) -> (source_fields_of_decl fields, repr) + | Type_record (fields, repr) -> + if has_mutable_field fields then raise_error loc env Mutable_source_record; + (source_fields_of_decl fields, repr) | _ -> assert false let resolve_source_record ~env ~unify_pat_types ~loc ~record_ty @@ -306,3 +313,6 @@ let report_error ppf = function field Printtyp.longident rest_type rest_runtime_name source_runtime_name | Unboxed_record -> fprintf ppf "Record rest patterns cannot be used with unboxed record types." + | Mutable_source_record -> + fprintf ppf + "Record rest patterns cannot be used on records with mutable fields." diff --git a/compiler/ml/typecore_record_rest.mli b/compiler/ml/typecore_record_rest.mli index 26aea184599..f8ddf7f46a8 100644 --- a/compiler/ml/typecore_record_rest.mli +++ b/compiler/ml/typecore_record_rest.mli @@ -14,6 +14,7 @@ type error = rest_runtime_name: string; } | Unboxed_record + | Mutable_source_record exception Error of Location.t * Env.t * error diff --git a/tests/ERROR_VARIANTS.md b/tests/ERROR_VARIANTS.md index 1096e006524..71ff64168d9 100644 --- a/tests/ERROR_VARIANTS.md +++ b/tests/ERROR_VARIANTS.md @@ -241,7 +241,7 @@ Source: [typecore.ml:27](../compiler/ml/typecore.ml). | `Empty_record_literal` | ✓ | `empty_record_literal.res` | | | `Uncurried_arity_mismatch` | ✓ | `arity_mismatch3.res` etc. | | | `Field_not_optional` | ✓ | `fieldNotOptional.res` | | -| `Record_rest` | ✓ | `record_rest_*.res` | Wrapper for record-rest validation errors reported by `typecore_record_rest.ml`; fixtures cover missing annotation, invalid rest type, non-record and unresolved rest types, private and unboxed record types, field mismatch/missing/extra cases, runtime-name mismatch, empty-rest warning, module destructure rejection, and singular/plural missing and overlap messages. | +| `Record_rest` | ✓ | `record_rest_*.res` | Wrapper for record-rest validation errors reported by `typecore_record_rest.ml`; fixtures cover missing annotation, invalid rest type, non-record and unresolved rest types, private and unboxed record types, mutable source records, field mismatch/missing/extra cases, runtime-name mismatch, empty-rest warning, module destructure rejection, and singular/plural missing and overlap messages. | | `Type_params_not_supported` | ✓ | `variant_spread_pattern_type_params.res` | Pattern-level variant spread (`| ...a as v`) where `a` has type params; typedecl path covered by `variant_spread_type_parameters.res`. | | `Field_access_on_dict_type` | ✓ | `field_access_on_dict_type.res` | | | `Jsx_not_enabled` | ☐ (needs harness flag) | — | typecore.ml:218/3470. Fires when JSX is used without `-bs-jsx N`. The `super_errors` runner hard-codes `-bs-jsx 4` in `bscFlags`; adding a per-fixture opt-out (e.g. a `.opts` sidecar) would expose this. Until then, it's reachable in real code but blocked at the harness level. | diff --git a/tests/build_tests/super_errors/expected/record_rest_mutable_source.res.expected b/tests/build_tests/super_errors/expected/record_rest_mutable_source.res.expected new file mode 100644 index 00000000000..72cddfaa600 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_mutable_source.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/record_rest_mutable_source.res:4:5-30 + + 2 │ type rest = {version: string} + 3 │ + 4 │ let {name: _, ...rest as rest} = ({name: "x", version: "1"}: source) + 5 │ + + Record rest patterns cannot be used on records with mutable fields. \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/record_rest_mutable_source.res b/tests/build_tests/super_errors/fixtures/record_rest_mutable_source.res new file mode 100644 index 00000000000..a204a98c33b --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_mutable_source.res @@ -0,0 +1,4 @@ +type source = {mutable name: string, version: string} +type rest = {version: string} + +let {name: _, ...rest as rest} = ({name: "x", version: "1"}: source) From 2250243f9a88828720883b8f7923d8c05d764032 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 18 Jun 2026 12:40:04 +0200 Subject: [PATCH 31/47] do not spread function params to avoid issues with 'use strict' --- compiler/core/js_pass_record_rest.ml | 56 ++++--------------- tests/tests/src/record_rest_test.mjs | 39 ++++++++++--- tests/tests/src/record_rest_test.res | 11 ++++ .../src/expected/ZRecordRest.res.jsout | 3 +- 4 files changed, 54 insertions(+), 55 deletions(-) diff --git a/compiler/core/js_pass_record_rest.ml b/compiler/core/js_pass_record_rest.ml index 2d5a60c30e9..d5e38b8ad87 100644 --- a/compiler/core/js_pass_record_rest.ml +++ b/compiler/core/js_pass_record_rest.ml @@ -1,4 +1,5 @@ module E = Js_exp_make +module S = Js_stmt_make open J let field_ident_name i label = @@ -7,18 +8,6 @@ let field_ident_name i label = let ignored_ident i = Ext_ident.create ("__unused" ^ string_of_int i) -let uses_ident ident block = - let found = ref false in - let obj = - { - Js_record_iter.super with - ident = - (fun _ candidate -> if Ident.same ident candidate then found := true); - } - in - obj.block obj block; - !found - let materialize_fields source fields tail = match source.J.expression_desc with | Var (Id source_ident) -> @@ -122,34 +111,8 @@ let pass = | Fun ({is_method = false; params = [Ident_param param]; body} as fun_) -> let body = self.block self body in - let params, body = + let body = match body with - | { - statement_desc = - Variable - { - ident = rest; - value = - Some - { - expression_desc = - Record_rest - (fields, {expression_desc = Var (Id source); _}); - _; - }; - _; - }; - _; - } - :: tail - when Ident.name param = "param" - && Ident.same param source - && not (uses_ident param tail) -> - ( [ - Object_rest_param - {object_rest_fields = fields; object_rest_rest = rest}; - ], - tail ) | [ { statement_desc = @@ -176,14 +139,15 @@ let pass = }; ] in - ( [ - Object_rest_param - {object_rest_fields = fields; object_rest_rest = rest}; - ], - body ) - | _ -> (fun_.params, body) + S.define_variable ~kind:Strict rest + { + rest_expr with + expression_desc = Record_rest (fields, source_expr); + } + :: body + | _ -> body in - {expr with expression_desc = Fun {fun_ with params; body}} + {expr with expression_desc = Fun {fun_ with body}} | Fun ({body} as fun_) -> let body = self.block self body in {expr with expression_desc = Fun {fun_ with body}} diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 16c1bb54f33..7ffd7eebcb7 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -13,26 +13,31 @@ function describeConfig(c) { ]; } -function getNameAndSubConfig({name, ...subConfig}) { +function getNameAndSubConfig(param) { + let {name, ...subConfig} = param; return [ name, subConfig ]; } -function getAliasedRest({name: __unused0, ...rest}) { +function getAliasedRest(param) { + let {name: __unused0, ...rest} = param; return rest; } -function getNamespacedRest({name: __unused0, ...rest}) { +function getNamespacedRest(param) { + let {name: __unused0, ...rest} = param; return rest; } -function getRenamedRest({"user-name": __unused0, ...rest}) { +function getRenamedRest(param) { + let {"user-name": __unused0, ...rest} = param; return rest; } -function getRenamedNameAndRest({"user-name": __rest_field0, ...rest}) { +function getRenamedNameAndRest(param) { + let {"user-name": __rest_field0, ...rest} = param; return [ __rest_field0, rest @@ -43,7 +48,8 @@ function getName(param) { return param.name; } -function getWholeConfig({...rest}) { +function getWholeConfig(param) { + let {...rest} = param; return rest; } @@ -72,11 +78,13 @@ function getNameRestAndOriginalVersion(original) { ]; } -function extractClassName({className: __unused0, ...rest}) { +function extractClassName(param) { + let {className: __unused0, ...rest} = param; return rest; } -function getValue({id: __unused0, ...rest}) { +function getValue(param) { + let {id: __unused0, ...rest} = param; return rest; } @@ -365,6 +373,21 @@ Mocha.describe("Record_rest_test", () => { debug: false }); }); + Mocha.test("strict directive functions keep record rest destructuring in the body", () => { + let strictDirectiveRest = param => { + 'use strict'; + let {name: __unused0, ...rest} = param; + return rest; + }; + Test_utils.eq("File \"record_rest_test.res\", line 336, characters 6-13", strictDirectiveRest({ + name: "strict", + version: "13.0", + debug: false + }), { + version: "13.0", + debug: false + }); + }); }); export { diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index d444f09d71d..0da2225a8af 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -327,4 +327,15 @@ describe(__MODULE__, () => { {version: "12.0", debug: false}, ) }) + + test("strict directive functions keep record rest destructuring in the body", () => { + let strictDirectiveRest = + @directive("'use strict'") ({name: _, ...subConfig as rest}: config) => rest + + eq( + __LOC__, + strictDirectiveRest({name: "strict", version: "13.0", debug: false}), + {version: "13.0", debug: false}, + ) + }) }) diff --git a/tests/tools_tests/src/expected/ZRecordRest.res.jsout b/tests/tools_tests/src/expected/ZRecordRest.res.jsout index 75da4bbdf89..79c1362adfd 100644 --- a/tests/tools_tests/src/expected/ZRecordRest.res.jsout +++ b/tests/tools_tests/src/expected/ZRecordRest.res.jsout @@ -2,7 +2,8 @@ 'use strict'; -function extract({name, ...rest}) { +function extract(param) { + let {name, ...rest} = param; return [ name, rest From a87f7f9406fa4575d81fdce5a685433254abb433 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 18 Jun 2026 16:24:10 +0200 Subject: [PATCH 32/47] fix comment table for rest spread --- compiler/syntax/src/res_comments_table.ml | 38 ++++++++++++++--- compiler/syntax/src/res_core.ml | 8 +++- compiler/syntax/src/res_printer.ml | 25 ++++++----- .../record_rest_empty_warning.res.expected | 4 +- .../record_rest_field_missing.res.expected | 4 +- ...d_rest_field_missing_singular.res.expected | 4 +- ...ecord_rest_field_not_optional.res.expected | 4 +- ...est_field_not_optional_plural.res.expected | 4 +- .../record_rest_invalid_type.res.expected | 4 +- ...ecord_rest_module_destructure.res.expected | 4 +- ...rest_requires_type_annotation.res.expected | 4 +- tests/ounit_tests/ounit_js_analyzer_tests.ml | 41 ++++++++++++------- .../expected/record_rest_duplicate.res.txt | 2 +- .../errors/other/expected/spread.res.txt | 2 +- .../printer/comments/expected/pattern.res.txt | 5 +++ .../data/printer/comments/pattern.res | 5 +++ 16 files changed, 109 insertions(+), 49 deletions(-) diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml index aef9ee4959a..1d0a470e52a 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -498,6 +498,7 @@ type node = | ObjectField of Parsetree.object_field | PackageConstraint of Longident.t Asttypes.loc * Parsetree.core_type | Pattern of Parsetree.pattern + | PatternRecordRest of Parsetree.record_pat_rest | PatternRecordRow of Longident.t Asttypes.loc * Parsetree.pattern | RowField of Parsetree.row_field | SignatureItem of Parsetree.signature_item @@ -536,6 +537,7 @@ let get_loc node = | _ -> Location.none) | PackageConstraint (li, te) -> {li.loc with loc_end = te.ptyp_loc.loc_end} | Pattern p -> p.ppat_loc + | PatternRecordRest rest -> rest.rest_loc | PatternRecordRow (li, p) -> {li.loc with loc_end = p.ppat_loc.loc_end} | RowField rf -> ( match rf with @@ -719,6 +721,7 @@ and walk_node node tbl comments = | ObjectField f -> walk_object_field f tbl comments | PackageConstraint (li, te) -> walk_package_constraint (li, te) tbl comments | Pattern p -> walk_pattern p tbl comments + | PatternRecordRest rest -> walk_pattern_record_rest rest tbl comments | PatternRecordRow (li, p) -> walk_pattern_record_row (li, p) tbl comments | RowField rf -> walk_row_field rf tbl comments | SignatureItem si -> walk_signature_item si tbl comments @@ -2135,10 +2138,16 @@ 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, _, _rest) -> - walk_list - (Ext_list.map record_rows (fun {lid; x = p} -> PatternRecordRow (lid, p))) - t comments + | Ppat_record (record_rows, _, rest) -> + let nodes = + Ext_list.map record_rows (fun {lid; x = p} -> PatternRecordRow (lid, p)) + in + let nodes = + match rest with + | None -> nodes + | Some rest -> nodes @ [PatternRecordRest rest] + in + walk_list nodes t comments | Ppat_or _ -> walk_list (Res_parsetree_viewer.collect_or_pattern_chain pat @@ -2176,7 +2185,26 @@ and walk_pattern pat t comments = | Ppat_extension extension -> walk_extension extension t comments | _ -> () -(* name: firstName *) +and walk_pattern_record_rest rest t comments = + let attach_rest_name comments = + let before_name, after_name = + partition_leading_trailing comments rest.rest_name.loc + in + attach t.leading rest.rest_name.loc before_name; + attach t.trailing rest.rest_name.loc after_name + in + match rest.rest_type with + | None -> attach_rest_name comments + | Some typ -> + let before_typ, inside_typ, after_typ = + partition_by_loc comments typ.ptyp_loc + in + attach t.leading typ.ptyp_loc before_typ; + walk_core_type typ t inside_typ; + let after_typ, rest = partition_adjacent_trailing typ.ptyp_loc after_typ in + attach t.trailing typ.ptyp_loc after_typ; + attach_rest_name rest + and walk_pattern_record_row row t comments = match row with (* punned {x}*) diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 93a340af8fb..3e67dcbf26f 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -1522,8 +1522,10 @@ and parse_record_pattern_row p = let attrs = parse_attributes p in match p.Parser.token with | DotDotDot -> ( + let rest_start_pos = p.Parser.start_pos in Parser.next p; - let start_pos = p.Parser.start_pos in + let start_pos = rest_start_pos in + let rest_name_start_pos = p.Parser.start_pos in let has_type_annotation = Parser.lookahead p (fun p -> ignore (parse_atomic_typ_expr ~attrs:[] p); @@ -1560,7 +1562,9 @@ and parse_record_pattern_row p = PatRest { Parsetree.rest_loc = loc; - rest_name = Location.mkloc ident loc; + rest_name = + Location.mkloc ident + (mk_loc rest_name_start_pos p.prev_end_pos); rest_type = None; } ) | _ -> diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index a1c1c631667..dd15d0bb630 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -2807,16 +2807,21 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = Doc.concat [Doc.lbrace; Doc.text "_"; Doc.rbrace] | Ppat_record (rows, open_flag, rest) -> let print_rest_pattern rest_pat = - match rest_pat.Parsetree.rest_type with - | Some typ -> - Doc.concat - [ - Doc.text "..."; - print_typ_expr ~state typ cmt_tbl; - Doc.text " as "; - Doc.text rest_pat.rest_name.txt; - ] - | None -> Doc.concat [Doc.text "..."; Doc.text rest_pat.rest_name.txt] + let doc = + match rest_pat.Parsetree.rest_type with + | Some typ -> + Doc.concat + [ + Doc.text "..."; + print_typ_expr ~state typ cmt_tbl; + Doc.text " as "; + print_string_loc rest_pat.rest_name cmt_tbl; + ] + | None -> + Doc.concat + [Doc.text "..."; print_string_loc rest_pat.rest_name cmt_tbl] + in + print_comments doc cmt_tbl rest_pat.rest_loc in Doc.group (Doc.concat 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 index f3343bc01d8..7412b2bff94 100644 --- 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 @@ -1,10 +1,10 @@ Warning number 112 - /.../fixtures/record_rest_empty_warning.res:3:16-26 + /.../fixtures/record_rest_empty_warning.res:3:13-26 1 │ type source = {a: int, b?: string} 2 │ type sub = {b?: string} - 3 │ let {a, ?b, ...sub as rest} = ({a: 1}: source) + 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. 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 index aafee7f85e0..4f391cb2986 100644 --- 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 @@ -1,10 +1,10 @@ We've found a bug for you! - /.../fixtures/record_rest_field_missing.res:3:12-22 + /.../fixtures/record_rest_field_missing.res:3:9-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) + 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`: diff --git a/tests/build_tests/super_errors/expected/record_rest_field_missing_singular.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_missing_singular.res.expected index 8531afb9f01..082e2df2473 100644 --- a/tests/build_tests/super_errors/expected/record_rest_field_missing_singular.res.expected +++ b/tests/build_tests/super_errors/expected/record_rest_field_missing_singular.res.expected @@ -1,10 +1,10 @@ We've found a bug for you! - /.../fixtures/record_rest_field_missing_singular.res:3:12-22 + /.../fixtures/record_rest_field_missing_singular.res:3:9-22 1 │ type source = {a: int, b: string, c: bool} 2 │ type sub = {b: string} - 3 │ let {a, ...sub as rest} = ({a: 1, b: "x", c: true}: source) + 3 │ let {a, ...sub as rest} = ({a: 1, b: "x", c: true}: source) 4 │ The following field is not part of the rest type `sub`: 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 index 458da763631..27c0ab5103d 100644 --- 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 @@ -1,10 +1,10 @@ We've found a bug for you! - /.../fixtures/record_rest_field_not_optional.res:3:12-22 + /.../fixtures/record_rest_field_not_optional.res:3:9-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} + 3 │ let {a, ...sub as rest}: source = {c: true} 4 │ The following field appears in both the explicit pattern and the rest type `sub`: diff --git a/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected index 573f87e46b7..490fcaf26ac 100644 --- a/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected +++ b/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected @@ -1,10 +1,10 @@ We've found a bug for you! - /.../fixtures/record_rest_field_not_optional_plural.res:3:15-25 + /.../fixtures/record_rest_field_not_optional_plural.res:3:12-25 1 │ type source = {a?: int, b?: string, c: bool} 2 │ type sub = {a?: int, b?: string} - 3 │ let {a, b, ...sub as rest}: source = {c: true} + 3 │ let {a, b, ...sub as rest}: source = {c: true} 4 │ The following fields appear in both the explicit pattern and the rest type `sub`: 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 index 98047fce9cd..93bebb2ed6e 100644 --- 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 @@ -1,9 +1,9 @@ We've found a bug for you! - /.../fixtures/record_rest_invalid_type.res:2:12-21 + /.../fixtures/record_rest_invalid_type.res:2:9-21 1 │ type source = {a: int, b: string} - 2 │ let {a, ...'a as rest} = ({a: 1, b: "x"}: source) + 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_module_destructure.res.expected b/tests/build_tests/super_errors/expected/record_rest_module_destructure.res.expected index 185c334b1f0..edb0b39f75e 100644 --- a/tests/build_tests/super_errors/expected/record_rest_module_destructure.res.expected +++ b/tests/build_tests/super_errors/expected/record_rest_module_destructure.res.expected @@ -1,10 +1,10 @@ We've found a bug for you! - /.../fixtures/record_rest_module_destructure.res:3:15-34 + /.../fixtures/record_rest_module_destructure.res:3:12-34 1 │ module A = Belt.Array 2 │ - 3 │ let {push, ...arrayMethods as rest} = module(A) + 3 │ let {push, ...arrayMethods as rest} = module(A) 4 │ Record rest patterns are not supported when destructuring modules. Bind the module fields explicitly. \ 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 index 49483d2c99e..77a9b9447bc 100644 --- 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 @@ -1,9 +1,9 @@ We've found a bug for you! - /.../fixtures/record_rest_requires_type_annotation.res:2:12-18 + /.../fixtures/record_rest_requires_type_annotation.res:2:9-18 1 │ type source = {a: int, b: string} - 2 │ let {a, ...theRest} = ({a: 1, b: "x"}: source) + 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/ounit_tests/ounit_js_analyzer_tests.ml b/tests/ounit_tests/ounit_js_analyzer_tests.ml index 8e8ea239e6b..587c374e214 100644 --- a/tests/ounit_tests/ounit_js_analyzer_tests.ml +++ b/tests/ounit_tests/ounit_js_analyzer_tests.ml @@ -144,22 +144,33 @@ let suites = match transformed.expression_desc with | Fun { - params = - [ - Object_rest_param - { - object_rest_fields = - [ - { - record_rest_label = "name"; - record_rest_ident = Some ignored; - }; - ]; - object_rest_rest = rest; - }; - ]; + params = [Ident_param transformed_param]; body = [ + { + statement_desc = + Variable + { + ident = rest; + value = + Some + { + expression_desc = + Record_rest + ( [ + { + record_rest_label = "name"; + record_rest_ident = Some ignored; + }; + ], + {expression_desc = Var (Id source); _} + ); + _; + }; + _; + }; + _; + }; { statement_desc = Return {expression_desc = Var (Id returned); _}; @@ -168,8 +179,10 @@ let suites = ]; _; } -> + OUnit.assert_bool __LOC__ (Ident.same param transformed_param); OUnit.assert_equal "__unused0" (Ident.name ignored); OUnit.assert_equal "rest" (Ident.name rest); + OUnit.assert_bool __LOC__ (Ident.same param source); OUnit.assert_bool __LOC__ (Ident.same rest returned) | _ -> OUnit.assert_failure __LOC__ ); ( __LOC__ >:: fun _ -> 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 index dce00643948..57e70a605ef 100644 --- 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 @@ -1,6 +1,6 @@ Syntax error! - syntax_tests/data/parsing/errors/other/record_rest_duplicate.res:1:9-51 + syntax_tests/data/parsing/errors/other/record_rest_duplicate.res:1:6-51 1 │ let {...Config.t as first, ...Config.t as second} = myRecord 2 │ 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 93a3f65fa05..feb12d9ad5d 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 @@ -29,7 +29,7 @@ Explanation: since records have a known, fixed shape, a spread like `{a, ...b}` Syntax error! - syntax_tests/data/parsing/errors/other/spread.res:4:9-18 + syntax_tests/data/parsing/errors/other/spread.res:4:6-18 2 │ 3 │ let record = {...x, ...y} diff --git a/tests/syntax_tests/data/printer/comments/expected/pattern.res.txt b/tests/syntax_tests/data/printer/comments/expected/pattern.res.txt index 5463de9be0d..275b2f251ef 100644 --- a/tests/syntax_tests/data/printer/comments/expected/pattern.res.txt +++ b/tests/syntax_tests/data/printer/comments/expected/pattern.res.txt @@ -58,6 +58,11 @@ let /* before */ { /* c3 */ age /* c4 */: /* c5 */ ageInYears /* c6 */, } /* after */ = {name: "steve", age: 31} +let /* before */ { + /* c0 */ name /* c1 */, + /* before rest */ .../* before type */ SubConfig.t /* after type */ as /* before name */ rest /* after rest */, +} /* after */ = config + // Ppat_or let /* b1 */ Blue /* b2 */ | /* c1 */ Red /* c2 */ = color let /* b1 */ Blue /* b2 */ | /* c1 */ Red /* c2 */ | /* d1 */ Green /* d2 */ = color diff --git a/tests/syntax_tests/data/printer/comments/pattern.res b/tests/syntax_tests/data/printer/comments/pattern.res index 8bcb620b8f0..996ef9bdb8e 100644 --- a/tests/syntax_tests/data/printer/comments/pattern.res +++ b/tests/syntax_tests/data/printer/comments/pattern.res @@ -54,6 +54,11 @@ let /* before */ { /* c3 */ age /* c4 */: /* c5 */ ageInYears /* c6 */, } /* after */ = {name: "steve", age: 31} +let /* before */ { + /* c0 */ name /* c1 */, + /* before rest */ .../* before type */ SubConfig.t /* after type */ as /* before name */ rest /* after rest */, +} /* after */ = config + // Ppat_or let /* b1 */ Blue /* b2 */ | /* c1 */ Red /* c2 */ = color let /* b1 */ Blue /* b2 */ | /* c1 */ Red /* c2 */ | /* d1 */ Green /* d2 */ = color From 527f0e1e0a40a37b2f5b3c0be020bdb36b69d901 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 18 Jun 2026 17:38:39 +0200 Subject: [PATCH 33/47] Include record rest binders in rec check Signed-off-by: tsnobip --- compiler/ml/rec_check.ml | 9 +++- tests/ounit_tests/ounit_rec_check_tests.ml | 61 ++++++++++++++++++++++ tests/ounit_tests/ounit_tests_main.ml | 1 + 3 files changed, 69 insertions(+), 2 deletions(-) create mode 100644 tests/ounit_tests/ounit_rec_check_tests.ml diff --git a/compiler/ml/rec_check.ml b/compiler/ml/rec_check.ml index bd3cddf1b1e..c78457b6e14 100644 --- a/compiler/ml/rec_check.ml +++ b/compiler/ml/rec_check.ml @@ -156,8 +156,13 @@ 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, _, _rest) -> - List.concat (List.map (fun (_, _, p, _) -> pattern_variables p) fields) + | Tpat_record (fields, _, rest) -> ( + let fields = + List.concat (List.map (fun (_, _, p, _) -> pattern_variables p) fields) + in + match rest with + | None -> fields + | Some {rest_ident; _} -> rest_ident :: fields) | Tpat_array pats -> List.concat (List.map pattern_variables pats) | Tpat_or (l, r, _) -> pattern_variables l @ pattern_variables r diff --git a/tests/ounit_tests/ounit_rec_check_tests.ml b/tests/ounit_tests/ounit_rec_check_tests.ml new file mode 100644 index 00000000000..ef2fbfa88e1 --- /dev/null +++ b/tests/ounit_tests/ounit_rec_check_tests.ml @@ -0,0 +1,61 @@ +let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: )) + +let loc = Location.none +let typ = Predef.type_unit + +let val_desc = + {Types.val_type = typ; val_kind = Val_reg; val_loc = loc; val_attributes = []} + +let ident_expr id = + { + Typedtree.exp_desc = + Texp_ident + ( Path.Pident id, + Location.mknoloc (Longident.Lident (Ident.name id)), + val_desc ); + exp_loc = loc; + exp_extra = []; + exp_type = typ; + exp_env = Env.empty; + exp_attributes = []; + } + +let record_rest_pat rest_ident = + { + Typedtree.pat_desc = + Tpat_record + ( [], + Asttypes.Closed, + Some + { + rest_ident; + rest_name = Location.mknoloc (Ident.name rest_ident); + rest_type = typ; + excluded_runtime_labels = []; + } ); + pat_loc = loc; + pat_extra = []; + pat_type = typ; + pat_env = Env.empty; + pat_attributes = []; + } + +let value_binding ~pat ~expr = + {Typedtree.vb_pat = pat; vb_expr = expr; vb_attributes = []; vb_loc = loc} + +let suites = + __FILE__ + >::: [ + ( __LOC__ >:: fun _ -> + let rest = Ident.create "rest" in + let binding = + value_binding ~pat:(record_rest_pat rest) ~expr:(ident_expr rest) + in + let raised = + try + Rec_check.check_recursive_bindings [binding]; + false + with _ -> true + in + OUnit.assert_bool __LOC__ raised ); + ] diff --git a/tests/ounit_tests/ounit_tests_main.ml b/tests/ounit_tests/ounit_tests_main.ml index aefc3f3abe2..dd7b1c1b376 100644 --- a/tests/ounit_tests/ounit_tests_main.ml +++ b/tests/ounit_tests/ounit_tests_main.ml @@ -18,6 +18,7 @@ let suites = Ounit_utf8_test.suites; Ounit_unicode_tests.suites; Ounit_util_tests.suites; + Ounit_rec_check_tests.suites; Ounit_js_analyzer_tests.suites; Ounit_jsx_loc_tests.suites; Ounit_analysis_config_tests.suites; From ec1897e52b58527050675fc83d841f7021d3a062 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 18 Jun 2026 17:51:24 +0200 Subject: [PATCH 34/47] Track record rest types in dead analysis Signed-off-by: tsnobip --- analysis/reanalyze/src/dead_value.ml | 74 ++++++++++++++++++- .../deadcode/expected/deadcode.txt | 37 ++++++++-- .../deadcode/src/RecordRest.res | 11 +++ 3 files changed, 113 insertions(+), 9 deletions(-) create mode 100644 tests/analysis_tests/tests-reanalyze/deadcode/src/RecordRest.res diff --git a/analysis/reanalyze/src/dead_value.ml b/analysis/reanalyze/src/dead_value.ml index a10a3f8d909..3fd1c343b79 100644 --- a/analysis/reanalyze/src/dead_value.ml +++ b/analysis/reanalyze/src/dead_value.ml @@ -230,16 +230,78 @@ let rec collect_expr ~config ~refs ~file_deps ~cross_file With this annotation we declare a new type for each branch to allow the function to be typed. *) -let collect_pattern ~config ~refs : +let type_path_candidates ~file ~(module_path : Module_path.t) path = + let path = Dce_path.from_path_t path in + let module_context = + module_path.path @ [File_context.module_name_tagged file] + in + let add_unique paths path = + if List.exists (fun existing -> existing = path) paths then paths + else path :: paths + in + [path; path @ module_context] + |> List.fold_left + (fun paths path -> + [ + path; + Dce_path.module_to_implementation path; + Dce_path.module_to_interface path; + ] + |> List.fold_left add_unique paths) + [] + +let add_record_label_type_references ~config ~refs ~pos_from labels = + labels + |> List.iter (fun {Types.ld_loc = {loc_start = pos_to; loc_ghost}; _} -> + if not loc_ghost then + Dead_type.add_type_reference ~config ~refs ~pos_from ~pos_to) + +let add_record_rest_type_references_from_path ~config ~decls ~refs ~file + ~module_path ~pos_from rest = + if !Config.analyze_types then + match (Ctype.repr rest.Typedtree.rest_type).desc with + | Types.Tconstr (path, _, _) -> + let type_paths = type_path_candidates ~file ~module_path path in + decls |> Declarations.builder_to_list + |> List.iter (fun (_, decl) -> + match (decl.Decl.decl_kind, decl.path) with + | RecordLabel, _label :: type_path + when List.exists + (fun candidate -> candidate = type_path) + type_paths -> + Dead_type.add_type_reference ~config ~refs ~pos_from + ~pos_to:decl.pos + | _ -> ()) + | _ -> () + +let add_record_rest_type_references ~config ~decls ~refs ~file ~module_path + ~pos_from ~env rest = + if !Config.analyze_types then + match + try Some (Ctype.extract_concrete_typedecl env rest.Typedtree.rest_type) + with Not_found -> None + with + | Some (_, _, {Types.type_kind = Type_record (labels, _)}) -> + add_record_label_type_references ~config ~refs ~pos_from labels + | _ -> + add_record_rest_type_references_from_path ~config ~decls ~refs ~file + ~module_path ~pos_from rest + +let collect_pattern ~config ~decls ~refs ~file ~module_path : _ -> _ -> Typedtree.pattern -> Typedtree.pattern = fun super self pat -> let pos_from = pat.Typedtree.pat_loc.loc_start in (match pat.pat_desc with - | Typedtree.Tpat_record (cases, _clodsedFlag, _rest) -> + | Typedtree.Tpat_record (cases, _clodsedFlag, rest) -> ( cases |> List.iter (fun (_loc, {Types.lbl_loc = {loc_start = pos_to}}, _pat, _) -> if !Config.analyze_types then - Dead_type.add_type_reference ~config ~refs ~pos_from ~pos_to) + Dead_type.add_type_reference ~config ~refs ~pos_from ~pos_to); + match rest with + | None -> () + | Some rest -> + add_record_rest_type_references ~config ~decls ~refs ~file ~module_path + ~pos_from:rest.rest_name.loc.loc_start ~env:pat.pat_env rest) | _ -> ()); super.Tast_mapper.pat self pat @@ -331,7 +393,11 @@ let traverse_structure ~config ~decls ~refs ~file_deps ~cross_file ~file e |> collect_expr ~config ~refs ~file_deps ~cross_file ~last_binding super mapper); - pat = (fun _self p -> p |> collect_pattern ~config ~refs super mapper); + pat = + (fun _self p -> + p + |> collect_pattern ~config ~decls ~refs ~file ~module_path super + mapper); structure_item = (fun _self (structure_item : Typedtree.structure_item) -> let modulePath_for_item_opt = diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt index 43d47ac7eb3..10c70d7cd19 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt +++ b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt @@ -1193,6 +1193,15 @@ DeadOptionalArgs.addReferences formatDate called with optional argNames: argNamesMaybe: OptionalArgsLiveDead.res:5:23 addValueReference OptionalArgsLiveDead.res:5:4 --> OptionalArgsLiveDead.res:1:4 addValueReference OptionalArgsLiveDead.res:7:8 --> OptionalArgsLiveDead.res:5:4 + Scanning RecordRest.cmt Source:RecordRest.res + addValueDeclaration +getRest RecordRest.res:8:4 path:+RecordRest + addRecordLabelDeclaration name RecordRest.res:1:15 path:+RecordRest.config + addRecordLabelDeclaration version RecordRest.res:1:29 path:+RecordRest.config + addRecordLabelDeclaration version RecordRest.res:4:12 path:+RecordRest.SubConfig.t + addValueReference RecordRest.res:8:4 --> RecordRest.res:10:14 + addTypeReference RecordRest.res:10:4 --> RecordRest.res:1:15 + addTypeReference RecordRest.res:10:32 --> RecordRest.res:4:12 + addValueReference RecordRest.res:8:4 --> RecordRest.res:8:15 Scanning Records.cmt Source:Records.res addValueDeclaration +origin Records.res:11:4 path:+Records addValueDeclaration +computeArea Records.res:14:4 path:+Records @@ -1949,9 +1958,9 @@ Forward Liveness Analysis - decls: 698 - roots(external targets): 135 - decl-deps: decls_with_out=410 edges_to_decls=287 + decls: 702 + roots(external targets): 137 + decl-deps: decls_with_out=411 edges_to_decls=289 Root (external ref): Value +FirstClassModules.M.InnerModule2.+k Root (external ref): VariantCase DeadRT.moduleAccessPath.Root @@ -2008,6 +2017,7 @@ Forward Liveness Analysis Root (annotated): Value +ImportHooks.+foo Root (annotated): RecordLabel +ImportIndex.props.method Root (annotated): Value +Docstrings.+unnamed2U + Root (external ref): RecordLabel +RecordRest.config.name Root (external ref): Value +FirstClassModules.M.Z.+u Root (annotated): Value +Uncurried.+callback2U Root (annotated): Value +ImportJsValue.+default @@ -2132,6 +2142,7 @@ Forward Liveness Analysis Root (annotated): Value +Records.+someBusiness Root (external ref): RecordLabel +Hooks.vehicle.name Root (annotated): Value +Uncurried.+sumLblCurried + Root (annotated): Value +RecordRest.+getRest Root (annotated): Value +References.+preserveRefIdentity Root (annotated): Value +Types.+jsStringT Root (annotated): Value +Variants.+restResult1 @@ -2146,6 +2157,7 @@ Forward Liveness Analysis Root (annotated): Value +ImportJsValue.+useColor Root (annotated): Value +Tuples.+changeSecondAge Root (external ref): Value +Unison.+group + Root (external ref): RecordLabel +RecordRest.SubConfig.t.version Root (annotated): Value +Docstrings.+unnamed1U Root (annotated): Value +Records.+recordValue Root (annotated): Value +ImportHookDefault.+make @@ -2276,7 +2288,7 @@ Forward Liveness Analysis Root (annotated): Value +UseImportJsValue.+useGetProp Root (annotated): Value +Hooks.+functionWithRenamedArgs - 322 roots found + 325 roots found Propagate: DeadRT.moduleAccessPath.Root -> +DeadRT.moduleAccessPath.Root Propagate: +TypeReexportCrossFileB.reexportedRecord.usedField -> +TypeReexportCrossFileA.originalRecord.usedField @@ -3413,6 +3425,17 @@ Forward Liveness Analysis Live (external ref) Value +OptionalArgsLiveDead.+liveCaller deps: in=0 (live=0 dead=0) out=1 -> +OptionalArgsLiveDead.+formatDate + Live (external ref) RecordLabel +RecordRest.config.name + deps: in=1 (live=1 dead=0) out=0 + <- +RecordRest.+getRest (live) + Dead RecordLabel +RecordRest.config.version + Live (external ref) RecordLabel +RecordRest.SubConfig.t.version + deps: in=1 (live=1 dead=0) out=0 + <- +RecordRest.+getRest (live) + Live (annotated) Value +RecordRest.+getRest + deps: in=0 (live=0 dead=0) out=2 + -> +RecordRest.config.name + -> +RecordRest.SubConfig.t.version Live (external ref) RecordLabel +Records.coord.x deps: in=1 (live=1 dead=0) out=0 <- +Records.+computeArea (live) @@ -4902,6 +4925,10 @@ Forward Liveness Analysis OptionalArgsLiveDead.res:3:1-59 deadCaller is never used + Warning Dead Type + RecordRest.res:1:30-44 + config.version is a record label never used to read a value + Warning Dead Type Records.res:24:3-14 person.name is a record label never used to read a value @@ -5246,4 +5273,4 @@ Forward Liveness Analysis OptArg.res:26:1-70 optional argument c of function wrapfourArgs is always supplied (2 calls) - Analysis reported 318 issues (Incorrect Dead Annotation:1, Warning Dead Exception:2, Warning Dead Module:22, Warning Dead Type:93, Warning Dead Value:177, Warning Dead Value With Side Effects:5, Warning Redundant Optional Argument:6, Warning Unused Argument:12) + Analysis reported 319 issues (Incorrect Dead Annotation:1, Warning Dead Exception:2, Warning Dead Module:22, Warning Dead Type:94, Warning Dead Value:177, Warning Dead Value With Side Effects:5, Warning Redundant Optional Argument:6, Warning Unused Argument:12) diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/src/RecordRest.res b/tests/analysis_tests/tests-reanalyze/deadcode/src/RecordRest.res new file mode 100644 index 00000000000..b1b76dab9fe --- /dev/null +++ b/tests/analysis_tests/tests-reanalyze/deadcode/src/RecordRest.res @@ -0,0 +1,11 @@ +type config = {name: string, version: string} + +module SubConfig = { + type t = {version: string} +} + +@live +let getRest = (config: config) => + switch config { + | {name: _, ...SubConfig.t as rest} => rest + } From 686c0d40a48762d8b649fffd7661b18bc067f6c3 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 18 Jun 2026 17:57:05 +0200 Subject: [PATCH 35/47] Rename record rest test config fixture Signed-off-by: tsnobip --- tests/tests/src/record_rest_test.mjs | 12 +++---- tests/tests/src/record_rest_test.res | 52 ++++++++++++++-------------- 2 files changed, 32 insertions(+), 32 deletions(-) diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 7ffd7eebcb7..5df24bb4ad9 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -3,7 +3,7 @@ import * as Mocha from "mocha"; import * as Test_utils from "./test_utils.mjs"; -let SubConfig = {}; +let RestConfig = {}; function describeConfig(c) { let {name, ...rest} = c; @@ -13,11 +13,11 @@ function describeConfig(c) { ]; } -function getNameAndSubConfig(param) { - let {name, ...subConfig} = param; +function getNameAndRestConfig(param) { + let {name, ...restConfig} = param; return [ name, - subConfig + restConfig ]; } @@ -391,9 +391,9 @@ Mocha.describe("Record_rest_test", () => { }); export { - SubConfig, + RestConfig, describeConfig, - getNameAndSubConfig, + getNameAndRestConfig, getAliasedRest, getNamespacedRest, getRenamedRest, diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index 0da2225a8af..067ab347c42 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -7,19 +7,19 @@ type config = { debug: bool, } -type subConfig = { +type restConfig = { version: string, debug: bool, } -module SubConfig = { +module RestConfig = { type t = { version: string, debug: bool, } } -type aliasedSubConfig = subConfig +type aliasedRestConfig = restConfig type renamedConfig = { @as("user-name") @@ -30,26 +30,26 @@ type renamedConfig = { let describeConfig = (c: config) => switch c { - | {name, ...subConfig as rest} => (name, rest) + | {name, ...restConfig as rest} => (name, rest) } -let getNameAndSubConfig = ({name, ...subConfig as subConfig}: config) => (name, subConfig) +let getNameAndRestConfig = ({name, ...restConfig as restConfig}: config) => (name, restConfig) -let getAliasedRest = ({name: _, ...aliasedSubConfig as rest}: config) => rest -let getNamespacedRest = ({name: _, ...SubConfig.t as rest}: config) => rest +let getAliasedRest = ({name: _, ...aliasedRestConfig as rest}: config) => rest +let getNamespacedRest = ({name: _, ...RestConfig.t as rest}: config) => rest -let getRenamedRest = ({name: _, ...subConfig as rest}: renamedConfig) => rest -let getRenamedNameAndRest = ({name, ...subConfig as rest}: renamedConfig) => (name, rest) +let getRenamedRest = ({name: _, ...restConfig as rest}: renamedConfig) => rest +let getRenamedNameAndRest = ({name, ...restConfig as rest}: renamedConfig) => (name, rest) -let getName = ({name, ...subConfig as _rest}: config) => name +let getName = ({name, ...restConfig as _rest}: config) => name let getWholeConfig = ({...config as rest}: config) => rest let makeConfig = (): config => {name: "call", version: "4.5", debug: true} let getCallResultRest = () => { - let {name: _, ...subConfig as rest} = makeConfig() + let {name: _, ...restConfig as rest} = makeConfig() rest } -let getNameRestAndOriginalVersion = ({name, ...subConfig as rest} as original: config) => ( +let getNameRestAndOriginalVersion = ({name, ...restConfig as rest} as original: config) => ( name, rest, original.version, @@ -84,12 +84,12 @@ type wrapped = | Wrap(config) | Mirror(config) -let getTupleRest = (({name: _, ...subConfig as rest}, _): (config, int)) => rest +let getTupleRest = (({name: _, ...restConfig as rest}, _): (config, int)) => rest let getWrappedRest = wrapped => switch wrapped { - | Wrap({name: _, ...subConfig as rest}) - | Mirror({name: _, ...subConfig as rest}) => rest + | Wrap({name: _, ...restConfig as rest}) + | Mirror({name: _, ...restConfig as rest}) => rest } type inlineWrapped = @@ -98,8 +98,8 @@ type inlineWrapped = let getInlineWrappedRest = wrapped => switch wrapped { - | InlineWrap({name: _, ...subConfig as rest}) - | InlineMirror({name: _, ...subConfig as rest}) => rest + | InlineWrap({name: _, ...restConfig as rest}) + | InlineMirror({name: _, ...restConfig as rest}) => rest } type renamedInlineWrapped = @@ -118,8 +118,8 @@ type renamedInlineWrapped = let getRenamedInlineWrappedRest = wrapped => switch wrapped { - | RenamedInlineWrap({name: _, ...subConfig as rest}) - | RenamedInlineMirror({name: _, ...subConfig as rest}) => rest + | RenamedInlineWrap({name: _, ...restConfig as rest}) + | RenamedInlineMirror({name: _, ...restConfig as rest}) => rest } @tag("kind") @@ -129,8 +129,8 @@ type customTaggedInlineWrapped = let getCustomTaggedInlineWrappedRest = wrapped => switch wrapped { - | CustomInlineWrap({name: _, ...subConfig as rest}) - | CustomInlineMirror({name: _, ...subConfig as rest}) => rest + | CustomInlineWrap({name: _, ...restConfig as rest}) + | CustomInlineMirror({name: _, ...restConfig as rest}) => rest } @tag("custom-tag") @@ -140,13 +140,13 @@ type dashedTaggedInlineWrapped = let getDashedTaggedInlineWrappedRest = wrapped => switch wrapped { - | DashedInlineWrap({name: _, ...subConfig as rest}) - | DashedInlineMirror({name: _, ...subConfig as rest}) => rest + | DashedInlineWrap({name: _, ...restConfig as rest}) + | DashedInlineMirror({name: _, ...restConfig 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) + let {name, ...restConfig as rest} = ({name: "test", version: "1.0", debug: true}: config) eq(__LOC__, name, "test") eq(__LOC__, rest, {version: "1.0", debug: true}) }) @@ -178,7 +178,7 @@ describe(__MODULE__, () => { {version: "3.15", debug: true}, ) - let {name: _, ...SubConfig.t as rest} = ( + let {name: _, ...RestConfig.t as rest} = ( { name: "namespaced-let", version: "3.16", @@ -330,7 +330,7 @@ describe(__MODULE__, () => { test("strict directive functions keep record rest destructuring in the body", () => { let strictDirectiveRest = - @directive("'use strict'") ({name: _, ...subConfig as rest}: config) => rest + @directive("'use strict'") ({name: _, ...restConfig as rest}: config) => rest eq( __LOC__, From ed0fd1736e2a9df4ef79653ebd68a1f0bcf85fd6 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 24 Jun 2026 10:08:46 +0200 Subject: [PATCH 36/47] add a warning for optional field overlap --- compiler/ext/warnings.ml | 23 +++++-- compiler/ext/warnings.mli | 2 +- compiler/ml/typecore_record_rest.ml | 36 ++++++----- tests/ERROR_VARIANTS.md | 2 +- .../record_rest_empty_warning.res.expected | 10 ---- ...ecord_rest_field_not_optional.res.expected | 8 +-- ...est_field_not_optional_plural.res.expected | 8 +-- ...rest_optional_overlap_warning.res.expected | 13 ++++ .../fixtures/record_rest_empty_warning.res | 3 - .../record_rest_field_not_optional.res | 6 +- .../record_rest_field_not_optional_plural.res | 6 +- .../record_rest_optional_overlap_warning.res | 3 + tests/tests/src/record_rest_test.mjs | 60 +++++++++---------- tests/tests/src/record_rest_test.res | 1 + 14 files changed, 101 insertions(+), 80 deletions(-) delete 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_optional_overlap_warning.res.expected delete mode 100644 tests/build_tests/super_errors/fixtures/record_rest_empty_warning.res create mode 100644 tests/build_tests/super_errors/fixtures/record_rest_optional_overlap_warning.res diff --git a/compiler/ext/warnings.ml b/compiler/ext/warnings.ml index 629a4ca759a..c41ef0f8e7b 100644 --- a/compiler/ext/warnings.ml +++ b/compiler/ext/warnings.ml @@ -75,7 +75,7 @@ type t = (string * top_level_unit_help) option (* 109 *) | Bs_todo of string option (* 110 *) | Bs_private_record_mutation of string (* 111 *) - | Bs_record_rest_empty (* 112 *) + | Bs_record_rest_optional_overlap of string list (* 112 *) (* If you remove a warning, leave a hole in the numbering. NEVER change the numbers of existing warnings. @@ -129,7 +129,7 @@ let number = function | Bs_toplevel_expression_unit _ -> 109 | Bs_todo _ -> 110 | Bs_private_record_mutation _ -> 111 - | Bs_record_rest_empty -> 112 + | Bs_record_rest_optional_overlap _ -> 112 let last_warning_number = 112 @@ -450,9 +450,22 @@ 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_record_rest_optional_overlap fields -> ( + let field_list = + fields |> List.map (fun field -> "\n- " ^ field) |> String.concat "" + in + (match fields with + | [_] -> + "The following optional field appears in both the explicit pattern and \ + the rest type:" + | _ -> + "The following optional fields appear in both the explicit pattern and \ + the rest type:") + ^ field_list + ^ + match fields with + | [_] -> "\n\nIt will always be absent from the rest record." + | _ -> "\n\nThey will always be absent from the rest record.") | Bs_todo maybe_text -> (match maybe_text with | None -> "Todo found." diff --git a/compiler/ext/warnings.mli b/compiler/ext/warnings.mli index e7be69baf32..9514ea21e6d 100644 --- a/compiler/ext/warnings.mli +++ b/compiler/ext/warnings.mli @@ -68,7 +68,7 @@ type t = (string * top_level_unit_help) option (* 109 *) | Bs_todo of string option (* 110 *) | Bs_private_record_mutation of string (* 111 *) - | Bs_record_rest_empty (* 112 *) + | Bs_record_rest_optional_overlap of string list (* 112 *) val parse_options : bool -> string -> unit diff --git a/compiler/ml/typecore_record_rest.ml b/compiler/ml/typecore_record_rest.ml index 085735b3b2a..8b4acd57af5 100644 --- a/compiler/ml/typecore_record_rest.ml +++ b/compiler/ml/typecore_record_rest.ml @@ -191,16 +191,22 @@ let type_record_pat_rest ~env ~pattern_force ~loc ~record_ty ~lbl_pat_list ~rest resolve_source_record ~env ~unify_pat_types ~loc ~record_ty ~rest_type_lid ~rest_type_expr ~rest_decl in - let not_optional = + let overlapping_fields = List.filter - (fun rest_field -> - List.mem rest_field explicit_fields - && not (List.mem rest_field explicit_optional_fields)) + (fun rest_field -> List.mem rest_field explicit_fields) rest_field_names in - if not_optional <> [] then + let non_optional_overlapping_fields = + List.filter + (fun rest_field -> not (List.mem rest_field explicit_optional_fields)) + overlapping_fields + in + if non_optional_overlapping_fields <> [] then raise_error rest.rest_loc env - (Field_not_optional (not_optional, rest_type_lid.txt)); + (Field_not_optional (non_optional_overlapping_fields, rest_type_lid.txt)) + else if overlapping_fields <> [] then + Location.prerr_warning rest.rest_loc + (Warnings.Bs_record_rest_optional_overlap overlapping_fields); let source_field_names = List.map (fun field -> field.source_name) source_fields in @@ -237,12 +243,6 @@ let type_record_pat_rest ~env ~pattern_force ~loc ~record_ty ~lbl_pat_list ~rest unify_pat_types rest_type_lid.loc env rest_label.ld_type source_field.source_type) rest_labels; - if - rest_field_names <> [] - && List.for_all - (fun field -> List.mem field explicit_fields) - rest_field_names - then Location.prerr_warning rest.rest_loc Warnings.Bs_record_rest_empty; let rest_ident = enter_variable rest.rest_loc rest.rest_name rest_type_expr in { Typedtree.rest_ident; @@ -270,17 +270,21 @@ let report_error ppf = function fields |> List.map (fun field -> "\n- " ^ field) |> 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." - Printtyp.longident lid field_list field + This is not type-safe because the field would always be absent from \ + the rest value. Remove it from the rest type, or match it as optional \ + if absence is intended." + Printtyp.longident lid field_list | _ -> 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." + This is not type-safe because these fields would always be absent \ + from the rest value. Remove them from the rest type, or match them as \ + optional if absence is intended." Printtyp.longident lid field_list) | Field_missing (fields, lid) -> ( let field_list = diff --git a/tests/ERROR_VARIANTS.md b/tests/ERROR_VARIANTS.md index 71ff64168d9..afeba3034e4 100644 --- a/tests/ERROR_VARIANTS.md +++ b/tests/ERROR_VARIANTS.md @@ -241,7 +241,7 @@ Source: [typecore.ml:27](../compiler/ml/typecore.ml). | `Empty_record_literal` | ✓ | `empty_record_literal.res` | | | `Uncurried_arity_mismatch` | ✓ | `arity_mismatch3.res` etc. | | | `Field_not_optional` | ✓ | `fieldNotOptional.res` | | -| `Record_rest` | ✓ | `record_rest_*.res` | Wrapper for record-rest validation errors reported by `typecore_record_rest.ml`; fixtures cover missing annotation, invalid rest type, non-record and unresolved rest types, private and unboxed record types, mutable source records, field mismatch/missing/extra cases, runtime-name mismatch, empty-rest warning, module destructure rejection, and singular/plural missing and overlap messages. | +| `Record_rest` | ✓ | `record_rest_*.res` | Wrapper for record-rest validation errors reported by `typecore_record_rest.ml`; fixtures cover missing annotation, invalid rest type, non-record and unresolved rest types, private and unboxed record types, mutable source records, field mismatch/missing/extra cases, runtime-name mismatch, non-optional overlap errors, optional overlap warnings, module destructure rejection, and singular/plural missing messages. | | `Type_params_not_supported` | ✓ | `variant_spread_pattern_type_params.res` | Pattern-level variant spread (`| ...a as v`) where `a` has type params; typedecl path covered by `variant_spread_type_parameters.res`. | | `Field_access_on_dict_type` | ✓ | `field_access_on_dict_type.res` | | | `Jsx_not_enabled` | ☐ (needs harness flag) | — | typecore.ml:218/3470. Fires when JSX is used without `-bs-jsx N`. The `super_errors` runner hard-codes `-bs-jsx 4` in `bscFlags`; adding a per-fixture opt-out (e.g. a `.opts` sidecar) would expose this. Until then, it's reachable in real code but blocked at the harness level. | 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 deleted file mode 100644 index 7412b2bff94..00000000000 --- a/tests/build_tests/super_errors/expected/record_rest_empty_warning.res.expected +++ /dev/null @@ -1,10 +0,0 @@ - - Warning number 112 - /.../fixtures/record_rest_empty_warning.res:3:13-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. 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 index 27c0ab5103d..73870f3e36b 100644 --- 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 @@ -2,12 +2,12 @@ We've found a bug for you! /.../fixtures/record_rest_field_not_optional.res:3:9-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} + 1 │ type source = {a: int, b: string} + 2 │ type sub = {a: int, b: string} + 3 │ let {a, ...sub as rest}: source = {a: 1, b: "x"} 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 +This is not type-safe because the field would always be absent from the rest value. Remove it from the rest type, or match it as optional if absence is intended. diff --git a/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected index 490fcaf26ac..53cebe701af 100644 --- a/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected +++ b/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected @@ -2,13 +2,13 @@ We've found a bug for you! /.../fixtures/record_rest_field_not_optional_plural.res:3:12-25 - 1 │ type source = {a?: int, b?: string, c: bool} - 2 │ type sub = {a?: int, b?: string} - 3 │ let {a, b, ...sub as rest}: source = {c: true} + 1 │ type source = {a: int, b: string} + 2 │ type sub = {a: int, b: string} + 3 │ let {a, b, ...sub as rest}: source = {a: 1, b: "x"} 4 │ The following fields appear in both the explicit pattern and the rest type `sub`: - a - b -Mark them as optional (e.g. `?fieldName`) in the explicit pattern. \ No newline at end of file +This is not type-safe because these fields would always be absent from the rest value. Remove them from the rest type, or match them as optional if absence is intended. diff --git a/tests/build_tests/super_errors/expected/record_rest_optional_overlap_warning.res.expected b/tests/build_tests/super_errors/expected/record_rest_optional_overlap_warning.res.expected new file mode 100644 index 00000000000..83f8bc80450 --- /dev/null +++ b/tests/build_tests/super_errors/expected/record_rest_optional_overlap_warning.res.expected @@ -0,0 +1,13 @@ + + Warning number 112 + /.../fixtures/record_rest_optional_overlap_warning.res:3:24-37 + + 1 │ type source = {a?: int, b: string} + 2 │ type sub = {a?: int, b: string} + 3 │ let getRest = ({a: ?_, ...sub as rest}: source) => rest + 4 │ + + The following optional field appears in both the explicit pattern and the rest type: +- a + +It will always be absent from the rest record. 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 deleted file mode 100644 index 817b139276c..00000000000 --- a/tests/build_tests/super_errors/fixtures/record_rest_empty_warning.res +++ /dev/null @@ -1,3 +0,0 @@ -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_field_not_optional.res b/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional.res index d5bffdb282f..e5a6f70b7d5 100644 --- 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 @@ -1,3 +1,3 @@ -type source = {a?: int, b?: string, c: bool} -type sub = {a?: int, b?: string} -let {a, ...sub as rest}: source = {c: true} +type source = {a: int, b: string} +type sub = {a: int, b: string} +let {a, ...sub as rest}: source = {a: 1, b: "x"} diff --git a/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional_plural.res b/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional_plural.res index a52ca15b596..4ce606b7a67 100644 --- a/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional_plural.res +++ b/tests/build_tests/super_errors/fixtures/record_rest_field_not_optional_plural.res @@ -1,3 +1,3 @@ -type source = {a?: int, b?: string, c: bool} -type sub = {a?: int, b?: string} -let {a, b, ...sub as rest}: source = {c: true} +type source = {a: int, b: string} +type sub = {a: int, b: string} +let {a, b, ...sub as rest}: source = {a: 1, b: "x"} diff --git a/tests/build_tests/super_errors/fixtures/record_rest_optional_overlap_warning.res b/tests/build_tests/super_errors/fixtures/record_rest_optional_overlap_warning.res new file mode 100644 index 00000000000..39166e604ed --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/record_rest_optional_overlap_warning.res @@ -0,0 +1,3 @@ +type source = {a?: int, b: string} +type sub = {a?: int, b: string} +let getRest = ({a: ?_, ...sub as rest}: source) => rest diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 5df24bb4ad9..59c24c10d30 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -119,13 +119,13 @@ Mocha.describe("Record_rest_test", () => { version: "1.0", debug: true }; - Test_utils.eq("File \"record_rest_test.res\", line 150, characters 7-14", "test", "test"); - Test_utils.eq("File \"record_rest_test.res\", line 151, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 151, characters 7-14", "test", "test"); + Test_utils.eq("File \"record_rest_test.res\", line 152, 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 156, characters 6-13", describeConfig({ + Mocha.test("match arm returns the named field and the rest record", () => Test_utils.eq("File \"record_rest_test.res\", line 157, characters 6-13", describeConfig({ name: "match", version: "2.0", debug: false @@ -136,12 +136,12 @@ Mocha.describe("Record_rest_test", () => { debug: false } ])); - Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 163, characters 7-14", getName({ + Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 164, characters 7-14", getName({ name: "param", version: "3.0", debug: true }), "param")); - Mocha.test("record rest accepts type aliases to record shapes", () => Test_utils.eq("File \"record_rest_test.res\", line 168, characters 6-13", getAliasedRest({ + Mocha.test("record rest accepts type aliases to record shapes", () => Test_utils.eq("File \"record_rest_test.res\", line 169, characters 6-13", getAliasedRest({ name: "aliased", version: "3.1", debug: false @@ -150,7 +150,7 @@ Mocha.describe("Record_rest_test", () => { debug: false })); Mocha.test("record rest accepts namespaced record types", () => { - Test_utils.eq("File \"record_rest_test.res\", line 176, characters 6-13", getNamespacedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 177, characters 6-13", getNamespacedRest({ name: "namespaced", version: "3.15", debug: true @@ -163,12 +163,12 @@ Mocha.describe("Record_rest_test", () => { version: "3.16", debug: false }; - Test_utils.eq("File \"record_rest_test.res\", line 188, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 189, characters 7-14", rest, { version: "3.16", debug: false }); }); - Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 193, characters 6-13", getRenamedRest({ + Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 194, characters 6-13", getRenamedRest({ "user-name": "renamed", version: "3.2", debug: true @@ -176,7 +176,7 @@ Mocha.describe("Record_rest_test", () => { version: "3.2", debug: true })); - Mocha.test("record rest can return a field renamed with @as alongside the rest", () => Test_utils.eq("File \"record_rest_test.res\", line 201, characters 6-13", getRenamedNameAndRest({ + Mocha.test("record rest can return a field renamed with @as alongside the rest", () => Test_utils.eq("File \"record_rest_test.res\", line 202, characters 6-13", getRenamedNameAndRest({ "user-name": "renamed", version: "3.25", debug: false @@ -187,7 +187,7 @@ Mocha.describe("Record_rest_test", () => { debug: false } ])); - Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 209, characters 6-13", (({...__rest}) => __rest)({ + Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 210, characters 6-13", (({...__rest}) => __rest)({ name: "whole", version: "3.5", debug: false @@ -203,12 +203,12 @@ Mocha.describe("Record_rest_test", () => { debug: true }; let {...rest} = whole; - Test_utils.eq("File \"record_rest_test.res\", line 217, characters 7-14", whole, { + Test_utils.eq("File \"record_rest_test.res\", line 218, characters 7-14", whole, { name: "wholeAlias", version: "3.6", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 218, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 219, characters 7-14", rest, { name: "wholeAlias", version: "3.6", debug: true @@ -221,7 +221,7 @@ Mocha.describe("Record_rest_test", () => { style: "bold", onClick: onClick }); - Test_utils.eq("File \"record_rest_test.res\", line 224, characters 7-14", rest, { + Test_utils.eq("File \"record_rest_test.res\", line 225, characters 7-14", rest, { style: "bold", onClick: onClick }); @@ -231,18 +231,18 @@ Mocha.describe("Record_rest_test", () => { id: "1", value: 42 }; - Test_utils.eq("File \"record_rest_test.res\", line 229, characters 7-14", "1", "1"); - Test_utils.eq("File \"record_rest_test.res\", line 230, characters 7-14", intRest, { + Test_utils.eq("File \"record_rest_test.res\", line 230, characters 7-14", "1", "1"); + Test_utils.eq("File \"record_rest_test.res\", line 231, characters 7-14", intRest, { value: 42 }); - Test_utils.eq("File \"record_rest_test.res\", line 231, characters 7-14", (({id: __unused0, ...__rest}) => __rest)({ + Test_utils.eq("File \"record_rest_test.res\", line 232, characters 7-14", (({id: __unused0, ...__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 236, characters 6-13", getTupleRest([ + Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 237, characters 6-13", getTupleRest([ { name: "tuple", version: "4.0", @@ -253,11 +253,11 @@ Mocha.describe("Record_rest_test", () => { version: "4.0", debug: false })); - Mocha.test("record rest works when the source is not a bare identifier", () => Test_utils.eq("File \"record_rest_test.res\", line 243, characters 7-14", getCallResultRest(), { + Mocha.test("record rest works when the source is not a bare identifier", () => Test_utils.eq("File \"record_rest_test.res\", line 244, characters 7-14", getCallResultRest(), { version: "4.5", debug: true })); - Mocha.test("record rest keeps the original parameter alias usable", () => Test_utils.eq("File \"record_rest_test.res\", line 248, characters 6-13", getNameRestAndOriginalVersion({ + Mocha.test("record rest keeps the original parameter alias usable", () => Test_utils.eq("File \"record_rest_test.res\", line 249, characters 6-13", getNameRestAndOriginalVersion({ name: "original", version: "4.75", debug: false @@ -270,7 +270,7 @@ Mocha.describe("Record_rest_test", () => { "4.75" ])); Mocha.test("variant payload rest works through the or-pattern path", () => { - Test_utils.eq("File \"record_rest_test.res\", line 256, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 257, characters 6-13", getWrappedRest({ TAG: "Wrap", _0: { name: "wrapped", @@ -281,7 +281,7 @@ Mocha.describe("Record_rest_test", () => { version: "5.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 261, characters 6-13", getWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 262, characters 6-13", getWrappedRest({ TAG: "Mirror", _0: { name: "mirror", @@ -294,7 +294,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes the runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 269, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 270, characters 6-13", getInlineWrappedRest({ TAG: "InlineWrap", name: "inline", version: "7.0", @@ -303,7 +303,7 @@ Mocha.describe("Record_rest_test", () => { version: "7.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 274, characters 6-13", getInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 275, characters 6-13", getInlineWrappedRest({ TAG: "InlineMirror", name: "inlineMirror", version: "8.0", @@ -314,7 +314,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest excludes fields renamed with @as", () => { - Test_utils.eq("File \"record_rest_test.res\", line 282, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 283, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineWrap", "user-name": "inlineRenamed", version: "8.5", @@ -323,7 +323,7 @@ Mocha.describe("Record_rest_test", () => { version: "8.5", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 289, characters 6-13", getRenamedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 290, characters 6-13", getRenamedInlineWrappedRest({ TAG: "RenamedInlineMirror", "user-name": "inlineRenamed2", version: "8.6", @@ -334,7 +334,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record variant rest removes a custom runtime tag field", () => { - Test_utils.eq("File \"record_rest_test.res\", line 299, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 300, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineWrap", name: "customInline", version: "9.0", @@ -343,7 +343,7 @@ Mocha.describe("Record_rest_test", () => { version: "9.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 306, characters 6-13", getCustomTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 307, characters 6-13", getCustomTaggedInlineWrappedRest({ kind: "CustomInlineMirror", name: "customInlineMirror", version: "10.0", @@ -354,7 +354,7 @@ Mocha.describe("Record_rest_test", () => { }); }); Mocha.test("inline record rest works with a non-identifier custom tag name", () => { - Test_utils.eq("File \"record_rest_test.res\", line 316, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 317, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineWrap", name: "dashedInline", version: "11.0", @@ -363,7 +363,7 @@ Mocha.describe("Record_rest_test", () => { version: "11.0", debug: true }); - Test_utils.eq("File \"record_rest_test.res\", line 323, characters 6-13", getDashedTaggedInlineWrappedRest({ + Test_utils.eq("File \"record_rest_test.res\", line 324, characters 6-13", getDashedTaggedInlineWrappedRest({ "custom-tag": "DashedInlineMirror", name: "dashedInlineMirror", version: "12.0", @@ -379,7 +379,7 @@ Mocha.describe("Record_rest_test", () => { let {name: __unused0, ...rest} = param; return rest; }; - Test_utils.eq("File \"record_rest_test.res\", line 336, characters 6-13", strictDirectiveRest({ + Test_utils.eq("File \"record_rest_test.res\", line 337, characters 6-13", strictDirectiveRest({ name: "strict", version: "13.0", debug: false diff --git a/tests/tests/src/record_rest_test.res b/tests/tests/src/record_rest_test.res index 067ab347c42..79cd4553241 100644 --- a/tests/tests/src/record_rest_test.res +++ b/tests/tests/src/record_rest_test.res @@ -67,6 +67,7 @@ type baseProps = { onClick: unit => unit, } +@warning("-112") let extractClassName = ({className: ?_, ...baseProps as rest}: fullProps) => rest type container<'a> = { From b79f5dac6939d34c7d905085e97a01fd0327dcec Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Jul 2026 19:55:57 +0200 Subject: [PATCH 37/47] no longer drop rest when printing pattern --- compiler/common/pattern_printer.ml | 10 ++++- .../ounit_pattern_printer_tests.ml | 38 +++++++++++++++++++ tests/ounit_tests/ounit_tests_main.ml | 1 + 3 files changed, 47 insertions(+), 2 deletions(-) create mode 100644 tests/ounit_tests/ounit_pattern_printer_tests.ml diff --git a/compiler/common/pattern_printer.ml b/compiler/common/pattern_printer.ml index 754eb2533c0..de47287bddd 100644 --- a/compiler/common/pattern_printer.ml +++ b/compiler/common/pattern_printer.ml @@ -5,6 +5,11 @@ open Asttypes let mkpat desc = Ast_helper.Pat.mk desc +let untype_record_rest (rest : Typedtree.record_pat_rest) : + Parsetree.record_pat_rest = + let rest_name = rest.rest_name in + {Parsetree.rest_loc = rest_name.loc; rest_name; rest_type = None} + let[@warning "-4"] is_generated_optional_constructor (lid : Longident.t Location.loc) = match lid.txt with @@ -76,7 +81,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, _rest) -> + | Tpat_record (subpatterns, closed_flag, rest) -> let fields, saw_optional_rewrite = List.fold_right (fun (_, lbl, p, opt) (fields, saw_optional_rewrite) -> @@ -97,7 +102,8 @@ 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, None)) + mkpat + (Ppat_record (fields, closed_flag, Option.map untype_record_rest rest)) | Tpat_array lst -> mkpat (Ppat_array (List.map loop lst)) in loop typed diff --git a/tests/ounit_tests/ounit_pattern_printer_tests.ml b/tests/ounit_tests/ounit_pattern_printer_tests.ml new file mode 100644 index 00000000000..f8a1ab4eabe --- /dev/null +++ b/tests/ounit_tests/ounit_pattern_printer_tests.ml @@ -0,0 +1,38 @@ +let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: )) + +let loc = Location.none + +let rest_type = + Btype.newgenty + (Types.Tconstr (Path.Pident (Ident.create "restConfig"), [], ref Types.Mnil)) + +let record_rest_pattern = + let rest = Ident.create "_rest" in + { + Typedtree.pat_desc = + Tpat_record + ( [], + Asttypes.Closed, + Some + { + rest_ident = rest; + rest_name = Location.mknoloc (Ident.name rest); + rest_type; + excluded_runtime_labels = []; + } ); + pat_loc = loc; + pat_extra = []; + pat_type = rest_type; + pat_env = Env.empty; + pat_attributes = []; + } + +let suites = + __FILE__ + >::: [ + ( __LOC__ >:: fun _ -> + OUnit.assert_equal + ~printer:(fun x -> x) + "{..._rest}" + (Pattern_printer.print_pattern record_rest_pattern) ); + ] diff --git a/tests/ounit_tests/ounit_tests_main.ml b/tests/ounit_tests/ounit_tests_main.ml index dd7b1c1b376..8ac38f71f2d 100644 --- a/tests/ounit_tests/ounit_tests_main.ml +++ b/tests/ounit_tests/ounit_tests_main.ml @@ -19,6 +19,7 @@ let suites = Ounit_unicode_tests.suites; Ounit_util_tests.suites; Ounit_rec_check_tests.suites; + Ounit_pattern_printer_tests.suites; Ounit_js_analyzer_tests.suites; Ounit_jsx_loc_tests.suites; Ounit_analysis_config_tests.suites; From 1824426a9d46787f7924d5ba07f2705129dabf9d Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Jul 2026 20:09:22 +0200 Subject: [PATCH 38/47] make Parmatch.Conv.conv no longer drop rest --- compiler/ml/parmatch.ml | 17 +++- .../ounit_pattern_printer_tests.ml | 77 +++++++++++++++++++ 2 files changed, 92 insertions(+), 2 deletions(-) diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml index 047a71b2f0d..039061936de 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -1968,6 +1968,19 @@ module Conv = struct name_counter := !name_counter + 1; "#$" ^ name ^ string_of_int current + let conv_record_rest (rest : Typedtree.record_pat_rest) = + match (Btype.repr rest.rest_type).desc with + | Tconstr (path, args, _) -> + let loc = rest.rest_name.loc in + let rest_type = + Ast_helper.Typ.constr ~loc + (mkloc (Ctype.lid_of_path path) loc) + (List.map (fun _ -> Ast_helper.Typ.any ~loc ()) args) + in + Some + {rest_loc = loc; rest_name = rest.rest_name; rest_type = Some rest_type} + | _ -> None + let conv typed = let constrs = Hashtbl.create 7 in let labels = Hashtbl.create 7 in @@ -1995,7 +2008,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, _rest) -> + | Tpat_record (subpatterns, _closed_flag, rest) -> let fields = List.map (fun (_, lbl, p, optional) -> @@ -2004,7 +2017,7 @@ module Conv = struct {lid = mknoloc (Longident.Lident id); x = loop p; opt = optional}) subpatterns in - mkpat (Ppat_record (fields, Open, None)) + mkpat (Ppat_record (fields, Open, Option.bind rest conv_record_rest)) | Tpat_array lst -> mkpat (Ppat_array (List.map loop lst)) in let ps = loop typed in diff --git a/tests/ounit_tests/ounit_pattern_printer_tests.ml b/tests/ounit_tests/ounit_pattern_printer_tests.ml index f8a1ab4eabe..daa1ef026f3 100644 --- a/tests/ounit_tests/ounit_pattern_printer_tests.ml +++ b/tests/ounit_tests/ounit_pattern_printer_tests.ml @@ -6,6 +6,10 @@ let rest_type = Btype.newgenty (Types.Tconstr (Path.Pident (Ident.create "restConfig"), [], ref Types.Mnil)) +let record_type = + Btype.newgenty + (Types.Tconstr (Path.Pident (Ident.create "config"), [], ref Types.Mnil)) + let record_rest_pattern = let rest = Ident.create "_rest" in { @@ -27,6 +31,78 @@ let record_rest_pattern = pat_attributes = []; } +let int_pattern n = + { + record_rest_pattern with + Typedtree.pat_desc = Tpat_constant (Const_int n); + pat_type = Predef.type_int; + } + +let count_label = + let label = + { + Types.lbl_name = "count"; + lbl_res = record_type; + lbl_arg = Predef.type_int; + lbl_mut = Asttypes.Immutable; + lbl_optional = false; + lbl_pos = 0; + lbl_all = [||]; + lbl_repres = Record_regular; + lbl_private = Asttypes.Public; + lbl_loc = loc; + lbl_attributes = []; + } + in + label.lbl_all <- [|label|]; + label + +let record_with_rest_pattern = + { + record_rest_pattern with + Typedtree.pat_desc = + Tpat_record + ( [ + ( Location.mknoloc (Longident.Lident "count"), + count_label, + int_pattern 1, + false ); + ], + Asttypes.Closed, + match record_rest_pattern.pat_desc with + | Tpat_record (_, _, rest) -> rest + | _ -> assert false ); + pat_type = record_type; + } + +let dummy_expr = + { + Typedtree.exp_desc = Texp_constant (Const_int 0); + exp_loc = loc; + exp_extra = []; + exp_type = Predef.type_int; + exp_env = Env.empty; + exp_attributes = []; + } + +let assert_parmatch_conv_keeps_record_rest _ = + let converted_pattern = ref None in + let pred _ _ pattern = + converted_pattern := Some pattern; + None + in + ignore + (Parmatch.check_partial_gadt pred loc + [{c_lhs = record_with_rest_pattern; c_guard = None; c_rhs = dummy_expr}]); + match !converted_pattern with + | Some {Parsetree.ppat_desc = Ppat_record (_, _, Some rest)} -> + OUnit.assert_equal ~printer:(fun x -> x) "_rest" rest.rest_name.txt; + OUnit.assert_bool __LOC__ (Option.is_some rest.rest_type) + | Some pattern -> + OUnit.assert_failure + (Format.asprintf "Expected record rest, got %a" Pprintast.pattern pattern) + | None -> OUnit.assert_failure "Expected exhaustiveness predicate to run" + let suites = __FILE__ >::: [ @@ -35,4 +111,5 @@ let suites = ~printer:(fun x -> x) "{..._rest}" (Pattern_printer.print_pattern record_rest_pattern) ); + __LOC__ >:: assert_parmatch_conv_keeps_record_rest; ] From b58f523927972d58e28a8851a61efc4f6ad58eea Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Jul 2026 20:17:19 +0200 Subject: [PATCH 39/47] remove unused Object_rest_param --- compiler/core/j.ml | 13 +--------- compiler/core/js_dump.ml | 7 ++---- compiler/core/js_fold.ml | 9 ------- compiler/core/js_record_fold.ml | 7 ------ compiler/core/js_record_iter.ml | 6 ----- compiler/core/js_record_map.ml | 9 ------- tests/ounit_tests/ounit_js_analyzer_tests.ml | 26 -------------------- 7 files changed, 3 insertions(+), 74 deletions(-) diff --git a/compiler/core/j.ml b/compiler/core/j.ml index 644756665fe..49efe97cc6a 100644 --- a/compiler/core/j.ml +++ b/compiler/core/j.ml @@ -82,12 +82,7 @@ and record_rest_field = { record_rest_ident: ident option; } -and object_rest_param = { - object_rest_fields: record_rest_field list; - object_rest_rest: ident; -} - -and param = Ident_param of ident | Object_rest_param of object_rest_param +and param = Ident_param of ident and expression_desc = | Length of expression * length_object @@ -341,7 +336,6 @@ and deps_program = { property_map; length_object; record_rest_field; - object_rest_param; param; (* for_ident; *) required_modules; @@ -357,12 +351,8 @@ so that we can achieve the optimal let record_rest_field_idents fields = List.filter_map (fun {record_rest_ident} -> record_rest_ident) fields -let object_rest_param_idents {object_rest_fields; object_rest_rest} = - object_rest_rest :: record_rest_field_idents object_rest_fields - let param_idents = function | Ident_param id -> [id] - | Object_rest_param param -> object_rest_param_idents param let params_idents params = List.concat_map param_idents params @@ -370,6 +360,5 @@ let params_as_idents params = let rec aux acc = function | [] -> Some (List.rev acc) | Ident_param id :: rest -> aux (id :: acc) rest - | Object_rest_param _ :: _ -> None in aux [] params diff --git a/compiler/core/js_dump.ml b/compiler/core/js_dump.ml index 1ceb8615867..247172261e6 100644 --- a/compiler/core/js_dump.ml +++ b/compiler/core/js_dump.ml @@ -271,8 +271,6 @@ and record_rest_pattern cxt f fields rest = and param cxt f = function | J.Ident_param id -> Ext_pp_scope.ident cxt f id - | Object_rest_param {object_rest_fields; object_rest_rest} -> - record_rest_pattern cxt f object_rest_fields object_rest_rest and formal_parameter_list cxt f l = iter_lst cxt f l param comma_sp @@ -401,7 +399,7 @@ and pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t) *) let inner_cxt = Ext_pp_scope.sub_scope outer_cxt set_env in let param_body () : unit = - if is_method then + if is_method then ( match l with | [] -> assert false | Ident_param this :: arguments -> @@ -415,8 +413,7 @@ and pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t) if Js_fun_env.get_unused env 0 then cxt else pp_var_assign_this cxt f this in - function_body ?directive ~return_unit cxt f b) - | Object_rest_param _ :: _ -> assert false + function_body ?directive ~return_unit cxt f b)) else let cxt = match l with diff --git a/compiler/core/js_fold.ml b/compiler/core/js_fold.ml index 25280fa0e7e..50646ca99e4 100644 --- a/compiler/core/js_fold.ml +++ b/compiler/core/js_fold.ml @@ -88,20 +88,11 @@ class fold = let _self = option (fun _self -> _self#ident) _self _x0 in _self - method object_rest_param : object_rest_param -> 'self_type = - fun {object_rest_fields = _x0; object_rest_rest = _x1} -> - let _self = list (fun _self -> _self#record_rest_field) _self _x0 in - let _self = _self#ident _x1 in - _self - method param : param -> 'self_type = function | Ident_param _x0 -> let _self = _self#ident _x0 in _self - | Object_rest_param _x0 -> - let _self = _self#object_rest_param _x0 in - _self method expression_desc : expression_desc -> 'self_type = function diff --git a/compiler/core/js_record_fold.ml b/compiler/core/js_record_fold.ml index 994ca79b177..86fb298c5d2 100644 --- a/compiler/core/js_record_fold.ml +++ b/compiler/core/js_record_fold.ml @@ -93,16 +93,9 @@ let record_rest_field : 'a. ('a, record_rest_field) fn = fun _self st {record_rest_ident; _} -> option _self.ident _self st record_rest_ident -let object_rest_param : 'a. ('a, object_rest_param) fn = - fun _self st {object_rest_fields; object_rest_rest} -> - let st = list record_rest_field _self st object_rest_fields in - let st = _self.ident _self st object_rest_rest in - st - let param : 'a. ('a, param) fn = fun _self st -> function | Ident_param id -> _self.ident _self st id - | Object_rest_param rest -> object_rest_param _self st rest let expression_desc : 'a. ('a, expression_desc) fn = fun _self st -> function diff --git a/compiler/core/js_record_iter.ml b/compiler/core/js_record_iter.ml index f925e5ab370..a94923509ca 100644 --- a/compiler/core/js_record_iter.ml +++ b/compiler/core/js_record_iter.ml @@ -82,15 +82,9 @@ let length_object : length_object fn = unknown let record_rest_field : record_rest_field fn = fun _self {record_rest_ident; _} -> option _self.ident _self record_rest_ident -let object_rest_param : object_rest_param fn = - fun _self {object_rest_fields; object_rest_rest} -> - list record_rest_field _self object_rest_fields; - _self.ident _self object_rest_rest - let param : param fn = fun _self -> function | Ident_param id -> _self.ident _self id - | Object_rest_param rest -> object_rest_param _self rest let expression_desc : expression_desc fn = fun _self -> function diff --git a/compiler/core/js_record_map.ml b/compiler/core/js_record_map.ml index 4e1d19deb62..8ab1fb5de29 100644 --- a/compiler/core/js_record_map.ml +++ b/compiler/core/js_record_map.ml @@ -94,20 +94,11 @@ let record_rest_field : record_rest_field fn = let record_rest_ident = option _self.ident _self record_rest_ident in {field with record_rest_ident} -let object_rest_param : object_rest_param fn = - fun _self {object_rest_fields; object_rest_rest} -> - let object_rest_fields = list record_rest_field _self object_rest_fields in - let object_rest_rest = _self.ident _self object_rest_rest in - {object_rest_fields; object_rest_rest} - let param : param fn = fun _self -> function | Ident_param id -> let id = _self.ident _self id in Ident_param id - | Object_rest_param rest -> - let rest = object_rest_param _self rest in - Object_rest_param rest let expression_desc : expression_desc fn = fun _self -> function diff --git a/tests/ounit_tests/ounit_js_analyzer_tests.ml b/tests/ounit_tests/ounit_js_analyzer_tests.ml index 587c374e214..1628f6445a0 100644 --- a/tests/ounit_tests/ounit_js_analyzer_tests.ml +++ b/tests/ounit_tests/ounit_js_analyzer_tests.ml @@ -105,32 +105,6 @@ let suites = OUnit.assert_bool __LOC__ (Set_ident.mem free source); OUnit.assert_bool __LOC__ (not (Set_ident.mem free field)); OUnit.assert_bool __LOC__ (not (Set_ident.mem free rest)) ); - ( __LOC__ >:: fun _ -> - let field = Ident.create "name" in - let rest = Ident.create "rest" in - let folder = - { - Js_record_fold.super with - ident = (fun _ names ident -> Ident.name ident :: names); - } - in - let names = - Js_record_fold.param folder [] - (Object_rest_param - { - object_rest_fields = - [ - { - record_rest_label = "name"; - record_rest_ident = Some field; - }; - ]; - object_rest_rest = rest; - }) - in - OUnit.assert_equal ["rest"; "name"] names; - OUnit.assert_equal ["name"] - (Js_record_fold.param folder [] (Ident_param field)) ); ( __LOC__ >:: fun _ -> let param = Ident.create "param" in let transformed = From b9bb68ccab46653df3c10d5d8fa589441acd61e1 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Jul 2026 20:37:28 +0200 Subject: [PATCH 40/47] use internal attribute for ast mapper --- compiler/ml/ast_mapper_from0.ml | 14 +++- compiler/ml/ast_mapper_to0.ml | 3 +- tests/ounit_tests/ounit_ast_mapper0_tests.ml | 79 ++++++++++++++++++++ tests/ounit_tests/ounit_tests_main.ml | 1 + 4 files changed, 92 insertions(+), 5 deletions(-) create mode 100644 tests/ounit_tests/ounit_ast_mapper0_tests.ml diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index 080b42b31b0..539833fb495 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -93,7 +93,8 @@ let for_await_of_attr_name = "_res.for_await_of" let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} -let record_rest_attr_name = "res.record_rest" +(* Internal Parsetree0 bridge metadata; public res.* attributes pass through. *) +let record_rest_attr_name = "_res.record_rest" let record_rest_of_pattern (rest : Pt.pattern) = match rest.Pt.ppat_desc with @@ -105,9 +106,14 @@ let record_rest_of_pattern (rest : Pt.pattern) = let get_record_rest_attr attrs_ = let rec remove_record_rest_attr acc = function - | ({Location.txt = attr_name; _}, Pt.PPat (rest, None)) :: attrs - when attr_name = record_rest_attr_name -> - (record_rest_of_pattern rest, List.rev_append acc attrs) + | ({Location.txt = attr_name; _}, payload) :: attrs + when attr_name = record_rest_attr_name -> ( + match payload with + | Pt.PPat (rest, None) -> ( + match record_rest_of_pattern rest with + | Some rest -> (Some rest, List.rev_append acc attrs) + | None -> failwith "Malformed internal _res.record_rest attribute") + | _ -> failwith "Malformed internal _res.record_rest attribute") | attr :: attrs -> remove_record_rest_attr (attr :: acc) attrs | [] -> (None, List.rev acc) in diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 1b05477b169..3bd7bd0ad70 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -87,7 +87,8 @@ let for_await_of_attr_name = "_res.for_await_of" let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} -let record_rest_attr_name = "res.record_rest" +(* Internal Parsetree0 bridge metadata; public res.* attributes pass through. *) +let record_rest_attr_name = "_res.record_rest" let add_record_rest_attr ~rest attrs = (Location.mknoloc record_rest_attr_name, Pt.PPat (rest, None)) :: attrs diff --git a/tests/ounit_tests/ounit_ast_mapper0_tests.ml b/tests/ounit_tests/ounit_ast_mapper0_tests.ml new file mode 100644 index 00000000000..b1d902e34d0 --- /dev/null +++ b/tests/ounit_tests/ounit_ast_mapper0_tests.ml @@ -0,0 +1,79 @@ +let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: )) +let assert_failure = OUnit.assert_failure + +let loc = Location.none + +let attr name payload = ({Location.txt = name; loc}, payload) + +let has_attr name attrs = + List.exists (fun ({Location.txt}, _) -> txt = name) attrs + +let record_pat0 attrs = + Ast_helper0.Pat.record ~loc ~attrs + [ + ( Location.mknoloc (Longident.Lident "name"), + Ast_helper0.Pat.var ~loc (Location.mknoloc "name") ); + ] + Asttypes.Open + +let map_pat0 pat = + Ast_mapper_from0.default_mapper.pat Ast_mapper_from0.default_mapper pat + +let test_public_record_rest_attr_is_not_internal _ = + let pat = + map_pat0 (record_pat0 [attr "res.record_rest" (Parsetree0.PStr [])]) + in + match pat.ppat_desc with + | Parsetree.Ppat_record (_, _, None) -> + OUnit.assert_bool "public res.record_rest attribute was not preserved" + (has_attr "res.record_rest" pat.ppat_attributes) + | Parsetree.Ppat_record (_, _, Some _) -> + assert_failure "public res.record_rest attribute was decoded as record rest" + | _ -> assert_failure "Expected a record pattern" + +let test_malformed_internal_record_rest_attr_fails _ = + OUnit.assert_raises (Failure "Malformed internal _res.record_rest attribute") + (fun () -> + ignore + (map_pat0 (record_pat0 [attr "_res.record_rest" (Parsetree0.PStr [])]))) + +let test_record_rest_roundtrips_through_ast0 _ = + let rest = + Some + { + Parsetree.rest_loc = loc; + rest_name = Location.mknoloc "rest"; + rest_type = None; + } + in + let pat = + Ast_helper.Pat.record ~loc ?rest + [ + { + Parsetree.lid = Location.mknoloc (Longident.Lident "name"); + x = Ast_helper.Pat.var ~loc (Location.mknoloc "name"); + opt = false; + }; + ] + Asttypes.Open + in + let pat0 = + Ast_mapper_to0.default_mapper.pat Ast_mapper_to0.default_mapper pat + in + let pat = map_pat0 pat0 in + match pat.ppat_desc with + | Parsetree.Ppat_record + (_, _, Some {rest_name = {txt = "rest"; _}; rest_type = None; _}) -> + () + | _ -> assert_failure "Expected record rest after ast0 roundtrip" + +let suites = + __FILE__ + >::: [ + "public_record_rest_attr_is_not_internal" + >:: test_public_record_rest_attr_is_not_internal; + "malformed_internal_record_rest_attr_fails" + >:: test_malformed_internal_record_rest_attr_fails; + "record_rest_roundtrips_through_ast0" + >:: test_record_rest_roundtrips_through_ast0; + ] diff --git a/tests/ounit_tests/ounit_tests_main.ml b/tests/ounit_tests/ounit_tests_main.ml index 8ac38f71f2d..b0241a6aa3b 100644 --- a/tests/ounit_tests/ounit_tests_main.ml +++ b/tests/ounit_tests/ounit_tests_main.ml @@ -19,6 +19,7 @@ let suites = Ounit_unicode_tests.suites; Ounit_util_tests.suites; Ounit_rec_check_tests.suites; + Ounit_ast_mapper0_tests.suites; Ounit_pattern_printer_tests.suites; Ounit_js_analyzer_tests.suites; Ounit_jsx_loc_tests.suites; From 969eec2512278310a34e4d9702de4bffe9387c46 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Wed, 1 Jul 2026 20:47:06 +0200 Subject: [PATCH 41/47] improve completion support for record rest destructuring --- analysis/src/completion_front_end.ml | 13 ++++- tests/analysis_tests/tests/src/RecordRest.res | 6 ++ .../tests/src/expected/RecordRest.res.txt | 56 ++++++++++++++++--- 3 files changed, 64 insertions(+), 11 deletions(-) diff --git a/analysis/src/completion_front_end.ml b/analysis/src/completion_front_end.ml index e0bc67bce69..31f6dc52076 100644 --- a/analysis/src/completion_front_end.ml +++ b/analysis/src/completion_front_end.ml @@ -517,7 +517,7 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file (NPolyvariantPayload {item_num = 0; constructor_name = txt} :: pattern_path) ?context_path p - | Ppat_record (fields, _, _rest) -> + | Ppat_record (fields, _, rest) -> ( Ext_list.iter fields (fun {lid = fname; x = p} -> match fname with | {Location.txt = Longident.Lident fname} -> @@ -526,7 +526,16 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file (Completable.NFollowRecordField {field_name = fname} :: pattern_path) ?context_path p - | _ -> ()) + | _ -> ()); + match rest with + | None -> () + | Some {rest_name = {txt; loc}; rest_type; _} -> + let context_path = + match rest_type with + | Some typ -> Type_utils.context_path_from_core_type typ + | None -> context_path_to_save + in + scope := !scope |> Scope.add_value ~name:txt ~loc ?context_path) | Ppat_array pl -> pl |> List.iter diff --git a/tests/analysis_tests/tests/src/RecordRest.res b/tests/analysis_tests/tests/src/RecordRest.res index a0e2a5373cc..d112faa6b16 100644 --- a/tests/analysis_tests/tests/src/RecordRest.res +++ b/tests/analysis_tests/tests/src/RecordRest.res @@ -10,6 +10,12 @@ let getVersion = (config: config) => // ^def } +let getVersionFromParam = ({name: _, ...SubConfig.t as paramRest}: config) => { + // param + // ^com + paramRest.version +} + let {name: _, ...SubConfig.t as localRest} = {name: "v", version: "1"} // ^ast diff --git a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt index 6d7cadcec09..143a8d44a4a 100644 --- a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt +++ b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt @@ -7,7 +7,30 @@ Definition src/RecordRest.res 8:4 "uri": "file:///RecordRest.res" } -Dump AST src/RecordRest.res 12:19 +Complete src/RecordRest.res 13:10 +posCursor:[13:10] posNoWhite:[13:9] Found expr:[12:26->16:1] +posCursor:[13:10] posNoWhite:[13:9] Found expr:[12:78->16:1] +posCursor:[13:10] posNoWhite:[13:9] Found expr:[13:5->13:10] +Pexp_ident param:[13:5->13:10] +Completable: Cpath Value[param] +Package opens Stdlib.place holder Pervasives.JsxModules.place holder +Resolved opens 1 Stdlib +ContextPath Value[param] +Path param +[ + { + "detail": "SubConfig.t", + "documentation": { + "kind": "markdown", + "value": "```rescript\ntype t = {version: string}\n```" + }, + "kind": 12, + "label": "paramRest", + "tags": [] + } +] + +Dump AST src/RecordRest.res 18:19 Source: // let {name: _, ...SubConfig.t as localRest} = {name: "v", version: "1"} @@ -36,7 +59,14 @@ Inlay Hint src/RecordRest.res 1:34 "label": ": SubConfig.t", "paddingLeft": true, "paddingRight": false, - "position": { "character": 41, "line": 12 } + "position": { "character": 41, "line": 18 } + }, + { + "kind": 1, + "label": ": config => string", + "paddingLeft": true, + "paddingRight": false, + "position": { "character": 23, "line": 12 } }, { "kind": 1, @@ -48,7 +78,7 @@ Inlay Hint src/RecordRest.res 1:34 ] Highlight src/RecordRest.res -structure items:4 diagnostics:0 +structure items:5 diagnostics:0 Lident: config 0:5 Type Lident: name 0:15 Property Lident: string 0:21 Type @@ -68,10 +98,18 @@ Ldot: SubConfig 7:17 Namespace Lident: t 7:27 Type Lident: version 8:9 Property Lident: rest 8:4 Variable -Lident: name 12:5 Property -Variable: localRest [12:32->12:41] -Ldot: SubConfig 12:17 Namespace -Lident: t 12:27 Type -Lident: name 12:46 Property -Lident: version 12:57 Property +Variable: getVersionFromParam [12:4->12:23] +Lident: name 12:28 Property +Variable: paramRest [12:55->12:64] +Ldot: SubConfig 12:40 Namespace +Lident: t 12:50 Type +Lident: config 12:67 Type +Lident: version 15:12 Property +Lident: paramRest 15:2 Variable +Lident: name 18:5 Property +Variable: localRest [18:32->18:41] +Ldot: SubConfig 18:17 Namespace +Lident: t 18:27 Type +Lident: name 18:46 Property +Lident: version 18:57 Property From 265c433b46ff2884c360a10cb07dbf8e72f2a1ed Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 2 Jul 2026 10:03:32 +0200 Subject: [PATCH 42/47] simplify js dump shape --- compiler/core/j.ml | 17 +--------- compiler/core/js_dump.ml | 33 ++++++++------------ compiler/core/js_exp_make.ml | 2 -- compiler/core/js_fold.ml | 8 +---- compiler/core/js_pass_record_rest.ml | 3 +- compiler/core/js_pass_scope.ml | 16 +++------- compiler/core/js_pass_tailcall_inline.ml | 15 ++------- compiler/core/js_record_fold.ml | 6 +--- compiler/core/js_record_iter.ml | 6 +--- compiler/core/js_record_map.ml | 8 +---- tests/ounit_tests/ounit_js_analyzer_tests.ml | 4 +-- 11 files changed, 27 insertions(+), 91 deletions(-) diff --git a/compiler/core/j.ml b/compiler/core/j.ml index 49efe97cc6a..ce91d290078 100644 --- a/compiler/core/j.ml +++ b/compiler/core/j.ml @@ -82,8 +82,6 @@ and record_rest_field = { record_rest_ident: ident option; } -and param = Ident_param of ident - and expression_desc = | Length of expression * length_object | Is_null_or_undefined of expression (** where we use a trick [== null ] *) @@ -139,7 +137,7 @@ and expression_desc = | Var of vident | Fun of { is_method: bool; - params: param list; + params: ident list; body: block; env: Js_fun_env.t; return_unit: bool; @@ -336,7 +334,6 @@ and deps_program = { property_map; length_object; record_rest_field; - param; (* for_ident; *) required_modules; case_clause; @@ -350,15 +347,3 @@ so that we can achieve the optimal let record_rest_field_idents fields = List.filter_map (fun {record_rest_ident} -> record_rest_ident) fields - -let param_idents = function - | Ident_param id -> [id] - -let params_idents params = List.concat_map param_idents params - -let params_as_idents params = - let rec aux acc = function - | [] -> Some (List.rev acc) - | Ident_param id :: rest -> aux (id :: acc) rest - in - aux [] params diff --git a/compiler/core/js_dump.ml b/compiler/core/js_dump.ml index 247172261e6..a4973352c52 100644 --- a/compiler/core/js_dump.ml +++ b/compiler/core/js_dump.ml @@ -269,10 +269,7 @@ and record_rest_pattern cxt f fields rest = P.string f "}"; cxt -and param cxt f = function - | J.Ident_param id -> Ext_pp_scope.ident cxt f id - -and formal_parameter_list cxt f l = iter_lst cxt f l param comma_sp +and formal_parameter_list cxt f l = iter_lst cxt f l Ext_pp_scope.ident comma_sp (* IdentMap *) (* @@ -305,18 +302,15 @@ let is_var (b : J.expression) a = | _ -> false let params_match_call params args fn = - match J.params_as_idents params with - | Some params -> ( - Ext_list.for_all2_no_exn args params is_var - && - match fn with - (* This check is needed to avoid some edge cases - {[function(x){return x(x)}]} - here the function is also called `x` - *) - | J.Id id -> not (Ext_list.exists params (fun x -> Ident.same x id)) - | Qualified _ -> true) - | None -> false + Ext_list.for_all2_no_exn args params is_var + && + match fn with + (* This check is needed to avoid some edge cases + {[function(x){return x(x)}]} + here the function is also called `x` + *) + | J.Id id -> not (Ext_list.exists params (fun x -> Ident.same x id)) + | Qualified _ -> true type fn_exp_state = | Is_return (* for sure no name *) @@ -335,7 +329,7 @@ let rec try_optimize_curry cxt f len function_id = P.paren_group f 1 (fun _ -> expression ~level:1 cxt f function_id) and pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t) - ~fn_state (l : J.param list) (b : J.block) (env : Js_fun_env.t) : cxt = + ~fn_state (l : Ident.t list) (b : J.block) (env : Js_fun_env.t) : cxt = match b with | [ { @@ -402,7 +396,7 @@ and pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t) if is_method then ( match l with | [] -> assert false - | Ident_param this :: arguments -> + | this :: arguments -> let cxt = P.paren_group f 1 (fun _ -> formal_parameter_list inner_cxt f arguments) @@ -417,8 +411,7 @@ and pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t) else let cxt = match l with - | [Ident_param single] when arrow -> - Ext_pp_scope.ident inner_cxt f single + | [single] when arrow -> Ext_pp_scope.ident inner_cxt f single | l -> P.paren_group f 1 (fun _ -> formal_parameter_list inner_cxt f l) in diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml index 711ce215e4b..188206119aa 100644 --- a/compiler/core/js_exp_make.ml +++ b/compiler/core/js_exp_make.ml @@ -243,7 +243,6 @@ let ocaml_fun ?comment ?immutable_mask ?directive ~return_unit ~async ~one_unit_arg params body : t = let params = if one_unit_arg then [] else params in let len = List.length params in - let params = List.map (fun id -> J.Ident_param id) params in { expression_desc = Fun @@ -261,7 +260,6 @@ let ocaml_fun ?comment ?immutable_mask ?directive ~return_unit ~async let method_ ?comment ?immutable_mask ~async ~return_unit params body : t = let len = List.length params in - let params = List.map (fun id -> J.Ident_param id) params in { expression_desc = Fun diff --git a/compiler/core/js_fold.ml b/compiler/core/js_fold.ml index 50646ca99e4..9cc50d779be 100644 --- a/compiler/core/js_fold.ml +++ b/compiler/core/js_fold.ml @@ -88,12 +88,6 @@ class fold = let _self = option (fun _self -> _self#ident) _self _x0 in _self - method param : param -> 'self_type = - function - | Ident_param _x0 -> - let _self = _self#ident _x0 in - _self - method expression_desc : expression_desc -> 'self_type = function | Length (_x0, _x1) -> @@ -170,7 +164,7 @@ class fold = let _self = _self#vident _x0 in _self | Fun {params = x1; body = x2} -> - let _self = list (fun _self -> _self#param) _self x1 in + let _self = list (fun _self -> _self#ident) _self x1 in let _self = _self#block x2 in _self | Str _ -> _self diff --git a/compiler/core/js_pass_record_rest.ml b/compiler/core/js_pass_record_rest.ml index d5e38b8ad87..4ff435cf3d8 100644 --- a/compiler/core/js_pass_record_rest.ml +++ b/compiler/core/js_pass_record_rest.ml @@ -108,8 +108,7 @@ let pass = expression = (fun self expr -> match expr.expression_desc with - | Fun ({is_method = false; params = [Ident_param param]; body} as fun_) - -> + | Fun ({is_method = false; params = [param]; body} as fun_) -> let body = self.block self body in let body = match body with diff --git a/compiler/core/js_pass_scope.ml b/compiler/core/js_pass_scope.ml index b246e43fbc0..f2bdc4e3506 100644 --- a/compiler/core/js_pass_scope.ml +++ b/compiler/core/js_pass_scope.ml @@ -148,14 +148,10 @@ let record_scope_pass = *) (* Note that [used_idents] is not complete it ignores some locally defined idents *) - let param_idents = J.params_idents params in - let param_set = Set_ident.of_list param_idents in + let param_set = Set_ident.of_list params in let {defined_idents = defined_idents'; used_idents = used_idents'} = let mutable_params = - match J.params_as_idents params with - | None -> Set_ident.empty - | Some params -> - Set_ident.of_list (Js_fun_env.get_mutable_params params env) + Set_ident.of_list (Js_fun_env.get_mutable_params params env) in self.block self {init_state with mutable_values = mutable_params} @@ -166,12 +162,8 @@ let record_scope_pass = (* mark which param is used *) params |> List.iteri (fun i v -> - if - not - (List.exists - (fun ident -> Set_ident.mem used_idents' ident) - (J.param_idents v)) - then Js_fun_env.mark_unused env i); + if not (Set_ident.mem used_idents' v) then + Js_fun_env.mark_unused env i); let closured_idents' = (* pass param_set down *) Set_ident.(diff used_idents' (union defined_idents' param_set)) diff --git a/compiler/core/js_pass_tailcall_inline.ml b/compiler/core/js_pass_tailcall_inline.ml index b60b4cf8919..5a92b05cac1 100644 --- a/compiler/core/js_pass_tailcall_inline.ml +++ b/compiler/core/js_pass_tailcall_inline.ml @@ -78,11 +78,6 @@ let inline_call (immutable_list : bool list) params (args : J.expression list) let obj = substitue_variables map in obj.block obj block -let simple_params_exn params = - match J.params_as_idents params with - | Some params -> params - | None -> assert false - (** There is a side effect when traversing dead code, since we assume that substitue a node would mark a node as dead node, @@ -187,16 +182,13 @@ let subst (export_set : Set_ident.t) stats = ident_info = {used_stats = Once_pure}; ident = _; } as v) - when match J.params_as_idents params with - | Some params -> Ext_list.same_length params args - | None -> false -> + when Ext_list.same_length params args -> Js_op_util.update_used_stats v.ident_info Dead_pure; let no_tailcall = Js_fun_env.no_tailcall env in let processed_blocks = self.block self body (* see #278 before changes*) in - let params = simple_params_exn params in inline_call no_tailcall params args processed_blocks (* Ext_list.fold_right2 params args processed_blocks @@ -230,15 +222,12 @@ let subst (export_set : Set_ident.t) stats = }; }; ] - when match J.params_as_idents params with - | Some params -> Ext_list.same_length params args - | None -> false -> + when Ext_list.same_length params args -> let no_tailcall = Js_fun_env.no_tailcall env in let processed_blocks = self.block self body (* see #278 before changes*) in - let params = simple_params_exn params in inline_call no_tailcall params args processed_blocks | x :: xs -> self.statement self x :: self.block self xs | [] -> []); diff --git a/compiler/core/js_record_fold.ml b/compiler/core/js_record_fold.ml index 86fb298c5d2..b5e63452bbd 100644 --- a/compiler/core/js_record_fold.ml +++ b/compiler/core/js_record_fold.ml @@ -93,10 +93,6 @@ let record_rest_field : 'a. ('a, record_rest_field) fn = fun _self st {record_rest_ident; _} -> option _self.ident _self st record_rest_ident -let param : 'a. ('a, param) fn = - fun _self st -> function - | Ident_param id -> _self.ident _self st id - let expression_desc : 'a. ('a, expression_desc) fn = fun _self st -> function | Length (_x0, _x1) -> @@ -173,7 +169,7 @@ let expression_desc : 'a. ('a, expression_desc) fn = let st = _self.vident _self st _x0 in st | Fun {params; body} -> - let st = list param _self st params in + let st = list _self.ident _self st params in let st = _self.block _self st body in st | Str _ -> st diff --git a/compiler/core/js_record_iter.ml b/compiler/core/js_record_iter.ml index a94923509ca..c313bf711f0 100644 --- a/compiler/core/js_record_iter.ml +++ b/compiler/core/js_record_iter.ml @@ -82,10 +82,6 @@ let length_object : length_object fn = unknown let record_rest_field : record_rest_field fn = fun _self {record_rest_ident; _} -> option _self.ident _self record_rest_ident -let param : param fn = - fun _self -> function - | Ident_param id -> _self.ident _self id - let expression_desc : expression_desc fn = fun _self -> function | Length (_x0, _x1) -> @@ -134,7 +130,7 @@ let expression_desc : expression_desc fn = option (fun _self arg -> list _self.expression _self arg) _self _x1 | Var _x0 -> _self.vident _self _x0 | Fun {params; body} -> - list param _self params; + list _self.ident _self params; _self.block _self body | Str _ -> () | Raw_js_code _ -> () diff --git a/compiler/core/js_record_map.ml b/compiler/core/js_record_map.ml index 8ab1fb5de29..9f2573f07a1 100644 --- a/compiler/core/js_record_map.ml +++ b/compiler/core/js_record_map.ml @@ -94,12 +94,6 @@ let record_rest_field : record_rest_field fn = let record_rest_ident = option _self.ident _self record_rest_ident in {field with record_rest_ident} -let param : param fn = - fun _self -> function - | Ident_param id -> - let id = _self.ident _self id in - Ident_param id - let expression_desc : expression_desc fn = fun _self -> function | Length (_x0, _x1) -> @@ -174,7 +168,7 @@ let expression_desc : expression_desc fn = let _x0 = _self.vident _self _x0 in Var _x0 | Fun ({params; body} as fun_) -> - let params = list param _self params in + let params = list _self.ident _self params in let body = _self.block _self body in Fun {fun_ with params; body} | Str _ as v -> v diff --git a/tests/ounit_tests/ounit_js_analyzer_tests.ml b/tests/ounit_tests/ounit_js_analyzer_tests.ml index 1628f6445a0..eab675470ab 100644 --- a/tests/ounit_tests/ounit_js_analyzer_tests.ml +++ b/tests/ounit_tests/ounit_js_analyzer_tests.ml @@ -37,7 +37,7 @@ let function_expression param body = Fun { is_method = false; - params = [Ident_param param]; + params = [param]; body; env = Js_fun_env.make 1; return_unit = false; @@ -118,7 +118,7 @@ let suites = match transformed.expression_desc with | Fun { - params = [Ident_param transformed_param]; + params = [transformed_param]; body = [ { From 30a72f10672810897d7a19917779e30499d9a099 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 2 Jul 2026 11:13:14 +0200 Subject: [PATCH 43/47] simplify materialize_fields --- compiler/core/js_pass_record_rest.ml | 52 +------------------- tests/ounit_tests/ounit_js_analyzer_tests.ml | 37 +++++--------- 2 files changed, 12 insertions(+), 77 deletions(-) diff --git a/compiler/core/js_pass_record_rest.ml b/compiler/core/js_pass_record_rest.ml index 4ff435cf3d8..c174d73451a 100644 --- a/compiler/core/js_pass_record_rest.ml +++ b/compiler/core/js_pass_record_rest.ml @@ -1,5 +1,4 @@ module E = Js_exp_make -module S = Js_stmt_make open J let field_ident_name i label = @@ -102,55 +101,6 @@ let pass = | statement :: tail -> self.statement self statement :: self.block self tail | [] -> [] in - { - super with - block; - expression = - (fun self expr -> - match expr.expression_desc with - | Fun ({is_method = false; params = [param]; body} as fun_) -> - let body = self.block self body in - let body = - match body with - | [ - { - statement_desc = - Return - ({ - expression_desc = - Record_rest - ( fields, - ({expression_desc = Var (Id source); _} as - source_expr) ); - _; - } as rest_expr); - _; - }; - ] - when Ident.name param = "param" && Ident.same param source -> - let rest = Ext_ident.create "rest" in - let fields, body = - materialize_fields source_expr fields - [ - { - statement_desc = Return (E.var rest); - comment = rest_expr.comment; - }; - ] - in - S.define_variable ~kind:Strict rest - { - rest_expr with - expression_desc = Record_rest (fields, source_expr); - } - :: body - | _ -> body - in - {expr with expression_desc = Fun {fun_ with body}} - | Fun ({body} as fun_) -> - let body = self.block self body in - {expr with expression_desc = Fun {fun_ with body}} - | _ -> super.expression self expr); - } + {super with block} let program program = pass.program pass program diff --git a/tests/ounit_tests/ounit_js_analyzer_tests.ml b/tests/ounit_tests/ounit_js_analyzer_tests.ml index eab675470ab..08fe210c882 100644 --- a/tests/ounit_tests/ounit_js_analyzer_tests.ml +++ b/tests/ounit_tests/ounit_js_analyzer_tests.ml @@ -123,41 +123,26 @@ let suites = [ { statement_desc = - Variable + Return { - ident = rest; - value = - Some - { - expression_desc = - Record_rest - ( [ - { - record_rest_label = "name"; - record_rest_ident = Some ignored; - }; - ], - {expression_desc = Var (Id source); _} - ); - _; - }; + expression_desc = + Record_rest + ( [ + { + record_rest_label = "name"; + record_rest_ident = None; + }; + ], + {expression_desc = Var (Id source); _} ); _; }; _; }; - { - statement_desc = - Return {expression_desc = Var (Id returned); _}; - _; - }; ]; _; } -> OUnit.assert_bool __LOC__ (Ident.same param transformed_param); - OUnit.assert_equal "__unused0" (Ident.name ignored); - OUnit.assert_equal "rest" (Ident.name rest); - OUnit.assert_bool __LOC__ (Ident.same param source); - OUnit.assert_bool __LOC__ (Ident.same rest returned) + OUnit.assert_bool __LOC__ (Ident.same param source) | _ -> OUnit.assert_failure __LOC__ ); ( __LOC__ >:: fun _ -> let rest = Ident.create "rest" in From 3b622fc49ea232a5e36127d126f07f434f25c14e Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 2 Jul 2026 11:26:55 +0200 Subject: [PATCH 44/47] improve record rest completion Signed-off-by: tsnobip --- analysis/src/completion_patterns.ml | 29 ++++++++++----- tests/analysis_tests/tests/src/RecordRest.res | 3 ++ .../tests/src/expected/RecordRest.res.txt | 35 ++++++++++++++++++- 3 files changed, 58 insertions(+), 9 deletions(-) diff --git a/analysis/src/completion_patterns.ml b/analysis/src/completion_patterns.ml index 16b6ae886df..fdbd30aeaec 100644 --- a/analysis/src/completion_patterns.ml +++ b/analysis/src/completion_patterns.ml @@ -48,6 +48,13 @@ and traverse_pattern (pat : Parsetree.pattern) ~pattern_path ~loc_has_cursor Some v) else None in + let rest_cursor (rest : Parsetree.record_pat_rest option) = + match rest with + | Some {rest_name = {txt; loc}; _} when loc_has_cursor loc -> + Some (`Name txt) + | Some {rest_loc; _} when loc_has_cursor rest_loc -> Some `Rest + | _ -> None + in match pat.ppat_desc with | Ppat_constant _ | Ppat_interval _ -> None | Ppat_constraint (p, _) @@ -106,12 +113,16 @@ and traverse_pattern (pat : Parsetree.pattern) ~pattern_path ~loc_has_cursor [Completable.NTupleItem {item_num}] @ pattern_path) ~result_from_found_item_num:(fun item_num -> [Completable.NTupleItem {item_num = item_num + 1}] @ pattern_path) - | Ppat_record ([], _, _rest) -> + | Ppat_record ([], _, rest) -> ( (* Empty fields means we're in a record body `{}`. Complete for the fields. *) - some_if_has_cursor - ("", [Completable.NRecordBody {seen_fields = []}] @ pattern_path) - "Ppat_record(empty)" - | Ppat_record (fields, _, _rest) -> ( + match rest_cursor rest with + | Some (`Name txt) -> Some (txt, pattern_path) + | Some `Rest -> None + | None -> + some_if_has_cursor + ("", [Completable.NRecordBody {seen_fields = []}] @ pattern_path) + "Ppat_record(empty)") + | Ppat_record (fields, _, rest) -> ( let field_with_cursor = ref None in let field_with_pat_hole = ref None in Ext_list.iter fields (fun {lid = fname; x = f} -> @@ -131,8 +142,10 @@ and traverse_pattern (pat : Parsetree.pattern) ~pattern_path ~loc_has_cursor | {Location.txt = Longident.Lident field_name} -> Some field_name | _ -> None) in - match (!field_with_cursor, !field_with_pat_hole) with - | Some (fname, f), _ | None, Some (fname, f) -> ( + match (rest_cursor rest, !field_with_cursor, !field_with_pat_hole) with + | Some (`Name txt), _, _ -> Some (txt, pattern_path) + | Some `Rest, _, _ -> None + | None, Some (fname, f), _ | None, None, Some (fname, f) -> ( match f.ppat_desc with | Ppat_extension ({txt = "rescript.patternhole"}, _) -> (* A pattern hole means for example `{someField: }`. We want to complete for the type of `someField`. *) @@ -154,7 +167,7 @@ and traverse_pattern (pat : Parsetree.pattern) ~pattern_path ~loc_has_cursor @ pattern_path) ~loc_has_cursor ~first_char_before_cursor_no_white ~pos_before_cursor) - | None, None -> ( + | None, None, None -> ( (* Figure out if we're completing for a new field. If the cursor is inside of the record body, but no field has the cursor, and there's no pattern hole. Check the first char to the left of the cursor, diff --git a/tests/analysis_tests/tests/src/RecordRest.res b/tests/analysis_tests/tests/src/RecordRest.res index d112faa6b16..e96f0102082 100644 --- a/tests/analysis_tests/tests/src/RecordRest.res +++ b/tests/analysis_tests/tests/src/RecordRest.res @@ -19,5 +19,8 @@ let getVersionFromParam = ({name: _, ...SubConfig.t as paramRest}: config) => { let {name: _, ...SubConfig.t as localRest} = {name: "v", version: "1"} // ^ast +let {...SubConfig.t as wholeRest} = {version: "2"} +// ^com + //^hin //^hig diff --git a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt index 143a8d44a4a..1742f63294a 100644 --- a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt +++ b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt @@ -52,8 +52,37 @@ Source: ) ) +Complete src/RecordRest.res 21:9 +posCursor:[21:9] posNoWhite:[21:8] Found pattern:[21:4->21:33] +posCursor:[21:9] posNoWhite:[21:8] Found type:[21:8->21:19] +Ptyp_constr SubConfig.t:[21:8->21:19] +Completable: Cpath Type[SubConfig, t] +Package opens Stdlib.place holder Pervasives.JsxModules.place holder +Resolved opens 1 Stdlib +ContextPath Type[SubConfig, t] +Path SubConfig.t +[ + { + "detail": "type t", + "documentation": { + "kind": "markdown", + "value": "```rescript\ntype t = {version: string}\n```" + }, + "kind": 22, + "label": "t", + "tags": [] + } +] + Inlay Hint src/RecordRest.res 1:34 [ + { + "kind": 1, + "label": ": SubConfig.t", + "paddingLeft": true, + "paddingRight": false, + "position": { "character": 32, "line": 21 } + }, { "kind": 1, "label": ": SubConfig.t", @@ -78,7 +107,7 @@ Inlay Hint src/RecordRest.res 1:34 ] Highlight src/RecordRest.res -structure items:5 diagnostics:0 +structure items:6 diagnostics:0 Lident: config 0:5 Type Lident: name 0:15 Property Lident: string 0:21 Type @@ -112,4 +141,8 @@ Ldot: SubConfig 18:17 Namespace Lident: t 18:27 Type Lident: name 18:46 Property Lident: version 18:57 Property +Variable: wholeRest [21:23->21:32] +Ldot: SubConfig 21:8 Namespace +Lident: t 21:18 Type +Lident: version 21:37 Property From 14327beaefe303a2559d3c1a176f462e22569117 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 2 Jul 2026 11:32:47 +0200 Subject: [PATCH 45/47] print record rest in typedtree dumps Signed-off-by: tsnobip --- compiler/ml/printtyped.ml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml index 57a56b052a7..2cf3c19c9b8 100644 --- a/compiler/ml/printtyped.ml +++ b/compiler/ml/printtyped.ml @@ -123,6 +123,10 @@ let arg_label i ppf = function | Optional {txt} -> line i ppf "Optional \"%s\"\n" txt | Labelled {txt} -> line i ppf "Labelled \"%s\"\n" txt +let record_pat_rest i ppf {rest_ident; rest_type; _} = + line i ppf "rest \"%a\" : %a\n" fmt_ident rest_ident Printtyp.type_expr + rest_type + let record_representation i ppf = let open Types in function @@ -231,9 +235,10 @@ 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, _rest) -> + | Tpat_record (l, _c, rest) -> line i ppf "Tpat_record\n"; - list i longident_x_pattern ppf l + list i longident_x_pattern ppf l; + Option.iter (record_pat_rest i ppf) rest | Tpat_array l -> line i ppf "Tpat_array\n"; list i pattern ppf l From edffeadb083246778d8e8c8a8d5ac5ecab19b6b7 Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 2 Jul 2026 11:48:50 +0200 Subject: [PATCH 46/47] simplify record rest implementation --- compiler/core/js_fold.ml | 5 ---- compiler/core/js_record_fold.ml | 4 --- compiler/core/js_record_iter.ml | 3 --- compiler/core/js_record_map.ml | 5 ---- compiler/ml/typecore_record_rest.ml | 39 ++++++++++++----------------- 5 files changed, 16 insertions(+), 40 deletions(-) diff --git a/compiler/core/js_fold.ml b/compiler/core/js_fold.ml index 9cc50d779be..b1857534852 100644 --- a/compiler/core/js_fold.ml +++ b/compiler/core/js_fold.ml @@ -83,11 +83,6 @@ class fold = method length_object : length_object -> 'self_type = unknown _self - method record_rest_field : record_rest_field -> 'self_type = - fun {record_rest_ident = _x0; _} -> - let _self = option (fun _self -> _self#ident) _self _x0 in - _self - method expression_desc : expression_desc -> 'self_type = function | Length (_x0, _x1) -> diff --git a/compiler/core/js_record_fold.ml b/compiler/core/js_record_fold.ml index b5e63452bbd..6c7f934569a 100644 --- a/compiler/core/js_record_fold.ml +++ b/compiler/core/js_record_fold.ml @@ -89,10 +89,6 @@ let property_map : 'a. ('a, property_map) fn = let length_object : 'a. ('a, length_object) fn = unknown -let record_rest_field : 'a. ('a, record_rest_field) fn = - fun _self st {record_rest_ident; _} -> - option _self.ident _self st record_rest_ident - let expression_desc : 'a. ('a, expression_desc) fn = fun _self st -> function | Length (_x0, _x1) -> diff --git a/compiler/core/js_record_iter.ml b/compiler/core/js_record_iter.ml index c313bf711f0..9c7be79e077 100644 --- a/compiler/core/js_record_iter.ml +++ b/compiler/core/js_record_iter.ml @@ -79,9 +79,6 @@ let property_map : property_map fn = let length_object : length_object fn = unknown -let record_rest_field : record_rest_field fn = - fun _self {record_rest_ident; _} -> option _self.ident _self record_rest_ident - let expression_desc : expression_desc fn = fun _self -> function | Length (_x0, _x1) -> diff --git a/compiler/core/js_record_map.ml b/compiler/core/js_record_map.ml index 9f2573f07a1..65b4b524103 100644 --- a/compiler/core/js_record_map.ml +++ b/compiler/core/js_record_map.ml @@ -89,11 +89,6 @@ let property_map : property_map fn = let length_object : length_object fn = unknown -let record_rest_field : record_rest_field fn = - fun _self ({record_rest_ident} as field) -> - let record_rest_ident = option _self.ident _self record_rest_ident in - {field with record_rest_ident} - let expression_desc : expression_desc fn = fun _self -> function | Length (_x0, _x1) -> diff --git a/compiler/ml/typecore_record_rest.ml b/compiler/ml/typecore_record_rest.ml index 8b4acd57af5..b6b9ad92d47 100644 --- a/compiler/ml/typecore_record_rest.ml +++ b/compiler/ml/typecore_record_rest.ml @@ -81,15 +81,14 @@ let source_fields_of_decl (fields : label_declaration list) = }) fields -let has_mutable_field fields = - Ext_list.exists fields (fun (field : label_declaration) -> - field.ld_mutable = Mutable) - let source_fields_and_repr ~env ~loc decl = match decl.type_kind with | Type_record (_, Record_unboxed _) -> raise_error loc env Unboxed_record | Type_record (fields, repr) -> - if has_mutable_field fields then raise_error loc env Mutable_source_record; + if + Ext_list.exists fields (fun (field : label_declaration) -> + field.ld_mutable = Mutable) + then raise_error loc env Mutable_source_record; (source_fields_of_decl fields, repr) | _ -> assert false @@ -112,9 +111,8 @@ let runtime_excluded_labels ~explicit_runtime_labels source_repr = | 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" + Ast_untagged_variants.process_tag_name attrs + |> Option.value ~default:"TAG" in if List.mem tag_name explicit_runtime_labels then explicit_runtime_labels else tag_name :: explicit_runtime_labels @@ -148,7 +146,7 @@ let type_record_pat_rest ~env ~pattern_force ~loc ~record_ty ~lbl_pat_list ~rest List.iter2 (fun param arg -> unify_pat_types rest_type_lid.loc env param arg) rest_annotation_decl.type_params rest_type_args; - let rest_decl = + let rest_decl, rest_labels = match try Some @@ -161,7 +159,7 @@ let type_record_pat_rest ~env ~pattern_force ~loc ~record_ty ~lbl_pat_list ~rest match rest_decl.type_kind with | Type_record (_, Record_unboxed _) -> raise_error rest_type_lid.loc env Unboxed_record - | Type_record _ -> rest_decl + | Type_record (labels, _) -> (rest_decl, labels) | _ -> raise_error rest_type_lid.loc env (Not_record rest_type_lid.txt)) | None -> raise_error rest_type_lid.loc env (Not_record rest_type_lid.txt) in @@ -179,11 +177,6 @@ let type_record_pat_rest ~env ~pattern_force ~loc ~record_ty ~lbl_pat_list ~rest if optional then Some label.lbl_name else None) lbl_pat_list in - let rest_labels = - match rest_decl.type_kind with - | Type_record (labels, _) -> labels - | _ -> assert false - in let rest_field_names = List.map (fun label -> Ident.name label.ld_id) rest_labels in @@ -207,15 +200,15 @@ let type_record_pat_rest ~env ~pattern_force ~loc ~record_ty ~lbl_pat_list ~rest else if overlapping_fields <> [] then Location.prerr_warning rest.rest_loc (Warnings.Bs_record_rest_optional_overlap overlapping_fields); - let source_field_names = - List.map (fun field -> field.source_name) source_fields - in let missing = - List.filter - (fun source_field -> - (not (List.mem source_field explicit_fields)) - && not (List.mem source_field rest_field_names)) - source_field_names + List.filter_map + (fun field -> + if + (not (List.mem field.source_name explicit_fields)) + && not (List.mem field.source_name rest_field_names) + then Some field.source_name + else None) + source_fields in if missing <> [] then raise_error rest.rest_loc env (Field_missing (missing, rest_type_lid.txt)); From 5e3773533d651322ed10e48ef6a6f813fd48ddcb Mon Sep 17 00:00:00 2001 From: tsnobip Date: Thu, 2 Jul 2026 14:46:21 +0200 Subject: [PATCH 47/47] restore better JS output for rest destructuring --- compiler/core/js_pass_record_rest.ml | 18 ++++++++++ tests/ounit_tests/ounit_js_analyzer_tests.ml | 37 ++++++++++++++------ tests/tests/src/record_rest_test.mjs | 23 +++++++----- 3 files changed, 59 insertions(+), 19 deletions(-) diff --git a/compiler/core/js_pass_record_rest.ml b/compiler/core/js_pass_record_rest.ml index c174d73451a..ef5232bfa07 100644 --- a/compiler/core/js_pass_record_rest.ml +++ b/compiler/core/js_pass_record_rest.ml @@ -1,4 +1,5 @@ module E = Js_exp_make +module S = Js_stmt_make open J let field_ident_name i label = @@ -98,6 +99,23 @@ let pass = }; } :: tail + | ({ + statement_desc = + Return + ({expression_desc = Record_rest (fields, source); _} as rest_expr); + _; + } as statement) + :: tail -> + let rest = Ext_ident.create "rest" in + let source = self.expression self source in + let tail = self.block self tail in + let fields, return = + materialize_fields source fields + [{statement with statement_desc = Return (E.var rest)}] + in + S.define_variable ~kind:Strict rest + {rest_expr with expression_desc = Record_rest (fields, source)} + :: (return @ tail) | statement :: tail -> self.statement self statement :: self.block self tail | [] -> [] in diff --git a/tests/ounit_tests/ounit_js_analyzer_tests.ml b/tests/ounit_tests/ounit_js_analyzer_tests.ml index 08fe210c882..eab675470ab 100644 --- a/tests/ounit_tests/ounit_js_analyzer_tests.ml +++ b/tests/ounit_tests/ounit_js_analyzer_tests.ml @@ -123,26 +123,41 @@ let suites = [ { statement_desc = - Return + Variable { - expression_desc = - Record_rest - ( [ - { - record_rest_label = "name"; - record_rest_ident = None; - }; - ], - {expression_desc = Var (Id source); _} ); + ident = rest; + value = + Some + { + expression_desc = + Record_rest + ( [ + { + record_rest_label = "name"; + record_rest_ident = Some ignored; + }; + ], + {expression_desc = Var (Id source); _} + ); + _; + }; _; }; _; }; + { + statement_desc = + Return {expression_desc = Var (Id returned); _}; + _; + }; ]; _; } -> OUnit.assert_bool __LOC__ (Ident.same param transformed_param); - OUnit.assert_bool __LOC__ (Ident.same param source) + OUnit.assert_equal "__unused0" (Ident.name ignored); + OUnit.assert_equal "rest" (Ident.name rest); + OUnit.assert_bool __LOC__ (Ident.same param source); + OUnit.assert_bool __LOC__ (Ident.same rest returned) | _ -> OUnit.assert_failure __LOC__ ); ( __LOC__ >:: fun _ -> let rest = Ident.create "rest" in diff --git a/tests/tests/src/record_rest_test.mjs b/tests/tests/src/record_rest_test.mjs index 59c24c10d30..4b2e393e7dc 100644 --- a/tests/tests/src/record_rest_test.mjs +++ b/tests/tests/src/record_rest_test.mjs @@ -62,11 +62,12 @@ function makeConfig() { } function getCallResultRest() { - return (({name: __unused0, ...__rest}) => __rest)({ + let {name: __unused0, ...rest} = { name: "call", version: "4.5", debug: true - }); + }; + return rest; } function getNameRestAndOriginalVersion(original) { @@ -89,27 +90,33 @@ function getValue(param) { } function getTupleRest(param) { - return (({name: __unused0, ...__rest}) => __rest)(param[0]); + let {name: __unused0, ...rest} = param[0]; + return rest; } function getWrappedRest(wrapped) { - return (({name: __unused0, ...__rest}) => __rest)(wrapped._0); + let {name: __unused0, ...rest} = wrapped._0; + return rest; } function getInlineWrappedRest(wrapped) { - return (({TAG: __unused0, name: __unused1, ...__rest}) => __rest)(wrapped); + let {TAG: __unused0, name: __unused1, ...rest} = wrapped; + return rest; } function getRenamedInlineWrappedRest(wrapped) { - return (({TAG: __unused0, "user-name": __unused1, ...__rest}) => __rest)(wrapped); + let {TAG: __unused0, "user-name": __unused1, ...rest} = wrapped; + return rest; } function getCustomTaggedInlineWrappedRest(wrapped) { - return (({kind: __unused0, name: __unused1, ...__rest}) => __rest)(wrapped); + let {kind: __unused0, name: __unused1, ...rest} = wrapped; + return rest; } function getDashedTaggedInlineWrappedRest(wrapped) { - return (({"custom-tag": __unused0, name: __unused1, ...__rest}) => __rest)(wrapped); + let {"custom-tag": __unused0, name: __unused1, ...rest} = wrapped; + return rest; } Mocha.describe("Record_rest_test", () => {