diff --git a/CHANGELOG.md b/CHANGELOG.md
index afce8dd43a7..6bdb979a3ea 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -30,6 +30,8 @@
 - Fix argument evaluation order when a function call is inlined: the beta reducer stacked argument bindings in reverse parameter order, so the last argument was evaluated first when arguments could not be substituted directly. https://github.com/rescript-lang/rescript/pull/8572
 - Preserve parentheses around multiplication, division, and modulo expressions used as exponents. https://github.com/rescript-lang/rescript/pull/8550
 - Enforce function arity in interface/module inclusion and type coercion. Previously a curried implementation (e.g. `int => int => int`) could satisfy an uncurried interface (`(int, int) => int`) or be coerced to it, which could miscompile calls made through the interface type. Such mismatches are now compile errors with an explanatory hint. https://github.com/rescript-lang/rescript/pull/8559
+- Fix termination-analysis false positives for functions whose progress flows through un-annotated helpers: collecting the callees of a function binding was accidentally disabled in 2024 (the collection guard required a node shape that uncurried code never produces), so helpers calling `@progress` functions were no longer added to the function table. https://github.com/rescript-lang/rescript/pull/8568
+- Fix default values of optional parameters being computed at the wrong time for curried functions: in `(~x=default, y) => (~z=default, w) => ...`, `x`'s default was only computed when the *inner* function was applied. Each default is now computed when its own parameter group is applied. https://github.com/rescript-lang/rescript/pull/8568
 - Fix bare labeled arrow types (`~x: int => string`) getting no arity: they printed identically to their parenthesized form (`(~x: int) => string`) but did not unify with it. https://github.com/rescript-lang/rescript/pull/8563
 - Fix losses of fidelity when code passes through an external PPX: the internal `@res.async` marker no longer leaks into the program, attributes on an arrow type or on an `await` expression are no longer dropped or relocated (previously this could crash the formatter), JSX elements keep their closing tag, and PPX-emitted OCaml-style `function` is desugared instead of crashing the compiler. https://github.com/rescript-lang/rescript/pull/8561
 - Preserve multibyte characters when wrapping long source lines in compiler code frames. https://github.com/rescript-lang/rescript/pull/8520
@@ -46,6 +48,7 @@
 
 - Sync the platform npm package's compiler binaries (`packages/@rescript/<platform>/bin`) via dune promotion on every `dune build`, instead of Makefile/CI copy steps that only ran when make did: a plain `dune build` can no longer leave `cli/*.js` and the test harnesses running a stale compiler. https://github.com/rescript-lang/rescript/pull/8560
 - Remove unused compiler IR definitions, modules, helpers, error variants, and Typedtree fields. https://github.com/rescript-lang/rescript/pull/8551 https://github.com/rescript-lang/rescript/pull/8555
+- Make the typed layers n-ary as well: `Types.Tarrow` carries a parameter list, `Texp_function` carries typed parameters (label, ident, pattern, per-parameter exhaustiveness) and a body, and `Ttyp_arrow`/`Otyp_arrow` follow. The `arity` annotation and its `int option` phantom state are gone from the compiler entirely; `push_defaults` in translcore and the hand-rolled gather-until-arity walks in gentype, reanalyze, and the outcome printer are deleted. The cmi and cmt magic numbers are bumped (`Caml1999I023`/`Caml1999T023`). Generated JavaScript is byte-identical across the test suite (optional-parameter internals are named `*opt_<label>*` instead of `*opt*`, visible only in the rare unprettified case); reanalyze no longer emits spurious empty optional-argument references, and genType recovers real parameter names after defaulted parameters. https://github.com/rescript-lang/rescript/pull/8568
 - Make functions and arrow types n-ary in the parsetree: `Pexp_fun` carries a parameter list and `Ptyp_arrow` a parameter list, replacing the curried one-parameter-per-node chains with an `arity` annotation on the head. Arity is now structural (`List.length params`) and `ast_uncurried.ml` is deleted. The typed layers, cmt format, printed output, and the external-PPX wire format are unchanged. Generated JavaScript is unchanged with one deliberate exception: `@this this => async arg => ...` now means what it says (a method returning an async function) instead of absorbing the nested parameter into the method; write `@this async (this, arg) => ...` for the old meaning. https://github.com/rescript-lang/rescript/pull/8566
 - Give marshaled current-parsetree streams (`-as-pp`, `res_parser -print binary`) their own magic numbers, distinct from the frozen Parsetree0 wire format used for external PPXes. https://github.com/rescript-lang/rescript/pull/8561
 - Record the written parameter count in parsed arrow arity for externals with phantom `@as(...) _` arguments. External processing recounts after erasing phantoms, so the parser no longer needs to pre-decrement the arity or the printer to compensate for it. https://github.com/rescript-lang/rescript/pull/8563
diff --git a/analysis/reanalyze/src/arnold.ml b/analysis/reanalyze/src/arnold.ml
index bdc2fab0afe..1116f1223c9 100644
--- a/analysis/reanalyze/src/arnold.ml
+++ b/analysis/reanalyze/src/arnold.ml
@@ -546,7 +546,7 @@ module Find_functions_called = struct
   let find_callees (expression : Typedtree.expression) =
     let is_function =
       match expression.exp_desc with
-      | Texp_function {arity = None} -> true
+      | Texp_function _ -> true
       | _ -> false
     in
     let callees = ref String_set.empty in
@@ -937,7 +937,7 @@ module Compile = struct
         let open Command in
         c +++ ConstrOption Rnone
       | _ -> c)
-    | Texp_function {case = case_} -> case ~ctx case_
+    | Texp_function {body} -> body |> expression ~ctx
     | Texp_match (e, cases_ok, cases_exn, _partial)
       when not
              (cases_exn
diff --git a/analysis/reanalyze/src/dead_optional_args.ml b/analysis/reanalyze/src/dead_optional_args.ml
index bfbeb9a5487..3b4880e77c6 100644
--- a/analysis/reanalyze/src/dead_optional_args.ml
+++ b/analysis/reanalyze/src/dead_optional_args.ml
@@ -5,8 +5,12 @@ let active () = true
 let rec has_optional_args (texpr : Types.type_expr) =
   match texpr.desc with
   | _ when not (active ()) -> false
-  | Tarrow ({lbl = Optional _}, _tTo, _) -> true
-  | Tarrow (_, t_to, _) -> has_optional_args t_to
+  | Tarrow (params, _) ->
+    params
+    |> List.exists (fun ({lbl} : Types.arg) ->
+           match lbl with
+           | Optional _ -> true
+           | _ -> false)
   | Tlink t -> has_optional_args t
   | Tsubst t -> has_optional_args t
   | _ -> false
@@ -25,34 +29,21 @@ let add_function_reference ~config ~cross_file ~(loc_from : Location.t)
         (pos_to |> Pos.to_string);
     Cross_file_items.add_function_reference cross_file ~pos_from ~pos_to)
 
+(* The function boundary is structural: a function's optional arguments are
+   exactly the optional parameters of its (one) arrow node. *)
 let rec from_type_expr (texpr : Types.type_expr) =
   match texpr.desc with
   | _ when not (active ()) -> []
-  | Tarrow ({lbl = Optional {txt = s}}, t_to, _) -> s :: from_type_expr t_to
-  | Tarrow (_, t_to, _) -> from_type_expr t_to
+  | Tarrow (params, _) ->
+    params
+    |> List.filter_map (fun ({lbl} : Types.arg) ->
+           match lbl with
+           | Optional {txt = s} -> Some s
+           | _ -> None)
   | Tlink t -> from_type_expr t
   | Tsubst t -> from_type_expr t
   | _ -> []
 
-let rec from_type_expr_with_arity (texpr : Types.type_expr) arity =
-  if arity <= 0 then []
-  else
-    match texpr.desc with
-    | _ when not (active ()) -> []
-    | Tarrow ({lbl = Optional {txt = s}}, t_to, _) ->
-      s :: from_type_expr_with_arity t_to (arity - 1)
-    | Tarrow (_, t_to, _) -> from_type_expr_with_arity t_to (arity - 1)
-    | Tlink t -> from_type_expr_with_arity t arity
-    | Tsubst t -> from_type_expr_with_arity t arity
-    | _ -> []
-
-let rec from_type_expr_with_declared_arity (texpr : Types.type_expr) =
-  match texpr.desc with
-  | Tarrow (_, _, Some arity) -> from_type_expr_with_arity texpr arity
-  | Tlink t -> from_type_expr_with_declared_arity t
-  | Tsubst t -> from_type_expr_with_declared_arity t
-  | _ -> from_type_expr texpr
-
 let add_references ~config ~cross_file ~(loc_from : Location.t)
     ~(loc_to : Location.t) ~(binding : Location.t) ~path
     (arg_names, arg_names_maybe) =
diff --git a/analysis/reanalyze/src/dead_value.ml b/analysis/reanalyze/src/dead_value.ml
index 981142eb082..fe107db278f 100644
--- a/analysis/reanalyze/src/dead_value.ml
+++ b/analysis/reanalyze/src/dead_value.ml
@@ -44,12 +44,6 @@ let collect_value_binding ~config ~decls ~file ~(current_binding : Location.t)
       let name = Ident.name id |> Name.create ~is_interface:false in
       let optional_args, reports_optional_args =
         match vb.vb_expr.exp_desc with
-        | Texp_function {arity = Some arity; _} ->
-          ( vb.vb_expr.exp_type
-            |> (fun texpr ->
-            Dead_optional_args.from_type_expr_with_arity texpr arity)
-            |> Optional_args.from_list,
-            true )
         | Texp_function _ ->
           ( vb.vb_expr.exp_type |> Dead_optional_args.from_type_expr
             |> Optional_args.from_list,
@@ -210,18 +204,12 @@ let rec collect_expr ~config ~refs ~file_deps ~cross_file ~direct_callees
           exp_desc =
             Texp_function
               {
-                case =
+                params = [{fp_pat = {pat_desc = Tpat_var (eta_arg, _)}}];
+                body =
                   {
-                    c_lhs = {pat_desc = Tpat_var (eta_arg, _)};
-                    c_rhs =
-                      {
-                        exp_desc =
-                          Texp_apply
-                            {
-                              funct = {exp_desc = Texp_ident (id_arg2, _, _)};
-                              args;
-                            };
-                      };
+                    exp_desc =
+                      Texp_apply
+                        {funct = {exp_desc = Texp_ident (id_arg2, _, _)}; args};
                   };
               };
         } )
@@ -397,7 +385,7 @@ let rec process_signature_item ~config ~decls ~file ~do_types ~do_values
       in
       if (not is_primitive) || !Config.analyze_externals then
         let optional_args =
-          val_type |> Dead_optional_args.from_type_expr_with_declared_arity
+          val_type |> Dead_optional_args.from_type_expr
           |> Optional_args.from_list
         in
         let reports_optional_args =
diff --git a/analysis/src/completion_back_end.ml b/analysis/src/completion_back_end.ml
index cbdece744ea..a1aa3f68928 100644
--- a/analysis/src/completion_back_end.ml
+++ b/analysis/src/completion_back_end.ml
@@ -1093,12 +1093,19 @@ and get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens ~pos
            ~pos
     with
     | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> (
-      let rec reconstruct_function_type args t_ret =
+      let reconstruct_function_type args t_ret =
         match args with
         | [] -> t_ret
-        | (label, t_arg) :: rest ->
-          let rest_type = reconstruct_function_type rest t_ret in
-          {typ with desc = Tarrow ({lbl = label; typ = t_arg}, rest_type, None)}
+        | args ->
+          {
+            typ with
+            desc =
+              Tarrow
+                ( List.map
+                    (fun (label, t_arg) -> {Types.lbl = label; typ = t_arg})
+                    args,
+                  t_ret );
+          }
       in
       let rec process_apply args labels =
         match (args, labels) with
diff --git a/analysis/src/completion_jsx.ml b/analysis/src/completion_jsx.ml
index cb591da2d40..eaa3c9ccaa0 100644
--- a/analysis/src/completion_jsx.ml
+++ b/analysis/src/completion_jsx.ml
@@ -246,7 +246,7 @@ let get_jsx_labels ~component_path ~find_type_of_value ~package ~state =
         | Some (path, type_args) -> get_fields ~path ~type_args
         | None -> [])
       | Tarrow
-          ({lbl = Nolabel; typ = {desc = Tconstr (path, type_args, _)}}, _, _)
+          ({lbl = Nolabel; typ = {desc = Tconstr (path, type_args, _)}} :: _, _)
         when Path.last path = "props" ->
         get_fields ~path ~type_args
       | Tconstr (cl_path, [{desc = Tconstr (path, type_args, _)}; _], _)
@@ -254,7 +254,7 @@ let get_jsx_labels ~component_path ~find_type_of_value ~package ~state =
              && Path.last path = "props" ->
         (* JSX V4 external or interface *)
         get_fields ~path ~type_args
