support type with parameter for record rest

Author: tsnobip

compiler/ml/typecore.ml

@@ -1558,11 +1558,11 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
         | None -> None
         | Some rest_pat ->
           (* Extract type annotation and binding name from rest pattern *)
-          let rest_type_lid, rest_name =
+          let rest_type_lid, rest_name, rest_type_args_syntax =
             match rest_pat.ppat_desc with
             | Ppat_constraint ({ppat_desc = Ppat_var name}, cty) -> (
               match cty.ptyp_desc with
-              | Ptyp_constr (lid, []) -> (lid, name)
+              | Ptyp_constr (lid, type_args) -> (lid, name, type_args)
               | _ ->
                 raise
                   (Error (rest_pat.ppat_loc, !env, Record_rest_invalid_type)))
@@ -1661,12 +1661,30 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
                            (Ident.name rest_label.ld_id, rest_type_lid.txt) )))
               rest_labels
           | [] -> ());
+          let rest_type_args =
+            match rest_type_args_syntax with
+            | [] -> List.map (fun _ -> newvar ()) rest_decl.type_params
+            | args ->
+              let n_args = List.length args in
+              let n_params = List.length rest_decl.type_params in
+              if n_args <> n_params then
+                raise
+                  (Typetexp.Error
+                     ( rest_type_lid.loc,
+                       !env,
+                       Typetexp.Type_arity_mismatch
+                         (rest_type_lid.txt, n_params, n_args) ));
+              List.map
+                (fun sty ->
+                  let cty, force =
+                    Typetexp.transl_simple_type_delayed !env sty
+                  in
+                  pattern_force := force :: !pattern_force;
+                  cty.ctyp_type)
+                args
+          in
           let rest_type_expr =
-            newgenty
-              (Tconstr
-                 ( rest_path,
-                   List.map (fun _ -> newvar ()) rest_decl.type_params,
-                   ref Mnil ))
+            newgenty (Tconstr (rest_path, rest_type_args, ref Mnil))
           in
           let rest_ident =
             enter_variable rest_pat.ppat_loc rest_name rest_type_expr

compiler/syntax/src/res_core.ml

@@ -1458,10 +1458,11 @@ and parse_record_pattern_row p =
     let start_pos = p.Parser.start_pos in
     match p.Parser.token with
     | Uident _ ->
-      (* ...ModulePath.t as name *)
+      (* ...ModulePath.t<'a> as name *)
       let type_path = parse_value_path p in
       let type_loc = type_path.loc in
-      let core_type = Ast_helper.Typ.constr ~loc:type_loc type_path [] in
+      let type_args = parse_type_constructor_args ~constr_name:type_path p in
+      let core_type = Ast_helper.Typ.constr ~loc:type_loc type_path type_args in
       Parser.expect As p;
       let name_start = p.start_pos in
       let name =
@@ -1482,14 +1483,17 @@ and parse_record_pattern_row p =
       Some (false, PatRest rest_pat)
     | Lident ident ->
       Parser.next p;
-      if p.Parser.token = As then (
-        (* ...typeName as name *)
+      if p.Parser.token = As || p.Parser.token = Token.LessThan then (
+        (* ...typeName<'a> as name *)
         let type_path =
           Location.mkloc (Longident.Lident ident)
             (mk_loc start_pos p.prev_end_pos)
         in
         let type_loc = type_path.loc in
-        let core_type = Ast_helper.Typ.constr ~loc:type_loc type_path [] in
+        let type_args = parse_type_constructor_args ~constr_name:type_path p in
+        let core_type =
+          Ast_helper.Typ.constr ~loc:type_loc type_path type_args
+        in
         Parser.expect As p;
         let name_start = p.start_pos in
         let name =

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 } = ()
+let f [arity:1]{ a } = ()
+let { a } = x
+let { a } = x
+let { a } = x
+let { a } = x

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<int> as rest} = x
+let {a, ...M.t<'a, 'b> as rest} = x

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<int> as rest} = x
+let {a, ...M.t<'a, 'b> as rest} = x

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<int> as rest} = x
+let {a, ...M.t<'a, 'b> as rest} = x

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 */

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<int> as intRest} = ({id: "1", value: 42}: container<int>)
+let _ = (id, intRest)
+
+// Polymorphic rest in function parameter
+let getValue = ({id: _, ...valueContainer<'a> as rest}: container<'a>) => rest