-      | Tarrow ({lbl = Nolabel; typ}, _, _) -> (
+      | Tarrow ({lbl = Nolabel; typ} :: _, _) -> (
         (* Component without the JSX PPX, like a make fn taking a hand-written
            type props. *)
         let rec dig_to_constr typ =
diff --git a/analysis/src/create_interface.ml b/analysis/src/create_interface.ml
index de037a0019e..7b4181e9c90 100644
--- a/analysis/src/create_interface.ml
+++ b/analysis/src/create_interface.ml
@@ -121,9 +121,8 @@ let print_signature ~extractor ~signature =
     in
     match typ.desc with
     | Tarrow
-        ( {typ = {desc = Tconstr (Path.Pident props_id, type_args, _)}},
-          ret_type,
-          _ )
+        ( {typ = {desc = Tconstr (Path.Pident props_id, type_args, _)}} :: _,
+          ret_type )
       when Ident.name props_id = "props" ->
       Some (type_args, ret_type)
     | Tconstr
@@ -159,24 +158,24 @@ let print_signature ~extractor ~signature =
           | Some x -> x
           | None -> assert false
         in
-        let rec mk_fun_type (label_decls : Types.label_declaration list) =
-          match label_decls with
-          | [] -> ret_type
-          | label_decl :: rest ->
-            let prop_type =
-              Type_utils.instantiate_type ~type_params ~type_args
-                label_decl.ld_type
-            in
-            let lbl_name = label_decl.ld_id |> Ident.name in
-            let lbl =
-              if label_decl.ld_optional then
-                Asttypes.Optional {txt = lbl_name; loc = Location.none}
-              else Asttypes.Labelled {txt = lbl_name; loc = Location.none}
-            in
-            {
-              ret_type with
-              desc = Tarrow ({lbl; typ = prop_type}, mk_fun_type rest, None);
-            }
+        let mk_fun_type (label_decls : Types.label_declaration list) =
+          let params =
+            label_decls
+            |> List.map (fun (label_decl : Types.label_declaration) ->
+                   let prop_type =
+                     Type_utils.instantiate_type ~type_params ~type_args
+                       label_decl.ld_type
+                   in
+                   let lbl_name = label_decl.ld_id |> Ident.name in
+                   let lbl =
+                     if label_decl.ld_optional then
+                       Asttypes.Optional {txt = lbl_name; loc = Location.none}
+                     else
+                       Asttypes.Labelled {txt = lbl_name; loc = Location.none}
+                   in
+                   {Types.lbl; typ = prop_type})
+          in
+          {ret_type with desc = Tarrow (params, ret_type)}
         in
         let fun_type =
           if List.length label_decls = 0 (* No props *) then
@@ -185,7 +184,7 @@ let print_signature ~extractor ~signature =
             in
             {
               ret_type with
-              desc = Tarrow ({lbl = Nolabel; typ = t_unit}, ret_type, None);
+              desc = Tarrow ([{Types.lbl = Nolabel; typ = t_unit}], ret_type);
             }
           else mk_fun_type label_decls
         in
diff --git a/analysis/src/process_cmt.ml b/analysis/src/process_cmt.ml
index 81e9a6817a6..1a6c0dd2367 100644
--- a/analysis/src/process_cmt.ml
+++ b/analysis/src/process_cmt.ml
@@ -723,12 +723,7 @@ and scan_let_modules ~env (e : Typedtree.expression) =
     in
     List.iter scan_case cases;
     List.iter scan_case exn_cases
-  | Texp_function {case; _} ->
-    let {Typedtree.c_lhs = _; c_guard; c_rhs} = case in
-    (match c_guard with
-    | Some g -> scan_let_modules ~env g
-    | None -> ());
-    scan_let_modules ~env c_rhs
+  | Texp_function {body; _} -> scan_let_modules ~env body
   | Texp_try (e, cases) ->
     scan_let_modules ~env e;
     cases
diff --git a/analysis/src/shared.ml b/analysis/src/shared.ml
index 011b990d067..cc2cbeea66f 100644
--- a/analysis/src/shared.ml
+++ b/analysis/src/shared.ml
@@ -48,8 +48,8 @@ let find_type_constructors (tel : Types.type_expr list) =
     | Tconstr (path, args, _) ->
       add_path path;
       args |> List.iter loop
-    | Tarrow (arg, ret, _) ->
-      loop arg.typ;
+    | Tarrow (params, ret) ->
+      List.iter (fun ({typ} : Types.arg) -> loop typ) params;
       loop ret
     | Ttuple tel -> tel |> List.iter loop
     | Tnil | Tvar _ | Tobject _ | Tfield _ | Tvariant _ | Tunivar _ | Tpackage _
diff --git a/analysis/src/type_utils.ml b/analysis/src/type_utils.ml
index ddec5318332..63702f0a301 100644
--- a/analysis/src/type_utils.ml
+++ b/analysis/src/type_utils.ml
@@ -30,7 +30,8 @@ let debug_log_type_arg_context {env; type_args; type_params} =
 let rec has_tvar (ty : Types.type_expr) : bool =
   match ty.desc with
   | Tvar _ -> true
-  | Tarrow (arg, ret, _) -> has_tvar arg.typ || has_tvar ret
+  | Tarrow (params, ret) ->
+    List.exists (fun ({typ} : Types.arg) -> has_tvar typ) params || has_tvar ret
   | Ttuple tyl -> List.exists has_tvar tyl
   | Tconstr (_, tyl, _) -> List.exists has_tvar tyl
   | Tobject (ty, _) -> has_tvar ty
@@ -144,8 +145,16 @@ let instantiate_type ~type_params ~type_args (t : Types.type_expr) =
       | Tsubst t -> loop t
       | Tvariant rd -> {t with desc = Tvariant (row_desc rd)}
       | Tnil -> t
-      | Tarrow (arg, ret, arity) ->
-        {t with desc = Tarrow ({arg with typ = loop arg.typ}, loop ret, arity)}
+      | Tarrow (params, ret) ->
+        {
+          t with
+          desc =
+            Tarrow
+              ( List.map
+                  (fun (arg : Types.arg) -> {arg with typ = loop arg.typ})
+                  params,
+                loop ret );
+        }
       | Ttuple tl -> {t with desc = Ttuple (tl |> List.map loop)}
       | Tobject (t, r) -> {t with desc = Tobject (loop t, r)}
       | Tfield (n, k, t1, t2) -> {t with desc = Tfield (n, k, loop t1, loop t2)}
@@ -197,8 +206,16 @@ let instantiate_type2 ?(type_arg_context : type_arg_context option)
       | Tsubst t -> loop t
       | Tvariant rd -> {t with desc = Tvariant (row_desc rd)}
       | Tnil -> t
-      | Tarrow (arg, ret, arity) ->
-        {t with desc = Tarrow ({arg with typ = loop arg.typ}, loop ret, arity)}
+      | Tarrow (params, ret) ->
+        {
+          t with
+          desc =
+            Tarrow
+              ( List.map
+                  (fun (arg : Types.arg) -> {arg with typ = loop arg.typ})
+                  params,
+                loop ret );
+        }
       | Ttuple tl -> {t with desc = Ttuple (tl |> List.map loop)}
       | Tobject (t, r) -> {t with desc = Tobject (loop t, r)}
       | Tfield (n, k, t1, t2) -> {t with desc = Tfield (n, k, loop t1, loop t2)}
@@ -266,7 +283,12 @@ let extract_function_type ~state ~env ~package ?(dig_into = true) typ =
   let rec loop ~env acc (t : Types.type_expr) =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ~env acc t1
-    | Tarrow (arg, t_ret, _) -> loop ~env ((arg.lbl, arg.typ) :: acc) t_ret
+    | Tarrow (params, t_ret) ->
+      loop ~env
+        (List.rev_append
+           (List.map (fun ({lbl; typ} : Types.arg) -> (lbl, typ)) params)
+           acc)
+        t_ret
     | Tconstr (path, type_args, _) when dig_into -> (
       match References.dig_constructor ~state ~env ~package path with
       | Some (env, {item = {decl = {type_manifest = Some t1; type_params}}}) ->
@@ -281,7 +303,12 @@ let extract_function_type_with_env ~state ~env ~package typ =
   let rec loop ~env acc (t : Types.type_expr) =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ~env acc t1
-    | Tarrow (arg, t_ret, _) -> loop ~env ((arg.lbl, arg.typ) :: acc) t_ret
+    | Tarrow (params, t_ret) ->
+      loop ~env
+        (List.rev_append
+           (List.map (fun ({lbl; typ} : Types.arg) -> (lbl, typ)) params)
+           acc)
+        t_ret
     | Tconstr (path, type_args, _) -> (
       match References.dig_constructor ~state ~env ~package path with
       | Some (_env, {item = {decl = {type_manifest = Some t1; type_params}}}) ->
@@ -317,8 +344,12 @@ let extract_function_type2 ?type_arg_context ~state ~env ~package typ =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
       loop ?type_arg_context ~env acc t1
-    | Tarrow (arg, t_ret, _) ->
-      loop ?type_arg_context ~env ((arg.lbl, arg.typ) :: acc) t_ret
+    | Tarrow (params, t_ret) ->
+      loop ?type_arg_context ~env
+        (List.rev_append
+           (List.map (fun ({lbl; typ} : Types.arg) -> (lbl, typ)) params)
+           acc)
+        t_ret
     | Tconstr (path, type_args, _) -> (
       match References.dig_constructor ~state ~env ~package path with
       | Some (env, {item = {decl = {type_manifest = Some t1; type_params}}}) ->
@@ -921,17 +952,22 @@ let get_args ~env (t : Types.type_expr) ~full ~state =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
       get_args_loop ~full ~env ~current_argument_position t1
-    | Tarrow ({lbl = Labelled {txt = l}; typ = t_arg}, t_ret, _) ->
-      (Shared_types.Completable.Labelled l, t_arg)
-      :: get_args_loop ~full ~env ~current_argument_position t_ret
-    | Tarrow ({lbl = Optional {txt = l}; typ = t_arg}, t_ret, _) ->
-      (Optional l, t_arg)
-      :: get_args_loop ~full ~env ~current_argument_position t_ret
-    | Tarrow ({lbl = Nolabel; typ = t_arg}, t_ret, _) ->
-      (Unlabelled {argument_position = current_argument_position}, t_arg)
-      :: get_args_loop ~full ~env
-           ~current_argument_position:(current_argument_position + 1)
-           t_ret
+    | Tarrow (params, t_ret) ->
+      let args, next_position =
+        List.fold_left
+          (fun (acc, position) ({lbl; typ = t_arg} : Types.arg) ->
+            match lbl with
+            | Labelled {txt = l} ->
+              ((Shared_types.Completable.Labelled l, t_arg) :: acc, position)
+            | Optional {txt = l} -> ((Optional l, t_arg) :: acc, position)
+            | Nolabel ->
+              ( (Unlabelled {argument_position = position}, t_arg) :: acc,
+                position + 1 ))
+          ([], current_argument_position)
+          params
+      in
+      List.rev args
+      @ get_args_loop ~full ~env ~current_argument_position:next_position t_ret
     | Tconstr (path, type_args, _) -> (
       match
         References.dig_constructor ~env ~state ~package:full.package path
diff --git a/compiler/core/lam_convert.ml b/compiler/core/lam_convert.ml
index 267c1d83790..49027c85654 100644
--- a/compiler/core/lam_convert.ml
+++ b/compiler/core/lam_convert.ml
@@ -323,6 +323,12 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
 
 let may_depend = Lam_module_ident.Hash_set.add
 
+let is_opt_param_name name =
+  (* [*opt*] historically; [*opt_<label>*] with the n-ary representation *)
+  String.length name >= 5
+  && String.sub name 0 4 = "*opt"
+  && String.get name (String.length name - 1) = '*'
+
 let rec rename_optional_parameters map params (body : Lambda.lambda) =
   match body with
   | Llet
@@ -330,11 +336,13 @@ let rec rename_optional_parameters map params (body : Lambda.lambda) =
         value_kind,
         id,
         Lifthenelse
-          ( Lprim (p, [Lvar ({name = "*opt*"} as opt)], p_loc),
-            Lprim (p1, [Lvar ({name = "*opt*"} as opt2)], x_loc),
+          ( Lprim (p, [Lvar ({name = opt_name} as opt)], p_loc),
+            Lprim (p1, [Lvar ({name = opt_name2} as opt2)], x_loc),
             f ),
         rest )
-    when Ident.same opt opt2 && List.mem opt params ->
+    when is_opt_param_name opt_name
+         && is_opt_param_name opt_name2
+         && Ident.same opt opt2 && List.mem opt params ->
     let map, rest = rename_optional_parameters map params rest in
     let new_id = Ident.create (id.name ^ "Opt") in
     ( Map_ident.add map opt new_id,
diff --git a/compiler/ext/config.ml b/compiler/ext/config.ml
index 5dd67831b18..efda9e29ae8 100644
--- a/compiler/ext/config.ml
+++ b/compiler/ext/config.ml
@@ -1,4 +1,4 @@
-let cmi_magic_number = "Caml1999I022"
+let cmi_magic_number = "Caml1999I023"
 
 (* Magic numbers for marshaled values of the *current* parsetree, whose layout
    changes across compiler versions. *)
@@ -13,6 +13,6 @@ and ast0_impl_magic_number = "Caml1999M022"
 
 and ast0_intf_magic_number = "Caml1999N022"
 
-and cmt_magic_number = "Caml1999T022"
+and cmt_magic_number = "Caml1999T023"
 
 let load_path = ref ([] : string list)
diff --git a/compiler/gentype/translate_core_type.ml b/compiler/gentype/translate_core_type.ml
index 29ba8f059a7..a9029e62ccb 100644
--- a/compiler/gentype/translate_core_type.ml
+++ b/compiler/gentype/translate_core_type.ml
@@ -50,74 +50,57 @@ let process_variant row_fields =
   row_fields |> loop ~no_payloads:[] ~payloads:[] ~inherits:[]
 
 let rec translate_arrow_type ~config ~type_vars_gen
-    ~no_function_return_dependencies ~type_env ~rev_arg_deps ~rev_args
-    (core_type : Typedtree.core_type) =
-  match core_type.ctyp_desc with
-  | Ttyp_arrow ({lbl = Nolabel; typ = core_type1}, core_type2, arity)
-    when arity = None || rev_args = [] ->
-    let {dependencies; type_} =
-      core_type1 |> fun __x ->
-      translateCoreType_ ~config ~type_vars_gen ~type_env __x
-    in
-    let next_rev_deps = List.rev_append dependencies rev_arg_deps in
-    core_type2
-    |> translate_arrow_type ~config ~type_vars_gen
-         ~no_function_return_dependencies ~type_env ~rev_arg_deps:next_rev_deps
-         ~rev_args:((Nolabel, type_) :: rev_args)
-  | Ttyp_arrow
-      ( {
-          lbl = (Labelled {txt = lbl} | Optional {txt = lbl}) as label;
-          typ = core_type1;
-        },
-        core_type2,
-        arity )
-    when arity = None || rev_args = [] -> (
-    let as_label =
-      match core_type.ctyp_attributes |> Annotation.get_gentype_as_renaming with
-      | Some s -> s
-      | None -> ""
-    in
-    match core_type1 |> remove_option ~label with
-    | None ->
-      let {dependencies; type_ = type1} =
-        core_type1 |> translateCoreType_ ~config ~type_vars_gen ~type_env
-      in
-      let next_rev_deps = List.rev_append dependencies rev_arg_deps in
-      core_type2
-      |> translate_arrow_type ~config ~type_vars_gen
-           ~no_function_return_dependencies ~type_env
-           ~rev_arg_deps:next_rev_deps
-           ~rev_args:
-             (( Label
+    ~no_function_return_dependencies ~type_env (params : Typedtree.arg list)
+    (ret : Typedtree.core_type) =
+  let rev_arg_deps, rev_args =
+    List.fold_left
+      (fun (rev_arg_deps, rev_args) ({attrs; lbl; typ} : Typedtree.arg) ->
+        match lbl with
+        | Nolabel ->
+          let {dependencies; type_} =
+            typ |> translateCoreType_ ~config ~type_vars_gen ~type_env
+          in
+          ( List.rev_append dependencies rev_arg_deps,
+            (Nolabel, type_) :: rev_args )
+        | (Labelled {txt = lbl_txt} | Optional {txt = lbl_txt}) as label -> (
+          let as_label =
+            match attrs |> Annotation.get_gentype_as_renaming with
+            | Some s -> s
+            | None -> ""
+          in
+          match typ |> remove_option ~label with
+          | None ->
+            let {dependencies; type_ = type1} =
+              typ |> translateCoreType_ ~config ~type_vars_gen ~type_env
+            in
+            ( List.rev_append dependencies rev_arg_deps,
+              ( Label
                   (match as_label = "" with
-                  | true -> lbl
+                  | true -> lbl_txt
                   | false -> as_label),
                 type1 )
-             :: rev_args)
-    | Some (lbl, t1) ->
-      let {dependencies; type_ = type1} =
-        t1 |> translateCoreType_ ~config ~type_vars_gen ~type_env
-      in
-      let next_rev_deps = List.rev_append dependencies rev_arg_deps in
-      core_type2
-      |> translate_arrow_type ~config ~type_vars_gen
-           ~no_function_return_dependencies ~type_env
-           ~rev_arg_deps:next_rev_deps
-           ~rev_args:((OptLabel lbl, type1) :: rev_args))
-  | _ ->
-    let {dependencies; type_ = ret_type} =
-      core_type |> translateCoreType_ ~config ~type_vars_gen ~type_env
-    in
-    let all_deps =
-      List.rev_append rev_arg_deps
-        (match no_function_return_dependencies with
-        | true -> []
-        | false -> dependencies)
-    in
-    let labeled_convertable_types = rev_args |> List.rev in
-    let arg_types = labeled_convertable_types |> Named_args.group in
-    let function_type = Function {arg_types; ret_type; type_vars = []} in
-    {dependencies = all_deps; type_ = function_type}
+              :: rev_args )
+          | Some (lbl_txt, t1) ->
+            let {dependencies; type_ = type1} =
+              t1 |> translateCoreType_ ~config ~type_vars_gen ~type_env
+            in
+            ( List.rev_append dependencies rev_arg_deps,
+              (OptLabel lbl_txt, type1) :: rev_args )))
+      ([], []) params
+  in
+  let {dependencies; type_ = ret_type} =
+    ret |> translateCoreType_ ~config ~type_vars_gen ~type_env
+  in
+  let all_deps =
+    List.rev_append rev_arg_deps
+      (match no_function_return_dependencies with
+      | true -> []
+      | false -> dependencies)
+  in
+  let labeled_convertable_types = rev_args |> List.rev in
+  let arg_types = labeled_convertable_types |> Named_args.group in
+  let function_type = Function {arg_types; ret_type; type_vars = []} in
+  {dependencies = all_deps; type_ = function_type}
 
 and translateCoreType_ ~config ~type_vars_gen
     ?(no_function_return_dependencies = false) ~type_env
@@ -154,11 +137,9 @@ and translateCoreType_ ~config ~type_vars_gen
     t
     |> translateCoreType_ ~config ~type_vars_gen
          ~no_function_return_dependencies ~type_env
-  | Ttyp_arrow _ ->
-    core_type
-    |> translate_arrow_type ~config ~type_vars_gen
-         ~no_function_return_dependencies ~type_env ~rev_arg_deps:[]
-         ~rev_args:[]
+  | Ttyp_arrow (params, ret) ->
+    translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies
+      ~type_env params ret
   | Ttyp_tuple list_exp ->
     let inner_types_translation =
       list_exp |> translateCoreTypes_ ~config ~type_vars_gen ~type_env
diff --git a/compiler/gentype/translate_structure.ml b/compiler/gentype/translate_structure.ml
index b55ba8b4469..2909b6c6801 100644
--- a/compiler/gentype/translate_structure.ml
+++ b/compiler/gentype/translate_structure.ml
@@ -2,22 +2,27 @@ open Gentype_common
 
 let rec addAnnotationsToTypes_ ~config ~(expr : Typedtree.expression)
     (arg_types : arg_type list) =
-  match (expr.exp_desc, expr.exp_type.desc, arg_types) with
-  | Texp_function {arg_label; param; case = {c_rhs}}, _, {a_type} :: next_types
-    ->
-    let next_types1 =
-      next_types |> addAnnotationsToTypes_ ~config ~expr:c_rhs
+  match expr.exp_desc with
+  | Texp_function {params; body} ->
+    let rec zip (params : Typedtree.function_param list)
+        (arg_types : arg_type list) =
+      match (params, arg_types) with
+      | {fp_lbl; fp_param} :: rest_params, {a_type} :: rest_types ->
+        let a_name = Ident.name fp_param in
+        let a_name =
+          (* optional parameters with a default are bound to a synthetic
+             [*opt_<label>*] variable; show the label instead *)
+          if String.length a_name >= 4 && String.sub a_name 0 4 = "*opt" then
+            match fp_lbl with
+            | Optional {txt = l} -> l
+            | _ -> "" (* should not happen *)
+          else a_name
+        in
+        {a_name; a_type} :: zip rest_params rest_types
+      | [], rest -> rest |> addAnnotationsToTypes_ ~config ~expr:body
+      | _, [] -> []
     in
-    let a_name = Ident.name param in
-    let _ = Printtyped.implementation in
-    let a_name =
-      if a_name = "*opt*" then
-        match arg_label with
-        | Optional {txt = l} -> l
-        | _ -> "" (* should not happen *)
-      else a_name
-    in
-    {a_name; a_type} :: next_types1
+    zip params arg_types
   | _ -> arg_types
 
 and add_annotations_to_types ~config ~(expr : Typedtree.expression)
@@ -36,18 +41,17 @@ and add_annotations_to_types ~config ~(expr : Typedtree.expression)
 
 and add_annotations_to_fields ~config (expr : Typedtree.expression)
     (fields : fields) (arg_types : arg_type list) =
-  match (expr.exp_desc, fields, arg_types) with
-  | _, [], _ -> ([], arg_types |> add_annotations_to_types ~config ~expr)
-  | Texp_function {case = {c_rhs}}, field :: next_fields, _ ->
+  match fields with
+  | [] -> ([], arg_types |> add_annotations_to_types ~config ~expr)
+  | field :: next_fields ->
     let next_fields1, types1 =
-      add_annotations_to_fields ~config c_rhs next_fields arg_types
+      add_annotations_to_fields ~config expr next_fields arg_types
     in
     let name =
       Translate_type_declarations.rename_record_field
         ~attributes:expr.exp_attributes ~name:field.name_js
     in
     ({field with name_js = name} :: next_fields1, types1)
-  | _ -> (fields, arg_types)
 [@@live]
 
 (** Recover from expr the renaming annotations on named arguments. *)
diff --git a/compiler/gentype/translate_type_expr_from_types.ml b/compiler/gentype/translate_type_expr_from_types.ml
index 193848fe086..96b5ffcfb41 100644
--- a/compiler/gentype/translate_type_expr_from_types.ml
+++ b/compiler/gentype/translate_type_expr_from_types.ml
@@ -461,60 +461,43 @@ let process_variant row_fields =
   in
   row_fields |> loop ~no_payloads:[] ~payloads:[] ~unknowns:[]
 
-let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps
-    ~rev_args (type_expr : Types.type_expr) =
-  match type_expr.desc with
-  | Tlink t ->
-    translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps
-      ~rev_args t
-  | Tarrow ({lbl = Nolabel; typ = type_expr1}, type_expr2, arity)
-    when arity = None || rev_args = [] ->
-    let {dependencies; type_} =
-      type_expr1 |> fun __x ->
-      translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env __x
-    in
-    let next_rev_deps = List.rev_append dependencies rev_arg_deps in
-    type_expr2
-    |> translate_arrow_type ~config ~type_vars_gen ~type_env
-         ~rev_arg_deps:next_rev_deps
-         ~rev_args:((Nolabel, type_) :: rev_args)
-  | Tarrow
-      ( {
-          lbl = (Labelled {txt = lbl} | Optional {txt = lbl}) as label;
-          typ = type_expr1;
-        },
-        type_expr2,
-        arity )
-    when arity = None || rev_args = [] -> (
-    match type_expr1 |> remove_option ~label with
-    | None ->
-      let {dependencies; type_ = type1} =
-        type_expr1
-        |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
-      in
-      let next_rev_deps = List.rev_append dependencies rev_arg_deps in
-      type_expr2
-      |> translate_arrow_type ~config ~type_vars_gen ~type_env
-           ~rev_arg_deps:next_rev_deps
-           ~rev_args:((Label lbl, type1) :: rev_args)
-    | Some (lbl, t1) ->
-      let {dependencies; type_ = type1} =
-        t1 |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
-      in
-      let next_rev_deps = List.rev_append dependencies rev_arg_deps in
-      type_expr2
-      |> translate_arrow_type ~config ~type_vars_gen ~type_env
-           ~rev_arg_deps:next_rev_deps
-           ~rev_args:((OptLabel lbl, type1) :: rev_args))
-  | _ ->
-    let {dependencies; type_ = ret_type} =
-      type_expr |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
-    in
-    let all_deps = List.rev_append rev_arg_deps dependencies in
-    let labeled_convertable_types = rev_args |> List.rev in
-    let arg_types = labeled_convertable_types |> Named_args.group in
-    let function_type = Function {arg_types; ret_type; type_vars = []} in
-    {dependencies = all_deps; type_ = function_type}
+let rec translate_arrow_type ~config ~type_vars_gen ~type_env
+    (params : Types.arg list) (ret : Types.type_expr) =
+  let rev_arg_deps, rev_args =
+    List.fold_left
+      (fun (rev_arg_deps, rev_args) ({lbl; typ} : Types.arg) ->
+        match lbl with
+        | Nolabel ->
+          let {dependencies; type_} =
+            typ |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
+          in
+          ( List.rev_append dependencies rev_arg_deps,
+            (Nolabel, type_) :: rev_args )
+        | (Labelled {txt = lbl_txt} | Optional {txt = lbl_txt}) as label -> (
+          match typ |> remove_option ~label with
+          | None ->
+            let {dependencies; type_ = type1} =
+              typ
+              |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
+            in
+            ( List.rev_append dependencies rev_arg_deps,
+              (Label lbl_txt, type1) :: rev_args )
+          | Some (lbl_txt, t1) ->
+            let {dependencies; type_ = type1} =
+              t1 |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
+            in
+            ( List.rev_append dependencies rev_arg_deps,
+              (OptLabel lbl_txt, type1) :: rev_args )))
+      ([], []) params
+  in
+  let {dependencies; type_ = ret_type} =
+    ret |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
+  in
+  let all_deps = List.rev_append rev_arg_deps dependencies in
+  let labeled_convertable_types = rev_args |> List.rev in
+  let arg_types = labeled_convertable_types |> Named_args.group in
+  let function_type = Function {arg_types; ret_type; type_vars = []} in
+  {dependencies = all_deps; type_ = function_type}
 
 and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
     (type_expr : Types.type_expr) =
@@ -555,10 +538,8 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
     translate_constr ~config ~params_translation ~path ~type_env
   | Tpoly (t, []) ->
     t |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
-  | Tarrow _ ->
-    type_expr
-    |> translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps:[]
-         ~rev_args:[]
+  | Tarrow (params, ret) ->
+    translate_arrow_type ~config ~type_vars_gen ~type_env params ret
   | Ttuple list_exp ->
     let inner_types_translation =
       list_exp |> translateTypeExprsFromTypes_ ~config ~type_vars_gen ~type_env
diff --git a/compiler/ml/asttypes.ml b/compiler/ml/asttypes.ml
index e12960a0058..a52db0da016 100644
--- a/compiler/ml/asttypes.ml
+++ b/compiler/ml/asttypes.ml
@@ -41,8 +41,6 @@ type closed_flag = Closed | Open
 
 type label = string
 
-type arity = int option
-
 type 'a loc = 'a Location.loc = {txt: 'a; loc: Location.t}
 
 type variance = Covariant | Contravariant | Invariant
diff --git a/compiler/ml/btype.ml b/compiler/ml/btype.ml
index f389add14f2..5e99ff5a3ad 100644
--- a/compiler/ml/btype.ml
+++ b/compiler/ml/btype.ml
@@ -255,9 +255,9 @@ let rec iter_row f row =
 let iter_type_expr f ty =
   match ty.desc with
   | Tvar _ -> ()
-  | Tarrow ({typ = ty1}, ty2, _) ->
-    f ty1;
-    f ty2
+  | Tarrow (params, ret) ->
+    List.iter (fun {typ} -> f typ) params;
+    f ret
   | Ttuple l -> List.iter f l
   | Tconstr (_, l, _) -> List.iter f l
   | Tobject (ty, {contents = Some (_, p)}) ->
@@ -419,7 +419,8 @@ let rec norm_univar ty =
 
 let rec copy_type_desc ?(keep_names = false) f = function
   | Tvar _ as ty -> if keep_names then ty else Tvar None
-  | Tarrow (arg, ret, arity) -> Tarrow ({arg with typ = f arg.typ}, f ret, arity)
+  | Tarrow (params, ret) ->
+    Tarrow (List.map (fun arg -> {arg with typ = f arg.typ}) params, f ret)
   | Ttuple l -> Ttuple (List.map f l)
   | Tconstr (p, l, _) -> Tconstr (p, List.map f l, ref Mnil)
   | Tobject (ty, {contents = Some (p, tl)}) ->
diff --git a/compiler/ml/ctype.ml b/compiler/ml/ctype.ml
index 7de120c53f7..4afd18d42cb 100644
--- a/compiler/ml/ctype.ml
+++ b/compiler/ml/ctype.ml
@@ -641,8 +641,10 @@ let rec generalize_expansive env var_level visited ty =
           else generalize_expansive env var_level visited t)
         variance tyl
     | Tpackage (_, _, tyl) -> List.iter (generalize_structure var_level) tyl
-    | Tarrow (arg, ret, _) ->
-      generalize_structure var_level arg.typ;
+    | Tarrow (params, ret) ->
+      List.iter
+        (fun ({typ} : Types.arg) -> generalize_structure var_level typ)
+        params;
       generalize_expansive env var_level visited ret
     | _ -> iter_type_expr (generalize_expansive env var_level visited) ty)
 
@@ -1780,10 +1782,17 @@ let rec mcomp type_pairs env t1 t2 =
             Type_pairs.add type_pairs (t1', t2') ();
             match (t1'.desc, t2'.desc) with
             | Tvar _, Tvar _ -> assert false
-            | Tarrow (arg1, ret1, _), Tarrow (arg2, ret2, _)
-              when Asttypes.same_arg_label arg1.lbl arg2.lbl
-                   || not (is_optional arg1.lbl || is_optional arg2.lbl) ->
-              mcomp type_pairs env arg1.typ arg2.typ;
+            | Tarrow (params1, ret1), Tarrow (params2, ret2)
+              when List.length params1 = List.length params2
+                   && List.for_all2
+                        (fun (a1 : Types.arg) (a2 : Types.arg) ->
+                          Asttypes.same_arg_label a1.lbl a2.lbl
+                          || not (is_optional a1.lbl || is_optional a2.lbl))
+                        params1 params2 ->
+              List.iter2
+                (fun (a1 : Types.arg) (a2 : Types.arg) ->
+                  mcomp type_pairs env a1.typ a2.typ)
+                params1 params2;
               mcomp type_pairs env ret1 ret2
             | Ttuple tl1, Ttuple tl2 -> mcomp_list type_pairs env tl1 tl2
             | Tconstr (p1, tl1, _), Tconstr (p2, tl2, _) ->
@@ -2195,12 +2204,17 @@ and unify3 env t1 t1' t2 t2' =
     | Pattern -> add_type_equality t1' t2');
     try
       (match (d1, d2) with
-      | Tarrow (arg1, ret1, a1), Tarrow (arg2, ret2, a2)
-        when a1 = a2
-             && (Asttypes.same_arg_label arg1.lbl arg2.lbl
-                || !umode = Pattern
-                   && not (is_optional arg1.lbl || is_optional arg2.lbl)) ->
-        unify env arg1.typ arg2.typ;
+      | Tarrow (params1, ret1), Tarrow (params2, ret2)
+        when List.length params1 = List.length params2
+             && List.for_all2
+                  (fun (a1 : Types.arg) (a2 : Types.arg) ->
+                    Asttypes.same_arg_label a1.lbl a2.lbl
+                    || !umode = Pattern
+                       && not (is_optional a1.lbl || is_optional a2.lbl))
+                  params1 params2 ->
+        List.iter2
+          (fun (a1 : Types.arg) (a2 : Types.arg) -> unify env a1.typ a2.typ)
+          params1 params2;
         unify env ret1 ret2
       | Ttuple tl1, Ttuple tl2 -> unify_list env tl1 tl2
       | Tconstr (p1, tl1, _), Tconstr (p2, tl2, _) when Path.same p1 p2 ->
@@ -2629,23 +2643,23 @@ let expand_head_trace env t =
   reset_trace_gadt_instances reset_tracing;
   t
 
-(*
-   Unify [t] and [l:'a -> 'b]. Return ['a] and ['b].
-   In label mode, label mismatch is accepted when
-   (1) the requested label is ""
-   (2) the original label is not optional
-*)
-
-let filter_arrow ~env ~arity t l =
+(* Unify [t] with an n-ary arrow taking parameters with the given labels.
+   Return the parameter types and the result type. *)
+let filter_arrow_n ~env t (labels : arg_label list) =
   let t = expand_head_trace env t in
   match t.desc with
   | Tvar _ ->
     let lv = t.level in
-    let t1 = newvar2 lv and t2 = newvar2 lv in
-    let t' = newty2 lv (Tarrow ({lbl = l; typ = t1}, t2, arity)) in
-    link_type t t';
-    (t1, t2)
-  | Tarrow (arg, ret, _) when Asttypes.same_arg_label l arg.lbl -> (arg.typ, ret)
+    let params = List.map (fun l -> {lbl = l; typ = newvar2 lv}) labels in
+    let t2 = newvar2 lv in
+    link_type t (newty2 lv (Tarrow (params, t2)));
+    (List.map (fun (p : Types.arg) -> p.typ) params, t2)
+  | Tarrow (params, ret)
+    when List.length params = List.length labels
+         && List.for_all2
+              (fun l (p : Types.arg) -> Asttypes.same_arg_label l p.lbl)
+              labels params ->
+    (List.map (fun (p : Types.arg) -> p.typ) params, ret)
   | _ -> raise (Unify [])
 
 (* Used by [filter_method]. *)
@@ -2740,9 +2754,16 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
               | Tvar _, _ when may_instantiate inst_nongen t1' ->
                 moregen_occur env t1'.level t2;
                 link_type t1' t2
-              | Tarrow (arg1, ret1, a1), Tarrow (arg2, ret2, a2)
-                when a1 = a2 && Asttypes.same_arg_label arg1.lbl arg2.lbl ->
-                moregen inst_nongen type_pairs env arg1.typ arg2.typ;
+              | Tarrow (params1, ret1), Tarrow (params2, ret2)
+                when List.length params1 = List.length params2
+                     && List.for_all2
+                          (fun (a1 : Types.arg) (a2 : Types.arg) ->
+                            Asttypes.same_arg_label a1.lbl a2.lbl)
+                          params1 params2 ->
+                List.iter2
+                  (fun (a1 : Types.arg) (a2 : Types.arg) ->
+                    moregen inst_nongen type_pairs env a1.typ a2.typ)
+                  params1 params2;
                 moregen inst_nongen type_pairs env ret1 ret2
               | Ttuple tl1, Ttuple tl2 ->
                 moregen_list inst_nongen type_pairs env tl1 tl2
@@ -3010,9 +3031,16 @@ let rec eqtype rename type_pairs subst env t1 t2 =
                   if List.exists (fun (_, t) -> t == t2') !subst then
                     raise (Unify []);
                   subst := (t1', t2') :: !subst)
-              | Tarrow (arg1, ret1, a1), Tarrow (arg2, ret2, a2)
-                when a1 = a2 && Asttypes.same_arg_label arg1.lbl arg2.lbl ->
-                eqtype rename type_pairs subst env arg1.typ arg2.typ;
+              | Tarrow (params1, ret1), Tarrow (params2, ret2)
+                when List.length params1 = List.length params2
+                     && List.for_all2
+                          (fun (a1 : Types.arg) (a2 : Types.arg) ->
+                            Asttypes.same_arg_label a1.lbl a2.lbl)
+                          params1 params2 ->
+                List.iter2
+                  (fun (a1 : Types.arg) (a2 : Types.arg) ->
+                    eqtype rename type_pairs subst env a1.typ a2.typ)
+                  params1 params2;
                 eqtype rename type_pairs subst env ret1 ret2
               | Ttuple tl1, Ttuple tl2 ->
                 eqtype_list rename type_pairs subst env tl1 tl2
@@ -3210,14 +3238,22 @@ let rec build_subtype env visited loops posi level t =
         (t', Equiv)
       with Not_found -> (t, Unchanged)
     else (t, Unchanged)
-  | Tarrow (arg, ret, a) ->
+  | Tarrow (params, ret) ->
     if memq_warn t visited then (t, Unchanged)
     else
       let visited = t :: visited in
-      let t1, c1 = build_subtype env visited loops (not posi) level arg.typ in
+      let params' =
+        List.map
+          (fun (arg : Types.arg) ->
+            let t1, c1 =
+              build_subtype env visited loops (not posi) level arg.typ
+            in
+            ({arg with typ = t1}, c1))
+          params
+      in
       let t2, c2 = build_subtype env visited loops posi level ret in
-      let c = max c1 c2 in
-      if c > Unchanged then (newty (Tarrow ({arg with typ = t1}, t2, a)), c)
+      let c = List.fold_left (fun acc (_, c1) -> max acc c1) c2 params' in
+      if c > Unchanged then (newty (Tarrow (List.map fst params', t2)), c)
       else (t, Unchanged)
   | Ttuple tlist ->
     if memq_warn t visited then (t, Unchanged)
@@ -3410,12 +3446,17 @@ let rec subtype_rec env trace t1 t2 cstrs =
       Type_pairs.add subtypes (t1, t2) ();
       match (t1.desc, t2.desc) with
       | Tvar _, _ | _, Tvar _ -> (trace, t1, t2, !univar_pairs, None) :: cstrs
-      | Tarrow (arg1, ret1, a1), Tarrow (arg2, ret2, a2)
-        when a1 = a2 && Asttypes.same_arg_label arg1.lbl arg2.lbl ->
+      | Tarrow (params1, ret1), Tarrow (params2, ret2)
+        when List.length params1 = List.length params2
+             && List.for_all2
+                  (fun (a1 : Types.arg) (a2 : Types.arg) ->
+                    Asttypes.same_arg_label a1.lbl a2.lbl)
+                  params1 params2 ->
         let cstrs =
-          subtype_rec env
-            ((arg2.typ, arg1.typ) :: trace)
-            arg2.typ arg1.typ cstrs
+          List.fold_left2
+            (fun cstrs (a1 : Types.arg) (a2 : Types.arg) ->
+              subtype_rec env ((a2.typ, a1.typ) :: trace) a2.typ a1.typ cstrs)
+            cstrs params1 params2
         in
         subtype_rec env ((ret1, ret2) :: trace) ret1 ret2 cstrs
       | Ttuple tl1, Ttuple tl2 ->
@@ -3892,7 +3933,7 @@ let unalias ty =
 (* Return the arity (as for curried functions) of the given type. *)
 let rec arity ty =
   match (repr ty).desc with
-  | Tarrow (_, ret, _) -> 1 + arity ret
+  | Tarrow (params, ret) -> List.length params + arity ret
   | _ -> 0
 
 (* Check whether an abbreviation expands to itself. *)
@@ -4236,5 +4277,5 @@ let maybe_pointer_type env typ =
 
 let get_arity env typ =
   match (expand_head env typ).desc with
-  | Tarrow (_, _, arity) -> arity
+  | Tarrow (params, _) -> Some (List.length params)
   | _ -> None
diff --git a/compiler/ml/ctype.mli b/compiler/ml/ctype.mli
index aa9cd39bae4..57a1bff37d9 100644
--- a/compiler/ml/ctype.mli
+++ b/compiler/ml/ctype.mli
@@ -209,9 +209,10 @@ val unify_var : Env.t -> type_expr -> type_expr -> unit
 val with_passive_variants : ('a -> 'b) -> 'a -> 'b
 (* Call [f] in passive_variants mode, for exhaustiveness check. *)
 
-val filter_arrow :
-  env:Env.t -> arity:arity -> type_expr -> arg_label -> type_expr * type_expr
-(* A special case of unification (with l:'a -> 'b). *)
+val filter_arrow_n :
+  env:Env.t -> type_expr -> arg_label list -> type_expr list * type_expr
+(* A special case of unification: unify with an n-ary arrow taking
+   parameters with the given labels; return parameter and result types. *)
 
 val filter_method : Env.t -> string -> private_flag -> type_expr -> type_expr
 (* A special case of unification (with {m : 'a; 'b}). *)
diff --git a/compiler/ml/includemod.ml b/compiler/ml/includemod.ml
index a6e872441bb..b71af86d677 100644
--- a/compiler/ml/includemod.ml
+++ b/compiler/ml/includemod.ml
@@ -503,15 +503,27 @@ let find_arity_mismatch env ty1 ty2 =
       let ty1 = Btype.repr (Ctype.expand_head env ty1) in
       let ty2 = Btype.repr (Ctype.expand_head env ty2) in
       match (ty1.desc, ty2.desc) with
-      | Tarrow (arg1, ret1, arity1), Tarrow (arg2, ret2, arity2) -> (
-        match (arity1, arity2) with
-        | Some n1, Some n2 when n1 <> n2 -> Some (n1, n2)
-        | _ when arity1 = arity2 && Asttypes.same_arg_label arg1.lbl arg2.lbl
-          -> (
-          match loop seen arg1.typ arg2.typ with
-          | Some _ as mismatch -> mismatch
-          | None -> loop seen ret1 ret2)
-        | _ -> None)
+      | Tarrow (params1, ret1), Tarrow (params2, ret2) ->
+        let arity1 = List.length params1 in
+        let arity2 = List.length params2 in
+        if arity1 <> arity2 then Some (arity1, arity2)
+        else if
+          List.for_all2
+            (fun (arg1 : Types.arg) (arg2 : Types.arg) ->
+              Asttypes.same_arg_label arg1.lbl arg2.lbl)
+            params1 params2
+        then
+          let rec loop_params params1 params2 =
+            match (params1, params2) with
+            | (arg1 : Types.arg) :: params1, arg2 :: params2 -> (
+              match loop seen arg1.typ arg2.typ with
+              | Some _ as mismatch -> mismatch
+              | None -> loop_params params1 params2)
+            | [], [] -> loop seen ret1 ret2
+            | _ -> assert false
+          in
+          loop_params params1 params2
+        else None
       | _ -> None
   in
   loop [] ty1 ty2
diff --git a/compiler/ml/oprint.ml b/compiler/ml/oprint.ml
index 153d68fb183..6d0b764d500 100644
--- a/compiler/ml/oprint.ml
+++ b/compiler/ml/oprint.ml
@@ -249,15 +249,18 @@ let rec print_out_type ppf = function
   | ty -> print_out_type_1 ppf ty
 
 and print_out_type_1 ppf = function
-  | Otyp_arrow (lab, ty1, ty2, _) ->
+  | Otyp_arrow (args, ret) ->
     pp_open_box ppf 0;
-    if lab <> "" then (
-      pp_print_string ppf lab;
-      pp_print_char ppf ':');
-    print_out_type_2 ppf ty1;
-    pp_print_string ppf " ->";
-    pp_print_space ppf ();
-    print_out_type_1 ppf ty2;
+    List.iter
+      (fun (lab, ty1) ->
+        if lab <> "" then (
+          pp_print_string ppf lab;
+          pp_print_char ppf ':');
+        print_out_type_2 ppf ty1;
+        pp_print_string ppf " ->";
+        pp_print_space ppf ())
+      args;
+    print_out_type_1 ppf ret;
     pp_close_box ppf ()
   | ty -> print_out_type_2 ppf ty
 
diff --git a/compiler/ml/outcometree.ml b/compiler/ml/outcometree.ml
index 13724209fa1..d2e02e036e9 100644
--- a/compiler/ml/outcometree.ml
+++ b/compiler/ml/outcometree.ml
@@ -53,7 +53,7 @@ type out_type =
   | Otyp_abstract
   | Otyp_open
   | Otyp_alias of out_type * string
-  | Otyp_arrow of string * out_type * out_type * Asttypes.arity
+  | Otyp_arrow of (string * out_type) list * out_type
   | Otyp_class of bool * out_ident * out_type list
   | Otyp_constr of out_ident * out_type list
   | Otyp_manifest of out_type * out_type
diff --git a/compiler/ml/printtyp.ml b/compiler/ml/printtyp.ml
index d2f00712bbc..624a3b75a0e 100644
--- a/compiler/ml/printtyp.ml
+++ b/compiler/ml/printtyp.ml
@@ -149,10 +149,6 @@ let string_of_label = function
   | Labelled {txt} -> txt
   | Optional {txt} -> "?" ^ txt
 
-let string_of_arity = function
-  | None -> ""
-  | Some arity -> string_of_int arity
-
 let visited = ref []
 let rec raw_type ppf ty =
   let ty = safe_repr [] ty in
@@ -166,10 +162,12 @@ and raw_type_list tl = raw_list raw_type tl
 
 and raw_type_desc ppf = function
   | Tvar name -> fprintf ppf "Tvar %a" print_name name
-  | Tarrow (arg, ret, a) ->
-    fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
-      (string_of_label arg.lbl) raw_type arg.typ raw_type ret
-      (string_of_arity a)
+  | Tarrow (params, ret) ->
+    fprintf ppf "@[<hov1>Tarrow(%a,@,%a)@]"
+      (raw_list (fun ppf (arg : Types.arg) ->
+           fprintf ppf "@[\"%s\":%a@]" (string_of_label arg.lbl) raw_type
+             arg.typ))
+      params raw_type ret
   | Ttuple tl -> fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
   | Tconstr (p, tl, abbrev) ->
     fprintf ppf "@[<hov1>Tconstr(@,%a,@,%a,@,%a)@]" path p raw_type_list tl
@@ -509,8 +507,8 @@ let rec mark_loops_rec visited ty =
     let visited = px :: visited in
     match ty.desc with
     | Tvar _ -> add_named_var ty
-    | Tarrow (arg, ret, _) ->
-      mark_loops_rec visited arg.typ;
+    | Tarrow (params, ret) ->
+      List.iter (fun (arg : Types.arg) -> mark_loops_rec visited arg.typ) params;
       mark_loops_rec visited ret
     | Ttuple tyl -> List.iter (mark_loops_rec visited) tyl
     | Tconstr (p, tyl, _) ->
@@ -614,18 +612,24 @@ let rec tree_of_typexp ?(printing_context : printing_context option) sch ty =
         let non_gen = is_non_gen sch ty in
         let name_gen = if non_gen then new_weak_name ty else new_name in
         Otyp_var (non_gen, name_of_type name_gen ty)
-      | Tarrow (arg, ret, arity) ->
-        let lab = string_of_label arg.lbl in
-        let t1 =
-          if is_optional arg.lbl then
-            match (repr arg.typ).desc with
-            | Tconstr (path, [ty], _) when Path.same path Predef.path_option ->
-              tree_of_typexp ?printing_context sch ty
-            | _ -> Otyp_stuff "<hidden>"
-          else tree_of_typexp ?printing_context sch arg.typ
+      | Tarrow (params, ret) ->
+        let args =
+          List.map
+            (fun (arg : Types.arg) ->
+              let lab = string_of_label arg.lbl in
+              let t1 =
+                if is_optional arg.lbl then
+                  match (repr arg.typ).desc with
+                  | Tconstr (path, [ty], _)
+                    when Path.same path Predef.path_option ->
+                    tree_of_typexp ?printing_context sch ty
+                  | _ -> Otyp_stuff "<hidden>"
+                else tree_of_typexp ?printing_context sch arg.typ
+              in
+              (lab, t1))
+            params
         in
-        (* should pass arity here? *)
-        Otyp_arrow (lab, t1, tree_of_typexp ?printing_context sch ret, arity)
+        Otyp_arrow (args, tree_of_typexp ?printing_context sch ret)
       | Ttuple tyl -> Otyp_tuple (tree_of_typlist ?printing_context sch tyl)
       | Tconstr (p, _tyl, _abbrev)
         when printing_context
diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml
index 2cf3c19c9b8..529b2de39c4 100644
--- a/compiler/ml/printtyped.ml
+++ b/compiler/ml/printtyped.ml
@@ -151,11 +151,14 @@ let rec core_type i ppf x =
   match x.ctyp_desc with
   | Ttyp_any -> line i ppf "Ttyp_any\n"
   | Ttyp_var s -> line i ppf "Ttyp_var %s\n" s
-  | Ttyp_arrow (arg, ret, _) ->
+  | Ttyp_arrow (params, ret) ->
     line i ppf "Ttyp_arrow\n";
-    arg_label i ppf arg.lbl;
-    attributes i ppf arg.attrs;
-    core_type i ppf arg.typ;
+    List.iter
+      (fun (arg : Typedtree.arg) ->
+        arg_label i ppf arg.lbl;
+        attributes i ppf arg.attrs;
+        core_type i ppf arg.typ)
+      params;
     core_type i ppf ret
   | Ttyp_tuple l ->
     line i ppf "Ttyp_tuple\n";
@@ -281,16 +284,17 @@ and expression i ppf x =
     line i ppf "Texp_let %a\n" fmt_rec_flag rf;
     list i value_binding ppf l;
     expression i ppf e
-  | Texp_function
-      {arg_label = p; arity; async; param; case = case_; partial = _} ->
+  | Texp_function {params; body; async} ->
     line i ppf "Texp_function\n";
     if async then line i ppf "async\n";
-    (match arity with
-    | Some arity -> line i ppf "arity: %d\n" arity
-    | None -> ());
-    line i ppf "%a" Ident.print param;
-    arg_label i ppf p;
-    case i ppf case_
+    line i ppf "arity: %d\n" (List.length params);
+    List.iter
+      (fun {fp_lbl; fp_param; fp_pat} ->
+        line i ppf "%a" Ident.print fp_param;
+        arg_label i ppf fp_lbl;
+        pattern i ppf fp_pat)
+      params;
+    expression i ppf body
   | Texp_apply {funct = e; args = l; partial} ->
     if partial then line i ppf "partial\n";
     line i ppf "Texp_apply\n";
diff --git a/compiler/ml/rec_check.ml b/compiler/ml/rec_check.ml
index c78457b6e14..ce96eb67ec7 100644
--- a/compiler/ml/rec_check.ml
+++ b/compiler/ml/rec_check.ml
@@ -309,8 +309,19 @@ let rec expression : Env.env -> Typedtree.expression -> Use.t =
     (* This is more permissive than the old check. *)
     let case env {Typedtree.c_rhs} = expression env c_rhs in
     Use.join (expression env e) (list case env cases)
-  | Texp_function {case = case_} ->
-    Use.delay (list (case ~scrutinee:Use.empty) env [case_])
+  | Texp_function {params; body} ->
+    let env =
+      List.fold_left
+        (fun env {Typedtree.fp_pat} ->
+          let ty =
+            if is_destructuring_pattern fp_pat then Use.inspect Use.empty
+            else Use.discard Use.empty
+          in
+          let vars = pattern_variables fp_pat in
+          List.fold_left (fun env id -> Ident.add id ty env) env vars)
+        env params
+    in
+    Use.delay (expression env body)
   | Texp_extension_constructor _ -> Use.empty
 
 and option : 'a. (Env.env -> 'a -> Use.t) -> Env.env -> 'a option -> Use.t =
diff --git a/compiler/ml/record_type_spread.ml b/compiler/ml/record_type_spread.ml
index ca28e07c7c8..7999921df54 100644
--- a/compiler/ml/record_type_spread.ml
+++ b/compiler/ml/record_type_spread.ml
@@ -22,8 +22,16 @@ let substitute_types ~type_map (t : Types.type_expr) =
       | Tsubst t -> {t with desc = Tsubst (loop t)}
       | Tvariant rd -> {t with desc = Tvariant (row_desc rd)}
       | Tnil -> t
-      | Tarrow (arg, ret, arity) ->
-        {t with desc = Tarrow ({arg with typ = loop arg.typ}, loop ret, arity)}
+      | Tarrow (params, ret) ->
+        {
+          t with
+          desc =
+            Tarrow
+              ( List.map
+                  (fun (arg : Types.arg) -> {arg with typ = loop arg.typ})
+                  params,
+                loop ret );
+        }
       | Ttuple tl -> {t with desc = Ttuple (tl |> List.map loop)}
       | Tobject (t, r) -> {t with desc = Tobject (loop t, r)}
       | Tfield (n, k, t1, t2) -> {t with desc = Tfield (n, k, loop t1, loop t2)}
diff --git a/compiler/ml/tast_iterator.ml b/compiler/ml/tast_iterator.ml
index 077837d2af6..9c8441fb986 100644
--- a/compiler/ml/tast_iterator.ml
+++ b/compiler/ml/tast_iterator.ml
@@ -151,7 +151,9 @@ let expr sub {exp_extra; exp_desc; exp_env; _} =
   | Texp_let (rec_flag, list, exp) ->
     sub.value_bindings sub (rec_flag, list);
     sub.expr sub exp
-  | Texp_function {case; _} -> sub.case sub case
+  | Texp_function {params; body} ->
+    List.iter (fun {fp_pat} -> sub.pat sub fp_pat) params;
+    sub.expr sub body
   | Texp_apply {funct = exp; args = list} ->
     sub.expr sub exp;
     List.iter (fun (_, o) -> Option.iter (sub.expr sub) o) list
@@ -291,8 +293,8 @@ let typ sub {ctyp_desc; ctyp_env; _} =
   match ctyp_desc with
   | Ttyp_any -> ()
   | Ttyp_var _ -> ()
-  | Ttyp_arrow (arg, ret, _) ->
-    sub.typ sub arg.typ;
+  | Ttyp_arrow (params, ret) ->
+    List.iter (fun (arg : Typedtree.arg) -> sub.typ sub arg.typ) params;
     sub.typ sub ret
   | Ttyp_tuple list -> List.iter (sub.typ sub) list
   | Ttyp_constr (_, _, list) -> List.iter (sub.typ sub) list
diff --git a/compiler/ml/tast_mapper.ml b/compiler/ml/tast_mapper.ml
index fd2e57baee5..0cfdc3e86cc 100644
--- a/compiler/ml/tast_mapper.ml
+++ b/compiler/ml/tast_mapper.ml
@@ -195,9 +195,14 @@ let expr sub x =
     | Texp_let (rec_flag, list, exp) ->
       let rec_flag, list = sub.value_bindings sub (rec_flag, list) in
       Texp_let (rec_flag, list, sub.expr sub exp)
-    | Texp_function {arg_label; arity; param; case; partial; async} ->
+    | Texp_function {params; body; async} ->
       Texp_function
-        {arg_label; arity; param; case = sub.case sub case; partial; async}
+        {
+          params =
+            List.map (fun fp -> {fp with fp_pat = sub.pat sub fp.fp_pat}) params;
+          body = sub.expr sub body;
+          async;
+        }
     | Texp_apply {funct = exp; args = list; partial; transformed_jsx} ->
       Texp_apply
         {
@@ -365,8 +370,12 @@ let typ sub x =
   let ctyp_desc =
     match x.ctyp_desc with
     | (Ttyp_any | Ttyp_var _) as d -> d
-    | Ttyp_arrow (arg, ret, arity) ->
-      Ttyp_arrow ({arg with typ = sub.typ sub arg.typ}, sub.typ sub ret, arity)
+    | Ttyp_arrow (params, ret) ->
+      Ttyp_arrow
+        ( List.map
+            (fun (arg : Typedtree.arg) -> {arg with typ = sub.typ sub arg.typ})
+            params,
+          sub.typ sub ret )
     | Ttyp_tuple list -> Ttyp_tuple (List.map (sub.typ sub) list)
     | Ttyp_constr (path, lid, list) ->
       Ttyp_constr (path, lid, List.map (sub.typ sub) list)
diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml
index bc8eb28c965..3e6be9bc248 100644
--- a/compiler/ml/translcore.ml
+++ b/compiler/ml/translcore.ml
@@ -552,75 +552,6 @@ let extract_constant = function
 (* Push the default values under the functional abstractions *)
 (* Also push bindings of module patterns, since this sound *)
 
-type binding =
-  | Bind_value of value_binding list
-  | Bind_module of Ident.t * string loc * module_expr
-
-let rec push_defaults loc bindings case partial =
-  match case with
-  | {
-   c_lhs = pat;
-   c_guard = None;
-   c_rhs =
-     {exp_desc = Texp_function {arg_label; arity; param; case; partial; async}}
-     as exp;
-  } ->
-    let case = push_defaults exp.exp_loc bindings case partial in
-
-    {
-      c_lhs = pat;
-      c_guard = None;
-      c_rhs =
-        {
-          exp with
-          exp_desc =
-            Texp_function {arg_label; arity; param; case; partial; async};
-        };
-    }
-  | {
-   c_lhs = pat;
-   c_guard = None;
-   c_rhs =
-     {
-       exp_attributes = [({txt = "#default"}, _)];
-       exp_desc =
-         Texp_let (Nonrecursive, binds, ({exp_desc = Texp_function _} as e2));
-     };
-  } ->
-    push_defaults loc
-      (Bind_value binds :: bindings)
-      {c_lhs = pat; c_guard = None; c_rhs = e2}
-      partial
-  | {
-   c_lhs = pat;
-   c_guard = None;
-   c_rhs =
-     {
-       exp_attributes = [({txt = "#modulepat"}, _)];
-       exp_desc =
-         Texp_letmodule (id, name, mexpr, ({exp_desc = Texp_function _} as e2));
-     };
-  } ->
-    push_defaults loc
-      (Bind_module (id, name, mexpr) :: bindings)
-      {c_lhs = pat; c_guard = None; c_rhs = e2}
-      partial
-  | case ->
-    let exp =
-      List.fold_left
-        (fun exp binds ->
-          {
-            exp with
-            exp_desc =
-              (match binds with
-              | Bind_value binds -> Texp_let (Nonrecursive, binds, exp)
-              | Bind_module (id, name, mexpr) ->
-                Texp_letmodule (id, name, mexpr, exp));
-          })
-        case.c_rhs bindings
-    in
-    {case with c_rhs = exp}
-
 (* Assertions *)
 
 let assert_failed exp =
@@ -681,16 +612,14 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
   | Texp_constant cst -> Lconst (Const_base cst)
   | Texp_let (rec_flag, pat_expr_list, body) ->
     transl_let rec_flag pat_expr_list (transl_exp body)
-  | Texp_function {arg_label = _; arity; param; case; partial; async} -> (
+  | Texp_function {params = fparams; body; async} ->
     let directive =
       match extract_directive_for_fn e with
       | None -> None
       | Some (directive, _) -> Some directive
     in
-    let params, body, return_unit =
-      let pl = push_defaults e.exp_loc [] case partial in
-      transl_function e.exp_loc partial param pl
-    in
+    let arity = List.length fparams in
+    let params, lbody, return_unit = transl_function e.exp_loc fparams body in
     let attr =
       {
         default_function_attribute with
@@ -701,23 +630,20 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
       }
     in
     let loc = e.exp_loc in
-    let lambda = Lfunction {params; body; attr; loc} in
-    match arity with
-    | Some arity ->
-      let prim =
-        let expanded = Ctype.expand_head e.exp_env e.exp_type in
-        match (Btype.repr expanded).desc with
-        | Tarrow ({lbl = Nolabel; typ}, _, _) -> (
-          match (Ctype.expand_head e.exp_env typ).desc with
-          | Tconstr (Pident {name = "unit"}, [], _) -> Pjs_fn_make_unit
-          | _ -> Pjs_fn_make arity)
-        | _ -> Pjs_fn_make arity
-      in
-      Lprim
-        ( prim (* could be replaced with Opaque in the future except arity 0*),
-          [lambda],
-          loc )
-    | None -> lambda)
+    let lambda = Lfunction {params; body = lbody; attr; loc} in
+    let prim =
+      let expanded = Ctype.expand_head e.exp_env e.exp_type in
+      match (Btype.repr expanded).desc with
+      | Tarrow ({lbl = Nolabel; typ} :: _, _) -> (
+        match (Ctype.expand_head e.exp_env typ).desc with
+        | Tconstr (Pident {name = "unit"}, [], _) -> Pjs_fn_make_unit
+        | _ -> Pjs_fn_make arity)
+      | _ -> Pjs_fn_make arity
+    in
+    Lprim
+      ( prim (* could be replaced with Opaque in the future except arity 0*),
+        [lambda],
+        loc )
   | Texp_apply {funct; args = oargs}
     when List.exists
            (fun (attr, _) -> attr.txt = "res.taggedTemplate")
@@ -1080,36 +1006,43 @@ and transl_apply ?(inlined = Default_inline)
           sargs)
       : Lambda.lambda)
 
-and transl_function loc partial param case =
-  match case with
-  | {
-   c_lhs = pat;
-   c_guard = None;
-   c_rhs =
-     {
-       exp_desc =
-         Texp_function
-           {
-             arg_label = _;
-             arity = None;
-             param = param';
-             case;
-             partial = partial';
-             async;
-           };
-     } as exp;
-  }
-    when Parmatch.inactive ~partial pat && not async ->
-    let params, body, return_unit =
-      transl_function exp.exp_loc partial' param' case
-    in
-    ( param :: params,
-      Matching.for_function loc None (Lvar param) [(pat, body)] partial,
-      return_unit )
-  | {c_rhs = {exp_env; exp_type}; _} ->
-    ( [param],
-      Matching.for_function loc None (Lvar param) [transl_case case] partial,
-      is_base_type exp_env exp_type Predef.path_unit )
+and transl_function loc (params : function_param list) body =
+  match params with
+  | [] -> assert false
+  | [{fp_param; fp_pat; fp_partial}] ->
+    ( [fp_param],
+      Matching.for_function loc None (Lvar fp_param)
+        [(fp_pat, transl_exp body)]
+        fp_partial,
+      is_base_type body.exp_env body.exp_type Predef.path_unit )
+  | {fp_param; fp_pat; fp_partial} :: rest ->
+    if Parmatch.inactive ~partial:fp_partial fp_pat then
+      let lparams, lbody, return_unit = transl_function loc rest body in
+      ( fp_param :: lparams,
+        Matching.for_function loc None (Lvar fp_param)
+          [(fp_pat, lbody)]
+          fp_partial,
+        return_unit )
+    else
+      (* An "active" pattern (whose compilation can have side effects, e.g.
+         a lazy or string pattern) must run when its own parameter group is
+         applied: split the remaining parameters into a nested curried
+         function, as the legacy chain representation did. *)
+      let lparams, lbody, _ = transl_function loc rest body in
+      let inner =
+        Lfunction
+          {
+            params = lparams;
+            body = lbody;
+            attr = default_function_attribute;
+            loc;
+          }
+      in
+      ( [fp_param],
+        Matching.for_function loc None (Lvar fp_param)
+          [(fp_pat, inner)]
+          fp_partial,
+        false )
 
 and transl_let rec_flag pat_expr_list body =
   match rec_flag with
diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml
index 6252b13e62a..13f247059eb 100644
--- a/compiler/ml/typecore.ml
+++ b/compiler/ml/typecore.ml
@@ -752,11 +752,12 @@ let show_extra_help ppf _env trace =
 let rec collect_missing_arguments env type1 type2 =
   match type1 with
   (* why do we use Ctype.matches here? Please see https://github.com/rescript-lang/rescript-compiler/pull/2554 *)
-  | {Types.desc = Tarrow (arg, ret, _)} when Ctype.matches env ret type2 ->
-    Some [(arg.lbl, arg.typ)]
-  | {desc = Tarrow (arg, ret, _)} -> (
+  | {Types.desc = Tarrow (params, ret)} when Ctype.matches env ret type2 ->
+    Some (List.map (fun ({lbl; typ} : Types.arg) -> (lbl, typ)) params)
+  | {desc = Tarrow (params, ret)} -> (
     match collect_missing_arguments env ret type2 with
-    | Some res -> Some ((arg.lbl, arg.typ) :: res)
+    | Some res ->
+      Some (List.map (fun ({lbl; typ} : Types.arg) -> (lbl, typ)) params @ res)
     | None -> None)
   | _ -> None
 
@@ -1972,20 +1973,17 @@ and is_nonexpansive_opt = function
 let rec approx_type env sty =
   match sty.ptyp_desc with
   | Ptyp_arrow {params; ret = sty} ->
-    let arity = Some (List.length params) in
-    let rec build n = function
-      | [] -> approx_type env sty
-      | ({lbl = p} : Parsetree.arg) :: rest ->
-        let ty1 =
-          if is_optional p then type_option (newvar ()) else newvar ()
-        in
-        newty
-          (Tarrow
-             ( {lbl = p; typ = ty1},
-               build (n + 1) rest,
-               if n = 0 then arity else None ))
-    in
-    build 0 params
+    newty
+      (Tarrow
+         ( List.map
+             (fun ({lbl = p} : Parsetree.arg) ->
+               {
+                 Types.lbl = p;
+                 typ =
+                   (if is_optional p then type_option (newvar ()) else newvar ());
+               })
+             params,
+           approx_type env sty ))
   | Ptyp_tuple args -> newty (Ttuple (List.map (approx_type env) args))
   | Ptyp_constr (lid, ctl) -> (
     try
@@ -2002,20 +2000,18 @@ let rec type_approx env sexp =
   match sexp.pexp_desc with
   | Pexp_let (_, _, e) -> type_approx env e
   | Pexp_fun {params; body} ->
-    let arity = Some (List.length params) in
-    let rec build n = function
-      | [] -> type_approx env body
-      | {p_lbl} :: rest ->
-        let ty =
-          if is_optional p_lbl then type_option (newvar ()) else newvar ()
-        in
-        newty
-          (Tarrow
-             ( {lbl = p_lbl; typ = ty},
-               build (n + 1) rest,
-               if n = 0 then arity else None ))
-    in
-    build 0 params
+    newty
+      (Tarrow
+         ( List.map
+             (fun {p_lbl} ->
+               {
+                 Types.lbl = p_lbl;
+                 typ =
+                   (if is_optional p_lbl then type_option (newvar ())
+                    else newvar ());
+               })
+             params,
+           type_approx env body ))
   | Pexp_match (_, {pc_rhs = e} :: _) -> type_approx env e
   | Pexp_try (e, _) -> type_approx env e
   | Pexp_tuple l -> newty (Ttuple (List.map (type_approx env) l))
@@ -2295,12 +2291,12 @@ let unify_exp ~context env exp expected_ty =
   let loc = proper_exp_loc exp in
   unify_exp_types ~context loc env exp.exp_type expected_ty
 
-let is_ignore ~env ~arity funct =
+let is_ignore ~env funct =
   match funct.exp_desc with
   | Texp_ident (_, _, {val_kind = Val_prim {Primitive.prim_name = "%ignore"}})
     -> (
     try
-      ignore (filter_arrow ~env ~arity (instance env funct.exp_type) Nolabel);
+      ignore (filter_arrow_n ~env (instance env funct.exp_type) [Nolabel]);
       true
     with Unify _ -> false)
   | _ -> false
@@ -2310,8 +2306,11 @@ let rec lower_args env seen ty_fun =
   if List.memq ty seen then ()
   else
     match ty.desc with
-    | Tarrow (arg, ty_fun, _) ->
-      (try unify_var env (newvar ()) arg.typ with Unify _ -> assert false);
+    | Tarrow (params, ty_fun) ->
+      List.iter
+        (fun ({typ} : Types.arg) ->
+          try unify_var env (newvar ()) typ with Unify _ -> assert false)
+        params;
       lower_args env (ty :: seen) ty_fun
     | _ -> ()
 
@@ -2333,9 +2332,6 @@ let should_unify_expected_result_before_typing_lowered_apply funct sargs =
     true
   | _ -> false
 
-type lazy_args =
-  (Asttypes.arg_label * (unit -> Typedtree.expression) option) list
-
 type targs = (Asttypes.arg_label * Typedtree.expression option) list
 let rec type_exp ?deprecated_context ~context ?recarg env sexp =
   (* We now delegate everything to type_expect *)
@@ -2473,90 +2469,9 @@ and type_expect_ ?deprecated_context ~context ?in_function ?(recarg = Rejected)
         exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
-  | Pexp_fun {params; body = sfun_body; async} -> (
-    (* Peel one parameter at a time, reproducing the legacy curried typing:
-       the head parameter carries [Some arity] (the full parameter count),
-       the synthesized rest-functions carry [None]. Rest-functions are
-       marked with an internal attribute consumed right here, so it never
-       appears in user ASTs or in the typedtree. *)
-    let is_rest, node_attrs =
-      let rec split acc = function
-        | ({Location.txt = "#res.fun_rest"}, _) :: rest ->
-          (true, List.rev_append acc rest)
-        | a :: rest -> split (a :: acc) rest
-        | [] -> (false, List.rev acc)
-      in
-      split [] sexp.pexp_attributes
-    in
-    let arity = if is_rest then None else Some (List.length params) in
-    match params with
-    | [] -> assert false
-    | {p_attrs; p_lbl = l; p_default; p_pat = spat} :: rest_params -> (
-      let level_attrs = node_attrs @ p_attrs in
-      let sbody =
-        match rest_params with
-        | [] -> sfun_body
-        | {p_pat = next_pat} :: _ ->
-          let rest_loc =
-            {
-              sexp.pexp_loc with
-              Location.loc_start = next_pat.ppat_loc.Location.loc_start;
-            }
-          in
-          {
-            pexp_desc =
-              Pexp_fun {params = rest_params; body = sfun_body; async = false};
-            pexp_loc = rest_loc;
-            pexp_attributes = [(mknoloc "#res.fun_rest", PStr [])];
-          }
-      in
-      match p_default with
-      | Some default ->
-        assert (is_optional l);
-        (* default allowed only with optional argument *)
-        let open Ast_helper in
-        let default_loc = default.pexp_loc in
-        let scases =
-          [
-            Exp.case
-              (Pat.construct ~loc:default_loc
-                 (mknoloc Longident.(Ldot (Lident "*predef*", "Some")))
-                 (Some (Pat.var ~loc:default_loc (mknoloc "*sth*"))))
-              (Exp.ident ~loc:default_loc (mknoloc (Longident.Lident "*sth*")));
-            Exp.case
-              (Pat.construct ~loc:default_loc
-                 (mknoloc Longident.(Ldot (Lident "*predef*", "None")))
-                 None)
-              default;
-          ]
-        in
-        let sloc =
-          {
-            Location.loc_start = spat.ppat_loc.Location.loc_start;
-            loc_end = default_loc.Location.loc_end;
-            loc_ghost = true;
-          }
-        in
-        let smatch =
-          Exp.match_ ~loc:sloc
-            ~attrs:[(mknoloc "#optional_arg_default", PStr [])]
-            (Exp.ident ~loc (mknoloc (Longident.Lident "*opt*")))
-            scases
-        in
-        let pat = Pat.var ~loc:sloc (mknoloc "*opt*") in
-        let body =
-          Exp.let_ ~loc Nonrecursive
-            ~attrs:[(mknoloc "#default", PStr [])]
-            [Vb.mk spat smatch]
-            sbody
-        in
-        type_function ?in_function ~arity ~async loc level_attrs env ty_expected
-          l
-          [Exp.case pat body]
-      | None ->
-        type_function ?in_function ~arity ~async loc level_attrs env ty_expected
-          l
-          [Ast_helper.Exp.case spat sbody]))
+  | Pexp_fun {params; body = sfun_body; async} ->
+    type_function ?in_function ~async loc sexp.pexp_attributes env ty_expected
+      params sfun_body
   | Pexp_apply {funct = sfunct; args = sargs; partial; transformed_jsx} ->
     assert (sargs <> []);
     begin_def ();
@@ -2570,9 +2485,8 @@ and type_expect_ ?deprecated_context ~context ?in_function ?(recarg = Rejected)
           application, so thread the expected result type into the application
           before typing its arguments. *)
        let _, ty_res =
-         filter_arrow ~env
-           ~arity:(Some (List.length sargs))
-           funct.exp_type Nolabel
+         filter_arrow_n ~env funct.exp_type
+           (List.map (fun _ -> Asttypes.Nolabel) sargs)
        in
        unify_exp_types ~context:None loc env ty_res (instance env ty_expected));
     let ty = instance env funct.exp_type in
@@ -3596,17 +3510,102 @@ and type_expect_ ?deprecated_context ~context ?in_function ?(recarg = Rejected)
   | Pexp_jsx_element _ ->
     raise (Error (sexp.pexp_loc, Env.empty, Jsx_not_enabled))
 
-and type_function ?in_function ~arity ~async loc attrs env ty_expected_ l
-    caselist =
+and type_function ?in_function ~async loc attrs env ty_expected_
+    (sparams : Parsetree.fun_param list) sbody =
+  (* Desugar optional-parameter defaults: the parameter becomes a fresh
+     [*opt_<label>*] variable and the original pattern is bound in a
+     [#default]-annotated let at the head of the body. The let syntax is kept
+     alongside its parameter rather than wrapped into the body here: each
+     binding is typed while the parameter environment accumulates left to
+     right, so a default only sees the parameters before it (typing it as
+     part of the body would let it see every parameter, changing what
+     shadowed names refer to). The typed lets are stacked back onto the
+     typed body below. *)
+  let sparams_bindings =
+    List.map
+      (fun (p : Parsetree.fun_param) ->
+        match p.p_default with
+        | None -> (p, None)
+        | Some default ->
+          let l = p.p_lbl in
+          let spat = p.p_pat in
+          assert (is_optional l);
+          (* default allowed only with optional argument *)
+          let opt_name = "*opt_" ^ label_name l ^ "*" in
+          let open Ast_helper in
+          let default_loc = default.pexp_loc in
+          let scases =
+            [
+              Exp.case
+                (Pat.construct ~loc:default_loc
+                   (mknoloc Longident.(Ldot (Lident "*predef*", "Some")))
+                   (Some (Pat.var ~loc:default_loc (mknoloc "*sth*"))))
+                (Exp.ident ~loc:default_loc
+                   (mknoloc (Longident.Lident "*sth*")));
+              Exp.case
+                (Pat.construct ~loc:default_loc
+                   (mknoloc Longident.(Ldot (Lident "*predef*", "None")))
+                   None)
+                default;
+            ]
+          in
+          let sloc =
+            {
+              Location.loc_start = spat.ppat_loc.Location.loc_start;
+              loc_end = default_loc.Location.loc_end;
+              loc_ghost = true;
+            }
+          in
+          let smatch =
+            Exp.match_ ~loc:sloc
+              ~attrs:[(mknoloc "#optional_arg_default", PStr [])]
+              (Exp.ident ~loc (mknoloc (Longident.Lident opt_name)))
+              scases
+          in
+          ( {
+              p with
+              p_default = None;
+              p_pat = Pat.var ~loc:sloc (mknoloc opt_name);
+            },
+            Some (Vb.mk spat smatch) ))
+      sparams
+  in
+  let sparams = List.map fst sparams_bindings in
+  let labels = List.map (fun (p : Parsetree.fun_param) -> p.p_lbl) sparams in
+  (* When the expected type is already an arrow, check the labels first so a
+     mismatch gets the dedicated message; committing the literal's labels via
+     unification would produce a generic clash. *)
+  (match (expand_head env ty_expected_).desc with
+  | Tarrow (exp_params, exp_ret)
+    when List.length exp_params = List.length labels ->
+    let rec check_labels (params : Parsetree.fun_param list)
+        (exp_params : Types.arg list) =
+      match (params, exp_params) with
+      | [], [] -> ()
+      | fp :: rest_fps, p :: rest_params ->
+        if Asttypes.same_arg_label fp.p_lbl p.lbl then
+          check_labels rest_fps rest_params
+        else
+          let remainder = newty (Tarrow (p :: rest_params, exp_ret)) in
+          let err_loc =
+            {loc with Location.loc_start = fp.p_pat.ppat_loc.Location.loc_start}
+          in
+          raise
+            (Error (err_loc, env, Abstract_wrong_label (fp.p_lbl, remainder)))
+      | _ -> ()
+    in
+    check_labels sparams exp_params
+  | _ -> ());
+  (* Commit the expected type to an arrow of the right shape. *)
   let ty_expected =
-    match arity with
-    | None -> ty_expected_
-    | Some arity ->
-      let fun_t =
-        newty (Tarrow ({lbl = l; typ = newvar ()}, newvar (), Some arity))
-      in
-      unify_exp_types ~context:None loc env fun_t ty_expected_;
-      fun_t
+    let fun_t =
+      newty
+        (Tarrow
+           ( List.map (fun l -> {Types.lbl = l; typ = newvar ()}) labels,
+             newvar () ))
+    in
+    unify_exp_types ~context:None loc env fun_t ty_expected_;
+    fun_t
   in
   let loc_fun, ty_fun =
     match in_function with
@@ -3615,41 +3614,206 @@ and type_function ?in_function ~arity ~async loc attrs env ty_expected_ l
   in
   let separate = Env.has_local_constraints env in
   if separate then begin_def ();
-  let ty_arg, ty_res =
-    try filter_arrow ~env ~arity (instance env ty_expected) l
+  let ty_params, ty_res =
+    try filter_arrow_n ~env (instance env ty_expected) labels
     with Unify _ -> (
       match expand_head env ty_expected with
       | {desc = Tarrow _} as ty ->
-        raise (Error (loc, env, Abstract_wrong_label (l, ty)))
+        raise (Error (loc, env, Abstract_wrong_label (List.hd labels, ty)))
       | _ ->
         raise
           (Error (loc_fun, env, Too_many_arguments (in_function <> None, ty_fun))))
   in
-  let ty_arg =
-    if is_optional l then (
-      let tv = newvar () in
-      (try unify env ty_arg (type_option tv) with Unify _ -> assert false);
-      type_option tv)
-    else ty_arg
+  let ty_params =
+    List.map2
+      (fun l ty_arg ->
+        if is_optional l then (
+          let tv = newvar () in
+          (try unify env ty_arg (type_option tv) with Unify _ -> assert false);
+          type_option tv)
+        else ty_arg)
+      labels ty_params
   in
   if separate then (
     end_def ();
-    generalize_structure ty_arg;
+    List.iter generalize_structure ty_params;
     generalize_structure ty_res);
-  let cases, partial =
+  (* Type the parameter patterns and the body; this specializes what
+     [type_cases] does for the one-pattern-no-guard case, with parameter
+     environments accumulating left to right and the body typed once. *)
+  let patterns = List.map (fun (p : Parsetree.fun_param) -> p.p_pat) sparams in
+  let contains_polyvars = List.exists contains_polymorphic_variant patterns in
+  let has_gadts = List.exists (contains_gadt env) patterns in
+  let synth_cases rhs =
+    List.map
+      (fun spat ->
+        {Parsetree.pc_bar = None; pc_lhs = spat; pc_guard = None; pc_rhs = rhs})
+      patterns
+  in
+  let ty_res, env =
+    if has_gadts then
+      (correct_levels ty_res, duplicate_ident_types (synth_cases sbody) env)
+    else (ty_res, env)
+  in
+  let rec is_var spat =
+    match spat.Parsetree.ppat_desc with
+    | Ppat_any | Ppat_var _ -> true
+    | Ppat_alias (spat, _) -> is_var spat
+    | _ -> false
+  in
+  let init_env () =
+    begin_def ();
+    Ident.set_current_time (get_current_level ());
+    let lev = Ident.current_time () in
+    Ctype.init_def (lev + 1000);
+    (* up to 1000 existentials *)
+    (lev, Env.add_gadt_instance_level lev env)
+  in
+  let lev, env =
+    if has_gadts then init_env () else (get_current_level (), env)
+  in
+  let scope = Some (Annot.Idef sbody.pexp_loc) in
+  let rec type_params typed_acc env unpacks_acc defaults_acc
+      (params : (Parsetree.fun_param * Parsetree.value_binding option) list) tys
+      =
+    match (params, tys) with
+    | [], [] -> (List.rev typed_acc, env, unpacks_acc, List.rev defaults_acc)
+    | (p, default_binding) :: rest_params, ty_arg :: rest_tys ->
+      let spat = p.p_pat in
+      let erase_either =
+        contains_polymorphic_variant spat && contains_variant_either ty_arg
+      in
+      let ty_arg_c =
+        if has_gadts || erase_either then correct_levels ty_arg else ty_arg
+      in
+      let propagate =
+        has_gadts || (repr ty_arg_c).level = generic_level || not (is_var spat)
+      in
+      if propagate then begin_def ();
+      let pattern_force = ref [] in
+      let pat, ext_env, force, unpacks =
+        let partial = if erase_either then Some false else None in
+        let ty_arg_i = instance ?partial env ty_arg_c in
+        type_pattern ~lev env spat scope ty_arg_i
+      in
+      pattern_force := force @ !pattern_force;
+      let ty_arg' = newvar () in
+      unify_pat ext_env pat ty_arg';
+      if has_variants pat then (
+        Parmatch.pressure_variants env [pat];
+        iter_pattern finalize_variant pat);
+      List.iter (fun f -> f ()) !pattern_force;
+      if propagate || erase_either then
+        unify_pat ext_env pat (instance env ty_arg_c);
+      if propagate then (
+        iter_pattern (fun {pat_type = t} -> unify_var env t (newvar ())) pat;
+        end_def ();
+        iter_pattern (fun {pat_type = t} -> generalize t) pat);
+      (* Type this parameter's default binding (if any) before any later
+         parameter enters the environment, mirroring the curried per-level
+         typing this replaced: a default sees only the parameters to its
+         left, and its pattern's bindings are in scope for what follows. *)
+      let ext_env, unpacks, defaults_acc =
+        match default_binding with
+        | None -> (ext_env, unpacks, defaults_acc)
+        | Some vb ->
+          let let_env = ext_env in
+          let pat_exp_list, ext_env, let_unpacks =
+            type_let ~context:None ext_env Nonrecursive [vb] None true
+          in
+          ( ext_env,
+            unpacks @ let_unpacks,
+            (pat_exp_list, let_env) :: defaults_acc )
+      in
+      type_params
+        ((p, pat, ty_arg_c) :: typed_acc)
+        ext_env (unpacks_acc @ unpacks) defaults_acc rest_params rest_tys
+    | _ -> assert false
+  in
+  let typed_params, body_env, unpacks, default_lets =
+    with_reset_control_flow (fun () ->
+        type_params [] env [] [] sparams_bindings ty_params)
+  in
+  let body_exp =
     with_reset_control_flow (fun () ->
-        type_cases ~call_context:`Function ~in_function:(loc_fun, ty_fun) env
-          ty_arg ty_res true loc caselist)
+        let sbody = wrap_unpacks sbody unpacks in
+        let ty_res' = if has_gadts then correct_levels ty_res else ty_res in
+        let exp =
+          type_expect ~context:None ~in_function:(loc_fun, ty_fun) body_env
+            sbody ty_res'
+        in
+        {exp with exp_type = instance env ty_res'})
   in
-  let case = List.hd cases in
-  let param = name_pattern "param" cases in
+  (if has_gadts then
+     let ty_res' = instance env ty_res in
+     unify_exp ~context:None env body_exp ty_res');
+  (* Stack the typed default bindings back onto the body, leftmost parameter
+     outermost — the same [#default] let shape [type_expect] would have
+     produced had the lets been part of the body's syntax. *)
+  let body_exp =
+    List.fold_right
+      (fun (pat_exp_list, let_env) inner ->
+        re
+          {
+            exp_desc = Texp_let (Nonrecursive, pat_exp_list, inner);
+            exp_loc = loc;
+            exp_extra = [];
+            exp_type = inner.exp_type;
+            exp_attributes = [(mknoloc "#default", Parsetree.PStr [])];
+            exp_env = let_env;
+          })
+      default_lets body_exp
+  in
+  let needs_exhaust_check =
+    List.exists
+      (fun ((p : Parsetree.fun_param), _, _) -> not (is_var p.p_pat))
+      typed_params
+  in
+  let do_init = has_gadts || needs_exhaust_check in
+  let lev, env = if do_init && not has_gadts then init_env () else (lev, env) in
+  ignore lev;
+  let tparams =
+    List.map
+      (fun ((p : Parsetree.fun_param), pat, ty_arg_c) ->
+        let case = {c_lhs = pat; c_guard = None; c_rhs = body_exp} in
+        let ty_arg_check =
+          if do_init then
+            (* Hack: use for_saving to copy variables too *)
+            Subst.type_expr (Subst.for_saving Subst.identity) ty_arg_c
+          else ty_arg_c
+        in
+        let partial = check_partial ~lev env ty_arg_check loc [case] in
+        let unused_check () =
+          check_absent_variant env pat;
+          check_unused ~lev env (instance env ty_arg_check) [case]
+        in
+        if contains_polyvars || do_init then
+          Delayed_checks.add_delayed_check unused_check
+        else unused_check ();
+        {
+          fp_lbl = p.p_lbl;
+          fp_param = name_pattern "param" [case];
+          fp_pat = pat;
+          fp_partial = partial;
+        })
+      typed_params
+  in
+  if do_init then (
+    end_def ();
+    (* Ensure that existential types do not escape *)
+    unify_exp_types ~context:None loc env (instance env ty_res) (newvar ()));
   let exp_type =
-    instance env (newgenty (Tarrow ({lbl = l; typ = ty_arg}, ty_res, arity)))
+    instance env
+      (newgenty
+         (Tarrow
+            ( List.map2
+                (fun l ty_arg -> {Types.lbl = l; typ = ty_arg})
+                labels ty_params,
+              ty_res )))
   in
   re
     {
-      exp_desc =
-        Texp_function {arg_label = l; arity; param; case; partial; async};
+      exp_desc = Texp_function {params = tparams; body = body_exp; async};
       exp_loc = loc;
       exp_extra = [];
       exp_type;
@@ -3859,228 +4023,13 @@ and translate_unified_ops (env : Env.t) (funct : Typedtree.expression)
 
 and type_application ~context total_app env funct (sargs : sargs) :
     targs * Types.type_expr * bool =
-  let result_type omitted ty_fun =
-    List.fold_left
-      (fun ty_fun (l, ty, lv) ->
-        newty2 lv (Tarrow ({lbl = l; typ = ty}, ty_fun, None)))
-      ty_fun omitted
-  in
-  let ignored = ref [] in
-  let force_tvar =
-    let t = funct.exp_type in
-    match (expand_head env t).desc with
-    | Tvar _ when total_app -> true
-    | _ -> false
-  in
-  let has_arity funct =
-    if force_tvar then Some (List.length sargs)
-    else
-      match (expand_head env funct.exp_type).desc with
-      | Tarrow (_, _, Some arity) -> Some arity
-      | _ -> None
-  in
-  let force_uncurried_type funct =
-    if force_tvar then ()
-    else if Ctype.get_arity env funct.exp_type = None then
-      raise
-        (Error
-           ( funct.exp_loc,
-             env,
-             Apply_non_function (expand_head env funct.exp_type) ))
-  in
-  let get_max_arity funct =
-    match has_arity funct with
-    | Some arity ->
-      if List.length sargs > arity then
-        raise
-          (Error
-             ( funct.exp_loc,
-               env,
-               Uncurried_arity_mismatch
-                 {
-                   function_type = funct.exp_type;
-                   expected_arity = arity;
-                   provided_arity = List.length sargs;
-                   provided_args = sargs |> List.map (fun (a, _) -> a);
-                   function_name = extract_function_name funct;
-                 } ));
-      arity
-    | None -> max_int
-  in
-  let update_uncurried_arity ~nargs funct new_t =
-    match has_arity funct with
-    | Some arity ->
-      let newarity = arity - nargs in
-      let fully_applied = newarity <= 0 in
-      (if total_app && not fully_applied then
-         let required_args = List.length sargs in
-         raise
-           (Error
-              ( funct.exp_loc,
-                env,
-                Uncurried_arity_mismatch
-                  {
-                    function_type = funct.exp_type;
-                    expected_arity = required_args + newarity;
-                    provided_arity = required_args;
-                    provided_args = sargs |> List.map (fun (a, _) -> a);
-                    function_name = extract_function_name funct;
-                  } )));
-      let new_t =
-        if fully_applied then new_t
-        else
-          match new_t.desc with
-          | Tarrow (arg, ret, _) ->
-            {new_t with desc = Tarrow (arg, ret, Some newarity)}
-          | _ -> new_t
-      in
-      (fully_applied, new_t)
-    | None -> (false, new_t)
-  in
-  let rec type_unknown_args max_arity ~(args : lazy_args) ~top_arity omitted
-      ty_fun (syntax_args : sargs) : targs * _ =
-    match syntax_args with
-    | [] ->
-      let collect_args () =
-        ( List.map
-            (function
-              | l, None -> (l, None)
-              | l, Some f -> (l, Some (f ())))
-            (List.rev args),
-          instance env (result_type omitted ty_fun) )
-      in
-      if List.length args < max_arity && total_app then
-        match (expand_head env ty_fun).desc with
-        | Tarrow ({lbl; typ = t1}, t2, _) when is_optional lbl ->
-          ignored := (lbl, t1, ty_fun.level) :: !ignored;
-          let arg =
-            (lbl, Some (fun () -> option_none (instance env t1) Location.none))
-          in
-          type_unknown_args max_arity ~args:(arg :: args) ~top_arity:None
-            omitted t2 []
-        | _ -> collect_args ()
-      else collect_args ()
-    | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})]
-      when total_app && omitted = [] && args <> []
-           && List.length args = List.length !ignored ->
-      (* foo(. ) treated as empty application if all args are optional (hence ignored) *)
-      type_unknown_args max_arity ~args ~top_arity:None omitted ty_fun []
-    | (l1, sarg1) :: sargl ->
-      let ty1, ty2 =
-        let ty_fun = expand_head env ty_fun in
-        let arity_ok = List.length args < max_arity in
-        match ty_fun.desc with
-        | Tvar _ when force_tvar ->
-          (* This is a total application when the toplevel type is a polymorphic variable,
-          so the function type including arity can be inferred. *)
-          let t1 = newvar () and t2 = newvar () in
-          if
-            ty_fun.level >= t1.level
-            && not (is_identity_coercion funct.exp_desc)
-          then Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
-          unify env ty_fun
-            (newty (Tarrow ({lbl = l1; typ = t1}, t2, top_arity)));
-          (t1, t2)
-        | Tarrow ({lbl = l; typ = t1}, t2, _)
-          when Asttypes.same_arg_label l l1 && arity_ok ->
-          (t1, t2)
-        | td -> (
-          let ty_fun =
-            match td with
-            | Tarrow _ -> newty td
-            | _ -> ty_fun
-          in
-          let ty_res = result_type (omitted @ !ignored) ty_fun in
-          match ty_res.desc with
-          | Tarrow _ ->
-            if not arity_ok then
-              raise
-                (Error
-                   (sarg1.pexp_loc, env, Apply_wrong_label (l1, funct.exp_type)))
-            else
-              raise
-                (Error (sarg1.pexp_loc, env, Apply_wrong_label (l1, ty_res)))
-          | _ ->
-            raise
-              (Error
-                 ( funct.exp_loc,
-                   env,
-                   Apply_non_function (expand_head env funct.exp_type) )))
-      in
-      let optional = is_optional l1 in
-      let arg1 () =
-        let arg1 = type_expect ~context env sarg1 ty1 in
-        if optional then unify_exp ~context env arg1 (type_option (newvar ()));
-        arg1
-      in
-      type_unknown_args max_arity ~args:((l1, Some arg1) :: args)
-        ~top_arity:None omitted ty2 sargl
-  in
-  let rec type_args ~context max_arity args omitted ~ty_fun ty_fun0
-      ~(sargs : sargs) ~top_arity =
-    match (expand_head env ty_fun, expand_head env ty_fun0) with
-    | ( {desc = Tarrow ({lbl = l; typ = ty}, ty_fun, _); level = lv},
-        {desc = Tarrow ({typ = ty0}, ty_fun0, _)} )
-      when sargs <> [] && List.length args < max_arity ->
-      let name = label_name l and optional = is_optional l in
-      let sargs, omitted, arg =
-        match extract_label name sargs with
-        | None ->
-          if optional && (total_app || label_assoc Nolabel sargs) then (
-            ignored := (l, ty, lv) :: !ignored;
-            ( sargs,
-              omitted,
-              Some (fun () -> option_none (instance env ty) Location.none) ))
-          else (sargs, (l, ty, lv) :: omitted, None)
-        | Some (l', sarg0, sargs) ->
-          if (not optional) && is_optional l' then
-            Location.prerr_warning sarg0.pexp_loc
-              (Warnings.Nonoptional_label (Printtyp.string_of_label l));
-          let argument_context =
-            match (context, args) with
-            | Some JsxComponent, [] -> Some JsxComponent
-            | Some JsxComponent, _ ->
-              type_clash_context_for_function_argument ~label:l' None sarg0
-            | _ ->
-              type_clash_context_for_function_argument ~label:l' context sarg0
-          in
-          ( sargs,
-            omitted,
-            Some
-              (if (not optional) || is_optional l' then fun () ->
-                 type_argument ~context:argument_context env sarg0 ty ty0
-               else fun () ->
-                 option_some
-                   (type_argument
-                      ~context:
-                        (Some
-                           (FunctionArgument
-                              {
-                                optional = true;
-                                name =
-                                  (match l' with
-                                  | Nolabel -> None
-                                  | Optional l | Labelled l -> Some l.txt);
-                              }))
-                      env sarg0
-                      (extract_option_type env ty)
-                      (extract_option_type env ty0))) )
-      in
-      type_args ~context max_arity ((l, arg) :: args) omitted ~ty_fun ty_fun0
-        ~sargs ~top_arity
-    | _ ->
-      type_unknown_args max_arity ~args ~top_arity omitted ty_fun0
-        sargs (* This is the hot path for non-labeled function*)
-  in
-  if total_app then force_uncurried_type funct;
-  let max_arity = get_max_arity funct in
-  let top_arity = if total_app then Some max_arity else None in
   match sargs with
   (* Special case for ignore: avoid discarding warning *)
-  | [(Nolabel, sarg)] when is_ignore ~env ~arity:top_arity funct ->
-    let ty_arg, ty_res =
-      filter_arrow ~env ~arity:top_arity (instance env funct.exp_type) Nolabel
+  | [(Nolabel, sarg)] when is_ignore ~env funct ->
+    let ty_args, ty_res =
+      filter_arrow_n ~env (instance env funct.exp_type) [Nolabel]
     in
+    let ty_arg = List.hd ty_args in
     let exp = type_expect ~context env sarg ty_arg in
     (match (expand_head env exp.exp_type).desc with
     | Tarrow _ when not total_app ->
@@ -4090,18 +4039,172 @@ and type_application ~context total_app env funct (sargs : sargs) :
           check_application_result env exp)
     | _ -> ());
     ([(Nolabel, Some exp)], ty_res, false)
-  | _ ->
-    let targs, ret_t =
-      type_args ~context max_arity [] [] ~ty_fun:funct.exp_type
-        (instance env funct.exp_type)
-        ~sargs ~top_arity
-    in
-    let fully_applied, ret_t =
-      update_uncurried_arity funct
-        ~nargs:(List.length !ignored + List.length sargs)
-        ret_t
-    in
-    (targs, ret_t, fully_applied)
+  | _ -> (
+    (* If the function type is still a variable and this is a total
+       application, commit it to an arrow matching the call site: this is
+       how parameter count and labels are inferred for unannotated function
+       parameters. *)
+    (match (expand_head env funct.exp_type).desc with
+    | Tvar _ when total_app ->
+      let ty_fun = expand_head env funct.exp_type in
+      let params =
+        List.map (fun (l1, _) -> {Types.lbl = l1; typ = newvar ()}) sargs
+      in
+      let ty_ret = newvar () in
+      if
+        ty_fun.level >= ty_ret.level
+        && not (is_identity_coercion funct.exp_desc)
+      then
+        List.iter
+          (fun (_, sarg1) ->
+            Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument)
+          sargs;
+      unify env ty_fun (newty (Tarrow (params, ty_ret)))
+    | _ -> ());
+    match (expand_head env funct.exp_type).desc with
+    | Tarrow (params, ty_ret) ->
+      let arity = List.length params in
+      let nargs = List.length sargs in
+      let mk_arity_mismatch_error expected_arity =
+        Error
+          ( funct.exp_loc,
+            env,
+            Uncurried_arity_mismatch
+              {
+                function_type = funct.exp_type;
+                expected_arity;
+                provided_arity = nargs;
+                provided_args = sargs |> List.map (fun (a, _) -> a);
+                function_name = extract_function_name funct;
+              } )
+      in
+      if total_app && nargs > arity then raise (mk_arity_mismatch_error arity);
+      let lv = (expand_head env funct.exp_type).level in
+      (* Match every parameter, in order, against the syntactic arguments,
+         commuting labeled arguments as needed. *)
+      let remaining = ref sargs in
+      let rev_args = ref [] in
+      let omitted = ref [] in
+      let ignored = ref [] in
+      List.iter
+        (fun ({lbl = l; typ = ty} : Types.arg) ->
+          let name = label_name l and optional = is_optional l in
+          match extract_label name !remaining with
+          | Some (l', sarg0, rest) ->
+            remaining := rest;
+            if (not optional) && is_optional l' then
+              Location.prerr_warning sarg0.pexp_loc
+                (Warnings.Nonoptional_label (Printtyp.string_of_label l));
+            let argument_context =
+              match (context, !rev_args) with
+              | Some JsxComponent, [] -> Some JsxComponent
+              | Some JsxComponent, _ ->
+                type_clash_context_for_function_argument ~label:l' None sarg0
+              | _ ->
+                type_clash_context_for_function_argument ~label:l' context sarg0
+            in
+            let thunk =
+              if (not optional) || is_optional l' then fun () ->
+                type_argument ~context:argument_context env sarg0 ty
+                  (instance env ty)
+              else fun () ->
+                option_some
+                  (type_argument
+                     ~context:
+                       (Some
+                          (FunctionArgument
+                             {
+                               optional = true;
+                               name =
+                                 (match l' with
+                                 | Nolabel -> None
+                                 | Optional l | Labelled l -> Some l.txt);
+                             }))
+                     env sarg0
+                     (extract_option_type env ty)
+                     (extract_option_type env (instance env ty)))
+            in
+            rev_args := (l, Some thunk) :: !rev_args
+          | None ->
+            if optional && (total_app || label_assoc Nolabel !remaining) then (
+              ignored := (l, ty, lv) :: !ignored;
+              rev_args :=
+                (l, Some (fun () -> option_none (instance env ty) Location.none))
+                :: !rev_args)
+            else (
+              omitted := {Types.lbl = l; typ = ty} :: !omitted;
+              (* When the parameter was skipped over by a later labeled
+                 argument, keep a placeholder so the eta-expansion of a
+                 partial application preserves the parameter's position;
+                 trailing unprovided parameters need none. *)
+              if !remaining <> [] then rev_args := (l, None) :: !rev_args))
+        params;
+      (* Leftover syntactic arguments *)
+      (match !remaining with
+      | [] -> ()
+      | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})]
+        when total_app && !omitted = [] && !rev_args <> []
+             && List.length !rev_args = List.length !ignored ->
+        (* foo() treated as empty application if all args are optional
+           (hence ignored) *)
+        remaining := []
+      | (l1, sarg1) :: _ -> (
+        let ty_res =
+          let extra_params =
+            List.rev !omitted
+            @ List.rev_map
+                (fun (l, ty, _) -> {Types.lbl = l; typ = ty})
+                !ignored
+          in
+          match extra_params with
+          | [] -> ty_ret
+          | _ -> newty (Tarrow (extra_params, ty_ret))
+        in
+        match (expand_head env ty_res).desc with
+        | Tarrow _ ->
+          if List.length !rev_args >= arity then
+            raise
+              (Error
+                 (sarg1.pexp_loc, env, Apply_wrong_label (l1, funct.exp_type)))
+          else
+            raise (Error (sarg1.pexp_loc, env, Apply_wrong_label (l1, ty_res)))
+        | _ ->
+          raise
+            (Error
+               ( funct.exp_loc,
+                 env,
+                 Apply_non_function (expand_head env funct.exp_type) ))));
+      (* Force the argument thunks in parameter order *)
+      let targs =
+        List.rev !rev_args
+        |> List.map (fun (l, thunk) ->
+               match thunk with
+               | None -> (l, None)
+               | Some f -> (l, Some (f ())))
+      in
+      let provided = List.length !ignored + nargs in
+      let newarity = arity - provided in
+      let fully_applied = newarity <= 0 in
+      if total_app && not fully_applied then
+        raise (mk_arity_mismatch_error (nargs + newarity));
+      let ret_t =
+        if fully_applied && !omitted = [] then instance env ty_ret
+        else instance env (newty2 lv (Tarrow (List.rev !omitted, ty_ret)))
+      in
+      (targs, ret_t, fully_applied)
+    | Tvar _ ->
+      (* partial application of a function whose type is unknown *)
+      raise
+        (Error
+           ( funct.exp_loc,
+             env,
+             Apply_non_function (expand_head env funct.exp_type) ))
+    | _ ->
+      raise
+        (Error
+           ( funct.exp_loc,
+             env,
+             Apply_non_function (expand_head env funct.exp_type) )))
 
 and type_construct ~context env loc lid sarg ty_expected attrs =
   let opath =
@@ -4744,23 +4847,13 @@ let report_error env loc ppf error =
   | Expr_type_clash
       {
         trace =
-          (_, {desc = Tarrow (_, _, None)})
-          :: (_, {desc = Tarrow (_, _, Some _)})
-          :: _;
-      } ->
-    fprintf ppf
-      "This function is a curried function where an uncurried function is \
-       expected"
-  | Expr_type_clash
-      {
-        trace =
-          (_, {desc = Tarrow (_, _, Some arity_a)})
-          :: (_, {desc = Tarrow (_, _, Some arity_b)})
+          (_, {desc = Tarrow (params_a, _)})
+          :: (_, {desc = Tarrow (params_b, _)})
           :: _;
       }
-    when arity_a <> arity_b ->
-    let arity_a = arity_a |> string_of_int in
-    let arity_b = arity_b |> string_of_int in
+    when List.length params_a <> List.length params_b ->
+    let arity_a = List.length params_a |> string_of_int in
+    let arity_b = List.length params_b |> string_of_int in
     report_arity_mismatch ~arity_a ~arity_b ppf
   | Expr_type_clash {trace; context} ->
     (* modified *)
@@ -4770,15 +4863,16 @@ let report_error env loc ppf error =
   | Apply_non_function typ -> (
     (* modified *)
     match (repr typ).desc with
-    | Tarrow (_, return_type, _) ->
+    | Tarrow (params, return_type) ->
       let rec count_number_of_args count {Types.desc} =
         match desc with
-        | Tarrow (_, return_type, _) ->
-          count_number_of_args (count + 1) return_type
+        | Tarrow (params, return_type) ->
+          count_number_of_args (count + List.length params) return_type
         | _ -> count
       in
-      let count_number_of_args = count_number_of_args 1 in
-      let accepts_count = count_number_of_args return_type in
+      let accepts_count =
+        count_number_of_args (List.length params) return_type
+      in
       fprintf ppf "@[<v>@[<2>This function has type@ @{<info>%a@}@]" type_expr
         typ;
       fprintf ppf "@ @[It only accepts %i %s; here, it's called with more.@]@]"
@@ -4971,7 +5065,13 @@ let report_error env loc ppf error =
     *)
     let rec collect_args ?(acc = []) typ =
       match typ.desc with
-      | Tarrow (arg, next, _) -> collect_args ~acc:(arg.lbl :: acc) next
+      | Tarrow (params, next) ->
+        collect_args
+          ~acc:
+            (List.rev_append
+               (List.rev_map (fun (a : Types.arg) -> a.lbl) params)
+               acc)
+          next
       | _ -> acc
     in
     let args_from_type = collect_args typ in
diff --git a/compiler/ml/typedecl.ml b/compiler/ml/typedecl.ml
index fbb56973583..9e3fc917a8a 100644
--- a/compiler/ml/typedecl.ml
+++ b/compiler/ml/typedecl.ml
@@ -1052,13 +1052,15 @@ let compute_variance env visited vari ty =
       visited := Type_map.add ty vari !visited;
       let compute_same = compute_variance_rec vari in
       match ty.desc with
-      | Tarrow (arg, ret, _) ->
+      | Tarrow (params, ret) ->
         let open Variance in
         let v = conjugate vari in
         let v1 =
           if mem May_pos v || mem May_neg v then set May_weak true v else v
         in
-        compute_variance_rec v1 arg.typ;
+        List.iter
+          (fun ({typ} : Types.arg) -> compute_variance_rec v1 typ)
+          params;
         compute_same ret
       | Ttuple tl -> List.iter compute_same tl
       | Tconstr (path, tl, _) -> (
@@ -1856,14 +1858,7 @@ let transl_exception env sext =
   let newenv = Env.add_extension ~check:true ext.ext_id ext.ext_type env in
   (ext, newenv)
 
-let rec arity_from_arrow_type env core_type ty =
-  match (core_type.ptyp_desc, (Ctype.repr ty).desc) with
-  | Ptyp_arrow {ret = ct2}, Tarrow (_, ret, _) ->
-    1 + arity_from_arrow_type env ct2 ret
-  | Ptyp_arrow _, _ | _, Tarrow _ -> assert false
-  | _ -> 0
-
-let parse_arity env core_type ty =
+let parse_arity env _core_type ty =
   match Ctype.get_arity env ty with
   | Some arity ->
     let from_constructor =
@@ -1872,7 +1867,7 @@ let parse_arity env core_type ty =
       | _ -> false
     in
     (arity, from_constructor)
-  | None -> (arity_from_arrow_type env core_type ty, false)
+  | None -> (0, false)
 
 (* Translate a value declaration *)
 let transl_value_decl env loc valdecl =
diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml
index 3711715c412..91cd31774e3 100644
--- a/compiler/ml/typedtree.ml
+++ b/compiler/ml/typedtree.ml
@@ -83,11 +83,8 @@ and expression_desc =
   | Texp_constant of constant
   | Texp_let of rec_flag * value_binding list * expression
   | Texp_function of {
-      arg_label: arg_label;
-      arity: arity;
-      param: Ident.t;
-      case: case;
-      partial: partial;
+      params: function_param list;
+      body: expression;
       async: bool;
     }
   | Texp_apply of {
@@ -143,6 +140,13 @@ and meth = Tmeth_name of string
 
 and case = {c_lhs: pattern; c_guard: expression option; c_rhs: expression}
 
+and function_param = {
+  fp_lbl: arg_label;
+  fp_param: Ident.t; (* the name the compiled parameter binds to *)
+  fp_pat: pattern;
+  fp_partial: partial; (* whether [fp_pat] is exhaustive *)
+}
+
 and record_label_definition =
   | Kept of Types.type_expr
   | Overridden of Longident.t loc * expression
@@ -322,7 +326,7 @@ and arg = {attrs: attributes; lbl: arg_label; typ: core_type}
 and core_type_desc =
   | Ttyp_any
   | Ttyp_var of string
-  | Ttyp_arrow of arg * core_type * arity
+  | Ttyp_arrow of arg list * core_type
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
   | Ttyp_object of object_field list * closed_flag
diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli
index a8da19b7a45..f4d4b6cb7a7 100644
--- a/compiler/ml/typedtree.mli
+++ b/compiler/ml/typedtree.mli
@@ -136,11 +136,8 @@ and expression_desc =
             let rec P1 = E1 and ... and Pn = EN in E   (flag = Recursive)
          *)
   | Texp_function of {
-      arg_label: arg_label;
-      arity: arity;
-      param: Ident.t;
-      case: case;
-      partial: partial;
+      params: function_param list;
+      body: expression;
       async: bool;
     }
       (** [Pexp_fun] and [Pexp_function] both translate to [Texp_function].
@@ -244,6 +241,13 @@ and meth = Tmeth_name of string
 
 and case = {c_lhs: pattern; c_guard: expression option; c_rhs: expression}
 
+and function_param = {
+  fp_lbl: arg_label;
+  fp_param: Ident.t; (* the name the compiled parameter binds to *)
+  fp_pat: pattern;
+  fp_partial: partial; (* whether [fp_pat] is exhaustive *)
+}
+
 and record_label_definition =
   | Kept of Types.type_expr
   | Overridden of Longident.t loc * expression
@@ -428,7 +432,7 @@ and arg = {attrs: attributes; lbl: arg_label; typ: core_type}
 and core_type_desc =
   | Ttyp_any
   | Ttyp_var of string
-  | Ttyp_arrow of arg * core_type * arity
+  | Ttyp_arrow of arg list * core_type
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
   | Ttyp_object of object_field list * closed_flag
diff --git a/compiler/ml/typedtree_iter.ml b/compiler/ml/typedtree_iter.ml
index a177d6aed7e..6ad85a37e06 100644
--- a/compiler/ml/typedtree_iter.ml
+++ b/compiler/ml/typedtree_iter.ml
@@ -226,7 +226,9 @@ end = struct
     | Texp_let (rec_flag, list, exp) ->
       iter_bindings rec_flag list;
       iter_expression exp
-    | Texp_function {case; _} -> iter_case case
+    | Texp_function {params; body} ->
+      List.iter (fun {fp_pat} -> iter_pattern fp_pat) params;
+      iter_expression body
     | Texp_apply {funct = exp; args = list} ->
       iter_expression exp;
       List.iter
@@ -382,8 +384,8 @@ end = struct
     (match ct.ctyp_desc with
     | Ttyp_any -> ()
     | Ttyp_var _ -> ()
-    | Ttyp_arrow (arg, ret, _) ->
-      iter_core_type arg.typ;
+    | Ttyp_arrow (params, ret) ->
+      List.iter (fun (arg : Typedtree.arg) -> iter_core_type arg.typ) params;
       iter_core_type ret
     | Ttyp_tuple list -> List.iter iter_core_type list
     | Ttyp_constr (_path, _, list) -> List.iter iter_core_type list
diff --git a/compiler/ml/typeopt.ml b/compiler/ml/typeopt.ml
index f1d191f321e..409961eaaf1 100644
--- a/compiler/ml/typeopt.ml
+++ b/compiler/ml/typeopt.ml
@@ -93,7 +93,7 @@ let rec type_cannot_contain_undefined (typ : Types.type_expr) (env : Env.t) =
 
 let is_function_type env ty =
   match scrape env ty with
-  | Tarrow (arg, rhs, _) -> Some (arg.typ, rhs)
+  | Tarrow (params, ret) -> Some ((List.hd params).typ, ret)
   | _ -> None
 
 let is_base_type env ty base_ty_path =
diff --git a/compiler/ml/types.ml b/compiler/ml/types.ml
index caddb8ebb33..2f9acf327d6 100644
--- a/compiler/ml/types.ml
+++ b/compiler/ml/types.ml
@@ -25,7 +25,7 @@ and arg = {lbl: arg_label; typ: type_expr}
 
 and type_desc =
   | Tvar of string option
-  | Tarrow of arg * type_expr * arity
+  | Tarrow of arg list * type_expr
   | Ttuple of type_expr list
   | Tconstr of Path.t * type_expr list * abbrev_memo ref
   | Tobject of type_expr * (Path.t * type_expr list) option ref
diff --git a/compiler/ml/types.mli b/compiler/ml/types.mli
index c8de510f22c..a18eb2ac2f0 100644
--- a/compiler/ml/types.mli
+++ b/compiler/ml/types.mli
@@ -63,10 +63,11 @@ and type_desc =
   | Tvar of string option
       (** [Tvar (Some "a")] ==> ['a] or ['_a]
       [Tvar None]       ==> [_] *)
-  | Tarrow of arg * type_expr * arity
-      (** [Tarrow (Nolabel,      e1, e2)] ==> [e1    -> e2]
-      [Tarrow (Labelled {txt="l"}, e1, e2)] ==> [l:e1  -> e2]
-      [Tarrow (Optional {txt="l"}, e1, e2)] ==> [?l:e1 -> e2] *)
+  | Tarrow of arg list * type_expr
+      (** [Tarrow ([e1; ~l:e2; ?l:e3], ret)] ==> [(e1, ~l:e2, ~l:e3=?) => ret]
+      The n-ary uncurried function type: the arity is the length of the
+      parameter list, and a function returning a function is a nested
+      [Tarrow] in the return type. Invariant: the list is non-empty. *)
   | Ttuple of type_expr list  (** [Ttuple [t1;...;tn]] ==> [(t1 * ... * tn)] *)
   | Tconstr of Path.t * type_expr list * abbrev_memo ref
       (** [Tconstr (`A.B.t', [t1;...;tn], _)] ==> [(t1,...,tn) A.B.t]
diff --git a/compiler/ml/typetexp.ml b/compiler/ml/typetexp.ml
index aef3195a0a9..9dcfd669388 100644
--- a/compiler/ml/typetexp.ml
+++ b/compiler/ml/typetexp.ml
@@ -305,9 +305,6 @@ and transl_type_aux env policy styp =
     in
     ctyp (Ttyp_var name) ty
   | Ptyp_arrow {params; ret} ->
-    (* The n-ary arrow is translated to the (still curried) [Tarrow] chain:
-       the head arrow carries [Some arity], inner arrows carry [None]. *)
-    let arity = List.length params in
     let cparams =
       List.map
         (fun (arg : Parsetree.arg) ->
@@ -321,23 +318,23 @@ and transl_type_aux env policy styp =
         params
     in
     let cty2 = transl_type env policy ret in
-    let rec fold n = function
-      | [] -> cty2
-      | ((arg : Parsetree.arg), cty1, ty1) :: rest ->
-        let arrow_arity = if n = 0 then Some arity else None in
-        let ret_cty = fold (n + 1) rest in
-        let ty =
-          newty
-            (Tarrow ({lbl = arg.lbl; typ = ty1}, ret_cty.ctyp_type, arrow_arity))
-        in
-        ctyp
-          (Ttyp_arrow
-             ( {attrs = arg.attrs; lbl = arg.lbl; typ = cty1},
-               ret_cty,
-               arrow_arity ))
-          ty
+    let ty =
+      newty
+        (Tarrow
+           ( List.map
+               (fun ((arg : Parsetree.arg), _, ty1) ->
+                 {Types.lbl = arg.lbl; typ = ty1})
+               cparams,
+             cty2.ctyp_type ))
     in
-    fold 0 cparams
+    ctyp
+      (Ttyp_arrow
+         ( List.map
+             (fun ((arg : Parsetree.arg), cty1, _) ->
+               {Typedtree.attrs = arg.attrs; lbl = arg.lbl; typ = cty1})
+             cparams,
+           cty2 ))
+      ty
   | Ptyp_tuple stl ->
     assert (List.length stl >= 2);
     let ctys = List.map (transl_type env policy) stl in
diff --git a/compiler/syntax/src/res_outcome_printer.ml b/compiler/syntax/src/res_outcome_printer.ml
index 5bf0598fb4c..ac723459952 100644
--- a/compiler/syntax/src/res_outcome_printer.ml
+++ b/compiler/syntax/src/res_outcome_printer.ml
@@ -80,13 +80,10 @@ let print_out_attributes_doc (attrs : Outcometree.out_attribute list) =
         Doc.line;
       ]
 
-let rec collect_arrow_args (out_type : Outcometree.out_type) args =
+let collect_arrow_args (out_type : Outcometree.out_type) =
   match out_type with
-  | Otyp_arrow (label, arg_type, return_type, arity)
-    when arity = None || args = [] ->
-    let arg = (label, arg_type) in
-    collect_arrow_args return_type (arg :: args)
-  | _ as return_type -> (List.rev args, return_type)
+  | Otyp_arrow (args, ret) -> (args, ret)
+  | _ -> ([], out_type)
 
 let rec collect_functor_args (out_module_type : Outcometree.out_module_type)
     args =
@@ -240,7 +237,7 @@ let rec print_out_type_doc (out_type : Outcometree.out_type) =
       ]
 
 and print_out_arrow_type typ =
-  let typ_args, typ = collect_arrow_args typ [] in
+  let typ_args, typ = collect_arrow_args typ in
   let args =
     Doc.join
       ~sep:(Doc.concat [Doc.comma; Doc.line])
diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt
index c70e371a0ff..d311f0c80c1 100644
--- a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt
+++ b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt
@@ -55,11 +55,9 @@
   addValueReference ContextOptionalArgs.res:19:43 --> ContextOptionalArgs.res:12:14
   addTypeReference _none_:1:-1 --> ContextOptionalArgs.res:12:14
   addValueReference ContextOptionalArgs.res:12:6 --> React.res:16:0
-  DeadOptionalArgs.addReferences React.useContext called with optional argNames: argNamesMaybe: ContextOptionalArgs.res:22:30
   addValueReference ContextOptionalArgs.res:22:6 --> ContextOptionalArgs.res:2:6
   addValueReference ContextOptionalArgs.res:22:6 --> React.res:250:0
   addValueDeclaration +dispatchNotification ContextOptionalArgs.res:28:8 path:+ContextOptionalArgs.ComponentUsingAction
-  DeadOptionalArgs.addReferences NotificationProvider.useNotification called with optional argNames: argNamesMaybe: ContextOptionalArgs.res:28:31
   addValueReference ContextOptionalArgs.res:28:8 --> ContextOptionalArgs.res:22:6
   addValueReference ContextOptionalArgs.res:35:4 --> React.res:3:0
   DeadOptionalArgs.addReferences dispatchNotification called with optional argNames:action argNamesMaybe: ContextOptionalArgs.res:31:6
@@ -67,7 +65,6 @@
   addValueReference ContextOptionalArgs.res:30:4 --> React.res:150:0
   addValueReference ContextOptionalArgs.res:27:6 --> React.res:16:0
   addValueDeclaration +dispatchNotification ContextOptionalArgs.res:42:8 path:+ContextOptionalArgs.ComponentNotUsingAction
-  DeadOptionalArgs.addReferences NotificationProvider.useNotification called with optional argNames: argNamesMaybe: ContextOptionalArgs.res:42:31
   addValueReference ContextOptionalArgs.res:42:8 --> ContextOptionalArgs.res:22:6
   addValueReference ContextOptionalArgs.res:49:4 --> React.res:3:0
   DeadOptionalArgs.addReferences dispatchNotification called with optional argNames: argNamesMaybe: ContextOptionalArgs.res:45:6
@@ -94,7 +91,6 @@
   Scanning CrossFileOptionalArgValueUse.cmt Source:CrossFileOptionalArgValueUse.res
   addValueDeclaration +liveReturnCaller CrossFileOptionalArgValueUse.res:1:4 path:+CrossFileOptionalArgValueUse
   addValueReference CrossFileOptionalArgValueUse.res:1:4 --> CrossFileOptionalArgProvider.res:1:4
-  DeadOptionalArgs.addReferences liveReturnCaller called with optional argNames: argNamesMaybe: CrossFileOptionalArgValueUse.res:5:8
   addValueReference CrossFileOptionalArgValueUse.res:5:8 --> CrossFileOptionalArgValueUse.res:1:4
   Scanning DeadCodeImplementation.cmt Source:DeadCodeImplementation.res
   addValueDeclaration +x DeadCodeImplementation.res:2:6 path:+DeadCodeImplementation.M
@@ -1597,13 +1593,11 @@
   addValueReference TopLevelOptionalArgValueUse.res:40:8 --> TopLevelOptionalArgValueUse.res:41:4
   addValueReference TopLevelOptionalArgValueUse.res:41:4 --> TopLevelOptionalArgValueUse.res:41:39
   addValueReference TopLevelOptionalArgValueUse.res:43:4 --> TopLevelOptionalArgValueUse.res:43:22
-  DeadOptionalArgs.addReferences returnsFunction called with optional argNames: argNamesMaybe: TopLevelOptionalArgValueUse.res:44:23
   addValueReference TopLevelOptionalArgValueUse.res:44:4 --> TopLevelOptionalArgValueUse.res:43:4
   DeadOptionalArgs.addReferences returnedFunction called with optional argNames: argNamesMaybe: TopLevelOptionalArgValueUse.res:45:39
   addValueReference TopLevelOptionalArgValueUse.res:45:4 --> TopLevelOptionalArgValueUse.res:44:4
   addValueReference TopLevelOptionalArgValueUse.res:47:8 --> TopLevelOptionalArgValueUse.res:18:4
   addValueReference TopLevelOptionalArgValueUse.res:48:8 --> TopLevelOptionalArgValueUse.res:20:4
-  DeadOptionalArgs.addReferences liveReturnCaller called with optional argNames: argNamesMaybe: TopLevelOptionalArgValueUse.res:49:8
   addValueReference TopLevelOptionalArgValueUse.res:49:8 --> TopLevelOptionalArgValueUse.res:25:4
   addValueReference TopLevelOptionalArgValueUse.res:50:8 --> TopLevelOptionalArgValueUse.res:29:4
   DeadOptionalArgs.addReferences liveForwardingCaller called with optional argNames: argNamesMaybe: TopLevelOptionalArgValueUse.res:51:8
diff --git a/tests/analysis_tests/tests-reanalyze/termination/expected/termination.txt b/tests/analysis_tests/tests-reanalyze/termination/expected/termination.txt
index 63e15f81349..5852d6ee99e 100644
--- a/tests/analysis_tests/tests-reanalyze/termination/expected/termination.txt
+++ b/tests/analysis_tests/tests-reanalyze/termination/expected/termination.txt
@@ -70,15 +70,16 @@
   Termination Analysis for butSecondArgumentIsAlwaysEvaluated
 
   Function Table
-  1 parseExpression: [_ || _]; [+Parser.next; parseExpression; parseExpression; _ || _]
-  2 parseList<f>: parseList$loop<f:f>
-  3 parseList$loop<f>: [_ || f; parseList$loop<f:f>; _]
-  4 parseListExpression: _
-  5 parseListExpression2: parseExpression; parseList<f:parseExpression>
-  6 parseListInt: _
-  7 parseListIntTailRecursive: parseListIntTailRecursive$loop
-  8 parseListIntTailRecursive$loop: [_ || parseListIntTailRecursive$loop]
-  9 parseListListInt: parseList<f:parseListInt>
+  1 parseExpression: [_ || _]; [+Parser.next; parseExpression; parseExpression; _ || parseInt]
+  2 parseInt: [_ || _]; +Parser.next; _
+  3 parseList<f>: parseList$loop<f:f>
+  4 parseList$loop<f>: [_ || f; parseList$loop<f:f>; _]
+  5 parseListExpression: _
+  6 parseListExpression2: parseExpression; parseList<f:parseExpression>
+  7 parseListInt: parseList<f:parseInt>
+  8 parseListIntTailRecursive: parseListIntTailRecursive$loop
+  9 parseListIntTailRecursive$loop: [_ || parseInt; parseListIntTailRecursive$loop]
+  10 parseListListInt: parseList<f:parseListInt>
 
   Termination Analysis for parseListInt
 
@@ -111,10 +112,13 @@
 
   Function Table
   1 alwaysReturnNone: [+Parser.next; alwaysReturnNone || None]
-  2 parseIntOWrapper: _
-  3 parseListIntO: _
-  4 testAlwaysReturnNone: alwaysReturnNone
-  5 thisMakesNoProgress: None; [_ || +Parser.next; Some]
+  2 parseIntO: [+Parser.next; Some || None]
+  3 parseIntOWrapper: parseIntO
+  4 parseListIntO: parseListO<f:parseIntO>
+  5 parseListO<f>: parseListO$loop<f:f>
+  6 parseListO$loop<f>: [+Parser.next; _ || switch f {some: parseListO$loop<f:f>, none: _}]
+  7 testAlwaysReturnNone: alwaysReturnNone
+  8 thisMakesNoProgress: None; [_ || +Parser.next; Some]
 
   Termination Analysis for parseListIntO
 
@@ -149,10 +153,10 @@
   Termination Analysis Stats
   Files:1
   Recursive Blocks:21
-  Functions:45
-  Infinite Loops:12
-  Hygiene Errors:3
-  Cache Hits:4/21
+  Functions:49
+  Infinite Loops:10
+  Hygiene Errors:2
+  Cache Hits:7/30
   
 
   Error Termination
@@ -207,10 +211,6 @@
   TestCyberTruck.res:217:32-73
   Call must have named argument f
 
-  Error Hygiene
-  TestCyberTruck.res:198:29-53
-  Named argument f must be passed a recursive function
-
   Error Termination
   TestCyberTruck.res:180:15-21
   Possible infinite loop when calling parseList$loop<f:f> which is parseList$loop<f:parseListInt>
@@ -219,21 +219,6 @@
     2 parseList<f:parseListInt> (TestCyberTruck.res 201)
     1 parseListListInt (TestCyberTruck.res 201)
 
-  Error Termination
-  TestCyberTruck.res:180:15-21
-  Possible infinite loop when calling parseList$loop<f:f> which is parseList$loop<f:parseExpression>
-  CallStack:
-    3 parseList$loop<f:parseExpression> (TestCyberTruck.res 183)
-    2 parseList<f:parseExpression> (TestCyberTruck.res 220)
-    1 parseListExpression2 (TestCyberTruck.res 220)
-
-  Error Termination
-  TestCyberTruck.res:228:7-38
-  Possible infinite loop when calling parseListIntTailRecursive$loop
-  CallStack:
-    2 parseListIntTailRecursive$loop (TestCyberTruck.res 230)
-    1 parseListIntTailRecursive (TestCyberTruck.res 223)
-
   Error Termination
   TestCyberTruck.res:238:31-49
   Possible infinite loop when calling loopAfterProgress
@@ -246,4 +231,4 @@
   CallStack:
     1 countRendersCompiled (TestCyberTruck.res 283)
   
-  Analysis reported 15 issues (Error Hygiene:3, Error Termination:12)
+  Analysis reported 12 issues (Error Hygiene:2, Error Termination:10)
diff --git a/tests/build_tests/super_errors/expected/default_refers_to_later_param.res.expected b/tests/build_tests/super_errors/expected/default_refers_to_later_param.res.expected
new file mode 100644
index 00000000000..0003110d55b
--- /dev/null
+++ b/tests/build_tests/super_errors/expected/default_refers_to_later_param.res.expected
@@ -0,0 +1,8 @@
+
+  We've found a bug for you!
+  /.../fixtures/default_refers_to_later_param.res:1:13
+
+  1 │ let f = (~x=z, z) => x + z
+  2 │ 
+
+  The value z can't be found
\ No newline at end of file
diff --git a/tests/build_tests/super_errors/expected/method_arity_mismatch.res.expected b/tests/build_tests/super_errors/expected/method_arity_mismatch.res.expected
index 1cfc6c2e9ac..00ea9a0fe6f 100644
--- a/tests/build_tests/super_errors/expected/method_arity_mismatch.res.expected
+++ b/tests/build_tests/super_errors/expected/method_arity_mismatch.res.expected
@@ -12,4 +12,4 @@
   The function has type:
   (int, int) => unit
   
-  It is called with 1 argument but requires 2.
\ No newline at end of file
+  - The function takes 2 unlabelled arguments, but is called with just 1
\ No newline at end of file
diff --git a/tests/build_tests/super_errors/expected/moreArguments4.res.expected b/tests/build_tests/super_errors/expected/moreArguments4.res.expected
index e15fcdc31e8..509aa8c7f62 100644
--- a/tests/build_tests/super_errors/expected/moreArguments4.res.expected
+++ b/tests/build_tests/super_errors/expected/moreArguments4.res.expected
@@ -10,5 +10,5 @@
   The function has type:
   (int, ~b: int, ~c: 'a, ~d: 'b) => int
   
-  - Missing arguments that must be provided: ~d, ~c, ~b
+  - Missing arguments that must be provided: ~b, ~c, ~d
   - Hint: Did you want to partially apply the function? You can do that by putting `...` just before the closing parens of the function call. Example: yourFn(~arg1=someVar, ...)
\ No newline at end of file
diff --git a/tests/build_tests/super_errors/fixtures/default_refers_to_later_param.res b/tests/build_tests/super_errors/fixtures/default_refers_to_later_param.res
new file mode 100644
index 00000000000..6c5de3d125f
--- /dev/null
+++ b/tests/build_tests/super_errors/fixtures/default_refers_to_later_param.res
@@ -0,0 +1 @@
+let f = (~x=z, z) => x + z
diff --git a/tests/gentype_tests/typescript-react-example/src/LabeledFun.gen.tsx b/tests/gentype_tests/typescript-react-example/src/LabeledFun.gen.tsx
index dad8e55edb3..2b4a8faccea 100644
--- a/tests/gentype_tests/typescript-react-example/src/LabeledFun.gen.tsx
+++ b/tests/gentype_tests/typescript-react-example/src/LabeledFun.gen.tsx
@@ -5,4 +5,6 @@
 
 import * as LabeledFunJS from './LabeledFun.res.js';
 
-export const labelled: (a:number, b:(undefined | number), c:number, _4:number, e:number, f:number) => number = LabeledFunJS.labelled as any;
+export type renamedParamCb = (renamed:number, second:number) => number;
+
+export const labelled: (a:number, b:(undefined | number), c:number, d:number, e:number, f:number) => number = LabeledFunJS.labelled as any;
diff --git a/tests/gentype_tests/typescript-react-example/src/LabeledFun.res b/tests/gentype_tests/typescript-react-example/src/LabeledFun.res
index 42956e69d93..69e7845047f 100644
--- a/tests/gentype_tests/typescript-react-example/src/LabeledFun.res
+++ b/tests/gentype_tests/typescript-react-example/src/LabeledFun.res
@@ -1,2 +1,7 @@
 @genType
 let labelled = (a, ~b=3, ~c, d, ~e, ~f) => a + b + c + d + e + f
+
+/* Pins @genType.as renaming of a function parameter: the annotation lives on
+ the parameter (Typedtree.arg attrs), not on the arrow node or the type. */
+@genType
+type renamedParamCb = (@genType.as("renamed") ~first: int, ~second: int) => int
diff --git a/tests/gentype_tests/typescript-react-example/src/TestPromise.gen.tsx b/tests/gentype_tests/typescript-react-example/src/TestPromise.gen.tsx
index 3e7580c2401..66afef8c0df 100644
--- a/tests/gentype_tests/typescript-react-example/src/TestPromise.gen.tsx
+++ b/tests/gentype_tests/typescript-react-example/src/TestPromise.gen.tsx
@@ -13,4 +13,4 @@ export type toPayload = { readonly result: string };
 
 export const convert: (p:Promise<fromPayload>) => Promise<toPayload> = TestPromiseJS.convert as any;
 
-export const barx: (x:(undefined | Promise<(undefined | string)>), _2:void) => boolean = TestPromiseJS.barx as any;
+export const barx: (x:(undefined | Promise<(undefined | string)>), param:void) => boolean = TestPromiseJS.barx as any;
diff --git a/tests/tests/src/mario_game.mjs b/tests/tests/src/mario_game.mjs
index 9463f53747b..d476323e488 100644
--- a/tests/tests/src/mario_game.mjs
+++ b/tests/tests/src/mario_game.mjs
@@ -847,9 +847,9 @@ function new_id() {
   return id_counter.contents;
 }
 
-function make$2($staropt$star, $staropt$star$1, spawnable, context, param) {
-  let id = $staropt$star !== undefined ? Primitive_option.valFromOption($staropt$star) : undefined;
-  let dir = $staropt$star$1 !== undefined ? $staropt$star$1 : "Left";
+function make$2($staropt_id$star, $staropt_dir$star, spawnable, context, param) {
+  let id = $staropt_id$star !== undefined ? Primitive_option.valFromOption($staropt_id$star) : undefined;
+  let dir = $staropt_dir$star !== undefined ? $staropt_dir$star : "Left";
   let spr = make(spawnable, dir, context);
   let params = make_type$2(spawnable);
   let id$1 = id !== undefined ? id : new_id();
diff --git a/tests/tests/src/uncurried_default.args.mjs b/tests/tests/src/uncurried_default.args.mjs
index 18f639c123e..e86b8db99ed 100644
--- a/tests/tests/src/uncurried_default.args.mjs
+++ b/tests/tests/src/uncurried_default.args.mjs
@@ -1,10 +1,10 @@
 // Generated by ReScript, PLEASE EDIT WITH CARE
 
 
-function withOpt($staropt$star, y) {
-  return ($staropt$star$1, w) => {
-    let x = $staropt$star !== undefined ? $staropt$star : 1;
-    let z = $staropt$star$1 !== undefined ? $staropt$star$1 : 1;
+function withOpt(xOpt, y) {
+  let x = xOpt !== undefined ? xOpt : 1;
+  return (zOpt, w) => {
+    let z = zOpt !== undefined ? zOpt : 1;
     return ((x + y | 0) + z | 0) + w | 0;
   };
 }
@@ -53,10 +53,10 @@ let StandardNotation = {
   r3: r3
 };
 
-function withOpt$1($staropt$star, y) {
-  return ($staropt$star$1, w) => {
-    let x = $staropt$star !== undefined ? $staropt$star : 1;
-    let z = $staropt$star$1 !== undefined ? $staropt$star$1 : 1;
+function withOpt$1(xOpt, y) {
+  let x = xOpt !== undefined ? xOpt : 1;
+  return (zOpt, w) => {
+    let z = zOpt !== undefined ? zOpt : 1;
     return ((x + y | 0) + z | 0) + w | 0;
   };
 }
@@ -98,6 +98,22 @@ let M = {
   foo: foo
 };
 
+let outerScope = "outer";
+
+function shadowedDefault(xOpt, outerScope$1) {
+  let x = xOpt !== undefined ? xOpt : outerScope;
+  return [
+    x,
+    outerScope$1
+  ];
+}
+
+function laterUsesEarlier(xOpt, yOpt, param) {
+  let x = xOpt !== undefined ? xOpt : 1;
+  let y = yOpt !== undefined ? yOpt : x + 1 | 0;
+  return x + y | 0;
+}
+
 export {
   StandardNotation,
   withOpt$1 as withOpt,
@@ -109,5 +125,8 @@ export {
   r2$1 as r2,
   foo3$1 as foo3,
   M,
+  outerScope,
+  shadowedDefault,
+  laterUsesEarlier,
 }
 /* testWithOpt Not a pure module */
diff --git a/tests/tests/src/uncurried_default.args.res b/tests/tests/src/uncurried_default.args.res
index c776b567349..a6012416b1a 100644
--- a/tests/tests/src/uncurried_default.args.res
+++ b/tests/tests/src/uncurried_default.args.res
@@ -1,3 +1,7 @@
+// The generated JS also pins *where* optional-parameter defaults are
+// computed: each default must be evaluated when its own parameter group is
+// applied (x's in the outer function, z's in the inner closure below), not
+// pushed into the innermost body as the legacy curried representation did.
 module StandardNotation = {
   let withOpt = (~x=1, y) => (~z=1, w) => x + y + z + w
   let testWithOpt = withOpt(3)(4)
@@ -33,3 +37,12 @@ module M: {
 } = {
   let foo = func => func() + 1
 }
+
+// Scoping of defaults: a default sees only the parameters to its left —
+// never a later parameter, and never a same-group shadow. `outerScope` in
+// the default below is the top-level binding, not the parameter.
+let outerScope = "outer"
+let shadowedDefault = (~x=outerScope, outerScope: int) => (x, outerScope)
+
+// A default may use parameters to its left.
+let laterUsesEarlier = (~x=1, ~y=x + 1, ()) => x + y
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index 886f8c33caf..d7787073952 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -350,8 +350,11 @@ let value_detail (typ : Types.type_expr) =
                  collect_signature_types t)
         in
         [{path = p; generic_parameters = ts}])
-    | Tarrow (arg, ret, _) ->
-      collect_signature_types arg.typ @ collect_signature_types ret
+    | Tarrow (params, ret) ->
+      List.concat_map
+        (fun ({typ} : Types.arg) -> collect_signature_types typ)
+        params
+      @ collect_signature_types ret
     | Tvar None -> [{path = "_"; generic_parameters = []}]
     | _ -> []
   in