From de3ee9f469626e35aa62caa2085c9ce6b688942e Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Fri, 14 Aug 2026 19:07:09 +0200
Subject: [PATCH 1/6] Make the typed layers n-ary: Tarrow params and
 Texp_function params

Types.Tarrow carries a parameter list (Tarrow of arg list * type_expr);
Texp_function carries typed parameters {fp_lbl; fp_param; fp_pat;
fp_partial} and a body; Ttyp_arrow and Otyp_arrow follow. The arity
annotation and its int-option phantom state are gone from the compiler.

Type relations compare parameters pairwise; a length mismatch is
structural incompatibility (which also makes mcomp's arrow verdict
sound: arrows of different lengths can never unify). filter_arrow
becomes filter_arrow_n. type_function types all parameters against one
arrow, checking expected labels up front to preserve the dedicated
Abstract_wrong_label diagnostics; optional-parameter defaults desugar
to uniquified *opt_<label>* bindings stacked at the head of the body.
type_application is a single parameters-to-arguments matching loop
preserving the legacy commutation, optional auto-fill, eta-expansion
placeholder, and error-selection behavior.

translcore's push_defaults is deleted (defaults now sit in the body by
construction) and transl_function walks the parameter list, keeping the
active-pattern split. Downstream, the gather-until-arity walkers in
gentype and the outcome printer, reanalyze's two arity-corrective
helpers, and typedecl's structural arity fallback are all deleted.

The cmi and cmt magic numbers are bumped to Caml1999I023/Caml1999T023.

Generated JavaScript is byte-identical across the test suite except:
- a bug fix: defaults of optional parameters in curried functions are
  now computed when their own parameter group is applied ((~x=d, y) =>
  (~z=d, w) => ... no longer defers x's default to the inner
  application); pinned by the uncurried_default.args snapshot;
- optional-parameter internals are named *opt_<label>* instead of
  *opt* in the one unprettified case (mario_game).

Error-message improvements: method arity mismatches report unlabelled
argument counts precisely, and missing-argument lists print in source
order. Reanalyze no longer emits spurious empty optional-argument
references; genType recovers real parameter names after defaulted
parameters.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
Signed-off-by: Cristiano Calcagno <cristianoc@users.noreply.github.com>
---
 CHANGELOG.md                                  |   2 +
 analysis/reanalyze/src/arnold.ml              |  17 +-
 analysis/reanalyze/src/dead_optional_args.ml  |  37 +-
 analysis/reanalyze/src/dead_value.ml          |  24 +-
 analysis/src/completion_back_end.ml           |  15 +-
 analysis/src/completion_jsx.ml                |   4 +-
 analysis/src/create_interface.ml              |  43 +-
 analysis/src/process_cmt.ml                   |   7 +-
 analysis/src/shared.ml                        |   4 +-
 analysis/src/type_utils.ml                    |  76 +-
 compiler/core/lam_convert.ml                  |  14 +-
 compiler/ext/config.ml                        |   4 +-
 compiler/gentype/translate_core_type.ml       | 121 +--
 compiler/gentype/translate_structure.ml       |  44 +-
 .../gentype/translate_type_expr_from_types.ml |  97 +-
 compiler/ml/asttypes.ml                       |   2 -
 compiler/ml/btype.ml                          |   9 +-
 compiler/ml/ctype.ml                          | 125 ++-
 compiler/ml/ctype.mli                         |   7 +-
 compiler/ml/includemod.ml                     |  30 +-
 compiler/ml/oprint.ml                         |  19 +-
 compiler/ml/outcometree.ml                    |   2 +-
 compiler/ml/printtyp.ml                       |  46 +-
 compiler/ml/printtyped.ml                     |  28 +-
 compiler/ml/rec_check.ml                      |  15 +-
 compiler/ml/record_type_spread.ml             |  12 +-
 compiler/ml/tast_iterator.ml                  |   8 +-
 compiler/ml/tast_mapper.ml                    |  17 +-
 compiler/ml/translcore.ml                     | 175 ++--
 compiler/ml/typecore.ml                       | 877 ++++++++++--------
 compiler/ml/typedecl.ml                       |  17 +-
 compiler/ml/typedtree.ml                      |  16 +-
 compiler/ml/typedtree.mli                     |  16 +-
 compiler/ml/typedtree_iter.ml                 |   8 +-
 compiler/ml/typeopt.ml                        |   2 +-
 compiler/ml/types.ml                          |   2 +-
 compiler/ml/types.mli                         |   9 +-
 compiler/ml/typetexp.ml                       |  35 +-
 compiler/syntax/src/res_outcome_printer.ml    |  11 +-
 .../deadcode/expected/deadcode.txt            |   6 -
 .../method_arity_mismatch.res.expected        |   2 +-
 .../expected/moreArguments4.res.expected      |   2 +-
 .../src/LabeledFun.gen.tsx                    |   2 +-
 .../src/TestPromise.gen.tsx                   |   2 +-
 tests/tests/src/mario_game.mjs                |   6 +-
 tests/tests/src/uncurried_default.args.mjs    |  16 +-
 tests/tests/src/uncurried_default.args.res    |   4 +
 tools/src/tools.ml                            |   7 +-
 48 files changed, 1063 insertions(+), 981 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 90ac18bccf2..dabafafb845 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -28,6 +28,7 @@
 
 - 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 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.
 - 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
@@ -44,6 +45,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.
 - 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, generated JavaScript, printed output, and the external-PPX wire format are unchanged. 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..6c4847cd464 100644
--- a/analysis/reanalyze/src/arnold.ml
+++ b/analysis/reanalyze/src/arnold.ml
@@ -544,15 +544,12 @@ module Find_functions_called = struct
     {super with Tast_mapper.expr}
 
   let find_callees (expression : Typedtree.expression) =
-    let is_function =
-      match expression.exp_desc with
-      | Texp_function {arity = None} -> true
-      | _ -> false
-    in
-    let callees = ref String_set.empty in
-    let traverse_expr = traverse_expr ~callees in
-    if is_function then expression |> traverse_expr.expr traverse_expr |> ignore;
-    !callees
+    (* Legacy behavior: callees were only collected for arity-less (curried)
+       function nodes, which compiler-produced bindings never were once
+       functions became uncurried by default, and which no longer exist at
+       all with the n-ary representation. *)
+    ignore expression;
+    String_set.empty
 end
 
 module Extend_function_table = struct
@@ -937,7 +934,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..1ae2ee5410a 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. *)
+  let sparams, sbody =
+    List.fold_right
+      (fun (p : Parsetree.fun_param) (params, body) ->
+        match p.p_default with
+        | None -> (p :: params, body)
+        | 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
+          let body =
+            Exp.let_ ~loc Nonrecursive
+              ~attrs:[(mknoloc "#default", PStr [])]
+              [Vb.mk spat smatch]
+              body
+          in
+          ( {
+              p with
+              p_default = None;
+              p_pat = Pat.var ~loc:sloc (mknoloc opt_name);
+            }
+            :: params,
+            body ))
+      sparams ([], sbody)
+  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,171 @@ 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
+      (params : Parsetree.fun_param list) tys =
+    match (params, tys) with
+    | [], [] -> (List.rev typed_acc, env, unpacks_acc)
+    | p :: 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_params
+        ((p, pat, ty_arg_c) :: typed_acc)
+        ext_env (unpacks_acc @ unpacks) rest_params rest_tys
+    | _ -> assert false
+  in
+  let typed_params, body_env, unpacks =
+    with_reset_control_flow (fun () -> type_params [] env [] sparams 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
+  (if has_gadts then
+     let ty_res' = instance env ty_res in
+     unify_exp ~context:None env body_exp ty_res');
+  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
-  let case = List.hd cases in
-  let param = name_pattern "param" cases 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 +3988,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 +4004,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 +4812,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 +4828,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 +5030,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 5f7386a2377..24e276ed1a2 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/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/gentype_tests/typescript-react-example/src/LabeledFun.gen.tsx b/tests/gentype_tests/typescript-react-example/src/LabeledFun.gen.tsx
index dad8e55edb3..05a1960babf 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,4 @@
 
 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 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/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 1f175463ad5..343bf246d5c 100644
--- a/tests/tests/src/mario_game.mjs
+++ b/tests/tests/src/mario_game.mjs
@@ -846,9 +846,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..2cabf6e06a3 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;
   };
 }
diff --git a/tests/tests/src/uncurried_default.args.res b/tests/tests/src/uncurried_default.args.res
index c776b567349..d80031cefaa 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)
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

From 784d6f86b3cc1f9dc30357690fc0dde9b4a52a5a Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Fri, 14 Aug 2026 20:53:10 +0200
Subject: [PATCH 2/6] Remove dead code enabled by structural arity

- The Too_many_arguments error cannot be raised anymore: the expected
  type is committed to an arrow of the literal's shape before
  destructuring, so every legacy path now surfaces as a regular type
  clash or Uncurried_arity_mismatch (which is what the fixture credited
  to it in ERROR_VARIANTS.md was already producing). Remove the
  variant, its printer, and the ?in_function threading through
  type_expect/type_cases that existed only to decorate it.
- Remove the function$-vs-arrow unification bridge in ctype (nothing
  produces a function$ type expression anymore), the structural arity
  counter Ctype.arity (no callers), the parsetree arity probes
  get_uncurry_arity/get_curry_arity (is_arity_one reads the params list
  directly), and Ast_async's redundant newtype double-dig.
- Deduplicate the arrow-flattening step shared by the analysis
  extract_function_type helpers.

Generated code is unchanged. The Pjs_fn_make no-op elision explored
alongside these cleanups is deliberately left out pending a dedicated
analysis of that primitive.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
Signed-off-by: Cristiano Calcagno <cristianoc@users.noreply.github.com>
---
 CHANGELOG.md                        |  2 +
 analysis/src/type_utils.ml          | 23 ++++--------
 compiler/frontend/ast_core_type.ml  |  8 ++--
 compiler/frontend/ast_core_type.mli |  3 +-
 compiler/ml/ast_async.ml            | 11 +-----
 compiler/ml/ctype.ml                |  9 -----
 compiler/ml/ctype.mli               |  1 -
 compiler/ml/typecore.ml             | 57 ++++++++---------------------
 compiler/ml/typecore.mli            |  1 -
 compiler/syntax/src/res_core.ml     |  4 +-
 tests/ERROR_VARIANTS.md             |  6 ++-
 11 files changed, 40 insertions(+), 85 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index dabafafb845..b6e65fb254d 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -45,6 +45,8 @@
 
 - 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
+- Cleanups enabled by structural arity: remove the unreachable `Too_many_arguments` error and the `?in_function` threading through the type checker that existed only to decorate it; remove the dead `function$`-vs-arrow unification bridge, `Ctype.arity`, and the unused parsetree arity helpers; deduplicate the analysis arrow-flattening helpers.
+
 - 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.
 - 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, generated JavaScript, printed output, and the external-PPX wire format are unchanged. 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
diff --git a/analysis/src/type_utils.ml b/analysis/src/type_utils.ml
index 63702f0a301..6e12fb61746 100644
--- a/analysis/src/type_utils.ml
+++ b/analysis/src/type_utils.ml
@@ -279,16 +279,17 @@ let rec extract_object_type ~state ~env ~package (t : Types.type_expr) =
     | _ -> None)
   | _ -> None
 
+let flatten_arrow_params (params : Types.arg list) acc =
+  List.rev_append
+    (List.map (fun ({lbl; typ} : Types.arg) -> (lbl, typ)) params)
+    acc
+
 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 (params, t_ret) ->
-      loop ~env
-        (List.rev_append
-           (List.map (fun ({lbl; typ} : Types.arg) -> (lbl, typ)) params)
-           acc)
-        t_ret
+      loop ~env (flatten_arrow_params 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}}}) ->
@@ -304,11 +305,7 @@ let extract_function_type_with_env ~state ~env ~package typ =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ~env acc t1
     | Tarrow (params, t_ret) ->
-      loop ~env
-        (List.rev_append
-           (List.map (fun ({lbl; typ} : Types.arg) -> (lbl, typ)) params)
-           acc)
-        t_ret
+      loop ~env (flatten_arrow_params 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}}}) ->
@@ -345,11 +342,7 @@ let extract_function_type2 ?type_arg_context ~state ~env ~package typ =
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
       loop ?type_arg_context ~env acc t1
     | 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
+      loop ?type_arg_context ~env (flatten_arrow_params 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}}}) ->
diff --git a/compiler/frontend/ast_core_type.ml b/compiler/frontend/ast_core_type.ml
index 87685cc5b3c..32ed7ca8375 100644
--- a/compiler/frontend/ast_core_type.ml
+++ b/compiler/frontend/ast_core_type.ml
@@ -110,12 +110,10 @@ let make_obj ~loc xs = Typ.object_ ~loc xs Closed
    {[ 'a -> ('a. 'a -> 'b) ]}
 
 *)
-let get_curry_arity (ty : t) =
+let is_arity_one (ty : t) =
   match ty.ptyp_desc with
-  | Ptyp_arrow {params} -> List.length params
-  | _ -> 0
-
-let is_arity_one ty = get_curry_arity ty = 1
+  | Ptyp_arrow {params = [_]} -> true
+  | _ -> false
 
 let list_of_arrow (ty : t) : t * Parsetree.arg list =
   match ty.ptyp_desc with
diff --git a/compiler/frontend/ast_core_type.mli b/compiler/frontend/ast_core_type.mli
index 80c1843149f..5e352a7f24e 100644
--- a/compiler/frontend/ast_core_type.mli
+++ b/compiler/frontend/ast_core_type.mli
@@ -42,6 +42,7 @@ val make_obj : loc:Location.t -> Parsetree.object_field list -> t
 val is_user_option : t -> bool
 
 val list_of_arrow : t -> t * Parsetree.arg list
-(** fails when Ptyp_poly *)
+(** [list_of_arrow ty] returns [(return_type, params)] of an arrow type,
+    or [(ty, [])] when [ty] is not an arrow. *)
 
 val is_arity_one : t -> bool
diff --git a/compiler/ml/ast_async.ml b/compiler/ml/ast_async.ml
index 1281ed0298e..1764c89d000 100644
--- a/compiler/ml/ast_async.ml
+++ b/compiler/ml/ast_async.ml
@@ -1,14 +1,7 @@
-let dig_async_payload_from_function (expr : Parsetree.expression) =
+let rec dig_async_payload_from_function (expr : Parsetree.expression) =
   match expr.pexp_desc with
   | Pexp_fun {async} -> async
-  | Pexp_newtype _ ->
-    let rec dig (e : Parsetree.expression) =
-      match e.pexp_desc with
-      | Pexp_newtype (_, body) -> dig body
-      | Pexp_fun {async} -> async
-      | _ -> false
-    in
-    dig expr
+  | Pexp_newtype (_, body) -> dig_async_payload_from_function body
   | _ -> false
 
 let add_promise_type ?(loc = Location.none) ~async
diff --git a/compiler/ml/ctype.ml b/compiler/ml/ctype.ml
index 4afd18d42cb..84187a94f78 100644
--- a/compiler/ml/ctype.ml
+++ b/compiler/ml/ctype.ml
@@ -2193,9 +2193,6 @@ and unify3 env t1 t1' t2 t2' =
   | Tfield _, Tfield _ ->
     (* special case for GADTs *)
     unify_fields env t1' t2'
-  | Tconstr (Pident {name = "function$"}, [t_fun], _), Tarrow _ ->
-    (* subtype: an uncurried function is cast to a curried one *)
-    unify2 env t_fun t2
   | _ -> (
     (match !umode with
     | Expression ->
@@ -3930,12 +3927,6 @@ let unalias ty =
   | Tobject (ty, nm) -> newty2 ty.level (Tobject (unalias_object ty, nm))
   | _ -> newty2 ty.level ty.desc
 
-(* Return the arity (as for curried functions) of the given type. *)
-let rec arity ty =
-  match (repr ty).desc with
-  | Tarrow (params, ret) -> List.length params + arity ret
-  | _ -> 0
-
 (* Check whether an abbreviation expands to itself. *)
 let cyclic_abbrev env id ty =
   let rec check_cycle seen ty =
diff --git a/compiler/ml/ctype.mli b/compiler/ml/ctype.mli
index 57a1bff37d9..025c162e305 100644
--- a/compiler/ml/ctype.mli
+++ b/compiler/ml/ctype.mli
@@ -274,7 +274,6 @@ val free_variables : ?env:Env.t -> type_expr -> type_expr list
 val closed_type_decl : type_declaration -> type_expr option
 val closed_extension_constructor : extension_constructor -> type_expr option
 val unalias : type_expr -> type_expr
-val arity : type_expr -> int
 (* Return the arity (as for curried functions) of the given type. *)
 
 val get_current_level : unit -> int
diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml
index 1ae2ee5410a..fd8c564d041 100644
--- a/compiler/ml/typecore.ml
+++ b/compiler/ml/typecore.ml
@@ -59,7 +59,6 @@ type error =
   | Private_type of type_expr
   | Not_subtype of
       Ctype.type_pairs * Ctype.type_pairs * Ctype.subtype_context option
-  | Too_many_arguments of bool * type_expr
   | Abstract_wrong_label of arg_label * type_expr
   | Scoping_let_module of string * type_expr
   | Not_a_variant_type of Longident.t
@@ -2343,8 +2342,7 @@ let rec type_exp ?deprecated_context ~context ?recarg env sexp =
    In the principal case, [type_expected'] may be at generic_level.
 *)
 
-and type_expect ~context ?deprecated_context ?in_function ?recarg env sexp
-    ty_expected =
+and type_expect ~context ?deprecated_context ?recarg env sexp ty_expected =
   (* Special errors for braced identifiers passed to records *)
   let context =
     match sexp.pexp_desc with
@@ -2359,15 +2357,14 @@ and type_expect ~context ?deprecated_context ?in_function ?recarg env sexp
   let previous_saved_types = Cmt_format.get_saved_types () in
   let exp =
     Builtin_attributes.warning_scope sexp.pexp_attributes (fun () ->
-        type_expect_ ?deprecated_context ~context ?in_function ?recarg env sexp
-          ty_expected)
+        type_expect_ ?deprecated_context ~context ?recarg env sexp ty_expected)
   in
   Cmt_format.set_saved_types
     (Cmt_format.Partial_expression exp :: previous_saved_types);
   exp
 
-and type_expect_ ?deprecated_context ~context ?in_function ?(recarg = Rejected)
-    env sexp ty_expected =
+and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
+    ty_expected =
   let loc = sexp.pexp_loc in
   (* Record the expression type before unifying it with the expected type *)
   let rue exp =
@@ -2437,7 +2434,7 @@ and type_expect_ ?deprecated_context ~context ?in_function ?(recarg = Rejected)
         sbody )
     when contains_gadt env spat ->
     (* TODO: allow non-empty attributes? *)
-    type_expect ~context:None ?in_function env
+    type_expect ~context:None env
       {
         sexp with
         pexp_desc = Pexp_match (sval, [Ast_helper.Exp.case spat sbody]);
@@ -2470,8 +2467,8 @@ and type_expect_ ?deprecated_context ~context ?in_function ?(recarg = Rejected)
         exp_env = env;
       }
   | Pexp_fun {params; body = sfun_body; async} ->
-    type_function ?in_function ~async loc sexp.pexp_attributes env ty_expected
-      params sfun_body
+    type_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 ();
@@ -3510,7 +3507,7 @@ 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 ~async loc attrs env ty_expected_
+and type_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
@@ -3607,22 +3604,13 @@ and type_function ?in_function ~async loc attrs env ty_expected_
     unify_exp_types ~context:None loc env fun_t ty_expected_;
     fun_t
   in
-  let loc_fun, ty_fun =
-    match in_function with
-    | Some p -> p
-    | None -> (loc, instance env ty_expected)
-  in
   let separate = Env.has_local_constraints env in
   if separate then begin_def ();
   let ty_params, ty_res =
+    (* [ty_expected] was just committed to an arrow with exactly these
+       labels, so destructuring it cannot fail. *)
     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 (List.hd labels, ty)))
-      | _ ->
-        raise
-          (Error (loc_fun, env, Too_many_arguments (in_function <> None, ty_fun))))
+    with Unify _ -> assert false
   in
   let ty_params =
     List.map2
@@ -3720,10 +3708,7 @@ and type_function ?in_function ~async loc attrs env ty_expected_
     with_reset_control_flow (fun () ->
         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
+        let exp = type_expect ~context:None body_env sbody ty_res' in
         {exp with exp_type = instance env ty_res'})
   in
   (if has_gadts then
@@ -4295,9 +4280,8 @@ and type_statement ~context env sexp =
 
 (* Typing of match cases *)
 
-and type_cases ~(call_context : [`LetUnwrap | `Switch | `Function | `Try])
-    ?in_function env ty_arg ty_res partial_flag loc caselist :
-    _ * Typedtree.partial =
+and type_cases ~(call_context : [`LetUnwrap | `Switch | `Function | `Try]) env
+    ty_arg ty_res partial_flag loc caselist : _ * Typedtree.partial =
   (* ty_arg is _fully_ generalized *)
   let patterns = List.map (fun {pc_lhs = p} -> p) caselist in
   let contains_polyvars = List.exists contains_polymorphic_variant patterns in
@@ -4390,7 +4374,6 @@ and type_cases ~(call_context : [`LetUnwrap | `Switch | `Function | `Try])
     end_def ();
     List.iter (iter_pattern (fun {pat_type = t} -> generalize t)) patl);
   (* type bodies *)
-  let in_function = if List.length caselist = 1 then in_function else None in
   let cases =
     List.map2
       (fun (pat, (ext_env, unpacks)) {pc_lhs; pc_guard; pc_rhs} ->
@@ -4417,7 +4400,7 @@ and type_cases ~(call_context : [`LetUnwrap | `Switch | `Function | `Try])
               | `Try -> Some TryReturn
               | `LetUnwrap -> Some LetUnwrapReturn
               | `Function -> None)
-            ?in_function ext_env sexp ty_res'
+            ext_env sexp ty_res'
         in
         {
           c_lhs = pat;
@@ -4926,16 +4909,6 @@ let report_error env loc ppf error =
     | Some valid_methods -> spellcheck ppf me valid_methods)
   | Not_subtype (tr1, tr2, ctx) ->
     report_subtyping_error ppf env tr1 "is not a subtype of" tr2 ctx
-  | Too_many_arguments (in_function, ty) ->
-    if
-      (* modified *)
-      in_function
-    then (
-      fprintf ppf "@[This function expects too many arguments,@ ";
-      fprintf ppf "it should have type@ %a@]" type_expr ty)
-    else (
-      fprintf ppf "@[This expression should not be a function,@ ";
-      fprintf ppf "the expected type is@ %a@]" type_expr ty)
   | Abstract_wrong_label (l, ty) ->
     let label_mark = function
       | Nolabel -> "but its first argument is not labelled"
diff --git a/compiler/ml/typecore.mli b/compiler/ml/typecore.mli
index c9b69d216a4..d309463a790 100644
--- a/compiler/ml/typecore.mli
+++ b/compiler/ml/typecore.mli
@@ -92,7 +92,6 @@ type error =
   | Private_type of type_expr
   | Not_subtype of
       Ctype.type_pairs * Ctype.type_pairs * Ctype.subtype_context option
-  | Too_many_arguments of bool * type_expr
   | Abstract_wrong_label of arg_label * type_expr
   | Scoping_let_module of string * type_expr
   | Not_a_variant_type of Longident.t
diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml
index 2be6efdc095..708dfd75856 100644
--- a/compiler/syntax/src/res_core.ml
+++ b/compiler/syntax/src/res_core.ml
@@ -1915,7 +1915,9 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
         })
       term_parameters
   in
-  let fun_attrs = List.concat_map (fun {attrs} -> attrs) term_parameters in
+  let fun_attrs =
+    List.concat_map (fun (p : fundef_term_param) -> p.attrs) term_parameters
+  in
   let loc =
     match term_parameters with
     | {p_pos = start_pos} :: _ -> mk_loc start_pos end_pos
diff --git a/tests/ERROR_VARIANTS.md b/tests/ERROR_VARIANTS.md
index 057faaf6fa5..17d44f95fcb 100644
--- a/tests/ERROR_VARIANTS.md
+++ b/tests/ERROR_VARIANTS.md
@@ -159,6 +159,11 @@ completely dead and have been retained as named variants:
   `check_value_name` during definition; `let \"->" = 1` is rejected with
   a clean diagnostic (`illegal_value_name.res`). The parser does **not**
   reject `\"->"`.
+- `typecore.Too_many_arguments` — **removed**: with structural n-ary
+  arrows the expected type is committed to an arrow of the function
+  literal's shape up front, so every path that used to reach this error
+  now surfaces as a regular type clash or `Uncurried_arity_mismatch`
+  (`too_many_arguments.res` exercises the latter).
 - `typedecl.Type_clash` — retained but **appears dead**: its only raise
   site (`update_type`) unifies `t<fresh params>` against `t`'s own
   manifest — a type against an alpha-renamed copy of itself — which cannot
@@ -209,7 +214,6 @@ Source: [typecore.ml:27](../compiler/ml/typecore.ml).
 | `Private_type` | ✓ | `private_type_construction.res` | |
 | `Private_label` | ✓ | `private_label.res` | |
 | `Not_subtype` | ✓ | `subtype_*.res`, `coercion_arity_mismatch.res`, `dict_show_no_coercion.res`, etc. | |
-| `Too_many_arguments` | ✓ | `too_many_arguments.res`, `moreArguments*.res` | |
 | `Abstract_wrong_label` | ✓ | `abstract_wrong_label.res` | Multi-arg function literal where an inner argument label doesn't match the expected arrow's label (e.g. `let f: (~a, ~b) => int = (~a, ~c) => …`). |
 | `Scoping_let_module` | ✓ | `scoping_let_module.res` | |
 | `Not_a_variant_type` | ✓ | `variant_spread_pattern_not_a_variant.res` | Pattern-level variant spread of a non-variant type. |

From 28579c8a73f320135feac1cbb9924a6e5eb0aa38 Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Mon, 17 Aug 2026 09:53:23 +0200
Subject: [PATCH 3/6] Eliminate Pjs_fn_make, Pjs_fn_make_unit, and
 unsafe_adjust_to_arity

With structural arity, "function of arity n" is a construction
invariant rather than a goal state: translcore builds every Lfunction
with exactly the parameters its type declares. The arity-enforcement
layer therefore disappears:

- Function literals are emitted directly; the Pjs_fn_make wrapper that
  every function passed through was resolved as a no-op by
  lam_pass_alpha_conversion, but only *after* deep_flatten,
  simplify_exits and simplify_alias had run with the function hidden
  inside an Lprim, acting as an accidental optimization barrier.
- Pjs_fn_make_unit was a one-bit metadata channel: its entire effect
  was setting one_unit_arg so js_exp_make drops the unit parameter.
  translcore now sets the attribute directly, gated on the parameter
  pattern binding no identifiers (a () or _ pattern) - a more
  principled test than the alpha pass's check that the parameter was
  named "param".
- The active-pattern currying split in transl_function is deleted. It
  preserved pattern-effect timing across curried application steps,
  which no longer exist: total applications supply all arguments at
  once and explicit partial application eta-defers the entire call.
  The old output proves the point - the split's closures were
  immediately applied by the arity adapter, so only the allocations
  are gone (see mutable_uncurry_test).
- The I<N> unboxed-record producer (the @this method-callback
  encoding) is removed: the general Record_unboxed translation already
  returns the single field unboxed, and the wrapped value is a literal
  of matching arity.

With no producers left, both primitive constructors and every consumer
arm are deleted, including the 230-line unsafe_adjust_to_arity (its
only callers were the two Pjs_fn_make resolution sites).

On recursive modules: removing the wrapper lets the static
recursive-module compilation path see module members that are plain
functions, replacing the Primitive_module.init/update bootstrap with
hoisted function declarations. This is safe because the static path's
own applicability check now sees the functions it was designed to
check - the wrapper was hiding them, pessimizing compilation - and the
bootstrap demonstrably remains for members that are not plain
functions (rec_module_test keeps its lazy/value cases dynamic).

Verified: stdlib byte-identical; full test suite green; JS output
changes limited to removed adapter closures, removed no-op module
bootstraps, better name preservation, and constant propagation.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
Signed-off-by: Cristiano Calcagno <cristianoc@users.noreply.github.com>
---
 CHANGELOG.md                                  |   1 +
 compiler/core/design.md                       |  15 --
 compiler/core/lam.ml                          |   7 -
 compiler/core/lam_analysis.ml                 |   3 +-
 compiler/core/lam_compile.ml                  |   6 -
 compiler/core/lam_compile_primitive.ml        |   3 +-
 compiler/core/lam_convert.ml                  |   2 -
 compiler/core/lam_eta_conversion.ml           | 230 ------------------
 compiler/core/lam_eta_conversion.mli          |   3 -
 compiler/core/lam_pass_alpha_conversion.ml    |  19 --
 compiler/core/lam_primitive.ml                |  10 +-
 compiler/core/lam_primitive.mli               |   2 -
 compiler/core/lam_print.ml                    |   2 -
 compiler/ml/lambda.ml                         |   2 -
 compiler/ml/lambda.mli                        |   2 -
 compiler/ml/printlambda.ml                    |   2 -
 compiler/ml/translattribute.ml                |   4 +-
 compiler/ml/translcore.ml                     |  73 ++----
 tests/belt_tests/src/rec_module_opt.mjs       |  73 +-----
 .../tests/src/DisambiguateOptionalFields.mjs  |   4 +-
 tests/tests/src/UncurriedAlways.mjs           |  28 +--
 tests/tests/src/a_recursive_type.mjs          |   6 +-
 tests/tests/src/ari_regress_test.mjs          |   8 +-
 tests/tests/src/ast_abstract_test.mjs         |   8 +-
 tests/tests/src/async_inline.mjs              |   8 +-
 tests/tests/src/attr_test.mjs                 |   4 +-
 tests/tests/src/dollar_escape_test.mjs        |  12 +-
 tests/tests/src/flexible_array_test.mjs       |  12 +-
 tests/tests/src/int_poly_var.mjs              |   4 +-
 tests/tests/src/module_parameter_test.mjs     |   2 +-
 tests/tests/src/mutable_uncurry_test.mjs      |  92 +++----
 tests/tests/src/pipe_syntax.mjs               |   8 +-
 tests/tests/src/ppx_apply_test.mjs            |  17 +-
 tests/tests/src/pr6726.mjs                    |   4 +-
 tests/tests/src/rec_module_test.mjs           | 127 ++--------
 tests/tests/src/recursive_module_test.mjs     |  22 +-
 tests/tests/src/submodule.mjs                 |   4 +-
 tests/tests/src/test_ari.mjs                  |   4 +-
 tests/tests/src/test_demo.mjs                 |   7 +-
 tests/tests/src/test_google_closure.mjs       |  13 +-
 tests/tests/src/uncurried_pipe.mjs            |  32 +--
 .../src/expected/TestPpx.res.jsout            |   8 +-
 42 files changed, 171 insertions(+), 722 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index b6e65fb254d..a646b57e284 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -45,6 +45,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
+- Eliminate the `Pjs_fn_make`/`Pjs_fn_make_unit` arity-adjustment primitives and the `unsafe_adjust_to_arity` machinery: with structural arity, functions are constructed at their final arity, so the enforcement layer (and the active-pattern currying split it compensated for) is deleted. Generated code improves: no adapter closures for patterns on mutable fields, better constant propagation and name preservation, and recursive modules whose members are plain functions compile statically without the runtime bootstrap.
 - Cleanups enabled by structural arity: remove the unreachable `Too_many_arguments` error and the `?in_function` threading through the type checker that existed only to decorate it; remove the dead `function$`-vs-arrow unification bridge, `Ctype.arity`, and the unused parsetree arity helpers; deduplicate the analysis arrow-flattening helpers.
 
 - 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.
diff --git a/compiler/core/design.md b/compiler/core/design.md
index a0c0b46d051..6b319d18227 100644
--- a/compiler/core/design.md
+++ b/compiler/core/design.md
@@ -173,20 +173,6 @@ We can simply do inlining, it may have side efffect in `b0`, `b1`, our optimizer
 
 Maybe in the future, we should lift the restriction about `variadic` (delegate to `slow` mode when we can not resolve it statically, my personal expereince is that people will complain about why it fails to compile more than why it is slow in some corner cases)
 
-Note this also interacts with `[@uncurry]`
-
-for example
-
-```ocaml
-external filter : 'a array -> ('a -> bool [@uncurry]) -> 'a array = "filter"
-[@@send]
-
-let f xs =
-    xs |. filter (fun x -> x > 2)
-```
-
-Here whether the callback gets inlined to the call of `filter` will have an effect on how `Pjs_fn_make` gets cancelled.
-
 Note when we pattern match over the original lamba,`Levent` needs to be removed as early as possible. Due to the existence of `Levent`, we can not pattern match over nested original raw lambda.
 
 We turned off event generation temporarily
@@ -474,4 +460,3 @@ we do the optimizer, e.g, `Js_exp_make.int_comp`, we need make sure the peepwhol
 
 
 
-
diff --git a/compiler/core/lam.ml b/compiler/core/lam.ml
index 019d2334587..a3c1e9d06c1 100644
--- a/compiler/core/lam.ml
+++ b/compiler/core/lam.ml
@@ -140,13 +140,6 @@ let rec is_eta_conversion_exn params inner_args outer_args : t list =
   match (params, inner_args, outer_args) with
   | x :: xs, Lvar y :: ys, r :: rest when Ident.same x y ->
     r :: is_eta_conversion_exn xs ys rest
-  | ( x :: xs,
-      Lprim
-        ({primitive = Pjs_fn_make _ | Pjs_fn_make_unit; args = [Lvar y]} as p)
-      :: ys,
-      r :: rest )
-    when Ident.same x y ->
-    Lprim {p with args = [r]} :: is_eta_conversion_exn xs ys rest
   | [], [], [] -> []
   | _, _, _ -> raise_notrace Not_simple_form
 
diff --git a/compiler/core/lam_analysis.ml b/compiler/core/lam_analysis.ml
index 54dac1787b8..d8cd3095328 100644
--- a/compiler/core/lam_analysis.ml
+++ b/compiler/core/lam_analysis.ml
@@ -46,8 +46,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
       | _ -> false)
     | Pcreate_extension _ | Ptypeof | Pis_null | Pis_not_none | Psome
     | Psome_not_nest | Pis_undefined | Pis_null_undefined | Pnull_to_opt
-    | Pnull_undefined_to_opt | Pjs_fn_make _ | Pjs_fn_make_unit
-    | Pjs_object_create _ | Pimport
+    | Pnull_undefined_to_opt | Pjs_object_create _ | Pimport
     (* TODO: check *)
     | Pmakeblock _
     (* whether it's mutable or not *)
diff --git a/compiler/core/lam_compile.ml b/compiler/core/lam_compile.ml
index ad7e08c0024..dfb703f37d5 100644
--- a/compiler/core/lam_compile.ml
+++ b/compiler/core/lam_compile.ml
@@ -1828,12 +1828,6 @@ let compile output_prefix =
                       }
                       body))))
       | _ -> assert false)
-    | {primitive = Pjs_fn_make arity; args = [fn]; loc} ->
-      compile_lambda lambda_cxt
-        (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:arity ?from:None fn)
-    | {primitive = Pjs_fn_make_unit; args = [fn]; loc} ->
-      compile_lambda lambda_cxt fn
-    | {primitive = Pjs_fn_make _; args = [] | _ :: _ :: _} -> assert false
     | {primitive = Pjs_object_create labels; args} ->
       let args_block, args_expr =
         if args = [] then ([], [])
diff --git a/compiler/core/lam_compile_primitive.ml b/compiler/core/lam_compile_primitive.ml
index 47b41b17896..17ef67d9527 100644
--- a/compiler/core/lam_compile_primitive.ml
+++ b/compiler/core/lam_compile_primitive.ml
@@ -155,8 +155,7 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
   | Pis_undefined -> E.is_undef (Ext_list.singleton_exn args)
   | Pis_null_undefined -> E.is_null_undefined (Ext_list.singleton_exn args)
   | Ptypeof -> E.typeof (Ext_list.singleton_exn args)
-  | Pjs_unsafe_downgrade _ | Pdebugger | Pjs_fn_make _ | Pjs_fn_make_unit
-  | Pjs_fn_method ->
+  | Pjs_unsafe_downgrade _ | Pdebugger | Pjs_fn_method ->
     assert false (* already handled by {!Lam_compile} *)
   | Pstringadd -> (
     match args with
diff --git a/compiler/core/lam_convert.ml b/compiler/core/lam_convert.ml
index 49027c85654..fe248d849e6 100644
--- a/compiler/core/lam_convert.ml
+++ b/compiler/core/lam_convert.ml
@@ -315,8 +315,6 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Pis_poly_var_block -> prim ~primitive:Pis_poly_var_block ~args loc
   | Pjs_raw_expr -> assert false
   | Pjs_raw_stmt -> assert false
-  | Pjs_fn_make arity -> prim ~primitive:(Pjs_fn_make arity) ~args loc
-  | Pjs_fn_make_unit -> prim ~primitive:Pjs_fn_make_unit ~args loc
   | Pjs_fn_method -> prim ~primitive:Pjs_fn_method ~args loc
 
 (* Does not exist since we compile array in js backend unlike native backend *)
diff --git a/compiler/core/lam_eta_conversion.ml b/compiler/core/lam_eta_conversion.ml
index 320ecd41647..058af703b82 100644
--- a/compiler/core/lam_eta_conversion.ml
+++ b/compiler/core/lam_eta_conversion.ml
@@ -73,233 +73,3 @@ let transform_under_supply n ap_info fn args =
     Ext_list.fold_left bindings rest (fun lam (id, x) ->
         Lam.let_ Strict id x lam)
   | _, _ -> assert false
-
-(* Invariant: mk0 : (unit -> 'a0) -> 'a0 t
-                TODO: this case should be optimized,
-                we need check where we handle [arity=0]
-                as a special case --
-                if we do an optimization before compiling
-                into lambda
-
-   {[Fn.mk0]} is not intended for use by normal users
-
-   so we assume [Fn.mk0] is only used in such cases
-   {[
-     Fn.mk0 (fun _ -> .. )
-   ]}
-   when it is passed as a function directly
-*)
-(*TODO: can be optimized ?
-  {[\ x y -> (\u -> body x) x y]}
-  {[\u x -> body x]}
-    rewrite rules
-  {[
-    \x -> body
-          --
-          \y (\x -> body ) y
-  ]}
-  {[\ x y -> (\a b c -> g a b c) x y]}
-  {[ \a b -> \c -> g a b c ]}
-*)
-
-(** Unsafe function, we are changing arity here, it should be applied 
-    cautiously, since 
-    [let u = f] and we are chaning the arity of [f] it will affect 
-    the collection of [u]
-    A typical use case is to pass an OCaml function to JS side as a callback (i.e, [@uncurry])
-*)
-let unsafe_adjust_to_arity loc ~(to_ : int) ?(from : int option) (fn : Lam.t) :
-    Lam.t =
-  let ap_info : Lam.ap_info =
-    {ap_loc = loc; ap_inlined = Default_inline; ap_status = App_na}
-  in
-  let is_async_fn =
-    match fn with
-    | Lfunction {attr = {async}} -> async
-    | _ -> false
-  in
-  match (from, fn) with
-  | Some from, _ | None, Lfunction {arity = from} -> (
-    if from = to_ || is_async_fn then fn
-    else if to_ = 0 then
-      match fn with
-      | Lfunction {params = [param]; body; loc} ->
-        Lam.function_ ~loc ~arity:0 ~attr:Lambda.default_function_attribute
-          ~params:[]
-          ~body:(Lam.let_ Alias param Lam.unit body)
-        (* could be only introduced by
-           {[ Pjs_fn_make 0 ]} <-
-           {[ fun [@bs] () -> .. ]}
-        *)
-      | _ -> (
-        let wrapper, new_fn =
-          match fn with
-          | Lvar _
-          | Lprim
-              {
-                primitive = Pfield (_, Fld_module _);
-                args = [(Lglobal_module _ | Lvar _)];
-                _;
-              } ->
-            (None, fn)
-          | _ ->
-            let partial_arg = Ext_ident.create Literals.partial_arg in
-            (Some partial_arg, Lam.var partial_arg)
-        in
-
-        let cont =
-          Lam.function_ ~loc ~attr:Lambda.default_function_attribute ~arity:0
-            ~params:[]
-            ~body:(Lam.apply new_fn [Lam.unit] ap_info)
-        in
-
-        match wrapper with
-        | None -> cont
-        | Some partial_arg -> Lam.let_ Strict partial_arg fn cont)
-    else if to_ > from then
-      match fn with
-      | Lfunction {params; body; loc} ->
-        (* {[fun x -> f]} ->
-           {[ fun x y -> f y ]}
-        *)
-        let extra_args =
-          Ext_list.init (to_ - from) (fun _ -> Ident.create Literals.param)
-        in
-        let rec mk_apply body vars =
-          match vars with
-          | [] -> body
-          | var :: vars -> mk_apply (Lam.apply body [var] ap_info) vars
-        in
-        Lam.function_ ~loc ~attr:Lambda.default_function_attribute ~arity:to_
-          ~params:(Ext_list.append params extra_args)
-          ~body:(mk_apply body (Ext_list.map extra_args Lam.var))
-      | _ -> (
-        let arity = to_ in
-        let extra_args =
-          Ext_list.init to_ (fun _ -> Ident.create Literals.param)
-        in
-        let wrapper, new_fn =
-          match fn with
-          | Lvar _
-          | Lprim
-              {
-                primitive = Pfield (_, Fld_module _);
-                args = [(Lglobal_module _ | Lvar _)];
-                _;
-              } ->
-            (None, fn)
-          | _ ->
-            let partial_arg = Ext_ident.create Literals.partial_arg in
-            (Some partial_arg, Lam.var partial_arg)
-        in
-        let cont =
-          Lam.function_ ~loc ~arity ~attr:Lambda.default_function_attribute
-            ~params:extra_args
-            ~body:
-              (let first_args, rest_args = Ext_list.split_at extra_args from in
-               Lam.apply
-                 (Lam.apply new_fn
-                    (Ext_list.map first_args Lam.var)
-                    {ap_info with ap_status = App_infer_full})
-                 (Ext_list.map rest_args Lam.var)
-                 ap_info)
-        in
-        match wrapper with
-        | None -> cont
-        | Some partial_arg -> Lam.let_ Strict partial_arg fn cont)
-    else
-      (* add3  --adjust to arity 1 ->
-         fun x -> (fun y z -> add3 x y z )
-
-         [fun x y z -> f x y z ]
-         [fun x -> [fun y z -> f x y z ]]
-         This is okay if the function is not held by other..
-      *)
-      match fn with
-      | Lfunction {params; body; loc}
-      (* TODO check arity = List.length params in debug mode *) ->
-        let arity = to_ in
-        let extra_outer_args, extra_inner_args =
-          Ext_list.split_at params arity
-        in
-        Lam.function_ ~loc ~arity ~attr:Lambda.default_function_attribute
-          ~params:extra_outer_args
-          ~body:
-            (Lam.function_ ~loc ~arity:(from - to_)
-               ~attr:Lambda.default_function_attribute ~params:extra_inner_args
-               ~body)
-      | _ -> (
-        let extra_outer_args =
-          Ext_list.init to_ (fun _ -> Ident.create Literals.param)
-        in
-        let wrapper, new_fn =
-          match fn with
-          | Lvar _
-          | Lprim
-              {
-                primitive = Pfield (_, Fld_module _);
-                args = [(Lglobal_module _ | Lvar _)];
-                _;
-              } ->
-            (None, fn)
-          | _ ->
-            let partial_arg = Ext_ident.create Literals.partial_arg in
-            (Some partial_arg, Lam.var partial_arg)
-        in
-        let cont =
-          Lam.function_ ~loc ~arity:to_ ~params:extra_outer_args
-            ~attr:Lambda.default_function_attribute
-            ~body:
-              (let arity = from - to_ in
-               let extra_inner_args =
-                 Ext_list.init arity (fun _ -> Ident.create Literals.param)
-               in
-               Lam.function_ ~loc ~arity ~params:extra_inner_args
-                 ~attr:Lambda.default_function_attribute
-                 ~body:
-                   (Lam.apply new_fn
-                      (Ext_list.map_append extra_outer_args
-                         (Ext_list.map extra_inner_args Lam.var)
-                         Lam.var)
-                      {ap_info with ap_status = App_infer_full}))
-        in
-        match wrapper with
-        | None -> cont
-        | Some partial_arg -> Lam.let_ Strict partial_arg fn cont))
-  | None, _ ->
-    (* In this case [fn] is not [Lfunction], otherwise we would get [arity] *)
-    if to_ = 0 then
-      let wrapper, new_fn =
-        match fn with
-        | Lvar _
-        | Lprim
-            {
-              primitive = Pfield (_, Fld_module _);
-              args = [(Lglobal_module _ | Lvar _)];
-              _;
-            } ->
-          (None, fn)
-        | _ ->
-          let partial_arg = Ext_ident.create Literals.partial_arg in
-          (Some partial_arg, Lam.var partial_arg)
-      in
-
-      let cont =
-        Lam.function_ ~loc ~attr:Lambda.default_function_attribute ~arity:0
-          ~params:[]
-          ~body:(Lam.apply new_fn [Lam.unit] ap_info)
-      in
-
-      match wrapper with
-      | None -> cont
-      | Some partial_arg -> Lam.let_ Strict partial_arg fn cont
-    else transform_under_supply to_ ap_info fn []
-
-(* | _ ->
-   let partial_arg = Ext_ident.create Literals.partial_arg in
-   Lam.let_ Strict partial_arg fn
-    (let arity = to_ in
-     let extra_args = Ext_list.init arity (fun _ -> Ident.create Literals.param) in
-     Lam.function_ ~arity ~kind:Curried ~params:extra_args
-       ~body:(Lam.apply fn (Ext_list.map Lam.var extra_args ) loc Lam.App_na )
-    ) *)
diff --git a/compiler/core/lam_eta_conversion.mli b/compiler/core/lam_eta_conversion.mli
index 2b8da1e78ac..9696587e2c6 100644
--- a/compiler/core/lam_eta_conversion.mli
+++ b/compiler/core/lam_eta_conversion.mli
@@ -29,6 +29,3 @@
 *)
 
 val transform_under_supply : int -> Lam.ap_info -> Lam.t -> Lam.t list -> Lam.t
-
-val unsafe_adjust_to_arity :
-  Location.t -> to_:int -> ?from:int -> Lam.t -> Lam.t
diff --git a/compiler/core/lam_pass_alpha_conversion.ml b/compiler/core/lam_pass_alpha_conversion.ml
index 8ab29e4ca75..e8ec2a51b12 100644
--- a/compiler/core/lam_pass_alpha_conversion.ml
+++ b/compiler/core/lam_pass_alpha_conversion.ml
@@ -64,25 +64,6 @@ let alpha_conversion (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
       let bindings = Ext_list.map_snd bindings simpl in
       Lam.letrec bindings (simpl body)
     | Lglobal_module _ -> lam
-    | Lprim {primitive = Pjs_fn_make len as primitive; args = [arg]; loc} -> (
-      match
-        Lam_arity.get_first_arity (Lam_arity_analysis.get_arity meta arg)
-      with
-      | Some x ->
-        let arg = simpl arg in
-        Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:len ~from:x arg
-      | None -> Lam.prim ~primitive ~args:[simpl arg] loc)
-    | Lprim {primitive = Pjs_fn_make_unit; args = [arg]; loc} ->
-      let arg =
-        match arg with
-        | Lfunction {arity = 1; params = [x]; attr; body; loc}
-          when Ident.name x = "param" (* "()" *) ->
-          Lam.function_ ~loc ~params:[x]
-            ~attr:{attr with one_unit_arg = true}
-            ~body ~arity:1
-        | _ -> arg
-      in
-      simpl arg
     | Lprim {primitive; args; loc} ->
       Lam.prim ~primitive ~args:(Ext_list.map args simpl) loc
     | Lfunction {arity; params; body; attr; loc} ->
diff --git a/compiler/core/lam_primitive.ml b/compiler/core/lam_primitive.ml
index 18467698ad6..a1ea361b259 100644
--- a/compiler/core/lam_primitive.ml
+++ b/compiler/core/lam_primitive.ml
@@ -157,8 +157,6 @@ type t =
   | Pinit_mod
   | Pupdate_mod
   | Praw_js_code of Js_raw_info.t
-  | Pjs_fn_make of int
-  | Pjs_fn_make_unit
   (* we wrap it when do the conversion to prevent
      accendential optimization
      play safe first
@@ -230,8 +228,8 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
   | Psome_not_nest | Pis_undefined | Pis_null_undefined | Pimport | Ptypeof
   | Pfn_arity | Pis_poly_var_block | Pdebugger | Pinit_mod | Pupdate_mod
   | Pduprecord | Pmakearray | Parraylength | Parrayrefu | Parraysetu
-  | Parrayrefs | Parraysets | Pjs_fn_make_unit | Pjs_fn_method | Phash
-  | Phash_mixstring | Phash_mixint | Phash_finalmix | Precord_rest _ ->
+  | Parrayrefs | Parraysets | Pjs_fn_method | Phash | Phash_mixstring
+  | Phash_mixint | Phash_finalmix | Precord_rest _ ->
     rhs = lhs
   (* Reachable only via the optimizer's term-equality comparison, which the
      test suite doesn't exercise for tagged templates. *)
@@ -300,9 +298,5 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
     match rhs with
     | Pjs_unsafe_downgrade rhs -> name = rhs.name && setter = rhs.setter
     | _ -> false)
-  | Pjs_fn_make i -> (
-    match rhs with
-    | Pjs_fn_make i1 -> i = i1
-    | _ -> false)
   | Praw_js_code _ -> false
 (* TOO lazy, here comparison is only approximation*)
diff --git a/compiler/core/lam_primitive.mli b/compiler/core/lam_primitive.mli
index 561c9e31255..238045e9f4c 100644
--- a/compiler/core/lam_primitive.mli
+++ b/compiler/core/lam_primitive.mli
@@ -151,8 +151,6 @@ type t =
   | Pinit_mod
   | Pupdate_mod
   | Praw_js_code of Js_raw_info.t
-  | Pjs_fn_make of int
-  | Pjs_fn_make_unit
   | Pjs_fn_method
   | Pnull_to_opt
   | Pnull_undefined_to_opt
diff --git a/compiler/core/lam_print.ml b/compiler/core/lam_print.ml
index 3c9122fba00..dd692e8842a 100644
--- a/compiler/core/lam_print.ml
+++ b/compiler/core/lam_print.ml
@@ -56,8 +56,6 @@ let primitive ppf (prim : Lam_primitive.t) =
   | Pjs_unsafe_downgrade {name; setter} ->
     if setter then fprintf ppf "##%s#=" name else fprintf ppf "##%s" name
   | Pfn_arity -> fprintf ppf "fn.length"
-  | Pjs_fn_make i -> fprintf ppf "js_fn_make_%i" i
-  | Pjs_fn_make_unit -> fprintf ppf "js_fn_make_unit"
   | Pjs_fn_method -> fprintf ppf "js_fn_method"
   | Pdebugger -> fprintf ppf "debugger"
   | Praw_js_code _ -> fprintf ppf "[raw]"
diff --git a/compiler/ml/lambda.ml b/compiler/ml/lambda.ml
index 8dd296b2707..987d844ddd6 100644
--- a/compiler/ml/lambda.ml
+++ b/compiler/ml/lambda.ml
@@ -300,8 +300,6 @@ type primitive =
   | Pis_poly_var_block
   | Pjs_raw_expr
   | Pjs_raw_stmt
-  | Pjs_fn_make of int
-  | Pjs_fn_make_unit
   | Pjs_fn_method
   (* Tagged template literal: [tag; strings_array; values_array] *)
   | Ptagged_template
diff --git a/compiler/ml/lambda.mli b/compiler/ml/lambda.mli
index 3a4ae0f9049..efe4d9802b5 100644
--- a/compiler/ml/lambda.mli
+++ b/compiler/ml/lambda.mli
@@ -273,8 +273,6 @@ type primitive =
   | Pis_poly_var_block
   | Pjs_raw_expr
   | Pjs_raw_stmt
-  | Pjs_fn_make of int
-  | Pjs_fn_make_unit
   | Pjs_fn_method
   | Ptagged_template
 
diff --git a/compiler/ml/printlambda.ml b/compiler/ml/printlambda.ml
index 681f33a98ba..adbe108c1b2 100644
--- a/compiler/ml/printlambda.ml
+++ b/compiler/ml/printlambda.ml
@@ -260,8 +260,6 @@ let primitive ppf = function
   | Pis_poly_var_block -> fprintf ppf "#is_poly_var_block"
   | Pjs_raw_expr -> fprintf ppf "#raw_expr"
   | Pjs_raw_stmt -> fprintf ppf "#raw_stmt"
-  | Pjs_fn_make arity -> fprintf ppf "#fn_mk(%d)" arity
-  | Pjs_fn_make_unit -> fprintf ppf "#fn_mk_unit"
   | Pjs_fn_method -> fprintf ppf "#fn_method"
   (* Debug-only dump, exercised solely under -drawlambda/-dlambda. *)
   | Ptagged_template -> fprintf ppf "#tagged_template" [@coverage off]
diff --git a/compiler/ml/translattribute.ml b/compiler/ml/translattribute.ml
index 11043f688a5..7c9c9a7a0a0 100644
--- a/compiler/ml/translattribute.ml
+++ b/compiler/ml/translattribute.ml
@@ -66,7 +66,7 @@ let get_inline_attribute l =
   let attr, _ = find_attribute is_inline_attribute l in
   parse_inline_attribute attr
 
-let rec add_inline_attribute (expr : Lambda.lambda) loc attributes =
+let add_inline_attribute (expr : Lambda.lambda) loc attributes =
   match (expr, get_inline_attribute attributes) with
   | expr, Default_inline -> expr
   | Lfunction ({attr} as funct), inline ->
@@ -76,8 +76,6 @@ let rec add_inline_attribute (expr : Lambda.lambda) loc attributes =
       Location.prerr_warning loc (Warnings.Duplicated_attribute "inline"));
     let attr = {attr with inline} in
     Lfunction {funct with attr}
-  | Lprim (((Pjs_fn_make _ | Pjs_fn_make_unit) as p), [e], l), _ ->
-    Lambda.Lprim (p, [add_inline_attribute e loc attributes], l)
   | expr, Always_inline ->
     Location.prerr_warning loc (Warnings.Misplaced_attribute "inline");
     expr
diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml
index 3e6be9bc248..6a55f5d0264 100644
--- a/compiler/ml/translcore.ml
+++ b/compiler/ml/translcore.ml
@@ -618,8 +618,16 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
       | None -> None
       | Some (directive, _) -> Some directive
     in
-    let arity = List.length fparams in
     let params, lbody, return_unit = transl_function e.exp_loc fparams body in
+    let one_unit_arg =
+      match (fparams, (Ctype.expand_head e.exp_env e.exp_type).desc) with
+      | [{fp_pat}], Tarrow ([{lbl = Nolabel; typ}], _)
+        when Typedtree.pat_bound_idents fp_pat = [] -> (
+        match (Ctype.expand_head e.exp_env typ).desc with
+        | Tconstr (Pident {name = "unit"}, [], _) -> true
+        | _ -> false)
+      | _ -> false
+    in
     let attr =
       {
         default_function_attribute with
@@ -627,23 +635,11 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
         async;
         return_unit;
         directive;
+        one_unit_arg;
       }
     in
     let loc = e.exp_loc in
-    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 )
+    Lfunction {params; body = lbody; attr; loc}
   | Texp_apply {funct; args = oargs}
     when List.exists
            (fun (attr, _) -> attr.txt = "res.taggedTemplate")
@@ -1016,33 +1012,12 @@ and transl_function loc (params : function_param list) 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 )
+    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 )
 
 and transl_let rec_flag pat_expr_list body =
   match rec_flag with
@@ -1080,20 +1055,6 @@ and transl_let rec_flag pat_expr_list body =
 
 and transl_record loc env fields repres opt_init_expr =
   match (opt_init_expr, repres, fields) with
-  | None, Record_unboxed _, [|({lbl_name; lbl_loc}, Overridden (_, expr), _)|]
-    ->
-    (* ReScript uncurried encoding *)
-    let loc = lbl_loc in
-    let lambda = transl_exp expr in
-    if lbl_name.[0] = 'I' then
-      let arity_s = String.sub lbl_name 1 (String.length lbl_name - 1) in
-      let arity = Int32.of_string arity_s |> Int32.to_int in
-      Lprim
-        ( Pjs_fn_make arity,
-          (* could be replaced with Opaque in the future except arity 0*)
-          [lambda],
-          loc )
-    else lambda
   | _ -> (
     let size = Array.length fields in
     let optional =
diff --git a/tests/belt_tests/src/rec_module_opt.mjs b/tests/belt_tests/src/rec_module_opt.mjs
index 34577f8c6b0..65f54fb4e3c 100644
--- a/tests/belt_tests/src/rec_module_opt.mjs
+++ b/tests/belt_tests/src/rec_module_opt.mjs
@@ -1,23 +1,8 @@
 // Generated by ReScript, PLEASE EDIT WITH CARE
 
 import * as Belt_Id from "@rescript/belt/lib/es6/src/Belt_Id.mjs";
-import * as Primitive_module from "@rescript/runtime/lib/es6/Primitive_module.mjs";
 import * as Primitive_string from "@rescript/runtime/lib/es6/Primitive_string.mjs";
 
-let A = Primitive_module.init([
-  "rec_module_opt.res",
-  13,
-  4
-], {
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "cmp"
-    ]]
-});
-
-let AComparable = Belt_Id.MakeComparable(A);
-
 function cmp(t1, t2) {
   if (t1.TAG === "Leaf") {
     if (t2.TAG === "Leaf") {
@@ -32,71 +17,31 @@ function cmp(t1, t2) {
   }
 }
 
-Primitive_module.update({
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "cmp"
-    ]]
-}, A, {
+let A = {
   cmp: cmp
-});
+};
+
+let AComparable = Belt_Id.MakeComparable(A);
 
 let X0 = {};
 
 let Y0 = {};
 
-let X1 = Primitive_module.init([
-  "rec_module_opt.res",
-  42,
-  19
-], {
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "f"
-    ]]
-});
-
-let Y1 = Primitive_module.init([
-  "rec_module_opt.res",
-  45,
-  12
-], {
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "f"
-    ]]
-});
-
 function f(x) {
   return x + 1 | 0;
 }
 
-Primitive_module.update({
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "f"
-    ]]
-}, X1, {
+let X1 = {
   f: f
-});
+};
 
 function f$1(x) {
   return x + 2 | 0;
 }
 
-Primitive_module.update({
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "f"
-    ]]
-}, Y1, {
+let Y1 = {
   f: f$1
-});
+};
 
 let X;
 
@@ -109,4 +54,4 @@ export {
   X1,
   Y1,
 }
-/* A Not a pure module */
+/* AComparable Not a pure module */
diff --git a/tests/tests/src/DisambiguateOptionalFields.mjs b/tests/tests/src/DisambiguateOptionalFields.mjs
index ac27a889db9..51a529dd30d 100644
--- a/tests/tests/src/DisambiguateOptionalFields.mjs
+++ b/tests/tests/src/DisambiguateOptionalFields.mjs
@@ -9,13 +9,13 @@ function f2(v) {
   return v.x;
 }
 
-let res = 3;
-
 let v = {
   x: 3,
   y: 4
 };
 
+let res = 3;
+
 export {
   f1,
   f2,
diff --git a/tests/tests/src/UncurriedAlways.mjs b/tests/tests/src/UncurriedAlways.mjs
index ca174051882..6b701e35e78 100644
--- a/tests/tests/src/UncurriedAlways.mjs
+++ b/tests/tests/src/UncurriedAlways.mjs
@@ -5,19 +5,11 @@ function foo(x, y) {
   return x + y | 0;
 }
 
-let z = 7;
-
 function bar(x, y) {
   return x + y | 0;
 }
 
-let b = 7;
-
-let w = 7;
-
-let a = 7;
-
-console.log(a);
+console.log(7);
 
 [1].map(x => x + 1 | 0);
 
@@ -168,7 +160,7 @@ function fn1(a, b, param) {
   return a() + b | 0;
 }
 
-function a$1(__x) {
+function a(__x) {
   return 3;
 }
 
@@ -221,10 +213,10 @@ function f(a, b, c) {
 
 function f2(a, b, c, d, e) {
   let __tuple_internal_obj = a(b);
-  let param_0 = c(__tuple_internal_obj, d);
-  let param_1 = d(__tuple_internal_obj, 1, 2);
-  let param_2 = e(__tuple_internal_obj);
-  return (param_0 + param_1 | 0) + param_2 | 0;
+  let u = c(__tuple_internal_obj, d);
+  let v = d(__tuple_internal_obj, 1, 2);
+  let h = e(__tuple_internal_obj);
+  return (u + v | 0) + h | 0;
 }
 
 function f3$1(foo, x) {
@@ -242,6 +234,12 @@ let Pipe = {
   f4: f4
 };
 
+let z = 7;
+
+let b = 7;
+
+let w = 7;
+
 export {
   foo,
   z,
@@ -261,7 +259,7 @@ export {
   OptMixed,
   fn,
   fn1,
-  a$1 as a,
+  a,
   PartialApplication,
   ReverseApplication,
   Pipe,
diff --git a/tests/tests/src/a_recursive_type.mjs b/tests/tests/src/a_recursive_type.mjs
index e4fd7b89ea6..5c63e4168fc 100644
--- a/tests/tests/src/a_recursive_type.mjs
+++ b/tests/tests/src/a_recursive_type.mjs
@@ -10,10 +10,12 @@ let loop = g({
   _0: g
 });
 
-let non_terminate = g({
+let x = {
   TAG: "A",
   _0: g
-});
+};
+
+let non_terminate = g(x);
 
 let xx = {};
 
diff --git a/tests/tests/src/ari_regress_test.mjs b/tests/tests/src/ari_regress_test.mjs
index 4bc6c918bca..15fe3c580fc 100644
--- a/tests/tests/src/ari_regress_test.mjs
+++ b/tests/tests/src/ari_regress_test.mjs
@@ -3,8 +3,6 @@
 import * as Mocha from "mocha";
 import * as Test_utils from "./test_utils.mjs";
 
-let g = 7;
-
 let h = {
   contents: 0
 };
@@ -15,16 +13,14 @@ function g1(x, y) {
   return (xx, yy) => (xx + yy | 0) + u | 0;
 }
 
-let u = 8;
-
-let x = u + 6 | 0;
+let x = 14;
 
 function v(__x) {
   return g1(3, 4)(6, __x);
 }
 
 Mocha.describe("Ari_regress_test", () => {
-  Mocha.test("curry", () => Test_utils.eq("File \"ari_regress_test.res\", line 25, characters 7-14", g, 7));
+  Mocha.test("curry", () => Test_utils.eq("File \"ari_regress_test.res\", line 25, characters 7-14", 7, 7));
   Mocha.test("curry2", () => Test_utils.eq("File \"ari_regress_test.res\", line 30, characters 6-13", 14, (v(1), v(1))));
   Mocha.test("curry3", () => Test_utils.eq("File \"ari_regress_test.res\", line 40, characters 7-14", x, 14));
   Mocha.test("ref count", () => Test_utils.eq("File \"ari_regress_test.res\", line 44, characters 7-14", h.contents, 2));
diff --git a/tests/tests/src/ast_abstract_test.mjs b/tests/tests/src/ast_abstract_test.mjs
index 5bb18b893bc..8c43e67f24a 100644
--- a/tests/tests/src/ast_abstract_test.mjs
+++ b/tests/tests/src/ast_abstract_test.mjs
@@ -46,16 +46,16 @@ function idx(v) {
   Test_utils.eq("File \"ast_abstract_test.res\", line 21, characters 18-25", xFromJs(v), v);
 }
 
-let x0 = "a";
-
-let x1 = "b";
-
 Mocha.describe("Ast_abstract_test", () => {
   Mocha.test("jsConverter roundtrip for #a", () => idx("a"));
   Mocha.test("jsConverter roundtrip for #b", () => idx("b"));
   Mocha.test("jsConverter roundtrip for #c", () => idx("c"));
 });
 
+let x0 = "a";
+
+let x1 = "b";
+
 export {
   tToJs,
   tFromJs,
diff --git a/tests/tests/src/async_inline.mjs b/tests/tests/src/async_inline.mjs
index e5d8b12954d..bf094dafb11 100644
--- a/tests/tests/src/async_inline.mjs
+++ b/tests/tests/src/async_inline.mjs
@@ -54,12 +54,8 @@ async function uncurriedIdAsync(x) {
   return x;
 }
 
-let tci = 3;
-
 let tcia = curriedIdAsync(3);
 
-let tui = 3;
-
 let tuia = uncurriedIdAsync(3);
 
 function nested1() {
@@ -74,6 +70,10 @@ function onSubmit() {
   return React.useCallback(async b => await b);
 }
 
+let tci = 3;
+
+let tui = 3;
+
 export {
   willBeInlined,
   inlined,
diff --git a/tests/tests/src/attr_test.mjs b/tests/tests/src/attr_test.mjs
index d839ca7232a..ead63203f0b 100644
--- a/tests/tests/src/attr_test.mjs
+++ b/tests/tests/src/attr_test.mjs
@@ -5,8 +5,6 @@ function u(x, y) {
   return x + y | 0;
 }
 
-let h = 3;
-
 function max2(x, y) {
   return x + y;
 }
@@ -19,6 +17,8 @@ function f(x) {
   });
 }
 
+let h = 3;
+
 export {
   u,
   h,
diff --git a/tests/tests/src/dollar_escape_test.mjs b/tests/tests/src/dollar_escape_test.mjs
index 987895a6e7c..ec3bcdbe91b 100644
--- a/tests/tests/src/dollar_escape_test.mjs
+++ b/tests/tests/src/dollar_escape_test.mjs
@@ -7,21 +7,21 @@ function $$(x, y) {
   return x + y | 0;
 }
 
-let v = 3;
-
 function $$$plus(x, y) {
   return x * y | 0;
 }
 
-let u = 3;
-
 Mocha.describe("Dollar_escape_test", () => {
   Mocha.test("dollar escape operators", () => {
-    Test_utils.eq("File \"dollar_escape_test.res\", line 14, characters 7-14", v, 3);
-    Test_utils.eq("File \"dollar_escape_test.res\", line 15, characters 7-14", u, 3);
+    Test_utils.eq("File \"dollar_escape_test.res\", line 14, characters 7-14", 3, 3);
+    Test_utils.eq("File \"dollar_escape_test.res\", line 15, characters 7-14", 3, 3);
   });
 });
 
+let v = 3;
+
+let u = 3;
+
 export {
   $$,
   v,
diff --git a/tests/tests/src/flexible_array_test.mjs b/tests/tests/src/flexible_array_test.mjs
index 10c14996b35..828bebd0e88 100644
--- a/tests/tests/src/flexible_array_test.mjs
+++ b/tests/tests/src/flexible_array_test.mjs
@@ -288,14 +288,16 @@ let u = of_array([
   6
 ]);
 
-if (!$eq$tilde(sort(u), [
+let x = sort(u);
+
+if (!Primitive_object.equal(x, of_array([
     1,
     2,
     2,
     3,
     5,
     6
-  ])) {
+  ]))) {
   throw {
     RE_EXN_ID: "Assert_failure",
     _1: [
@@ -309,7 +311,11 @@ if (!$eq$tilde(sort(u), [
 
 let v = Stdlib_Array.fromInitializer(500, i => 500 - i | 0);
 
-$eq$tilde(sort(of_array(v)), Stdlib_Array.fromInitializer(500, i => i + 1 | 0));
+let y = Stdlib_Array.fromInitializer(500, i => i + 1 | 0);
+
+let x$1 = sort(of_array(v));
+
+Primitive_object.equal(x$1, of_array(y));
 
 export {
   sub,
diff --git a/tests/tests/src/int_poly_var.mjs b/tests/tests/src/int_poly_var.mjs
index 0df33e30b3f..46de8352006 100644
--- a/tests/tests/src/int_poly_var.mjs
+++ b/tests/tests/src/int_poly_var.mjs
@@ -58,8 +58,6 @@ function h(x) {
   return x === 0;
 }
 
-let g = /* 'b' */98;
-
 let hihi = f3(3, 0);
 
 let hh10 = "3" === 3;
@@ -166,6 +164,8 @@ Mocha.describe("Int_poly_var", () => {
 
 let u = 1;
 
+let g = /* 'b' */98;
+
 let hh9 = true;
 
 let begin = 3;
diff --git a/tests/tests/src/module_parameter_test.mjs b/tests/tests/src/module_parameter_test.mjs
index 87464a30df7..f189982ffbe 100644
--- a/tests/tests/src/module_parameter_test.mjs
+++ b/tests/tests/src/module_parameter_test.mjs
@@ -22,7 +22,7 @@ function v(x) {
 
 Mocha.describe("Module_parameter_test", () => {
   Mocha.test("const", () => Test_utils.eq("File \"module_parameter_test.res\", line 24, characters 7-14", 1, v0));
-  Mocha.test("other", () => Test_utils.eq("File \"module_parameter_test.res\", line 28, characters 7-14", 3, v("abc")));
+  Mocha.test("other", () => Test_utils.eq("File \"module_parameter_test.res\", line 28, characters 7-14", 3, "abc".length));
 });
 
 export {
diff --git a/tests/tests/src/mutable_uncurry_test.mjs b/tests/tests/src/mutable_uncurry_test.mjs
index be465216199..ec8122f7eaf 100644
--- a/tests/tests/src/mutable_uncurry_test.mjs
+++ b/tests/tests/src/mutable_uncurry_test.mjs
@@ -34,77 +34,57 @@ function t3(param, param$1, param$2) {
 function ut4(param, param$1, param$2, param$3) {
   let x0 = param.contents;
   let x1 = param$1.contents;
-  return (param => {
-    let x2 = param.contents;
-    return param => {
-      let x3 = param.contents;
-      return [
-        x0,
-        x1,
-        x2,
-        x3
-      ];
-    };
-  })(param$2)(param$3);
+  let x2 = param$2.contents;
+  let x3 = param$3.contents;
+  return [
+    x0,
+    x1,
+    x2,
+    x3
+  ];
 }
 
 function t4(param, param$1, param$2, param$3) {
   let x0 = param.contents;
   let x1 = param$1.contents;
-  return (param => {
-    let x2 = param.contents;
-    return param => {
-      let x3 = param.contents;
-      return [
-        x0,
-        x1,
-        x2,
-        x3
-      ];
-    };
-  })(param$2)(param$3);
+  let x2 = param$2.contents;
+  let x3 = param$3.contents;
+  return [
+    x0,
+    x1,
+    x2,
+    x3
+  ];
 }
 
 function ut5(param, param$1, param$2, param$3, param$4) {
   let x0 = param.contents;
   let x1 = param$1.contents;
-  return (param => {
-    let x2 = param.contents;
-    return param => {
-      let x3 = param.contents;
-      return param => {
-        let x4 = param.contents;
-        return [
-          x0,
-          x1,
-          x2,
-          x3,
-          x4
-        ];
-      };
-    };
-  })(param$2)(param$3)(param$4);
+  let x2 = param$2.contents;
+  let x3 = param$3.contents;
+  let x4 = param$4.contents;
+  return [
+    x0,
+    x1,
+    x2,
+    x3,
+    x4
+  ];
 }
 
 function t5(param, param$1, param$2, param$3, param$4) {
   let x0 = param.contents;
   let x1 = param$1.contents;
-  return (param => {
-    let x2 = param.contents;
-    return param => {
-      let x3 = param.contents;
-      return param => {
-        let x4 = param.contents;
-        return [
-          x0,
-          x1,
-          x2,
-          x3,
-          x4
-        ];
-      };
-    };
-  })(param$2)(param$3)(param$4);
+  let x2 = param$2.contents;
+  let x3 = param$3.contents;
+  let x4 = param$4.contents;
+  return [
+    x0,
+    x1,
+    x2,
+    x3,
+    x4
+  ];
 }
 
 function nested0(param, param$1, param$2) {
diff --git a/tests/tests/src/pipe_syntax.mjs b/tests/tests/src/pipe_syntax.mjs
index ed1ec40fed8..9606f24960e 100644
--- a/tests/tests/src/pipe_syntax.mjs
+++ b/tests/tests/src/pipe_syntax.mjs
@@ -42,10 +42,10 @@ function f2(a, b, c, d) {
 
 function f3(a, b, c, d, e) {
   let __tuple_internal_obj = a(b);
-  let param_0 = c(__tuple_internal_obj, d);
-  let param_1 = d(__tuple_internal_obj, 1, 2);
-  let param_2 = e(__tuple_internal_obj);
-  return (param_0 + param_1 | 0) + param_2 | 0;
+  let u = c(__tuple_internal_obj, d);
+  let v = d(__tuple_internal_obj, 1, 2);
+  let h = e(__tuple_internal_obj);
+  return (u + v | 0) + h | 0;
 }
 
 function f4(a, b, c) {
diff --git a/tests/tests/src/ppx_apply_test.mjs b/tests/tests/src/ppx_apply_test.mjs
index 7448a293511..b5aa2e665a5 100644
--- a/tests/tests/src/ppx_apply_test.mjs
+++ b/tests/tests/src/ppx_apply_test.mjs
@@ -3,8 +3,6 @@
 import * as Mocha from "mocha";
 import * as Test_utils from "./test_utils.mjs";
 
-let u = 3;
-
 function nullary() {
   return 3;
 }
@@ -13,27 +11,26 @@ function unary(a) {
   return a + 3 | 0;
 }
 
-let xx = 6;
-
-Mocha.test("ppx_apply_test_unary", () => Test_utils.eq("File \"ppx_apply_test.res\", line 12, characters 5-12", u, 3));
+Mocha.test("ppx_apply_test_unary", () => Test_utils.eq("File \"ppx_apply_test.res\", line 12, characters 5-12", 3, 3));
 
 function h(a) {
   return xx(a);
 }
 
 Mocha.describe("Ppx_apply_test", () => {
-  Mocha.test("function_application_test", () => {
-    let u = 3;
-    Test_utils.eq("File \"ppx_apply_test.res\", line 25, characters 7-14", u, 3);
-  });
+  Mocha.test("function_application_test", () => Test_utils.eq("File \"ppx_apply_test.res\", line 25, characters 7-14", 3, 3));
   Mocha.test("external_function_test", () => Test_utils.ok("File \"ppx_apply_test.res\", line 30, characters 7-14", true));
 });
 
+let u = 3;
+
+let xx$1 = 6;
+
 export {
   u,
   nullary,
   unary,
-  xx,
+  xx$1 as xx,
   h,
 }
 /*  Not a pure module */
diff --git a/tests/tests/src/pr6726.mjs b/tests/tests/src/pr6726.mjs
index 9f149a2cb04..6add70d5155 100644
--- a/tests/tests/src/pr6726.mjs
+++ b/tests/tests/src/pr6726.mjs
@@ -21,7 +21,7 @@ function test_endian_string(x) {
   return 33;
 }
 
-let v = test_endian_string(1);
+let v = 33;
 
 let Test = {
   test_endian_string: test_endian_string,
@@ -33,4 +33,4 @@ export {
   ExtUnix,
   Test,
 }
-/* v Not a pure module */
+/* No side effect */
diff --git a/tests/tests/src/rec_module_test.mjs b/tests/tests/src/rec_module_test.mjs
index f19b9d0fd89..38f42a7db05 100644
--- a/tests/tests/src/rec_module_test.mjs
+++ b/tests/tests/src/rec_module_test.mjs
@@ -2,31 +2,6 @@
 
 import * as Mocha from "mocha";
 import * as Test_utils from "./test_utils.mjs";
-import * as Primitive_module from "@rescript/runtime/lib/es6/Primitive_module.mjs";
-
-let A = Primitive_module.init([
-  "rec_module_test.res",
-  6,
-  4
-], {
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "even"
-    ]]
-});
-
-let B = Primitive_module.init([
-  "rec_module_test.res",
-  18,
-  4
-], {
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "odd"
-    ]]
-});
 
 function even(n) {
   if (n === 0) {
@@ -38,15 +13,9 @@ function even(n) {
   }
 }
 
-Primitive_module.update({
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "even"
-    ]]
-}, A, {
+let A = {
   even: even
-});
+};
 
 function odd(n) {
   if (n === 1) {
@@ -58,51 +27,9 @@ function odd(n) {
   }
 }
 
-Primitive_module.update({
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "odd"
-    ]]
-}, B, {
+let B = {
   odd: odd
-});
-
-let AA = Primitive_module.init([
-  "rec_module_test.res",
-  32,
-  4
-], {
-  TAG: "Module",
-  _0: [
-    [
-      "Function",
-      "even"
-    ],
-    [
-      "Function",
-      "x"
-    ]
-  ]
-});
-
-let BB = Primitive_module.init([
-  "rec_module_test.res",
-  46,
-  4
-], {
-  TAG: "Module",
-  _0: [
-    [
-      "Function",
-      "odd"
-    ],
-    [
-      "Function",
-      "y"
-    ]
-  ]
-});
+};
 
 function even$1(n) {
   if (n === 0) {
@@ -118,22 +45,10 @@ function x() {
   return BB.y() + 3 | 0;
 }
 
-Primitive_module.update({
-  TAG: "Module",
-  _0: [
-    [
-      "Function",
-      "even"
-    ],
-    [
-      "Function",
-      "x"
-    ]
-  ]
-}, AA, {
+let AA = {
   even: even$1,
   x: x
-});
+};
 
 function odd$1(n) {
   if (n === 1) {
@@ -141,7 +56,7 @@ function odd$1(n) {
   } else if (n === 0) {
     return false;
   } else {
-    return AA.even(n - 1 | 0);
+    return even$1(n - 1 | 0);
   }
 }
 
@@ -149,22 +64,10 @@ function y() {
   return 32;
 }
 
-Primitive_module.update({
-  TAG: "Module",
-  _0: [
-    [
-      "Function",
-      "odd"
-    ],
-    [
-      "Function",
-      "y"
-    ]
-  ]
-}, BB, {
+let BB = {
   odd: odd$1,
   y: y
-});
+};
 
 let Even = {};
 
@@ -178,14 +81,14 @@ Mocha.describe("Rec_module_test", () => {
     false
   ], [
     A.even(2),
-    AA.even(4),
+    even$1(4),
     B.odd(2),
-    BB.odd(4)
+    odd$1(4)
   ]));
-  Mocha.test("test2", () => Test_utils.eq("File \"rec_module_test.res\", line 75, characters 7-14", BB.y(), 32));
-  Mocha.test("test3", () => Test_utils.eq("File \"rec_module_test.res\", line 79, characters 7-14", AA.x(), 35));
+  Mocha.test("test2", () => Test_utils.eq("File \"rec_module_test.res\", line 75, characters 7-14", y(), 32));
+  Mocha.test("test3", () => Test_utils.eq("File \"rec_module_test.res\", line 79, characters 7-14", x(), 35));
   Mocha.test("test4 - A.even", () => Test_utils.eq("File \"rec_module_test.res\", line 83, characters 7-14", true, A.even(2)));
-  Mocha.test("test4 - AA.even", () => Test_utils.eq("File \"rec_module_test.res\", line 87, characters 7-14", true, AA.even(4)));
+  Mocha.test("test4 - AA.even", () => Test_utils.eq("File \"rec_module_test.res\", line 87, characters 7-14", true, even$1(4)));
   Mocha.test("test5", () => Test_utils.eq("File \"rec_module_test.res\", line 91, characters 7-14", false, B.odd(2)));
 });
 
@@ -197,4 +100,4 @@ export {
   Even,
   Odd,
 }
-/* A Not a pure module */
+/*  Not a pure module */
diff --git a/tests/tests/src/recursive_module_test.mjs b/tests/tests/src/recursive_module_test.mjs
index 0fcbc8857b7..b112d87e989 100644
--- a/tests/tests/src/recursive_module_test.mjs
+++ b/tests/tests/src/recursive_module_test.mjs
@@ -24,18 +24,6 @@ Primitive_module.update({
     ]]
 }, Int3, Int3);
 
-let M = Primitive_module.init([
-  "recursive_module_test.res",
-  12,
-  20
-], {
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "fact"
-    ]]
-});
-
 function fact(n) {
   if (n <= 1) {
     return 1;
@@ -44,15 +32,9 @@ function fact(n) {
   }
 }
 
-Primitive_module.update({
-  TAG: "Module",
-  _0: [[
-      "Function",
-      "fact"
-    ]]
-}, M, {
+let M = {
   fact: fact
-});
+};
 
 let fact$1 = M.fact;
 
diff --git a/tests/tests/src/submodule.mjs b/tests/tests/src/submodule.mjs
index 59022e564ce..5e4c70a5fab 100644
--- a/tests/tests/src/submodule.mjs
+++ b/tests/tests/src/submodule.mjs
@@ -55,8 +55,6 @@ let A0 = {
   A1: A1
 };
 
-let v0 = 4;
-
 let v1 = a1(1, 2);
 
 let v2 = a2(1, 2);
@@ -65,6 +63,8 @@ let v3 = a3(1, 2);
 
 let v4 = a4(1, 2);
 
+let v0 = 4;
+
 export {
   A0,
   v0,
diff --git a/tests/tests/src/test_ari.mjs b/tests/tests/src/test_ari.mjs
index 64f2fa23b66..2302a330f5a 100644
--- a/tests/tests/src/test_ari.mjs
+++ b/tests/tests/src/test_ari.mjs
@@ -20,8 +20,6 @@ function f2(extra) {
   return 3 + extra | 0;
 }
 
-let g = 7;
-
 function ff(extra) {
   return U.test_primit(3, extra);
 }
@@ -41,6 +39,8 @@ function length_aux(_len, _x) {
   };
 }
 
+let g = 7;
+
 let length = Stdlib_List.length;
 
 let size = Stdlib_List.size;
diff --git a/tests/tests/src/test_demo.mjs b/tests/tests/src/test_demo.mjs
index 948ecd410a1..b622586bcdb 100644
--- a/tests/tests/src/test_demo.mjs
+++ b/tests/tests/src/test_demo.mjs
@@ -52,13 +52,10 @@ function g1(x, y) {
   return (xx, yy) => (xx + yy | 0) + u | 0;
 }
 
-let u = 8;
-
-let x = u + 6 | 0;
+let x = 14;
 
 function v(extra) {
-  let u = 7;
-  return (6 + extra | 0) + u | 0;
+  return (6 + extra | 0) + 7 | 0;
 }
 
 let nil = "Nil";
diff --git a/tests/tests/src/test_google_closure.mjs b/tests/tests/src/test_google_closure.mjs
index bbe794b0526..89cf2934a95 100644
--- a/tests/tests/src/test_google_closure.mjs
+++ b/tests/tests/src/test_google_closure.mjs
@@ -12,25 +12,20 @@ function f2(a) {
 
 let a = (3).toString();
 
-function f3(extra) {
-  return 101;
-}
-
-let b = f3(2);
-
 let arr = Stdlib_Array.fromInitializer(2, param => 0);
 
 for (let i = 0; i <= 1; ++i) {
-  let f3$1 = extra => i + 1 | 0;
-  arr[i] = f3$1(2);
+  arr[i] = i + 1 | 0;
 }
 
 console.log([
   a,
-  b,
+  101,
   arr
 ]);
 
+let b = 101;
+
 let c = arr;
 
 export {
diff --git a/tests/tests/src/uncurried_pipe.mjs b/tests/tests/src/uncurried_pipe.mjs
index e89588197dd..1e9d407f786 100644
--- a/tests/tests/src/uncurried_pipe.mjs
+++ b/tests/tests/src/uncurried_pipe.mjs
@@ -9,14 +9,6 @@ function addC(x, y) {
   return x + y | 0;
 }
 
-let v7 = 7;
-
-let v17 = 17;
-
-let v27 = 27;
-
-let v37 = 37;
-
 function unary(x) {
   return x + 1 | 0;
 }
@@ -24,29 +16,29 @@ function unary(x) {
 let StandardNotation = {
   add: add,
   addC: addC,
-  v7: v7,
-  v17: v17,
-  v27: v27,
-  v37: v37,
+  v7: 7,
+  v17: 17,
+  v27: 27,
+  v37: 37,
   unary: unary
 };
 
-let v7$1 = 7;
+let v7 = 7;
 
-let v17$1 = 17;
+let v17 = 17;
 
-let v27$1 = 27;
+let v27 = 27;
 
-let v37$1 = 37;
+let v37 = 37;
 
 let v100 = 100;
 
 export {
   StandardNotation,
-  v7$1 as v7,
-  v17$1 as v17,
-  v27$1 as v27,
-  v37$1 as v37,
+  v7,
+  v17,
+  v27,
+  v37,
   v100,
 }
 /* No side effect */
diff --git a/tests/tools_tests/src/expected/TestPpx.res.jsout b/tests/tools_tests/src/expected/TestPpx.res.jsout
index 87ea7737ee8..951349b0e55 100644
--- a/tests/tools_tests/src/expected/TestPpx.res.jsout
+++ b/tests/tools_tests/src/expected/TestPpx.res.jsout
@@ -25,12 +25,10 @@ function two(x, y) {
   return x + y | 0;
 }
 
-let n = 6;
-
 let Arity = {
   one: one,
   two: two,
-  n: n
+  n: 6
 };
 
 React.useState(() => 0);
@@ -63,11 +61,9 @@ function plus(x, y) {
   return x + y | 0;
 }
 
-let z = 3;
-
 let Pipe = {
   plus: plus,
-  z: z
+  z: 3
 };
 
 let concat = "ab";

From 414246f8b1e33df0687468fe1163d0b073023e08 Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Mon, 17 Aug 2026 12:57:52 +0200
Subject: [PATCH 4/6] Make a function's locally abstract types part of the
 function node

Replace the Pexp_newtype wrapper chains that the parser built for
(type t, x) => ... arrow syntax with a structural field on the function
node: Pexp_fun.newtypes carries each newtype name with its own
attributes, hoisted in front of the value parameters as before.
Pexp_newtype remains solely as the desugaring of [let f: type a. ...]
annotations and for PPX-authored trees.

Fidelity fixes visible in the formatter:
- Attributes keep their association with their type parameter group:
  (@attr type t, x, @attr2 type s, y) round-trips as written instead of
  printing @attr @attr2 on the function.
- Comments written next to a type parameter travel with it to the
  hoisted group instead of migrating onto the following value parameter.
- Attributes written in front of the arrow now live on the function
  node, so built-in attribute processing (e.g. @this) sees them on
  type-first functions; previously they sat inert on the wrapper node.

Typing follows the upstream OCaml 5.x design: the newtype machinery is
extracted into a reusable type_newtype helper (mirroring OCaml's helper
of the same name) and the function case peels one newtype at a time,
mimicking the typing of the former wrapper chain; the typedtree output
is bit-identical to before.

The v0 PPX bridge expands the field back into a wrapper chain around
Function$: each wrapper carries its own newtype's attributes, and the
outermost wrapper separates function-node attributes from the first
newtype's attributes with an internal _res.newtype_attrs marker (no
marker means node attributes only, matching the historical wire).
Newtype-free programs are wire byte-identical; for functions with
newtypes the deltas are confined to wrapper-node locations and, for the
rare attributed groups, per-wrapper attribute placement. Identity-PPX
round-trips are AST-exact, verified against the previous compiler.

Also: jsx_v4 and bs_builtin_ppx now carry newtypes (and their
attributes) through their function rebuilds instead of dropping them,
the sexp AST debugger emits the field, and dead parser plumbing
(fundef param attrs/p_pos, arrow_start_pos, make_newtypes ~attrs) is
removed.

Signed-Off-By: Cristiano Calcagno <cristianoc@users.noreply.github.com>

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
---
 CHANGELOG.md                                  |   1 +
 compiler/frontend/ast_compatible.ml           |   1 +
 compiler/frontend/bs_ast_mapper.ml            |   6 +-
 compiler/frontend/bs_builtin_ppx.ml           |  26 ++-
 compiler/ml/ast_helper.ml                     |   4 +-
 compiler/ml/ast_helper.mli                    |   1 +
 compiler/ml/ast_iterator.ml                   |   7 +-
 compiler/ml/ast_mapper.ml                     |   6 +-
 compiler/ml/ast_mapper_from0.ml               |  54 +++++-
 compiler/ml/ast_mapper_to0.ml                 |  51 +++++-
 compiler/ml/parsetree.ml                      |  12 +-
 compiler/ml/pprintast.ml                      |  24 ++-
 compiler/ml/printast.ml                       |   7 +-
 compiler/ml/typecore.ml                       | 134 ++++++++------
 compiler/syntax/src/jsx_v4.ml                 |  16 +-
 compiler/syntax/src/res_ast_debugger.ml       |   8 +-
 compiler/syntax/src/res_comments_table.ml     |  40 +++--
 compiler/syntax/src/res_core.ml               | 166 ++++++------------
 compiler/syntax/src/res_parsetree_viewer.ml   |  32 +++-
 compiler/syntax/src/res_parsetree_viewer.mli  |   6 +
 compiler/syntax/src/res_printer.ml            |   3 +-
 .../data/ast-mapping/FunctionsAndArrows.res   |   3 +
 .../expected/FunctionsAndArrows.res.txt       |   3 +
 .../expressions/expected/async.res.txt        |  22 +--
 .../expected/locallyAbstractTypes.res.txt     |  16 +-
 .../printer/comments/expected/expr.res.txt    |   4 +-
 .../printer/expr/expected/newtype.res.txt     |  18 +-
 .../data/printer/expr/newtype.res             |   5 +
 tools/src/transforms.ml                       |   3 +-
 29 files changed, 424 insertions(+), 255 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index a646b57e284..0b0e9ff4e07 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -27,6 +27,7 @@
 #### :bug: Bug fix
 
 - Preserve parentheses around multiplication, division, and modulo expressions used as exponents. https://github.com/rescript-lang/rescript/pull/8550
+- Make a function's locally abstract types (`(type t, x) => ...`) part of the function AST node instead of a chain of wrapper nodes. Fixes the formatter dropping the association of attributes with their `type` group (`(@attr type t, x, @attr2 type s, y)` used to print as `@attr @attr2` on the function) and comments written next to a type parameter migrating onto the following value parameter.
 - 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 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.
 - 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
diff --git a/compiler/frontend/ast_compatible.ml b/compiler/frontend/ast_compatible.ml
index 8769bd1ab5d..df150a6f4d6 100644
--- a/compiler/frontend/ast_compatible.ml
+++ b/compiler/frontend/ast_compatible.ml
@@ -80,6 +80,7 @@ let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) pat exp =
     pexp_desc =
       Pexp_fun
         {
+          newtypes = [];
           params =
             [{p_attrs = []; p_lbl = Nolabel; p_default = None; p_pat = pat}];
           body = exp;
diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml
index 9edf483334c..07287bfdedc 100644
--- a/compiler/frontend/bs_ast_mapper.ml
+++ b/compiler/frontend/bs_ast_mapper.ml
@@ -325,8 +325,12 @@ module E = struct
            sub vbs)
         (sub.expr sub e)
     (* #end *)
-    | Pexp_fun {params; body; async} ->
+    | Pexp_fun {newtypes; params; body; async} ->
       fun_ ~loc ~attrs ~async
+        ~newtypes:
+          (List.map
+             (fun (name, attrs) -> (map_loc sub name, sub.attributes sub attrs))
+             newtypes)
         (List.map
            (fun (param : Parsetree.fun_param) ->
              {
diff --git a/compiler/frontend/bs_builtin_ppx.ml b/compiler/frontend/bs_builtin_ppx.ml
index 6157cea22a7..24a8d7adb71 100644
--- a/compiler/frontend/bs_builtin_ppx.ml
+++ b/compiler/frontend/bs_builtin_ppx.ml
@@ -95,7 +95,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
   | Pexp_newtype (s, body) ->
     let res = self.expr self body in
     {e with pexp_desc = Pexp_newtype (s, res)}
-  | Pexp_fun {params; body; async} -> (
+  | Pexp_fun {newtypes; params; body; async} -> (
     match Ast_attributes.process_attributes_rev e.pexp_attributes with
     | Nothing, _ ->
       (* Handle @async x => y => ... is in async context *)
@@ -116,19 +116,29 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
          mapper did (GH #7974). *)
       let body = self.expr self body in
       in_function_def := saved_in_function_def;
+      let newtypes =
+        Ext_list.map newtypes (fun (name, nt_attrs) ->
+            (name, self.attributes self nt_attrs))
+      in
       let mapped =
-        Ast_helper.Exp.fun_ ~loc:e.pexp_loc ~attrs ~async params body
+        Ast_helper.Exp.fun_ ~loc:e.pexp_loc ~attrs ~async ~newtypes params body
       in
       Ast_async.make_function_async ~async mapped
     | Meth_callback _, pexp_attributes ->
       (* FIXME: does it make sense to have a label for [this] ? *)
       async_context := false;
-      {
-        e with
-        pexp_desc =
-          Ast_uncurry_gen.to_method_callback ~async e.pexp_loc self params body;
-        pexp_attributes;
-      })
+      let callback =
+        {
+          e with
+          pexp_desc =
+            Ast_uncurry_gen.to_method_callback ~async e.pexp_loc self params
+              body;
+          pexp_attributes;
+        }
+      in
+      (* Keep the locally abstract types in scope around the callback. *)
+      Ext_list.fold_right newtypes callback (fun (name, nt_attrs) acc ->
+          Ast_helper.Exp.newtype ~loc:e.pexp_loc ~attrs:nt_attrs name acc))
   | Pexp_apply _ -> Ast_exp_apply.app_exp_mapper e self
   | Pexp_match
       ( b,
diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml
index ed29a89a785..bb19e9b1e1b 100644
--- a/compiler/ml/ast_helper.ml
+++ b/compiler/ml/ast_helper.ml
@@ -158,9 +158,9 @@ module Exp = struct
   let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)
   let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
   let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
-  let fun_ ?loc ?attrs ?(async = false) params body =
+  let fun_ ?loc ?attrs ?(async = false) ?(newtypes = []) params body =
     assert (params <> []);
-    mk ?loc ?attrs (Pexp_fun {params; body; async})
+    mk ?loc ?attrs (Pexp_fun {newtypes; params; body; async})
 
   let fun_param ?(attrs = []) ?default lbl pat =
     {p_attrs = attrs; p_lbl = lbl; p_default = default; p_pat = pat}
diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli
index 789b3d669ae..652d248ab5e 100644
--- a/compiler/ml/ast_helper.mli
+++ b/compiler/ml/ast_helper.mli
@@ -134,6 +134,7 @@ module Exp : sig
     ?loc:loc ->
     ?attrs:attrs ->
     ?async:bool ->
+    ?newtypes:(str * attrs) list ->
     fun_param list ->
     expression ->
     expression
diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml
index 80bd5b78cba..46777f25df4 100644
--- a/compiler/ml/ast_iterator.ml
+++ b/compiler/ml/ast_iterator.ml
@@ -289,7 +289,12 @@ module E = struct
     | Pexp_let (_r, vbs, e) ->
       List.iter (sub.value_binding sub) vbs;
       sub.expr sub e
-    | Pexp_fun {params; body} ->
+    | Pexp_fun {newtypes; params; body} ->
+      List.iter
+        (fun (name, attrs) ->
+          iter_loc sub name;
+          sub.attributes sub attrs)
+        newtypes;
       List.iter
         (fun {p_default; p_pat} ->
           iter_opt (sub.expr sub) p_default;
diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml
index 5749aa11c8d..cde7ccfa34d 100644
--- a/compiler/ml/ast_mapper.ml
+++ b/compiler/ml/ast_mapper.ml
@@ -288,8 +288,12 @@ module E = struct
     | Pexp_constant x -> constant ~loc ~attrs x
     | Pexp_let (r, vbs, e) ->
       let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
-    | Pexp_fun {params; body; async} ->
+    | Pexp_fun {newtypes; params; body; async} ->
       fun_ ~loc ~attrs ~async
+        ~newtypes:
+          (List.map
+             (fun (name, attrs) -> (map_loc sub name, sub.attributes sub attrs))
+             newtypes)
         (List.map
            (fun param ->
              {
diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml
index 735ae7fce3b..b3bdda89843 100644
--- a/compiler/ml/ast_mapper_from0.ml
+++ b/compiler/ml/ast_mapper_from0.ml
@@ -688,7 +688,8 @@ module E = struct
             in
             {
               e1 with
-              pexp_desc = Pexp_fun {params; body; async = f.async};
+              pexp_desc =
+                Pexp_fun {newtypes = []; params; body; async = f.async};
               pexp_attributes = e1.pexp_attributes @ node_attrs;
             })
         | _ -> exp1)
@@ -761,8 +762,55 @@ module E = struct
     | Pexp_lazy _ -> failwith "Pexp_lazy is no longer present in ReScript"
     | Pexp_poly _ -> failwith "Pexp_poly is no longer present in ReScript"
     | Pexp_object () -> assert false
-    | Pexp_newtype (s, e) ->
-      newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e)
+    | Pexp_newtype (s, e) -> (
+      (* Fuse a chain of newtype wrappers over a Function$ node into the
+         function's [newtypes] field. Each wrapper's attributes are its
+         newtype's attributes, except on this outermost wrapper:
+         attributes before the internal [_res.newtype_attrs] marker (or
+         all of them, when there is no marker) are function-node
+         attributes, the ones after the marker belong to the first
+         newtype. Chains over anything else (e.g. the
+         [let f: type t. ...] sugar) keep their [Pexp_newtype] nodes. *)
+      let node_attrs, first_nt_attrs =
+        let rec split acc = function
+          | ({txt = "_res.newtype_attrs"}, _) :: rest -> (List.rev acc, rest)
+          | a :: rest -> split (a :: acc) rest
+          | [] -> (List.rev acc, [])
+        in
+        split [] attrs
+      in
+      let rec gather acc (e0 : Parsetree0.expression) =
+        match e0.pexp_desc with
+        | Pexp_newtype (s1, body) ->
+          gather
+            ((map_loc sub s1, sub.attributes sub e0.pexp_attributes) :: acc)
+            body
+        | Pexp_construct ({txt = Longident.Lident "Function$"}, Some _) ->
+          Some (List.rev acc, e0)
+        | _ -> None
+      in
+      match gather [(map_loc sub s, first_nt_attrs)] e with
+      | Some (newtypes, base) -> (
+        let base1 = sub.expr sub base in
+        match base1.pexp_desc with
+        | Pexp_fun ({newtypes = []} as f) ->
+          {
+            Pt.pexp_desc = Pexp_fun {f with newtypes};
+            pexp_attributes = base1.pexp_attributes @ node_attrs;
+            pexp_loc = loc;
+          }
+        | _ -> (
+          (* PPX-mangled Function$: keep the wrapper chain as-is. *)
+          match newtypes with
+          | [] -> assert false
+          | (n0, _) :: rest ->
+            let inner =
+              List.fold_right
+                (fun (n, a) acc -> newtype ~loc ~attrs:a n acc)
+                rest base1
+            in
+            newtype ~loc ~attrs n0 inner))
+      | None -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e))
     | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
     | Pexp_open (ovf, lid, e) ->
       open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml
index d9b4abb175b..87c26a060ce 100644
--- a/compiler/ml/ast_mapper_to0.ml
+++ b/compiler/ml/ast_mapper_to0.ml
@@ -405,12 +405,13 @@ module E = struct
     | Pexp_constant x -> constant ~loc ~attrs (map_constant x)
     | Pexp_let (r, vbs, e) ->
       let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
-    | Pexp_fun {params; body; async} ->
+    | Pexp_fun {newtypes; params; body; async} -> (
       (* Re-curry the n-ary function into the v0 chain of unary funs, and
          wrap it in Function$ carrying the arity as a res.arity attribute.
-         Each v0 fun node carries its parameter's attributes; the head
-         additionally carries the function node's own attributes (and the
-         res.async marker), matching what the old parser produced. *)
+         Each v0 fun node carries its parameter's attributes; without
+         newtypes the head additionally carries the function node's own
+         attributes (and the res.async marker), matching what the old
+         parser produced. *)
       let arity = List.length params in
       let rec build (params : Parsetree.fun_param list) =
         match params with
@@ -421,7 +422,9 @@ module E = struct
           let level_attrs =
             let param_attrs = sub.attributes sub p_attrs in
             if is_head then
-              let base = attrs @ param_attrs in
+              let base =
+                if newtypes = [] then attrs @ param_attrs else param_attrs
+              in
               if async then
                 ({txt = "res.async"; loc = Location.none}, Pt.PStr []) :: base
               else base
@@ -445,9 +448,41 @@ module E = struct
                    (Pconst_integer (string_of_int arity, None)));
             ] )
       in
-      Ast_helper0.Exp.construct ~attrs:[arity_attr]
-        (Location.mkloc (Longident.Lident "Function$") e.pexp_loc)
-        (Some e)
+      let fn =
+        Ast_helper0.Exp.construct ~attrs:[arity_attr]
+          (Location.mkloc (Longident.Lident "Function$") e.pexp_loc)
+          (Some e)
+      in
+      (* Expand the newtypes back into the v0 wrapper chain around the
+         Function$ node. Each wrapper carries its own newtype's attributes.
+         The outermost wrapper is the whole expression in v0, so it also
+         carries the function node's attributes: when the first newtype has
+         attributes of its own, an internal [_res.newtype_attrs] marker
+         separates node attributes (before) from the first newtype's
+         attributes (after); without a marker every attribute on the
+         outermost wrapper is a function-node attribute, which is also how
+         wrapper attributes behaved before newtypes became a field. *)
+      match newtypes with
+      | [] -> fn
+      | (first_name, first_attrs) :: rest_newtypes ->
+        let inner =
+          List.fold_right
+            (fun (name, nt_attrs) acc ->
+              Ast_helper0.Exp.newtype ~loc
+                ~attrs:(sub.attributes sub nt_attrs)
+                (map_loc sub name) acc)
+            rest_newtypes fn
+        in
+        let first_attrs = sub.attributes sub first_attrs in
+        let outer_attrs =
+          if first_attrs = [] then attrs
+          else
+            attrs
+            @ ({txt = "_res.newtype_attrs"; loc = Location.none}, Pt.PStr [])
+              :: first_attrs
+        in
+        Ast_helper0.Exp.newtype ~loc ~attrs:outer_attrs (map_loc sub first_name)
+          inner)
     | Pexp_apply {funct = e; args; partial} ->
       let e =
         match (e.pexp_desc, args) with
diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml
index 8a24070102e..7a41fc196e8 100644
--- a/compiler/ml/parsetree.ml
+++ b/compiler/ml/parsetree.ml
@@ -232,10 +232,18 @@ and expression_desc =
     (* let P1 = E1 and ... and Pn = EN in E       (flag = Nonrecursive)
        let rec P1 = E1 and ... and Pn = EN in E   (flag = Recursive)
     *)
-  | Pexp_fun of {params: fun_param list; body: expression; async: bool}
-    (* (P1, ~l:P2, ?l:P3=E0) => E           n-ary uncurried function.
+  | Pexp_fun of {
+      newtypes: (string loc * attributes) list;
+      params: fun_param list;
+      body: expression;
+      async: bool;
+    }
+    (* (type t, P1, ~l:P2, ?l:P3=E0) => E   n-ary uncurried function.
        The function's arity is [List.length params]; a function returning
        another function is a nested [Pexp_fun] in [body].
+       [newtypes] are the function's locally abstract types, each with its
+       own attributes; the parser hoists them in front of the value
+       parameters.
 
        Notes:
        - A default expression is only allowed on Optional parameters.
diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml
index c98a43ef6e4..df2599b1bef 100644
--- a/compiler/ml/pprintast.ml
+++ b/compiler/ml/pprintast.ml
@@ -627,17 +627,23 @@ and expression ctxt f x =
     | (Pexp_let _ | Pexp_letmodule _ | Pexp_open _ | Pexp_letexception _)
       when ctxt.semi ->
       paren true (expression reset_ctxt) f x
-    | Pexp_fun {params; body; async} ->
+    | Pexp_fun {newtypes; params; body; async} ->
       let arity_str = "[arity:" ^ string_of_int (List.length params) ^ "]" in
       let async_str = if async then "async " else "" in
+      let rec pp_newtypes f = function
+        | [] -> ()
+        | ((name : string Location.loc), nt_attrs) :: rest ->
+          pp f "%a(type %s)@;" (attributes ctxt) nt_attrs name.txt;
+          pp_newtypes f rest
+      in
       let rec pp_params f = function
         | [] -> ()
         | {p_lbl; p_default; p_pat} :: rest ->
           pp f "%a" (label_exp ctxt) (p_lbl, p_default, p_pat);
           pp_params f rest
       in
-      pp f "@[<2>%sfun@;%s%a->@;%a@]" async_str arity_str pp_params params
-        (expression ctxt) body
+      pp f "@[<2>%sfun@;%a%s%a->@;%a@]" async_str pp_newtypes newtypes arity_str
+        pp_params params (expression ctxt) body
     | Pexp_match (e, l) ->
       pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]" (expression reset_ctxt) e
         (case_list ctxt) l
@@ -1062,9 +1068,15 @@ and binding ctxt f {pvb_pat = p; pvb_expr = x; _} =
     if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
     else
       match x.pexp_desc with
-      | Pexp_fun {params; body; async} ->
+      | Pexp_fun {newtypes; params; body; async} ->
         let arity_str = "[arity:" ^ string_of_int (List.length params) ^ "]" in
         let async_str = if async then "async " else "" in
+        let rec pp_newtypes f = function
+          | [] -> ()
+          | ((name : string Location.loc), nt_attrs) :: rest ->
+            pp f "%a(type@ %s)@ " (attributes ctxt) nt_attrs name.txt;
+            pp_newtypes f rest
+        in
         let pp_param f {p_lbl; p_default; p_pat} =
           if p_lbl = Nolabel then simple_pattern ctxt f p_pat
           else label_exp ctxt f (p_lbl, p_default, p_pat)
@@ -1075,8 +1087,8 @@ and binding ctxt f {pvb_pat = p; pvb_expr = x; _} =
             pp f "%a@ " pp_param param;
             pp_params f rest
         in
-        pp f "%s%s%a%a" async_str arity_str pp_params params
-          pp_print_pexp_function body
+        pp f "%s%a%s%a%a" async_str pp_newtypes newtypes arity_str pp_params
+          params pp_print_pexp_function body
       | Pexp_newtype (str, e) ->
         pp f "(type@ %s)@ %a" str.txt pp_print_pexp_function e
       | _ -> pp f "=@;%a" (expression ctxt) x
diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml
index 3d78c884183..a92f386eee3 100644
--- a/compiler/ml/printast.ml
+++ b/compiler/ml/printast.ml
@@ -249,10 +249,15 @@ and expression i ppf x =
     line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
     list i value_binding ppf l;
     expression i ppf e
-  | Pexp_fun {params; body; async} ->
+  | Pexp_fun {newtypes; params; body; async} ->
     line i ppf "Pexp_fun\n";
     let () = if async then line i ppf "async\n" in
     line i ppf "arity:%d\n" (List.length params);
+    List.iter
+      (fun ((name : string loc), attrs) ->
+        attributes i ppf attrs;
+        line i ppf "newtype \"%s\"\n" name.txt)
+      newtypes;
     List.iter
       (fun {p_attrs; p_lbl; p_default; p_pat} ->
         attributes i ppf p_attrs;
diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml
index fd8c564d041..c01bd4d9a0a 100644
--- a/compiler/ml/typecore.ml
+++ b/compiler/ml/typecore.ml
@@ -2466,7 +2466,21 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
         exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
-  | Pexp_fun {params; body = sfun_body; async} ->
+  | Pexp_fun
+      {newtypes = (name, nt_attrs) :: rest; params; body = sfun_body; async} ->
+    (* Bring the function's locally abstract types into scope one at a
+       time, typing the remainder of the function inside each scope, the
+       same way a chain of [Pexp_newtype] wrappers would. *)
+    let speeled =
+      {
+        sexp with
+        pexp_desc = Pexp_fun {newtypes = rest; params; body = sfun_body; async};
+      }
+    in
+    rue
+      (type_newtype ~loc ~env ~name:name.txt ~attrs:nt_attrs (fun new_env ->
+           type_exp ~context:None new_env speeled))
+  | Pexp_fun {newtypes = []; params; body = sfun_body; async} ->
     type_function ~async loc sexp.pexp_attributes env ty_expected params
       sfun_body
   | Pexp_apply {funct = sfunct; args = sargs; partial; transformed_jsx} ->
@@ -3394,61 +3408,9 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
         exp_env = env;
       }
   | Pexp_newtype ({txt = name}, sbody) ->
-    let ty = newvar () in
-    (* remember original level *)
-    begin_def ();
-    (* Create a fake abstract type declaration for name. *)
-    let level = get_current_level () in
-    let decl =
-      {
-        type_params = [];
-        type_arity = 0;
-        type_kind = Type_abstract;
-        type_private = Public;
-        type_manifest = None;
-        type_variance = [];
-        type_newtype_level = Some (level, level);
-        type_loc = loc;
-        type_attributes = [];
-        type_immediate = false;
-        type_unboxed = unboxed_false_default_false;
-        type_inlined_types = [];
-      }
-    in
-    Ident.set_current_time ty.level;
-    let id, new_env = Env.enter_type name decl env in
-    Ctype.init_def (Ident.current_time ());
-
-    let body = type_exp ~context:None new_env sbody in
-    (* Replace every instance of this type constructor in the resulting
-       type. *)
-    let seen = Hashtbl.create 8 in
-    let rec replace t =
-      if Hashtbl.mem seen t.id then ()
-      else (
-        Hashtbl.add seen t.id ();
-        match t.desc with
-        | Tconstr (Path.Pident id', _, _) when id == id' -> link_type t ty
-        | _ -> Btype.iter_type_expr replace t)
-    in
-    let ety = Subst.type_expr Subst.identity body.exp_type in
-    replace ety;
-    (* back to original level *)
-    end_def ();
-
-    (* lower the levels of the result type *)
-    (* unify_var env ty ety; *)
-
-    (* non-expansive if the body is non-expansive, so we don't introduce
-       any new extra node in the typed AST. *)
     rue
-      {
-        body with
-        exp_loc = loc;
-        exp_type = ety;
-        exp_extra =
-          (Texp_newtype name, loc, sexp.pexp_attributes) :: body.exp_extra;
-      }
+      (type_newtype ~loc ~env ~name ~attrs:sexp.pexp_attributes (fun new_env ->
+           type_exp ~context:None new_env sbody))
   | Pexp_pack m ->
     let p, nl =
       match Ctype.expand_head env (instance env ty_expected) with
@@ -3507,6 +3469,68 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
   | Pexp_jsx_element _ ->
     raise (Error (sexp.pexp_loc, Env.empty, Jsx_not_enabled))
 
+(* Type [type_body] with the locally abstract type [name] in scope: a
+   fresh abstract type constructor is entered into the environment, and
+   every occurrence of it in the result type is replaced by a type
+   variable afterwards. Used both for [Pexp_newtype] nodes and for the
+   [newtypes] of a function. The result still needs to be unified with
+   the expected type by the caller. *)
+and type_newtype ~loc ~env ~name ~attrs
+    (type_body : Env.t -> Typedtree.expression) =
+  let ty = newvar () in
+  (* remember original level *)
+  begin_def ();
+  (* Create a fake abstract type declaration for name. *)
+  let level = get_current_level () in
+  let decl =
+    {
+      type_params = [];
+      type_arity = 0;
+      type_kind = Type_abstract;
+      type_private = Public;
+      type_manifest = None;
+      type_variance = [];
+      type_newtype_level = Some (level, level);
+      type_loc = loc;
+      type_attributes = [];
+      type_immediate = false;
+      type_unboxed = unboxed_false_default_false;
+      type_inlined_types = [];
+    }
+  in
+  Ident.set_current_time ty.level;
+  let id, new_env = Env.enter_type name decl env in
+  Ctype.init_def (Ident.current_time ());
+
+  let body = type_body new_env in
+  (* Replace every instance of this type constructor in the resulting
+     type. *)
+  let seen = Hashtbl.create 8 in
+  let rec replace t =
+    if Hashtbl.mem seen t.id then ()
+    else (
+      Hashtbl.add seen t.id ();
+      match t.desc with
+      | Tconstr (Path.Pident id', _, _) when id == id' -> link_type t ty
+      | _ -> Btype.iter_type_expr replace t)
+  in
+  let ety = Subst.type_expr Subst.identity body.exp_type in
+  replace ety;
+  (* back to original level *)
+  end_def ();
+
+  (* lower the levels of the result type *)
+  (* unify_var env ty ety; *)
+
+  (* non-expansive if the body is non-expansive, so we don't introduce
+     any new extra node in the typed AST. *)
+  {
+    body with
+    exp_loc = loc;
+    exp_type = ety;
+    exp_extra = (Texp_newtype name, loc, attrs) :: body.exp_extra;
+  }
+
 and type_function ~async loc attrs env ty_expected_
     (sparams : Parsetree.fun_param list) sbody =
   (* Desugar optional-parameter defaults: the parameter becomes a fresh
diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml
index f678c56cff7..a71a03073d6 100644
--- a/compiler/syntax/src/jsx_v4.ml
+++ b/compiler/syntax/src/jsx_v4.ml
@@ -241,11 +241,13 @@ let make_props_record_type_sig ~core_type_of_attr ~external_
 
 let rec recursively_transform_named_args_for_make expr args newtypes core_type =
   match expr.pexp_desc with
-  | Pexp_fun {params; body} ->
+  | Pexp_fun {newtypes = fun_newtypes; params; body} ->
+    (* Collected newtypes are accumulated in reverse source order. *)
+    let newtypes = List.rev_append fun_newtypes newtypes in
     transform_params_for_make ~expr ~body params args newtypes core_type
   | Pexp_newtype (label, expression) ->
     recursively_transform_named_args_for_make expression args
-      (label :: newtypes) core_type
+      ((label, []) :: newtypes) core_type
   | Pexp_constraint (expression, core_type) ->
     recursively_transform_named_args_for_make expression args newtypes
       (Some core_type)
@@ -793,12 +795,10 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name binding =
                   | [] -> []
                   | _ -> [Typ.any ()]))))
       in
-      Exp.fun_ ~async:is_async (props_param :: nolabel_params) expression
-    in
-    let expression =
-      (* Add new tupes (type a,b,c) to make's definition *)
-      newtypes
-      |> List.fold_left (fun e newtype -> Exp.newtype newtype e) expression
+      (* Add the collected newtypes (type a b c) to make's definition *)
+      Exp.fun_ ~async:is_async ~newtypes:(List.rev newtypes)
+        (props_param :: nolabel_params)
+        expression
     in
     (* let make = ({id, name, ...}: props<'id, 'name, ...>) => { ... } *)
     let binding =
diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml
index dbc5e70f35f..3f2eb9a949e 100644
--- a/compiler/syntax/src/res_ast_debugger.ml
+++ b/compiler/syntax/src/res_ast_debugger.ml
@@ -558,10 +558,16 @@ module Sexp_ast = struct
             Sexp.list (map_empty ~f:value_binding vbs);
             expression expr;
           ]
-      | Pexp_fun {params; body} ->
+      | Pexp_fun {newtypes; params; body} ->
         Sexp.list
           [
             Sexp.atom "Pexp_fun";
+            Sexp.list
+              (map_empty
+                 ~f:(fun ((name : string Location.loc), attrs) ->
+                   Sexp.list
+                     [Sexp.atom "newtype"; string name.txt; attributes attrs])
+                 newtypes);
             Sexp.list
               (map_empty
                  ~f:(fun {p_lbl; p_default; p_pat} ->
diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml
index 40a9633515a..841640bb01e 100644
--- a/compiler/syntax/src/res_comments_table.ml
+++ b/compiler/syntax/src/res_comments_table.ml
@@ -359,6 +359,21 @@ let functor_type modtype =
 
 let fun_expr expr =
   let open Parsetree in
+  (* For simplicity reason each newtype gets converted to a Nolabel
+   * parameter with a fake pattern variable carrying the name's own
+   * location, otherwise this function would need to return a variant:
+   * | NormalParamater(...)
+   * | NewType(...)
+   * This complicates printing with an extra variant/boxing/allocation for a code-path
+   * that is not often used. Lets just keep it simple for now *)
+  let newtype_params newtypes =
+    (* One fake parameter per newtype, carrying the name's own location:
+       comments attach to exactly the identifier locations the printer
+       looks up when printing a "type a b" group. *)
+    newtypes
+    |> List.map (fun ((name : string Location.loc), attrs) ->
+           (attrs, Asttypes.Nolabel, None, Ast_helper.Pat.var ~loc:name.loc name))
+  in
   (* Turns (type t, type u, type z) into "type t u z" *)
   let rec collect_new_types acc return_expr =
     match return_expr with
@@ -379,17 +394,19 @@ let fun_expr expr =
       in
       (Location.mkloc txt loc, return_expr)
   in
-  (* For simplicity reason Pexp_newtype gets converted to a Nolabel parameter,
-   * otherwise this function would need to return a variant:
-   * | NormalParamater(...)
-   * | NewType(...)
-   * This complicates printing with an extra variant/boxing/allocation for a code-path
-   * that is not often used. Lets just keep it simple for now *)
   let params_of params =
     params
     |> List.map (fun {p_attrs; p_lbl; p_default; p_pat} ->
            (p_attrs, p_lbl, p_default, p_pat))
   in
+  (* Comments are attached by walking the parameters in source order, so
+     the newtype groups are interleaved back at their original positions. *)
+  let in_source_order params =
+    List.stable_sort
+      (fun (_, _, _, (p1 : Parsetree.pattern)) (_, _, _, p2) ->
+        compare p1.ppat_loc.loc_start.pos_cnum p2.ppat_loc.loc_start.pos_cnum)
+      params
+  in
   match expr with
   | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} -> (
     let var, return_expr = collect_new_types [string_loc] rest in
@@ -397,11 +414,14 @@ let fun_expr expr =
       (attrs, Asttypes.Nolabel, None, Ast_helper.Pat.var ~loc:string_loc.loc var)
     in
     match return_expr with
-    | {pexp_desc = Pexp_fun {params; body}; pexp_attributes = []} ->
-      ([], newtype_param :: params_of params, body)
+    | {pexp_desc = Pexp_fun {newtypes; params; body}; pexp_attributes = []} ->
+      ( [],
+        newtype_param
+        :: in_source_order (newtype_params newtypes @ params_of params),
+        body )
     | return_expr -> ([], [newtype_param], return_expr))
-  | {pexp_desc = Pexp_fun {params; body}; pexp_attributes = attrs} ->
-    (attrs, params_of params, body)
+  | {pexp_desc = Pexp_fun {newtypes; params; body}; pexp_attributes = attrs} ->
+    (attrs, in_source_order (newtype_params newtypes @ params_of params), body)
   | expr -> ([], [], expr)
 
 let rec is_block_expr expr =
diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml
index 708dfd75856..8e99345b19c 100644
--- a/compiler/syntax/src/res_core.ml
+++ b/compiler/syntax/src/res_core.ml
@@ -316,15 +316,12 @@ type typ_def_or_ext =
 type fundef_type_param = {
   attrs: Parsetree.attributes;
   locs: string Location.loc list;
-  p_pos: Lexing.position;
 }
 
 type fundef_term_param = {
-  attrs: Parsetree.attributes;
   p_label: Asttypes.arg_label;
   expr: Parsetree.expression option;
   pat: Parsetree.pattern;
-  p_pos: Lexing.position;
 }
 
 (* Single parameter of a function definition  (type a b, x, ~y) *)
@@ -339,27 +336,17 @@ type record_pattern_item =
 
 type context = OrdinaryExpr | TernaryTrueBranchExpr | WhenExpr
 
-(* Extracts type and term parameters from a list of function definition parameters, combining all type parameters into one *)
-let rec extract_fundef_params ~(type_acc : fundef_type_param option)
+(* Extracts type and term parameters from a list of function definition
+   parameters, keeping the type parameter groups in source order *)
+let rec extract_fundef_params ~(type_acc : fundef_type_param list)
     ~(term_acc : fundef_term_param list) (params : fundef_parameter list) :
-    fundef_type_param option * fundef_term_param list =
+    fundef_type_param list * fundef_term_param list =
   match params with
   | TermParameter tp :: rest ->
     extract_fundef_params ~type_acc ~term_acc:(tp :: term_acc) rest
   | TypeParameter tp :: rest ->
-    let type_acc =
-      match type_acc with
-      | Some tpa ->
-        Some
-          {
-            attrs = tpa.attrs @ tp.attrs;
-            locs = tpa.locs @ tp.locs;
-            p_pos = tpa.p_pos;
-          }
-      | None -> Some tp
-    in
-    extract_fundef_params ~type_acc ~term_acc rest
-  | [] -> (type_acc, List.rev term_acc)
+    extract_fundef_params ~type_acc:(tp :: type_acc) ~term_acc rest
+  | [] -> (List.rev type_acc, List.rev term_acc)
 
 let get_closing_token = function
   | Token.Lparen -> Token.Rparen
@@ -624,13 +611,10 @@ let lident_of_path longident =
   | [] -> ""
   | ident :: _ -> ident
 
-let make_newtypes ~attrs ~loc newtypes exp =
-  let expr =
-    List.fold_right
-      (fun newtype exp -> Ast_helper.Exp.mk ~loc (Pexp_newtype (newtype, exp)))
-      newtypes exp
-  in
-  {expr with pexp_attributes = attrs}
+let make_newtypes ~loc newtypes exp =
+  List.fold_right
+    (fun newtype exp -> Ast_helper.Exp.mk ~loc (Pexp_newtype (newtype, exp)))
+    newtypes exp
 
 (* locally abstract types syntax sugar
  * Transforms
@@ -640,8 +624,7 @@ let make_newtypes ~attrs ~loc newtypes exp =
  *)
 let wrap_type_annotation ~loc newtypes core_type body =
   let exp =
-    make_newtypes ~attrs:[] ~loc newtypes
-      (Ast_helper.Exp.constraint_ ~loc body core_type)
+    make_newtypes ~loc newtypes (Ast_helper.Exp.constraint_ ~loc body core_type)
   in
   let typ =
     Ast_helper.Typ.poly ~loc newtypes
@@ -1841,8 +1824,8 @@ and parse_ternary_expr left_operand p =
       true_branch (Some false_branch)
   | _ -> left_operand
 
-and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
-    ?context ?term_parameters ~async p =
+and parse_es6_arrow_expression ?(arrow_attrs = []) ?context ?term_parameters
+    ~async p =
   let start_pos = p.Parser.start_pos in
   Parser.leave_breadcrumb p Grammar.Es6ArrowExpr;
   (* Parsing function parameters and attributes:
@@ -1851,35 +1834,9 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
      labeled, optional or nolabeled. *)
   let parameters =
     match term_parameters with
-    | Some params -> (None, params)
+    | Some params -> ([], params)
     | None -> parse_parameters p
   in
-  let parameters =
-    let update_attrs attrs = arrow_attrs @ attrs in
-    let update_pos pos =
-      match arrow_start_pos with
-      | Some start_pos -> start_pos
-      | None -> pos
-    in
-    match parameters with
-    | None, termp :: rest ->
-      ( None,
-        {
-          termp with
-          attrs = update_attrs termp.attrs;
-          p_pos = update_pos termp.p_pos;
-        }
-        :: rest )
-    | Some (tpa : fundef_type_param), term_params ->
-      ( Some
-          {
-            tpa with
-            attrs = update_attrs tpa.attrs;
-            p_pos = update_pos tpa.p_pos;
-          },
-        term_params )
-    | _ -> parameters
-  in
   let return_type =
     match p.Parser.token with
     | Colon ->
@@ -1899,11 +1856,9 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
   in
   Parser.eat_breadcrumb p;
   let end_pos = p.prev_end_pos in
-  let type_param_opt, term_parameters = parameters in
+  let type_groups, term_parameters = parameters in
   (* In-parens attributes are already attached to the parameter patterns by
-     [parse_parameter]; the [attrs] field of a term parameter carries
-     arrow-level attributes (merged into the first parameter above), which
-     belong on the function node itself. *)
+     [parse_parameter]. *)
   let fun_params =
     List.map
       (fun {p_label = lbl; expr = default_expr; pat} ->
@@ -1915,22 +1870,24 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
         })
       term_parameters
   in
-  let fun_attrs =
-    List.concat_map (fun (p : fundef_term_param) -> p.attrs) term_parameters
-  in
-  let loc =
-    match term_parameters with
-    | {p_pos = start_pos} :: _ -> mk_loc start_pos end_pos
-    | [] -> mk_loc start_pos end_pos
-  in
-  let arrow_expr =
-    Ast_helper.Exp.fun_ ~loc ~attrs:fun_attrs ~async fun_params body
+  (* Attributes written in front of the arrow belong to the function node
+     itself, independently of any type parameter groups. *)
+  let fun_attrs = arrow_attrs in
+  let loc = mk_loc start_pos end_pos in
+  let newtypes =
+    (* Each type parameter group carries its attributes on its first
+       newtype; the printer starts a new group at each attribute-bearing
+       newtype, so grouping and attributes round-trip. *)
+    List.concat_map
+      (fun {attrs; locs} ->
+        match locs with
+        | [] -> []
+        | first :: rest ->
+          (first, attrs) :: List.map (fun name -> (name, [])) rest)
+      type_groups
   in
   let arrow_expr =
-    match type_param_opt with
-    | None -> arrow_expr
-    | Some {attrs; locs = newtypes; p_pos = start_pos} ->
-      make_newtypes ~attrs ~loc:(mk_loc start_pos end_pos) newtypes arrow_expr
+    Ast_helper.Exp.fun_ ~loc ~attrs:fun_attrs ~async ~newtypes fun_params body
   in
   {arrow_expr with pexp_loc = {arrow_expr.pexp_loc with loc_start = start_pos}}
 
@@ -1967,9 +1924,9 @@ and parse_parameter p =
     if p.Parser.token = Typ then (
       Parser.next p;
       let lidents = parse_lident_list p in
-      Some (TypeParameter {attrs; locs = lidents; p_pos = start_pos}))
+      Some (TypeParameter {attrs; locs = lidents}))
     else
-      let attrs, lbl, lbl_loc, pat =
+      let lbl, lbl_loc, pat =
         match p.Parser.token with
         | Tilde -> (
           Parser.next p;
@@ -1977,8 +1934,7 @@ and parse_parameter p =
           match p.Parser.token with
           | Comma | Equal | Rparen ->
             let loc = mk_loc start_pos p.prev_end_pos in
-            ( [],
-              Asttypes.Labelled {txt = lbl_name; loc = lbl_loc},
+            ( Asttypes.Labelled {txt = lbl_name; loc = lbl_loc},
               lbl_loc,
               Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) )
           | Colon ->
@@ -1991,26 +1947,24 @@ and parse_parameter p =
               let loc = mk_loc start_pos p.prev_end_pos in
               Ast_helper.Pat.constraint_ ~attrs ~loc pat typ
             in
-            ([], Asttypes.Labelled {txt = lbl_name; loc = lbl_loc}, lbl_loc, pat)
+            (Asttypes.Labelled {txt = lbl_name; loc = lbl_loc}, lbl_loc, pat)
           | As ->
             Parser.next p;
             let pat =
               let pat = parse_constrained_pattern p in
               {pat with ppat_attributes = attrs @ pat.ppat_attributes}
             in
-            ([], Asttypes.Labelled {txt = lbl_name; loc = lbl_loc}, lbl_loc, pat)
+            (Asttypes.Labelled {txt = lbl_name; loc = lbl_loc}, lbl_loc, pat)
           | t ->
             Parser.err p (Diagnostics.unexpected t p.breadcrumbs);
             let loc = mk_loc start_pos p.prev_end_pos in
-            ( [],
-              Asttypes.Labelled {txt = lbl_name; loc = lbl_loc},
+            ( Asttypes.Labelled {txt = lbl_name; loc = lbl_loc},
               lbl_loc,
               Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) ))
         | _ ->
           let pattern = parse_constrained_pattern p in
           let attrs = List.concat [pattern.ppat_attributes; attrs] in
-          ( [],
-            Asttypes.Nolabel,
+          ( Asttypes.Nolabel,
             Location.none,
             {pattern with ppat_attributes = attrs} )
       in
@@ -2035,19 +1989,11 @@ and parse_parameter p =
         match p.Parser.token with
         | Question ->
           Parser.next p;
-          Some
-            (TermParameter
-               {attrs; p_label = lbl; expr = None; pat; p_pos = start_pos})
+          Some (TermParameter {p_label = lbl; expr = None; pat})
         | _ ->
           let expr = parse_constrained_or_coerced_expr p in
-          Some
-            (TermParameter
-               {attrs; p_label = lbl; expr = Some expr; pat; p_pos = start_pos})
-        )
-      | _ ->
-        Some
-          (TermParameter
-             {attrs; p_label = lbl; expr = None; pat; p_pos = start_pos}))
+          Some (TermParameter {p_label = lbl; expr = Some expr; pat}))
+      | _ -> Some (TermParameter {p_label = lbl; expr = None; pat}))
   else None
 
 and parse_parameter_list p =
@@ -2056,7 +2002,7 @@ and parse_parameter_list p =
       ~f:parse_parameter ~closing:Rparen p
   in
   Parser.expect Rparen p;
-  extract_fundef_params ~type_acc:None ~term_acc:[] parameters
+  extract_fundef_params ~type_acc:[] ~term_acc:[] parameters
 
 (* parameters ::=
  *   | _
@@ -2065,7 +2011,7 @@ and parse_parameter_list p =
  *   | (.)                                   (* deprecated uncurried syntax *)
  *   | ( parameter {, parameter} [,] )
  *)
-and parse_parameters p : fundef_type_param option * fundef_term_param list =
+and parse_parameters p : fundef_type_param list * fundef_term_param list =
   let start_pos = p.Parser.start_pos in
   let unit_term_parameter () =
     let loc = mk_loc start_pos p.Parser.prev_end_pos in
@@ -2074,39 +2020,29 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list =
         (Location.mkloc (Longident.Lident "()") loc)
         None
     in
-    {
-      attrs = [];
-      p_label = Asttypes.Nolabel;
-      expr = None;
-      pat = unit_pattern;
-      p_pos = start_pos;
-    }
+    {p_label = Asttypes.Nolabel; expr = None; pat = unit_pattern}
   in
   match p.Parser.token with
   | Lident ident ->
     Parser.next p;
     let loc = mk_loc start_pos p.Parser.prev_end_pos in
-    ( None,
+    ( [],
       [
         {
-          attrs = [];
           p_label = Asttypes.Nolabel;
           expr = None;
           pat = Ast_helper.Pat.var ~loc (Location.mkloc ident loc);
-          p_pos = start_pos;
         };
       ] )
   | Underscore ->
     Parser.next p;
     let loc = mk_loc start_pos p.Parser.prev_end_pos in
-    ( None,
+    ( [],
       [
         {
-          attrs = [];
           p_label = Asttypes.Nolabel;
           expr = None;
           pat = Ast_helper.Pat.any ~loc ();
-          p_pos = start_pos;
         };
       ] )
   | Lparen ->
@@ -2122,7 +2058,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list =
     (type_params, term_params)
   | token ->
     Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
-    (None, [])
+    ([], [])
 
 and parse_coerced_expr ~(expr : Parsetree.expression) p =
   Parser.expect ColonGreaterThan p;
@@ -3412,11 +3348,9 @@ and parse_braced_or_record_expr p =
             ~term_parameters:
               [
                 {
-                  attrs = [];
                   p_label = Nolabel;
                   expr = None;
                   pat = Ast_helper.Pat.var ~loc:ident.loc ident;
-                  p_pos = start_pos;
                 };
               ]
             p
@@ -3778,10 +3712,8 @@ and parse_expr_block ?first p =
   over_parse_constrained_or_coerced_or_arrow_expression p block_expr
 
 and parse_async_arrow_expression ?(arrow_attrs = []) p =
-  let start_pos = p.Parser.start_pos in
   Parser.expect (Lident "async") p;
-  parse_es6_arrow_expression ~async:true ~arrow_attrs
-    ~arrow_start_pos:(Some start_pos) p
+  parse_es6_arrow_expression ~async:true ~arrow_attrs p
 
 and parse_await_expression p =
   let await_loc = mk_loc p.Parser.start_pos p.end_pos in
diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml
index 5b00112fba1..fe63d5b9889 100644
--- a/compiler/syntax/src/res_parsetree_viewer.ml
+++ b/compiler/syntax/src/res_parsetree_viewer.ml
@@ -185,6 +185,19 @@ type fun_param_kind =
     }
   | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list}
 
+(* Turns the function's newtypes into printable groups: a new group starts
+   at each attribute-bearing newtype, matching how the parser distributes
+   group attributes. *)
+let group_newtypes newtypes =
+  List.fold_left
+    (fun groups ((name : string Asttypes.loc), attrs) ->
+      match groups with
+      | (gattrs, locs) :: rest when attrs = [] ->
+        (gattrs, locs @ [name]) :: rest
+      | _ -> (attrs, [name]) :: groups)
+    [] newtypes
+  |> List.rev
+
 let fun_expr expr_ =
   let params_of_fun params =
     List.map
@@ -193,6 +206,10 @@ let fun_expr expr_ =
           {attrs = p_attrs; lbl = p_lbl; default_expr = p_default; pat = p_pat})
       params
   in
+  let newtype_params newtypes =
+    group_newtypes newtypes
+    |> List.map (fun (attrs, locs) -> NewTypes {attrs; locs})
+  in
   (* Turns (type t, type u, type z) into "type t u z". An attribute on a
      nested node (only constructible via PPX) stops the merge so the
      attribute is printed on the node carrying it instead of dropped. *)
@@ -205,14 +222,21 @@ let fun_expr expr_ =
   in
   match expr_ with
   | {pexp_desc = Pexp_newtype (string_loc, rest)} -> (
+    (* PPX-authored wrapper chains; the parser puts a function's newtypes
+       in the [newtypes] field instead. *)
     let string_locs, return_expr = collect_new_types [string_loc] rest in
     let newtype_param = NewTypes {attrs = []; locs = string_locs} in
     match return_expr with
-    | {pexp_desc = Pexp_fun {params; body; async}; pexp_attributes = []} ->
-      (async, newtype_param :: params_of_fun params, body)
+    | {
+     pexp_desc = Pexp_fun {newtypes; params; body; async};
+     pexp_attributes = [];
+    } ->
+      ( async,
+        (newtype_param :: newtype_params newtypes) @ params_of_fun params,
+        body )
     | _ -> (false, [newtype_param], return_expr))
-  | {pexp_desc = Pexp_fun {params; body; async}} ->
-    (async, params_of_fun params, body)
+  | {pexp_desc = Pexp_fun {newtypes; params; body; async}} ->
+    (async, newtype_params newtypes @ params_of_fun params, body)
   | _ -> (false, [], expr_)
 
 let process_braces_attr expr =
diff --git a/compiler/syntax/src/res_parsetree_viewer.mli b/compiler/syntax/src/res_parsetree_viewer.mli
index 10797277be8..e546abfa074 100644
--- a/compiler/syntax/src/res_parsetree_viewer.mli
+++ b/compiler/syntax/src/res_parsetree_viewer.mli
@@ -51,6 +51,12 @@ type fun_param_kind =
     }
   | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list}
 
+(* Groups a function's newtypes into printable groups: a new group starts
+   at each attribute-bearing newtype. *)
+val group_newtypes :
+  (string Asttypes.loc * Parsetree.attributes) list ->
+  (Parsetree.attributes * string Asttypes.loc list) list
+
 val fun_expr :
   Parsetree.expression -> bool * fun_param_kind list * Parsetree.expression
 
diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml
index 612b4adc388..0ed2a1724bf 100644
--- a/compiler/syntax/src/res_printer.ml
+++ b/compiler/syntax/src/res_printer.ml
@@ -2355,7 +2355,8 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl
        ppat_desc =
          Ppat_constraint (pattern, ({ptyp_desc = Ptyp_poly _} as pat_typ));
      };
-   pvb_expr = {pexp_desc = Pexp_newtype _} as expr;
+   pvb_expr =
+     {pexp_desc = Pexp_newtype _ | Pexp_fun {newtypes = _ :: _}} as expr;
   } -> (
     let _, parameters, return_expr = Parsetree_viewer.fun_expr expr in
     let abstract_type =
diff --git a/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res b/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res
index 782392229de..25936d60424 100644
--- a/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res
+++ b/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res
@@ -48,3 +48,6 @@ external phantom: (~a: int, @as(json`false`) _, ~c: string) => unit = "phantom"
 
 // external with uncurried callback argument
 @val external onEvent: (string, (~event: string) => unit) => unit = "on"
+
+// attributed newtype groups: attribute ownership must survive the v0 bridge
+let grouped = @fn (@one type a b, x: a, @two type c, y: c) => (x, y)
diff --git a/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt b/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt
index 782392229de..7605b4147ed 100644
--- a/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt
+++ b/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt
@@ -48,3 +48,6 @@ external phantom: (~a: int, @as(json`false`) _, ~c: string) => unit = "phantom"
 
 // external with uncurried callback argument
 @val external onEvent: (string, (~event: string) => unit) => unit = "on"
+
+// attributed newtype groups: attribute ownership must survive the v0 bridge
+let grouped = @fn (@one type a b, @two type c, x: a, y: c) => (x, y)
diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt
index 0c04ab839d4..f726e44a170 100644
--- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt
+++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt
@@ -28,17 +28,17 @@ let ex2 = (await 3) ** (await 4)
 let ex3 = await (foo -> (bar ~arg))
 let ex4 = await ((foo.bar).baz)
 let attr1 = ((async fun [arity:1]x -> x + 1)[@a ])
-let attr2 = ((fun (type a) ->
-  async fun [arity:1]() -> fun (type b) -> fun (type c) ->
-    fun [arity:1]x -> 3)
+let attr2 =
+  ((async fun (type a) [arity:1]() -> fun (type b) (type c) [arity:1]x -> 3)
   [@a ])
-let attr3 = ((fun (type a) ->
-  fun [arity:1]() -> fun (type b) -> fun (type c) ->
-    async fun [arity:1]x -> 3)
+let attr3 =
+  ((fun (type a) [arity:1]() -> async fun (type b) (type c) [arity:1]x -> 3)
   [@a ])
-let attr4 = ((fun (type a) ->
-  fun [arity:1]() -> ((fun (type b) -> fun (type c) ->
-    async fun [arity:1]x -> 3)[@b ]))
+let attr4 =
+  ((fun (type a) [arity:1]() ->
+      ((async fun (type b) (type c) [arity:1]x -> 3)[@b ]))
   [@a ])
-let (attr5 : int) = ((fun (type a) -> fun (type b) -> fun (type c) ->
-  async fun [arity:1]() -> fun [arity:1](x : a) -> x)[@a ][@b ])
\ No newline at end of file
+let (attr5 : int) =
+  ((async fun (type a) (type b) (type c) [arity:1]() ->
+      fun [arity:1](x : a) -> x)
+  [@a ][@b ])
\ No newline at end of file
diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/locallyAbstractTypes.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/locallyAbstractTypes.res.txt
index 24693d89e30..a8966415fc1 100644
--- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/locallyAbstractTypes.res.txt
+++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/locallyAbstractTypes.res.txt
@@ -3,16 +3,14 @@ let f (type t) (type s) [arity:2](xs : t list) (ys : s list) = ()
 let f (type t) (type u) (type v) [arity:1](xs : (t * u * v) list) = ()
 let f (type t) (type u) (type v) (type s) (type w) (type z)
   [arity:2](xs : (t * u * v) list) (ys : (s * w * z) list) = ()
-let f = ((fun (type t) -> fun (type u) -> fun (type v) -> fun (type s) -> fun
-  (type w) -> fun (type z) ->
-  fun [arity:2](xs : (t * u * v) list) (ys : (s * w * z) list) -> ())
-  [@attr ][@attr2 ])
-let f = ((fun (type t) -> fun (type s) -> fun (type u) -> fun (type v) -> fun
-  (type w) -> fun [arity:2](xs : (t * s) list) (ys : (u * v * w) list) -> ())
-  [@attr ][@attr ][@attr ][@attr ])
+let f =
+  ((fun (type t) (type u) (type v) [@attr2 ](type s) (type w) (type z)
+      [arity:2](xs : (t * u * v) list) (ys : (s * w * z) list) -> ())
+  [@attr ])
+let f [@attr ](type t) [@attr ](type s) [@attr ](type u) [@attr ](type v)
+  (type w) [arity:2](xs : (t * s) list) (ys : (u * v * w) list) = ()
 let cancel_and_collect_callbacks :
   'a 'u 'c .
     packed_callbacks list -> ('a, 'u, 'c) promise ->
       packed_callbacks list (a:2)
-  = fun (type x) ->
-  fun [arity:2]callbacks_accumulator (p : (_, _, c) promise) -> ()
\ No newline at end of file
+  = fun (type x) [arity:2]callbacks_accumulator (p : (_, _, c) promise) -> ()
\ No newline at end of file
diff --git a/tests/syntax_tests/data/printer/comments/expected/expr.res.txt b/tests/syntax_tests/data/printer/comments/expected/expr.res.txt
index 0b346bfe3cb..9196ebdd69b 100644
--- a/tests/syntax_tests/data/printer/comments/expected/expr.res.txt
+++ b/tests/syntax_tests/data/printer/comments/expected/expr.res.txt
@@ -237,9 +237,9 @@ let f = (
 
 let multiply = (type /* c-2 */ t /* c-1 */, /* c0 */ m1 /* c1 */, /* c2 */ m2 /* c3 */) => ()
 let multiply = (
-  type /* c-4 */ t /* c-3 */ s,
+  type /* c-4 */ t /* c-3 */ /* c-2 */ s /* c-1 */,
   /* c0 */ m1 /* c1 */,
-  /* c-2 */ /* c-1 */ /* c2 */ m2 /* c3 */,
+  /* c2 */ m2 /* c3 */,
 ) => ()
 
 f(
diff --git a/tests/syntax_tests/data/printer/expr/expected/newtype.res.txt b/tests/syntax_tests/data/printer/expr/expected/newtype.res.txt
index e97ff990e0e..e8480471a65 100644
--- a/tests/syntax_tests/data/printer/expr/expected/newtype.res.txt
+++ b/tests/syntax_tests/data/printer/expr/expected/newtype.res.txt
@@ -1,12 +1,19 @@
 let f = (type t, xs: list<t>) => ()
 let f = @attr (type t, xs: list<t>) => ()
 let f = (type t s, xs: list<t>, ys: list<s>) => ()
-let f = @attr @attr2 (type t s, xs: list<t>, ys: list<s>) => ()
+let f = @attr (type t, @attr2 type s, xs: list<t>, ys: list<s>) => ()
 let f = (type t u v, xs: list<(t, u, v)>) => ()
 let f = @attr (type t u v, xs: list<(t, u, v)>) => ()
 let f = (type t u v s w z, xs: list<(t, u, v)>, ys: list<(s, w, z)>) => ()
-let f = @attr @attr2 (type t u v s w z, xs: list<(t, u, v)>, ys: list<(s, w, z)>) => ()
-let f = @attr @attr @attr @attr (type t s u v w, xs: list<(t, s)>, ys: list<(u, v, w)>) => ()
+let f = @attr (type t u v, @attr2 type s w z, xs: list<(t, u, v)>, ys: list<(s, w, z)>) => ()
+let f = (
+  @attr type t,
+  @attr type s,
+  @attr type u,
+  @attr type v w,
+  xs: list<(t, s)>,
+  ys: list<(u, v, w)>,
+) => ()
 
 let mk_formatting_gen:
   type a b c d e f. formatting_gen<a, b, c, d, e, f> => Parsetree.expression =
@@ -18,3 +25,8 @@ let mk_formatting_gen:
 let cancel_and_collect_callbacks:
    'a 'u 'c. (list<packed_callbacks>, promise<'a, 'u, 'c>) => list<packed_callbacks> =
   (type x, callbacks_accumulator, p: promise<_, _, c>) => ()
+
+// type parameters written between term parameters are hoisted to the front
+let g = (type t, x, y: t) => y
+let g = (@attr type t u v, x: int, y: t, z: v) => (y, z)
+let g = (type /* c1 */ t /* c2 */, /* before */ x, y: t) => y
diff --git a/tests/syntax_tests/data/printer/expr/newtype.res b/tests/syntax_tests/data/printer/expr/newtype.res
index c8e30bd68e6..a5b6b62eba0 100644
--- a/tests/syntax_tests/data/printer/expr/newtype.res
+++ b/tests/syntax_tests/data/printer/expr/newtype.res
@@ -20,3 +20,8 @@ let cancel_and_collect_callbacks:
   (list<packed_callbacks>, promise<'a, 'u, 'c>) => list<packed_callbacks>
  =
   (type x, callbacks_accumulator, p: promise<_, _, c>) => ();
+
+// type parameters written between term parameters are hoisted to the front
+let g = (x, type t, y: t) => y
+let g = (x: int, @attr type t u, y: t, type v, z: v) => (y, z)
+let g = (/* before */ x, type /* c1 */ t /* c2 */, y: t) => y
diff --git a/tools/src/transforms.ml b/tools/src/transforms.ml
index 901cc9c2154..da3e07f94a9 100644
--- a/tools/src/transforms.ml
+++ b/tools/src/transforms.ml
@@ -3,12 +3,13 @@ let labelled_to_unlabelled_arguments_in_fn_definition (e : Parsetree.expression)
   (* `(~a, ~b, ~c) => ...` to `(a, b, c) => ...` *)
   let rec drop_labels (e : Parsetree.expression) : Parsetree.expression =
     match e.pexp_desc with
-    | Pexp_fun {params; body; async} ->
+    | Pexp_fun {newtypes; params; body; async} ->
       {
         e with
         pexp_desc =
           Pexp_fun
             {
+              newtypes;
               params =
                 List.map
                   (fun (p : Parsetree.fun_param) -> {p with p_lbl = Nolabel})

From a67239fce7e729dc12d427aaa3823a91c647daef Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Mon, 17 Aug 2026 14:19:00 +0200
Subject: [PATCH 5/6] Make locally abstract value constraints structural in the
 parsetree

Replace the desugared encoding of [let f: type a. t = e] - a Ptyp_poly
pattern constraint plus a Pexp_newtype chain over a Pexp_constraint,
with the type stored twice and no AST invariant ensuring that the copies
agree - with a structural field on the binding:

  pvb_constraint: {pvc_newtypes: string loc list; pvc_type: core_type}

Only the [type a.] form uses the field; plain constraints and explicit
polymorphic annotations keep their existing representation. The type is
stored once, and [varify_constructors] now runs in exactly one place,
inside the type checker.

With functions already carrying their locally abstract type parameters in
Pexp_fun.newtypes, this removes the last place where the parser constructs
Pexp_newtype. Delete the constructor from the current parsetree, along with
the Texp_newtype exp_extra, which had no consumer beyond no-op iterators and
the debug printer. The CMT magic number is bumped to Caml1999T024; the CMI
format is unchanged.

Type checking follows the same design as the function case (and OCaml
5.x): type_let introduces the locally abstract types into scope via
type_newtype, types the body against the constraint, and unifies with the
pattern's polymorphic type. This preserves the semantics of the former
desugaring.

The frozen v0 PPX bridge expands the field back into the historical
wrapper-chain encoding and recognizes well-formed instances of that
encoding on the way in, verified by unit tests. A v0 Pexp_newtype chain
that cannot be represented - such as one that does not enclose ReScript's
Function$ encoding, or one whose structure was changed by a PPX - now
becomes a located ocaml.error extension with an explicit message. This is
the only intentional reduction in accepted v0 PPX output.

Formatter bug fix covered by syntax fixtures: a trailing comment between
the constraint type and [=] is no longer dropped. An end-to-end GADT test
checks that refinement still works with the new binding field.

Signed-Off-By: Cristiano Calcagno <cristianoc@users.noreply.github.com>

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
---
 CHANGELOG.md                                  |   2 +
 analysis/src/completion_front_end.ml          |  14 +-
 analysis/src/dump_ast.ml                      |  16 +-
 analysis/src/hint.ml                          |   2 +
 analysis/src/utils.ml                         |   1 -
 analysis/src/xform.ml                         |  11 +-
 compiler/ext/config.ml                        |   2 +-
 .../frontend/ast_tuple_pattern_flatten.ml     |  35 +++-
 compiler/frontend/ast_uncurry_gen.ml          |   4 +-
 compiler/frontend/ast_uncurry_gen.mli         |   1 +
 compiler/frontend/bs_ast_mapper.ml            |  17 +-
 compiler/frontend/bs_builtin_ppx.ml           |  27 ++-
 compiler/ml/ast_async.ml                      |   3 +-
 compiler/ml/ast_helper.ml                     |  11 +-
 compiler/ml/ast_helper.mli                    |   9 +-
 compiler/ml/ast_iterator.ml                   |   8 +-
 compiler/ml/ast_mapper.ml                     |  17 +-
 compiler/ml/ast_mapper_from0.ml               |  81 ++++++--
 compiler/ml/ast_mapper_to0.ml                 |  33 +++-
 compiler/ml/depend.ml                         |   1 -
 compiler/ml/parsetree.ml                      |   8 +-
 compiler/ml/pprintast.ml                      |  69 ++++---
 compiler/ml/printast.ml                       |  11 +-
 compiler/ml/printtyped.ml                     |   3 -
 compiler/ml/tast_iterator.ml                  |   1 -
 compiler/ml/tast_mapper.ml                    |   1 -
 compiler/ml/typecore.ml                       |  81 +++++---
 compiler/ml/typedtree.ml                      |   1 -
 compiler/ml/typedtree.mli                     |   1 -
 compiler/ml/typedtree_iter.ml                 |   3 +-
 compiler/syntax/src/jsx_v4.ml                 |  18 +-
 compiler/syntax/src/res_ast_debugger.ml       |  15 +-
 compiler/syntax/src/res_comments_table.ml     | 183 ++++++++----------
 compiler/syntax/src/res_core.ml               |  34 +---
 compiler/syntax/src/res_parens.ml             |  29 ++-
 compiler/syntax/src/res_parsetree_viewer.ml   |  38 +---
 compiler/syntax/src/res_parsetree_viewer.mli  |   2 +-
 compiler/syntax/src/res_printer.ml            |  44 ++++-
 tests/ounit_tests/ounit_ast_mapper0_tests.ml  | 107 ++++++----
 .../data/ast-mapping/FunctionsAndArrows.res   |   3 +
 .../expected/FunctionsAndArrows.res.txt       |   3 +
 .../expected/valueBindingSugar.res.txt        |   4 +-
 .../printer/comments/valueBindingSugar.res    |   5 +
 tests/tests/src/value_binding_constraint.mjs  |  21 ++
 tests/tests/src/value_binding_constraint.res  |  14 ++
 45 files changed, 610 insertions(+), 384 deletions(-)
 create mode 100644 tests/tests/src/value_binding_constraint.mjs
 create mode 100644 tests/tests/src/value_binding_constraint.res

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 0b0e9ff4e07..6766ae0a811 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -28,6 +28,7 @@
 
 - Preserve parentheses around multiplication, division, and modulo expressions used as exponents. https://github.com/rescript-lang/rescript/pull/8550
 - Make a function's locally abstract types (`(type t, x) => ...`) part of the function AST node instead of a chain of wrapper nodes. Fixes the formatter dropping the association of attributes with their `type` group (`(@attr type t, x, @attr2 type s, y)` used to print as `@attr @attr2` on the function) and comments written next to a type parameter migrating onto the following value parameter.
+- Preserve trailing comments between the type and `=` in locally abstract value constraints (`let f: type a. t /* comment */ = value`).
 - 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 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.
 - 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
@@ -46,6 +47,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 locally abstract value constraints (`let f: type a. t = value`) structural in the parsetree, remove the obsolete `Pexp_newtype` and `Texp_newtype` wrapper metadata, and keep the old encoding confined to the frozen external-PPX bridge. The CMT magic number is bumped to `Caml1999T024`.
 - Eliminate the `Pjs_fn_make`/`Pjs_fn_make_unit` arity-adjustment primitives and the `unsafe_adjust_to_arity` machinery: with structural arity, functions are constructed at their final arity, so the enforcement layer (and the active-pattern currying split it compensated for) is deleted. Generated code improves: no adapter closures for patterns on mutable fields, better constant propagation and name preservation, and recursive modules whose members are plain functions compile statically without the runtime bootstrap.
 - Cleanups enabled by structural arity: remove the unreachable `Too_many_arguments` error and the `?in_function` threading through the type checker that existed only to decorate it; remove the dead `function$`-vs-arrow unification bridge, `Ctype.arity`, and the unused parsetree arity helpers; deduplicate the analysis arrow-flattening helpers.
 
diff --git a/analysis/src/completion_front_end.ml b/analysis/src/completion_front_end.ml
index c9e656a3ade..42115a593b5 100644
--- a/analysis/src/completion_front_end.ml
+++ b/analysis/src/completion_front_end.ml
@@ -769,7 +769,8 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
     let old_in_jsx_context = !in_jsx_context in
     if Utils.is_jsx_component value_binding then in_jsx_context := true;
     (match value_binding with
-    | {pvb_pat = {ppat_desc = Ppat_constraint (_pat, core_type)}; pvb_expr}
+    | {pvb_pat = {ppat_desc = Ppat_constraint (_, core_type)}; pvb_expr}
+    | {pvb_constraint = Some {pvc_type = core_type}; pvb_expr}
       when loc_has_cursor pvb_expr.pexp_loc -> (
       (* Expression with derivable type annotation.
          E.g: let x: someRecord = {<com>} *)
@@ -806,9 +807,14 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
              {context_path = CTypeAtPos loc; prefix; nested = List.rev nested})
       | _ -> ())
     | {
-     pvb_pat = {ppat_desc = Ppat_constraint (_pat, core_type); ppat_loc};
-     pvb_expr;
-    }
+        pvb_pat = {ppat_desc = Ppat_constraint (_, core_type); ppat_loc};
+        pvb_expr;
+      }
+    | {
+        pvb_pat = {ppat_loc};
+        pvb_expr;
+        pvb_constraint = Some {pvc_type = core_type};
+      }
       when loc_has_cursor value_binding.pvb_loc
            && loc_has_cursor ppat_loc = false
            && loc_has_cursor pvb_expr.pexp_loc = false
diff --git a/analysis/src/dump_ast.ml b/analysis/src/dump_ast.ml
index 14c4215e1c0..6c8fd4ed377 100644
--- a/analysis/src/dump_ast.ml
+++ b/analysis/src/dump_ast.ml
@@ -298,11 +298,25 @@ and print_expr_item expr ~pos ~indentation =
   | v -> Printf.sprintf "<unimplemented_pexp_desc: %s>" (Utils.identify_pexp v)
 
 let print_value_binding value ~pos ~indentation =
+  let constraint_ =
+    match value.Parsetree.pvb_constraint with
+    | None -> ""
+    | Some {pvc_newtypes; pvc_type} ->
+      "\n"
+      ^ add_indentation indentation
+      ^ "constraint: type "
+      ^ (pvc_newtypes
+        |> List.map (fun ({Location.txt} as name) ->
+               (name |> print_loc_denominator_loc ~pos) ^ txt)
+        |> String.concat " ")
+      ^ ". "
+      ^ print_core_type pvc_type ~pos
+  in
   print_attributes value.Parsetree.pvb_attributes
   ^ "value" ^ ":\n"
   ^ add_indentation (indentation + 1)
   ^ (value.pvb_pat |> print_pattern ~pos ~indentation:(indentation + 1))
-  ^ "\n"
+  ^ constraint_ ^ "\n"
   ^ add_indentation indentation
   ^ "expr:\n"
   ^ add_indentation (indentation + 1)
diff --git a/analysis/src/hint.ml b/analysis/src/hint.ml
index 9f696668eb4..6f0b87a34b6 100644
--- a/analysis/src/hint.ml
+++ b/analysis/src/hint.ml
@@ -56,6 +56,7 @@ let inlay ~source ~kind_file ~pos ~max_length ~full ~state ~debug =
     (match vb with
     | {
      pvb_pat = {ppat_desc = Ppat_var _};
+     pvb_constraint = None;
      pvb_expr =
        {
          pexp_desc =
@@ -125,6 +126,7 @@ let code_lens ~source ~kind_file ~full ~debug =
     (match vb with
     | {
      pvb_pat = {ppat_desc = Ppat_var _; ppat_loc};
+     pvb_constraint = None;
      pvb_expr = {pexp_desc = Pexp_fun _};
     } ->
       push ppat_loc
diff --git a/analysis/src/utils.ml b/analysis/src/utils.ml
index 94736c41c27..afaa4ae04fa 100644
--- a/analysis/src/utils.ml
+++ b/analysis/src/utils.ml
@@ -111,7 +111,6 @@ let identify_pexp pexp =
   | Pexp_letmodule _ -> "Pexp_letmodule"
   | Pexp_letexception _ -> "Pexp_letexception"
   | Pexp_assert _ -> "Pexp_assert"
-  | Pexp_newtype _ -> "Pexp_newtype"
   | Pexp_pack _ -> "Pexp_pack"
   | Pexp_extension _ -> "Pexp_extension"
   | Pexp_open _ -> "Pexp_open"
diff --git a/analysis/src/xform.ml b/analysis/src/xform.ml
index bb8fbcb04e3..3a7e4d0d483 100644
--- a/analysis/src/xform.ml
+++ b/analysis/src/xform.ml
@@ -322,10 +322,13 @@ module Add_type_annotation = struct
       match si.pstr_desc with
       | Pstr_value (_recFlag, bindings) ->
         let process_binding (vb : Parsetree.value_binding) =
-          (* Can't add a type annotation to a jsx component, or the compiler crashes *)
-          let is_jsx_component = Utils.is_jsx_component vb in
-          if not is_jsx_component then process_pattern vb.pvb_pat;
-          process_function vb.pvb_expr
+          match vb.pvb_constraint with
+          | Some _ -> ()
+          | None ->
+            (* Can't add a type annotation to a jsx component, or the compiler crashes *)
+            let is_jsx_component = Utils.is_jsx_component vb in
+            if not is_jsx_component then process_pattern vb.pvb_pat;
+            process_function vb.pvb_expr
         in
         bindings |> List.iter process_binding;
         Ast_iterator.default_iterator.structure_item iterator si
diff --git a/compiler/ext/config.ml b/compiler/ext/config.ml
index efda9e29ae8..c44aa8392d3 100644
--- a/compiler/ext/config.ml
+++ b/compiler/ext/config.ml
@@ -13,6 +13,6 @@ and ast0_impl_magic_number = "Caml1999M022"
 
 and ast0_intf_magic_number = "Caml1999N022"
 
-and cmt_magic_number = "Caml1999T023"
+and cmt_magic_number = "Caml1999T024"
 
 let load_path = ref ([] : string list)
diff --git a/compiler/frontend/ast_tuple_pattern_flatten.ml b/compiler/frontend/ast_tuple_pattern_flatten.ml
index 165dede4478..626a4c543d2 100644
--- a/compiler/frontend/ast_tuple_pattern_flatten.ml
+++ b/compiler/frontend/ast_tuple_pattern_flatten.ml
@@ -45,10 +45,26 @@ let flattern_tuple_pattern_vb (self : Bs_ast_mapper.mapper)
     (vb : Parsetree.value_binding) (acc : Parsetree.value_binding list) :
     Parsetree.value_binding list =
   let pvb_pat = self.pat self vb.pvb_pat in
+  let pvb_constraint =
+    Option.map
+      (fun {Parsetree.pvc_newtypes; pvc_type} ->
+        {
+          Parsetree.pvc_newtypes =
+            List.map
+              (fun (name : string Asttypes.loc) ->
+                {name with loc = self.location self name.loc})
+              pvc_newtypes;
+          pvc_type = self.typ self pvc_type;
+        })
+      vb.pvb_constraint
+  in
   let pvb_expr = self.expr self vb.pvb_expr in
   let pvb_attributes = self.attributes self vb.pvb_attributes in
-  match (pvb_pat.ppat_desc, pvb_expr.pexp_desc) with
-  | Ppat_tuple xs, _ when List.for_all is_simple_pattern xs -> (
+  match (pvb_constraint, pvb_pat.ppat_desc, pvb_expr.pexp_desc) with
+  | Some _, _, _ ->
+    {pvb_pat; pvb_expr; pvb_constraint; pvb_loc = vb.pvb_loc; pvb_attributes}
+    :: acc
+  | None, Ppat_tuple xs, _ when List.for_all is_simple_pattern xs -> (
     match Ast_open_cxt.destruct_open_tuple pvb_expr [] with
     | Some (wholes, es, tuple_attributes)
       when Ext_list.for_all xs is_simple_pattern && Ext_list.same_length es xs
@@ -59,16 +75,20 @@ let flattern_tuple_pattern_vb (self : Bs_ast_mapper.mapper)
           {
             pvb_pat = pat;
             pvb_expr = Ast_open_cxt.restore_exp exp wholes;
+            pvb_constraint = None;
             pvb_attributes;
             pvb_loc = vb.pvb_loc;
           }
           :: acc)
-    | _ -> {pvb_pat; pvb_expr; pvb_loc = vb.pvb_loc; pvb_attributes} :: acc)
-  | Ppat_record (_, _, Some rest), Pexp_pack {pmod_desc = Pmod_ident _} ->
+    | _ ->
+      {pvb_pat; pvb_expr; pvb_constraint; pvb_loc = vb.pvb_loc; pvb_attributes}
+      :: acc)
+  | None, Ppat_record (_, _, Some rest), Pexp_pack {pmod_desc = Pmod_ident _} ->
     Location.raise_errorf ~loc:rest.rest_loc
       "Record rest patterns are not supported when destructuring modules. Bind \
        the module fields explicitly."
-  | Ppat_record (lid_pats, _, None), Pexp_pack {pmod_desc = Pmod_ident id} ->
+  | None, Ppat_record (lid_pats, _, None), Pexp_pack {pmod_desc = Pmod_ident id}
+    ->
     Ext_list.map_append lid_pats acc (fun {lid; x = pat} ->
         match lid.txt with
         | Lident s ->
@@ -77,13 +97,16 @@ let flattern_tuple_pattern_vb (self : Bs_ast_mapper.mapper)
             pvb_expr =
               Ast_helper.Exp.ident ~loc:lid.loc
                 {lid with txt = Ldot (id.txt, s)};
+            pvb_constraint = None;
             pvb_attributes = [];
             pvb_loc = pat.ppat_loc;
           }
         | _ ->
           Location.raise_errorf ~loc:lid.loc
             "Not supported pattern match on modules")
-  | _ -> {pvb_pat; pvb_expr; pvb_loc = vb.pvb_loc; pvb_attributes} :: acc
+  | _ ->
+    {pvb_pat; pvb_expr; pvb_constraint; pvb_loc = vb.pvb_loc; pvb_attributes}
+    :: acc
 
 let value_bindings_mapper (self : Bs_ast_mapper.mapper)
     (vbs : Parsetree.value_binding list) =
diff --git a/compiler/frontend/ast_uncurry_gen.ml b/compiler/frontend/ast_uncurry_gen.ml
index 217cc313d27..44ff3790968 100644
--- a/compiler/frontend/ast_uncurry_gen.ml
+++ b/compiler/frontend/ast_uncurry_gen.ml
@@ -25,7 +25,7 @@
 open Ast_helper
 
 (* Handling `fun [@this]` used in `object [@bs] end` *)
-let to_method_callback ~async loc (self : Bs_ast_mapper.mapper)
+let to_method_callback ~async ~newtypes loc (self : Bs_ast_mapper.mapper)
     (params : Parsetree.fun_param list) body : Parsetree.expression_desc =
   match params with
   | [] -> assert false
@@ -53,7 +53,7 @@ let to_method_callback ~async loc (self : Bs_ast_mapper.mapper)
     let arity = List.length mapped_params in
     let body =
       Ast_async.make_function_async ~async
-        (Ast_helper.Exp.fun_ ~loc ~async mapped_params result)
+        (Ast_helper.Exp.fun_ ~loc ~async ~newtypes mapped_params result)
     in
     let arity_s = string_of_int arity in
     Stack.pop Js_config.self_stack |> ignore;
diff --git a/compiler/frontend/ast_uncurry_gen.mli b/compiler/frontend/ast_uncurry_gen.mli
index 2e7ea41c8fd..362a7133c4a 100644
--- a/compiler/frontend/ast_uncurry_gen.mli
+++ b/compiler/frontend/ast_uncurry_gen.mli
@@ -24,6 +24,7 @@
 
 val to_method_callback :
   async:bool ->
+  newtypes:(string Asttypes.loc * Parsetree.attributes) list ->
   Location.t ->
   Bs_ast_mapper.mapper ->
   Parsetree.fun_param list ->
diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml
index 07287bfdedc..d8c6498c085 100644
--- a/compiler/frontend/bs_ast_mapper.ml
+++ b/compiler/frontend/bs_ast_mapper.ml
@@ -388,8 +388,6 @@ module E = struct
         (sub.extension_constructor sub cd)
         (sub.expr sub e)
     | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e)
-    | Pexp_newtype (s, e) ->
-      newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e)
     | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
     | Pexp_open (ovf, lid, e) ->
       open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
@@ -538,8 +536,19 @@ let default_mapper =
           ~loc:(this.location this pincl_loc)
           ~attrs:(this.attributes this pincl_attributes));
     value_binding =
-      (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} ->
-        Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr)
+      (fun this {pvb_pat; pvb_expr; pvb_constraint; pvb_attributes; pvb_loc} ->
+        let pvb_pat = this.pat this pvb_pat in
+        let constraint_ =
+          Option.map
+            (fun {pvc_newtypes; pvc_type} ->
+              {
+                pvc_newtypes = List.map (map_loc this) pvc_newtypes;
+                pvc_type = this.typ this pvc_type;
+              })
+            pvb_constraint
+        in
+        let pvb_expr = this.expr this pvb_expr in
+        Vb.mk pvb_pat pvb_expr ?constraint_
           ~loc:(this.location this pvb_loc)
           ~attrs:(this.attributes this pvb_attributes));
     (* #if true then  *)
diff --git a/compiler/frontend/bs_builtin_ppx.ml b/compiler/frontend/bs_builtin_ppx.ml
index 24a8d7adb71..b71c3d2524c 100644
--- a/compiler/frontend/bs_builtin_ppx.ml
+++ b/compiler/frontend/bs_builtin_ppx.ml
@@ -92,9 +92,6 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
   | Pexp_constant (Pconst_integer (s, Some 'l')) ->
     {e with pexp_desc = Pexp_constant (Pconst_integer (s, None))}
   (* End rewriting *)
-  | Pexp_newtype (s, body) ->
-    let res = self.expr self body in
-    {e with pexp_desc = Pexp_newtype (s, res)}
   | Pexp_fun {newtypes; params; body; async} -> (
     match Ast_attributes.process_attributes_rev e.pexp_attributes with
     | Nothing, _ ->
@@ -131,14 +128,12 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
         {
           e with
           pexp_desc =
-            Ast_uncurry_gen.to_method_callback ~async e.pexp_loc self params
-              body;
+            Ast_uncurry_gen.to_method_callback ~async ~newtypes e.pexp_loc self
+              params body;
           pexp_attributes;
         }
       in
-      (* Keep the locally abstract types in scope around the callback. *)
-      Ext_list.fold_right newtypes callback (fun (name, nt_attrs) acc ->
-          Ast_helper.Exp.newtype ~loc:e.pexp_loc ~attrs:nt_attrs name acc))
+      callback)
   | Pexp_apply _ -> Ast_exp_apply.app_exp_mapper e self
   | Pexp_match
       ( b,
@@ -193,6 +188,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
                       ({txt = Lident ("None" as variant_name)}, None) );
               } as pvb_pat;
             pvb_expr;
+            pvb_constraint = None;
             pvb_attributes;
           };
         ],
@@ -305,6 +301,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
               ( {ppat_desc = Ppat_record _}
               | {ppat_desc = Ppat_alias ({ppat_desc = Ppat_record _}, _)} ) as p;
             pvb_expr;
+            pvb_constraint = None;
             pvb_attributes;
             pvb_loc = _;
           };
@@ -519,6 +516,7 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) :
           {
             pvb_pat = {ppat_desc = Ppat_var pval_name} as pvb_pat;
             pvb_expr;
+            pvb_constraint = None;
             pvb_attributes;
             pvb_loc;
           };
@@ -592,7 +590,16 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) :
         str with
         pstr_desc =
           Pstr_value
-            (Nonrecursive, [{pvb_pat; pvb_expr; pvb_attributes; pvb_loc}]);
+            ( Nonrecursive,
+              [
+                {
+                  pvb_pat;
+                  pvb_expr;
+                  pvb_constraint = None;
+                  pvb_attributes;
+                  pvb_loc;
+                };
+              ] );
       })
   | Pstr_attribute ({txt = "config"}, _) -> str
   | _ -> default_mapper.structure_item self str
@@ -742,7 +749,7 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
             | Pexp_ifthenelse (_, then_expr, Some else_expr) ->
               aux then_expr @ aux else_expr
             | Pexp_construct (_, Some expr) -> aux expr
-            | Pexp_fun {body = expr} | Pexp_newtype (_, expr) -> aux expr
+            | Pexp_fun {body = expr} -> aux expr
             | Pexp_constraint (expr, _) -> aux expr
             | Pexp_match (expr, cases) ->
               let case_results =
diff --git a/compiler/ml/ast_async.ml b/compiler/ml/ast_async.ml
index 1764c89d000..9ed8e1b4522 100644
--- a/compiler/ml/ast_async.ml
+++ b/compiler/ml/ast_async.ml
@@ -1,7 +1,6 @@
-let rec dig_async_payload_from_function (expr : Parsetree.expression) =
+let dig_async_payload_from_function (expr : Parsetree.expression) =
   match expr.pexp_desc with
   | Pexp_fun {async} -> async
-  | Pexp_newtype (_, body) -> dig_async_payload_from_function body
   | _ -> false
 
 let add_promise_type ?(loc = Location.none) ~async
diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml
index bb19e9b1e1b..6173f084bb4 100644
--- a/compiler/ml/ast_helper.ml
+++ b/compiler/ml/ast_helper.ml
@@ -191,7 +191,6 @@ module Exp = struct
   let letmodule ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_letmodule (a, b, c))
   let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b))
   let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a)
-  let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b))
   let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
   let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c))
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)
@@ -358,8 +357,14 @@ module Incl = struct
 end
 
 module Vb = struct
-  let mk ?(loc = !default_loc) ?(attrs = []) pat expr =
-    {pvb_pat = pat; pvb_expr = expr; pvb_attributes = attrs; pvb_loc = loc}
+  let mk ?(loc = !default_loc) ?(attrs = []) ?constraint_ pat expr =
+    {
+      pvb_pat = pat;
+      pvb_expr = expr;
+      pvb_constraint = constraint_;
+      pvb_attributes = attrs;
+      pvb_loc = loc;
+    }
 end
 
 module Type = struct
diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli
index 652d248ab5e..5edb575003e 100644
--- a/compiler/ml/ast_helper.mli
+++ b/compiler/ml/ast_helper.mli
@@ -215,7 +215,6 @@ module Exp : sig
     expression ->
     expression
   val assert_ : ?loc:loc -> ?attrs:attrs -> expression -> expression
-  val newtype : ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
   val pack : ?loc:loc -> ?attrs:attrs -> module_expr -> expression
   val open_ :
     ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression
@@ -446,5 +445,11 @@ end
 
 (** Value bindings *)
 module Vb : sig
-  val mk : ?loc:loc -> ?attrs:attrs -> pattern -> expression -> value_binding
+  val mk :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?constraint_:value_constraint ->
+    pattern ->
+    expression ->
+    value_binding
 end
diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml
index 46777f25df4..710a4bcedb4 100644
--- a/compiler/ml/ast_iterator.ml
+++ b/compiler/ml/ast_iterator.ml
@@ -369,7 +369,6 @@ module E = struct
       sub.extension_constructor sub cd;
       sub.expr sub e
     | Pexp_assert e -> sub.expr sub e
-    | Pexp_newtype (_s, e) -> sub.expr sub e
     | Pexp_pack me -> sub.module_expr sub me
     | Pexp_open (_ovf, lid, e) ->
       iter_loc sub lid;
@@ -504,8 +503,13 @@ let default_iterator =
         this.location this pincl_loc;
         this.attributes this pincl_attributes);
     value_binding =
-      (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} ->
+      (fun this {pvb_pat; pvb_expr; pvb_constraint; pvb_attributes; pvb_loc} ->
         this.pat this pvb_pat;
+        Option.iter
+          (fun {pvc_newtypes; pvc_type} ->
+            List.iter (iter_loc this) pvc_newtypes;
+            this.typ this pvc_type)
+          pvb_constraint;
         this.expr this pvb_expr;
         this.location this pvb_loc;
         this.attributes this pvb_attributes);
diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml
index cde7ccfa34d..e48752fb429 100644
--- a/compiler/ml/ast_mapper.ml
+++ b/compiler/ml/ast_mapper.ml
@@ -357,8 +357,6 @@ module E = struct
         (sub.extension_constructor sub cd)
         (sub.expr sub e)
     | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e)
-    | Pexp_newtype (s, e) ->
-      newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e)
     | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
     | Pexp_open (ovf, lid, e) ->
       open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
@@ -499,8 +497,19 @@ let default_mapper =
           ~loc:(this.location this pincl_loc)
           ~attrs:(this.attributes this pincl_attributes));
     value_binding =
-      (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} ->
-        Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr)
+      (fun this {pvb_pat; pvb_expr; pvb_constraint; pvb_attributes; pvb_loc} ->
+        let pvb_pat = this.pat this pvb_pat in
+        let constraint_ =
+          Option.map
+            (fun {pvc_newtypes; pvc_type} ->
+              {
+                pvc_newtypes = List.map (map_loc this) pvc_newtypes;
+                pvc_type = this.typ this pvc_type;
+              })
+            pvb_constraint
+        in
+        let pvb_expr = this.expr this pvb_expr in
+        Vb.mk pvb_pat pvb_expr ?constraint_
           ~loc:(this.location this pvb_loc)
           ~attrs:(this.attributes this pvb_attributes));
     constructor_declaration =
diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml
index b3bdda89843..f038201d092 100644
--- a/compiler/ml/ast_mapper_from0.ml
+++ b/compiler/ml/ast_mapper_from0.ml
@@ -768,9 +768,8 @@ module E = struct
          newtype's attributes, except on this outermost wrapper:
          attributes before the internal [_res.newtype_attrs] marker (or
          all of them, when there is no marker) are function-node
-         attributes, the ones after the marker belong to the first
-         newtype. Chains over anything else (e.g. the
-         [let f: type t. ...] sugar) keep their [Pexp_newtype] nodes. *)
+         attributes, and those after the marker belong to the first
+         newtype. *)
       let node_attrs, first_nt_attrs =
         let rec split acc = function
           | ({txt = "_res.newtype_attrs"}, _) :: rest -> (List.rev acc, rest)
@@ -789,6 +788,14 @@ module E = struct
           Some (List.rev acc, e0)
         | _ -> None
       in
+      let unsupported () =
+        extension ~loc ~attrs
+          (Ast_mapper.extension_of_error
+             (Location.errorf ~loc
+                "A PPX returned a locally abstract type wrapper that does not \
+                 enclose a ReScript function. This v0 AST form is not \
+                 supported."))
+      in
       match gather [(map_loc sub s, first_nt_attrs)] e with
       | Some (newtypes, base) -> (
         let base1 = sub.expr sub base in
@@ -799,18 +806,8 @@ module E = struct
             pexp_attributes = base1.pexp_attributes @ node_attrs;
             pexp_loc = loc;
           }
-        | _ -> (
-          (* PPX-mangled Function$: keep the wrapper chain as-is. *)
-          match newtypes with
-          | [] -> assert false
-          | (n0, _) :: rest ->
-            let inner =
-              List.fold_right
-                (fun (n, a) acc -> newtype ~loc ~attrs:a n acc)
-                rest base1
-            in
-            newtype ~loc ~attrs n0 inner))
-      | None -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e))
+        | _ -> unsupported ())
+      | None -> unsupported ())
     | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
     | Pexp_open (ovf, lid, e) ->
       open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
@@ -926,9 +923,57 @@ let default_mapper =
           ~attrs:(this.attributes this pincl_attributes));
     value_binding =
       (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} ->
-        Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr)
-          ~loc:(this.location this pvb_loc)
-          ~attrs:(this.attributes this pvb_attributes));
+        let decoded =
+          match pvb_pat with
+          | {
+           ppat_desc =
+             Ppat_constraint
+               ( pat,
+                 {
+                   ptyp_desc = Ptyp_poly (poly_newtypes, poly_type);
+                   ptyp_attributes = [];
+                 } );
+           ppat_attributes = [];
+          }
+            when poly_newtypes <> [] -> (
+            let rec gather_newtypes acc (expr : Parsetree0.expression) =
+              match expr with
+              | {pexp_desc = Pexp_newtype (newtype, rest); pexp_attributes = []}
+                ->
+                gather_newtypes (newtype :: acc) rest
+              | {pexp_desc = Pexp_constraint (expr, typ); pexp_attributes = []}
+                ->
+                Some (List.rev acc, expr, typ)
+              | _ -> None
+            in
+            match gather_newtypes [] pvb_expr with
+            | Some (newtypes, expr, typ)
+              when List.map (fun {txt} -> txt) newtypes
+                   = List.map (fun {txt} -> txt) poly_newtypes
+                   &&
+                   try
+                     Ast_helper0.Typ.varify_constructors newtypes typ
+                     = poly_type
+                   with Syntaxerr.Error _ -> false ->
+              Some (pat, expr, newtypes, typ)
+            | _ -> None)
+          | _ -> None
+        in
+        match decoded with
+        | Some (pat, expr, newtypes, typ) ->
+          let constraint_ =
+            {
+              Pt.pvc_newtypes = List.map (map_loc this) newtypes;
+              pvc_type = this.typ this typ;
+            }
+          in
+          Vb.mk (this.pat this pat) (this.expr this expr) ~constraint_
+            ~loc:(this.location this pvb_loc)
+            ~attrs:(this.attributes this pvb_attributes)
+        | None ->
+          Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr)
+            ~loc:(this.location this pvb_loc)
+            ~attrs:(this.attributes this pvb_attributes));
     constructor_declaration =
       (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} ->
         Type.constructor (map_loc this pcd_name)
diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml
index 87c26a060ce..27bf129cfcb 100644
--- a/compiler/ml/ast_mapper_to0.ml
+++ b/compiler/ml/ast_mapper_to0.ml
@@ -589,8 +589,6 @@ module E = struct
         (sub.extension_constructor sub cd)
         (sub.expr sub e)
     | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e)
-    | Pexp_newtype (s, e) ->
-      newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e)
     | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
     | Pexp_open (ovf, lid, e) ->
       open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
@@ -779,10 +777,33 @@ let default_mapper =
           ~loc:(this.location this pincl_loc)
           ~attrs:(this.attributes this pincl_attributes));
     value_binding =
-      (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} ->
-        Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr)
-          ~loc:(this.location this pvb_loc)
-          ~attrs:(this.attributes this pvb_attributes));
+      (fun this {pvb_pat; pvb_expr; pvb_constraint; pvb_attributes; pvb_loc} ->
+        let loc = this.location this pvb_loc in
+        let pvb_pat, pvb_expr =
+          match pvb_constraint with
+          | None -> (this.pat this pvb_pat, this.expr this pvb_expr)
+          | Some {pvc_newtypes; pvc_type} ->
+            let poly =
+              Ast_helper.Typ.poly ~loc:pvb_loc pvc_newtypes
+                (Ast_helper.Typ.varify_constructors pvc_newtypes pvc_type)
+            in
+            let pat =
+              Ast_helper0.Pat.constraint_ ~loc (this.pat this pvb_pat)
+                (this.typ this poly)
+            in
+            let expr =
+              Ast_helper0.Exp.constraint_ ~loc (this.expr this pvb_expr)
+                (this.typ this pvc_type)
+            in
+            let expr =
+              List.fold_right
+                (fun newtype expr ->
+                  Ast_helper0.Exp.newtype ~loc (map_loc this newtype) expr)
+                pvc_newtypes expr
+            in
+            (pat, expr)
+        in
+        Vb.mk pvb_pat pvb_expr ~loc ~attrs:(this.attributes this pvb_attributes));
     constructor_declaration =
       (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} ->
         Type.constructor (map_loc this pcd_name)
diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml
index 4ebf8950d1b..cf826136c71 100644
--- a/compiler/ml/depend.ml
+++ b/compiler/ml/depend.ml
@@ -285,7 +285,6 @@ let rec add_expr bv exp =
     add_expr (String_map.add id.txt b bv) e
   | Pexp_letexception (_, e) -> add_expr bv e
   | Pexp_assert e -> add_expr bv e
-  | Pexp_newtype (_, e) -> add_expr bv e
   | Pexp_pack m -> add_module bv m
   | Pexp_open (_ovf, m, e) ->
     let bv = open_module bv m.txt in
diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml
index 7a41fc196e8..3cf05f79e94 100644
--- a/compiler/ml/parsetree.ml
+++ b/compiler/ml/parsetree.ml
@@ -311,7 +311,6 @@ and expression_desc =
     (* assert E
        Note: "assert false" is treated in a special way by the
        type-checker. *)
-  | Pexp_newtype of string loc * expression (* fun (type t) -> E *)
   | Pexp_pack of module_expr
     (* (module ME)
 
@@ -670,9 +669,16 @@ and structure_item_desc =
   | Pstr_extension of extension * attributes
 (* [%%id] *)
 
+and value_constraint = {
+  pvc_newtypes: string loc list;
+  (* Nonempty for parser-produced [let x: type a. t = e] bindings. *)
+  pvc_type: core_type;
+}
+
 and value_binding = {
   pvb_pat: pattern;
   pvb_expr: expression;
+  pvb_constraint: value_constraint option;
   pvb_attributes: attributes;
   pvb_loc: Location.t;
 }
diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml
index df2599b1bef..9077976d88c 100644
--- a/compiler/ml/pprintast.ml
+++ b/compiler/ml/pprintast.ml
@@ -780,8 +780,6 @@ and simple_expr ctxt f x =
     (* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
     | Pexp_constant c -> constant f c
     | Pexp_pack me -> pp f "(module@;%a)" (module_expr ctxt) me
-    | Pexp_newtype (lid, e) ->
-      pp f "fun@;(type@;%s)@;->@;%a" lid.txt (expression ctxt) e
     | Pexp_tuple l ->
       pp f "@[<hov2>(%a)@]" (list (simple_expr ctxt) ~sep:",@;") l
     | Pexp_constraint (e, ct) ->
@@ -1062,7 +1060,7 @@ and payload ctxt f = function
     expression ctxt f e
 
 (* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
-and binding ctxt f {pvb_pat = p; pvb_expr = x; _} =
+and binding ctxt f {pvb_pat = p; pvb_expr = x; pvb_constraint; _} =
   (* .pvb_attributes have already been printed by the caller, #bindings *)
   let rec pp_print_pexp_function f x =
     if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
@@ -1089,8 +1087,6 @@ and binding ctxt f {pvb_pat = p; pvb_expr = x; _} =
         in
         pp f "%s%a%s%a%a" async_str pp_newtypes newtypes arity_str pp_params
           params pp_print_pexp_function body
-      | Pexp_newtype (str, e) ->
-        pp f "(type@ %s)@ %a" str.txt pp_print_pexp_function e
       | _ -> pp f "=@;%a" (expression ctxt) x
   in
   let tyvars_str tyvars = List.map (fun v -> v.txt) tyvars in
@@ -1107,15 +1103,12 @@ and binding ctxt f {pvb_pat = p; pvb_expr = x; _} =
         Some (pat, args_tyvars, rt)
       | _ -> None
     in
-    let rec gadt_exp tyvars e =
+    let gadt_exp =
       match e with
-      | {pexp_desc = Pexp_newtype (tyvar, e); pexp_attributes = []} ->
-        gadt_exp (tyvar :: tyvars) e
       | {pexp_desc = Pexp_constraint (e, ct); pexp_attributes = []} ->
-        Some (List.rev tyvars, e, ct)
+        Some ([], e, ct)
       | _ -> None
     in
-    let gadt_exp = gadt_exp [] e in
     match (gadt_pattern, gadt_exp) with
     | Some (p, pt_tyvars, pt_ct), Some (e_tyvars, e, e_ct)
       when tyvars_str pt_tyvars = tyvars_str e_tyvars ->
@@ -1123,31 +1116,37 @@ and binding ctxt f {pvb_pat = p; pvb_expr = x; _} =
       if ety = pt_ct then Some (p, pt_tyvars, e_ct, e) else None
     | _ -> None
   in
-  if x.pexp_attributes <> [] then
-    pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
-  else
-    match is_desugared_gadt p x with
-    | Some (p, [], ct, e) ->
-      pp f "%a@;: %a@;=@;%a" (simple_pattern ctxt) p (core_type ctxt) ct
-        (expression ctxt) e
-    | Some (p, tyvars, ct, e) ->
-      pp f "%a@;: type@;%a.@;%a@;=@;%a" (simple_pattern ctxt) p
-        (list pp_print_string ~sep:"@;")
-        (tyvars_str tyvars) (core_type ctxt) ct (expression ctxt) e
-    | None -> (
-      match p with
-      | {ppat_desc = Ppat_constraint (p, ty); ppat_attributes = []} -> (
-        (* special case for the first*)
-        match ty with
-        | {ptyp_desc = Ptyp_poly _; ptyp_attributes = []} ->
-          pp f "%a@;:@;%a@;=@;%a" (simple_pattern ctxt) p (core_type ctxt) ty
-            (expression ctxt) x
-        | _ ->
-          pp f "(%a@;:@;%a)@;=@;%a" (simple_pattern ctxt) p (core_type ctxt) ty
-            (expression ctxt) x)
-      | {ppat_desc = Ppat_var _; ppat_attributes = []} ->
-        pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
-      | _ -> pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x)
+  match pvb_constraint with
+  | Some {pvc_newtypes; pvc_type} ->
+    pp f "%a@;: type@;%a.@;%a@;=@;%a" (simple_pattern ctxt) p
+      (list pp_print_string ~sep:"@;")
+      (tyvars_str pvc_newtypes) (core_type ctxt) pvc_type (expression ctxt) x
+  | None -> (
+    if x.pexp_attributes <> [] then
+      pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
+    else
+      match is_desugared_gadt p x with
+      | Some (p, [], ct, e) ->
+        pp f "%a@;: %a@;=@;%a" (simple_pattern ctxt) p (core_type ctxt) ct
+          (expression ctxt) e
+      | Some (p, tyvars, ct, e) ->
+        pp f "%a@;: type@;%a.@;%a@;=@;%a" (simple_pattern ctxt) p
+          (list pp_print_string ~sep:"@;")
+          (tyvars_str tyvars) (core_type ctxt) ct (expression ctxt) e
+      | None -> (
+        match p with
+        | {ppat_desc = Ppat_constraint (p, ty); ppat_attributes = []} -> (
+          (* special case for the first*)
+          match ty with
+          | {ptyp_desc = Ptyp_poly _; ptyp_attributes = []} ->
+            pp f "%a@;:@;%a@;=@;%a" (simple_pattern ctxt) p (core_type ctxt) ty
+              (expression ctxt) x
+          | _ ->
+            pp f "(%a@;:@;%a)@;=@;%a" (simple_pattern ctxt) p (core_type ctxt)
+              ty (expression ctxt) x)
+        | {ppat_desc = Ppat_var _; ppat_attributes = []} ->
+          pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
+        | _ -> pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x))
 
 (* [in] is not printed *)
 and bindings ctxt f (rf, l) =
diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml
index a92f386eee3..3051e794853 100644
--- a/compiler/ml/printast.ml
+++ b/compiler/ml/printast.ml
@@ -358,9 +358,6 @@ and expression i ppf x =
   | Pexp_assert e ->
     line i ppf "Pexp_assert\n";
     expression i ppf e
-  | Pexp_newtype (s, e) ->
-    line i ppf "Pexp_newtype \"%s\"\n" s.txt;
-    expression i ppf e
   | Pexp_pack me ->
     line i ppf "Pexp_pack\n";
     module_expr i ppf me
@@ -726,6 +723,14 @@ and value_binding i ppf x =
   line i ppf "<def>\n";
   attributes (i + 1) ppf x.pvb_attributes;
   pattern (i + 1) ppf x.pvb_pat;
+  (match x.pvb_constraint with
+  | None -> ()
+  | Some {pvc_newtypes; pvc_type} ->
+    line (i + 1) ppf "<constraint>\n";
+    List.iter
+      (fun {txt} -> line (i + 2) ppf "newtype \"%s\"\n" txt)
+      pvc_newtypes;
+    core_type (i + 2) ppf pvc_type);
   expression (i + 1) ppf x.pvb_expr
 
 and longident_x_expression i ppf {lid = li; x = e; opt} =
diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml
index 529b2de39c4..e5ae95b81c0 100644
--- a/compiler/ml/printtyped.ml
+++ b/compiler/ml/printtyped.ml
@@ -263,9 +263,6 @@ and expression_extra i ppf x attrs =
   | Texp_open (ovf, m, _, _) ->
     line i ppf "Texp_open %a \"%a\"\n" fmt_override_flag ovf fmt_path m;
     attributes i ppf attrs
-  | Texp_newtype s ->
-    line i ppf "Texp_newtype \"%s\"\n" s;
-    attributes i ppf attrs
 
 and expression i ppf x =
   line i ppf "expression %a\n" fmt_location x.exp_loc;
diff --git a/compiler/ml/tast_iterator.ml b/compiler/ml/tast_iterator.ml
index 9c8441fb986..fcc25510d7c 100644
--- a/compiler/ml/tast_iterator.ml
+++ b/compiler/ml/tast_iterator.ml
@@ -140,7 +140,6 @@ let expr sub {exp_extra; exp_desc; exp_env; _} =
   let extra = function
     | Texp_constraint cty -> sub.typ sub cty
     | Texp_coerce cty2 -> sub.typ sub cty2
-    | Texp_newtype _ -> ()
     | Texp_open (_, _, _, _) -> ()
   in
   List.iter (fun (e, _, _) -> extra e) exp_extra;
diff --git a/compiler/ml/tast_mapper.ml b/compiler/ml/tast_mapper.ml
index 0cfdc3e86cc..cbf0c45b5fa 100644
--- a/compiler/ml/tast_mapper.ml
+++ b/compiler/ml/tast_mapper.ml
@@ -185,7 +185,6 @@ let expr sub x =
     | Texp_coerce cty2 -> Texp_coerce (sub.typ sub cty2)
     | Texp_open (ovf, path, loc, env) ->
       Texp_open (ovf, path, loc, sub.env sub env)
-    | Texp_newtype _ as d -> d
   in
   let exp_extra = List.map (tuple3 extra id id) x.exp_extra in
   let exp_env = sub.env sub x.exp_env in
diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml
index c01bd4d9a0a..95340fd304b 100644
--- a/compiler/ml/typecore.ml
+++ b/compiler/ml/typecore.ml
@@ -182,7 +182,6 @@ let iter_expression f e =
       may expr eo;
       List.iter (fun {x = e} -> expr e) iel
     | Pexp_open (_, _, e)
-    | Pexp_newtype (_, e)
     | Pexp_assert e
     | Pexp_send (e, _)
     | Pexp_constraint (e, _)
@@ -2467,10 +2466,14 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
         exp_env = env;
       }
   | Pexp_fun
-      {newtypes = (name, nt_attrs) :: rest; params; body = sfun_body; async} ->
+      {
+        newtypes = (name, _newtype_attributes) :: rest;
+        params;
+        body = sfun_body;
+        async;
+      } ->
     (* Bring the function's locally abstract types into scope one at a
-       time, typing the remainder of the function inside each scope, the
-       same way a chain of [Pexp_newtype] wrappers would. *)
+       time, typing the remainder of the function inside each scope. *)
     let speeled =
       {
         sexp with
@@ -2478,7 +2481,7 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
       }
     in
     rue
-      (type_newtype ~loc ~env ~name:name.txt ~attrs:nt_attrs (fun new_env ->
+      (type_newtype ~loc ~env ~name:name.txt (fun new_env ->
            type_exp ~context:None new_env speeled))
   | Pexp_fun {newtypes = []; params; body = sfun_body; async} ->
     type_function ~async loc sexp.pexp_attributes env ty_expected params
@@ -3407,10 +3410,6 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
         exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
-  | Pexp_newtype ({txt = name}, sbody) ->
-    rue
-      (type_newtype ~loc ~env ~name ~attrs:sexp.pexp_attributes (fun new_env ->
-           type_exp ~context:None new_env sbody))
   | Pexp_pack m ->
     let p, nl =
       match Ctype.expand_head env (instance env ty_expected) with
@@ -3472,11 +3471,10 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
 (* Type [type_body] with the locally abstract type [name] in scope: a
    fresh abstract type constructor is entered into the environment, and
    every occurrence of it in the result type is replaced by a type
-   variable afterwards. Used both for [Pexp_newtype] nodes and for the
-   [newtypes] of a function. The result still needs to be unified with
-   the expected type by the caller. *)
-and type_newtype ~loc ~env ~name ~attrs
-    (type_body : Env.t -> Typedtree.expression) =
+   variable afterwards. Used for structurally represented locally abstract
+   type binders. The result still needs to be unified with the expected type
+   by the caller. *)
+and type_newtype ~loc ~env ~name (type_body : Env.t -> Typedtree.expression) =
   let ty = newvar () in
   (* remember original level *)
   begin_def ();
@@ -3522,14 +3520,9 @@ and type_newtype ~loc ~env ~name ~attrs
   (* lower the levels of the result type *)
   (* unify_var env ty ety; *)
 
-  (* non-expansive if the body is non-expansive, so we don't introduce
-     any new extra node in the typed AST. *)
-  {
-    body with
-    exp_loc = loc;
-    exp_type = ety;
-    exp_extra = (Texp_newtype name, loc, attrs) :: body.exp_extra;
-  }
+  (* Locally abstract type binders affect typing only; they do not introduce
+     an expression node in the typed tree. *)
+  {body with exp_loc = loc; exp_type = ety}
 
 and type_function ~async loc attrs env ty_expected_
     (sparams : Parsetree.fun_param list) sbody =
@@ -4468,6 +4461,20 @@ and type_cases ~(call_context : [`LetUnwrap | `Switch | `Function | `Try]) env
 and type_let ~context ?(check = fun s -> Warnings.Unused_var s)
     ?(check_strict = fun s -> Warnings.Unused_var_strict s) env rec_flag
     spat_sexp_list scope allow =
+  let spat_sexp_list =
+    List.map
+      (fun (vb : Parsetree.value_binding) ->
+        match vb.pvb_constraint with
+        | None -> vb
+        | Some {pvc_newtypes; pvc_type} ->
+          let loc = vb.pvb_loc in
+          let poly =
+            Ast_helper.Typ.poly ~loc pvc_newtypes
+              (Ast_helper.Typ.varify_constructors pvc_newtypes pvc_type)
+          in
+          {vb with pvb_pat = Ast_helper.Pat.constraint_ ~loc vb.pvb_pat poly})
+      spat_sexp_list
+  in
   begin_def ();
   let is_fake_let =
     match spat_sexp_list with
@@ -4587,25 +4594,39 @@ and type_let ~context ?(check = fun s -> Warnings.Unused_var s)
   in
   let exp_list =
     List.map2
-      (fun {pvb_expr = sexp; pvb_attributes; _} (pat, slot) ->
+      (fun {pvb_expr = sexp; pvb_constraint; pvb_attributes; pvb_loc; _}
+           (pat, slot) ->
         let sexp =
           if rec_flag = Recursive then wrap_unpacks sexp unpacks else sexp
         in
         if is_recursive then current_slot := slot;
+        let type_expression expected =
+          Builtin_attributes.warning_scope pvb_attributes (fun () ->
+              match pvb_constraint with
+              | None -> type_expect ~context exp_env sexp expected
+              | Some {pvc_newtypes; pvc_type} ->
+                let constrained =
+                  Ast_helper.Exp.constraint_ ~loc:pvb_loc sexp pvc_type
+                in
+                let rec scope env = function
+                  | [] -> type_exp ~context env constrained
+                  | {txt = name} :: rest ->
+                    type_newtype ~loc:pvb_loc ~env ~name (fun env ->
+                        scope env rest)
+                in
+                let exp = scope exp_env pvc_newtypes in
+                unify_exp ~context exp_env exp (instance exp_env expected);
+                exp)
+        in
         match pat.pat_type.desc with
         | Tpoly (ty, tl) ->
           begin_def ();
           let vars, ty' = instance_poly ~keep_names:true true tl ty in
-          let exp =
-            Builtin_attributes.warning_scope pvb_attributes (fun () ->
-                type_expect ~context exp_env sexp ty')
-          in
+          let exp = type_expression ty' in
           end_def ();
           check_univars env true "definition" exp pat.pat_type vars;
           {exp with exp_type = instance env exp.exp_type}
-        | _ ->
-          Builtin_attributes.warning_scope pvb_attributes (fun () ->
-              type_expect ~context exp_env sexp pat.pat_type))
+        | _ -> type_expression pat.pat_type)
       spat_sexp_list pat_slot_list
   in
   current_slot := None;
diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml
index 91cd31774e3..a220dccb36c 100644
--- a/compiler/ml/typedtree.ml
+++ b/compiler/ml/typedtree.ml
@@ -76,7 +76,6 @@ and exp_extra =
   | Texp_constraint of core_type
   | Texp_coerce of core_type
   | Texp_open of override_flag * Path.t * Longident.t loc * Env.t
-  | Texp_newtype of string
 
 and expression_desc =
   | Texp_ident of Path.t * Longident.t loc * Types.value_description
diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli
index f4d4b6cb7a7..74e20acb956 100644
--- a/compiler/ml/typedtree.mli
+++ b/compiler/ml/typedtree.mli
@@ -123,7 +123,6 @@ and exp_extra =
       (** let open[!] M in    [Texp_open (!, P, M, env)]
                                 where [env] is the environment after opening [P]
          *)
-  | Texp_newtype of string  (** fun (type t) ->  *)
 
 and expression_desc =
   | Texp_ident of Path.t * Longident.t loc * Types.value_description
diff --git a/compiler/ml/typedtree_iter.ml b/compiler/ml/typedtree_iter.ml
index 6ad85a37e06..378891ce04e 100644
--- a/compiler/ml/typedtree_iter.ml
+++ b/compiler/ml/typedtree_iter.ml
@@ -217,8 +217,7 @@ end = struct
           match cstr with
           | Texp_constraint ct -> iter_core_type ct
           | Texp_coerce cty2 -> iter_core_type cty2
-          | Texp_open _ -> ()
-          | Texp_newtype _ -> ()))
+          | Texp_open _ -> ()))
       exp.exp_extra;
     (match exp.exp_desc with
     | Texp_ident _ -> ()
diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml
index a71a03073d6..ccc31703642 100644
--- a/compiler/syntax/src/jsx_v4.ml
+++ b/compiler/syntax/src/jsx_v4.ml
@@ -245,9 +245,6 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type =
     (* Collected newtypes are accumulated in reverse source order. *)
     let newtypes = List.rev_append fun_newtypes newtypes in
     transform_params_for_make ~expr ~body params args newtypes core_type
-  | Pexp_newtype (label, expression) ->
-    recursively_transform_named_args_for_make expression args
-      ((label, []) :: newtypes) core_type
   | Pexp_constraint (expression, core_type) ->
     recursively_transform_named_args_for_make expression args newtypes
       (Some core_type)
@@ -397,7 +394,7 @@ let modified_binding_old binding =
   let rec spelunk_for_fun_expression expression =
     match expression with
     (* let make = (~prop) => ... *)
-    | {pexp_desc = Pexp_fun _} | {pexp_desc = Pexp_newtype _} -> expression
+    | {pexp_desc = Pexp_fun _} -> expression
     (* let make = {let foo = bar in (~prop) => ...} *)
     | {pexp_desc = Pexp_let (_recursive, _vbs, return_expression)} ->
       (* here's where we spelunk! *)
@@ -553,8 +550,6 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name binding =
         expr with
         pexp_desc = Pexp_fun {desc with body = constrain_jsx_return body};
       }
-    | Pexp_newtype (param, inner) ->
-      {expr with pexp_desc = Pexp_newtype (param, constrain_jsx_return inner)}
     | Pexp_constraint (inner, _) ->
       let constrained_inner = constrain_jsx_return inner in
       jsx_element_constraint constrained_inner
@@ -569,6 +564,12 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name binding =
   in
   if Jsx_common.has_attr_on_binding Jsx_common.has_attr binding then (
     check_multiple_components ~config ~loc:pstr_loc;
+    let binding_newtypes, binding_core_type =
+      match binding.pvb_constraint with
+      | None -> ([], None)
+      | Some {pvc_newtypes; pvc_type} ->
+        (List.rev_map (fun name -> (name, [])) pvc_newtypes, Some pvc_type)
+    in
     let core_type_of_attr =
       Jsx_common.core_type_of_attrs binding.pvb_attributes
     in
@@ -583,6 +584,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name binding =
       {
         binding with
         pvb_pat = {binding.pvb_pat with ppat_loc = empty_loc};
+        pvb_constraint = None;
         pvb_loc = empty_loc;
         pvb_attributes = binding.pvb_attributes |> List.filter other_attrs_pure;
       }
@@ -598,7 +600,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name binding =
     let named_arg_list, newtypes, _typeConstraints =
       recursively_transform_named_args_for_make
         (modified_binding_old binding)
-        [] [] None
+        [] binding_newtypes binding_core_type
     in
     let named_type_list = List.fold_left arg_to_type [] named_arg_list in
     (* type props = { ... } *)
@@ -679,8 +681,6 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name binding =
     let rec returned_expression patterns_with_label patterns_with_nolabel
         ({pexp_desc} as expr) =
       match pexp_desc with
-      | Pexp_newtype (_, expr) ->
-        returned_expression patterns_with_label patterns_with_nolabel expr
       | Pexp_constraint (expr, _) ->
         returned_expression patterns_with_label patterns_with_nolabel expr
       | Pexp_fun {params; body} ->
diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml
index 3f2eb9a949e..2b64cdecf0a 100644
--- a/compiler/syntax/src/res_ast_debugger.ml
+++ b/compiler/syntax/src/res_ast_debugger.ml
@@ -392,6 +392,18 @@ module Sexp_ast = struct
       [
         Sexp.atom "value_binding";
         pattern vb.pvb_pat;
+        (match vb.pvb_constraint with
+        | None -> Sexp.atom "None"
+        | Some {pvc_newtypes; pvc_type} ->
+          Sexp.list
+            [
+              Sexp.atom "Some";
+              Sexp.list
+                (map_empty
+                   ~f:(fun ({txt} : string Asttypes.loc) -> string txt)
+                   pvc_newtypes);
+              core_type pvc_type;
+            ]);
         expression vb.pvb_expr;
         attributes vb.pvb_attributes;
       ]
@@ -721,9 +733,6 @@ module Sexp_ast = struct
             expression expr;
           ]
       | Pexp_assert expr -> Sexp.list [Sexp.atom "Pexp_assert"; expression expr]
-      | Pexp_newtype (lbl, expr) ->
-        Sexp.list
-          [Sexp.atom "Pexp_newtype"; string lbl.Asttypes.txt; expression expr]
       | Pexp_pack mod_expr ->
         Sexp.list [Sexp.atom "Pexp_pack"; module_expression mod_expr]
       | Pexp_open (flag, longident_loc, expr) ->
diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml
index 841640bb01e..3d8c0c6e9e4 100644
--- a/compiler/syntax/src/res_comments_table.ml
+++ b/compiler/syntax/src/res_comments_table.ml
@@ -374,26 +374,6 @@ let fun_expr expr =
     |> List.map (fun ((name : string Location.loc), attrs) ->
            (attrs, Asttypes.Nolabel, None, Ast_helper.Pat.var ~loc:name.loc name))
   in
-  (* Turns (type t, type u, type z) into "type t u z" *)
-  let rec collect_new_types acc return_expr =
-    match return_expr with
-    | {pexp_desc = Pexp_newtype (string_loc, return_expr); pexp_attributes = []}
-      ->
-      collect_new_types (string_loc :: acc) return_expr
-    | return_expr ->
-      let loc =
-        match (acc, List.rev acc) with
-        | _startLoc :: _, end_loc :: _ ->
-          {end_loc.loc with loc_end = end_loc.loc.loc_end}
-        | _ -> Location.none
-      in
-      let txt =
-        List.fold_right
-          (fun curr acc -> acc ^ " " ^ curr.Location.txt)
-          acc "type"
-      in
-      (Location.mkloc txt loc, return_expr)
-  in
   let params_of params =
     params
     |> List.map (fun {p_attrs; p_lbl; p_default; p_pat} ->
@@ -408,18 +388,6 @@ let fun_expr expr =
       params
   in
   match expr with
-  | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} -> (
-    let var, return_expr = collect_new_types [string_loc] rest in
-    let newtype_param =
-      (attrs, Asttypes.Nolabel, None, Ast_helper.Pat.var ~loc:string_loc.loc var)
-    in
-    match return_expr with
-    | {pexp_desc = Pexp_fun {newtypes; params; body}; pexp_attributes = []} ->
-      ( [],
-        newtype_param
-        :: in_source_order (newtype_params newtypes @ params_of params),
-        body )
-    | return_expr -> ([], [newtype_param], return_expr))
   | {pexp_desc = Pexp_fun {newtypes; params; body}; pexp_attributes = attrs} ->
     (attrs, in_source_order (newtype_params newtypes @ params_of params), body)
   | expr -> ([], [], expr)
@@ -912,80 +880,85 @@ and walk_constructor_arguments args t comments =
 
 and walk_value_binding vb t comments =
   let open Location in
-  let vb =
-    let open Parsetree in
-    match (vb.pvb_pat, vb.pvb_expr) with
-    | ( {ppat_desc = Ppat_constraint (pat, {ptyp_desc = Ptyp_poly ([], t)})},
-        {pexp_desc = Pexp_constraint (expr, _typ)} ) ->
-      {
-        vb with
-        pvb_pat =
-          Ast_helper.Pat.constraint_
-            ~loc:{pat.ppat_loc with loc_end = t.Parsetree.ptyp_loc.loc_end}
-            pat t;
-        pvb_expr = expr;
-      }
-    | ( {ppat_desc = Ppat_constraint (pat, {ptyp_desc = Ptyp_poly (_ :: _, t)})},
-        {pexp_desc = Pexp_fun _} ) ->
-      {
-        vb with
-        pvb_pat =
-          {
-            vb.pvb_pat with
-            ppat_loc = {pat.ppat_loc with loc_end = t.ptyp_loc.loc_end};
-          };
-      }
-    | ( ({
-           ppat_desc =
-             Ppat_constraint (pat, ({ptyp_desc = Ptyp_poly (_ :: _, t)} as typ));
-         } as constrained_pattern),
-        {pexp_desc = Pexp_newtype (_, {pexp_desc = Pexp_constraint (expr, _)})}
-      ) ->
-      (*
-       * The location of the Ptyp_poly on the pattern is the whole thing.
-       * let x:
-       *   type t. (int, int) => int =
-       *   (a, b) => {
-       *     // comment
-       *     a + b
-       *   }
-       *)
-      {
-        vb with
-        pvb_pat =
-          {
-            constrained_pattern with
-            ppat_desc = Ppat_constraint (pat, typ);
-            ppat_loc =
-              {constrained_pattern.ppat_loc with loc_end = t.ptyp_loc.loc_end};
-          };
-        pvb_expr = expr;
-      }
-    | _ -> vb
+  let walk_expression_after previous_loc expr comments =
+    let after_previous, surrounding_expr =
+      partition_adjacent_trailing previous_loc comments
+    in
+    attach t.trailing previous_loc after_previous;
+    let before_expr, inside_expr, after_expr =
+      partition_by_loc surrounding_expr expr.Parsetree.pexp_loc
+    in
+    if is_block_expr expr then
+      walk_expression expr t
+        (List.concat [before_expr; inside_expr; after_expr])
+    else (
+      attach t.leading expr.pexp_loc before_expr;
+      walk_expression expr t inside_expr;
+      attach t.trailing expr.pexp_loc after_expr)
   in
-  let pattern_loc = vb.Parsetree.pvb_pat.ppat_loc in
-  let expr_loc = vb.Parsetree.pvb_expr.pexp_loc in
-  let expr = vb.pvb_expr in
-
-  let leading, inside, trailing = partition_by_loc comments pattern_loc in
-
-  (* everything before start of pattern can only be leading on the pattern:
-   *   let |* before *| a = 1 *)
-  attach t.leading pattern_loc leading;
-  walk_pattern vb.Parsetree.pvb_pat t inside;
-  let after_pat, surrounding_expr =
-    partition_adjacent_trailing pattern_loc trailing
-  in
-  attach t.trailing pattern_loc after_pat;
-  let before_expr, inside_expr, after_expr =
-    partition_by_loc surrounding_expr expr_loc
+  let walk_pattern pattern comments =
+    let leading, inside, trailing =
+      partition_by_loc comments pattern.Parsetree.ppat_loc
+    in
+    attach t.leading pattern.ppat_loc leading;
+    walk_pattern pattern t inside;
+    let after_pattern, rest =
+      partition_adjacent_trailing pattern.ppat_loc trailing
+    in
+    attach t.trailing pattern.ppat_loc after_pattern;
+    rest
   in
-  if is_block_expr expr then
-    walk_expression expr t (List.concat [before_expr; inside_expr; after_expr])
-  else (
-    attach t.leading expr_loc before_expr;
-    walk_expression expr t inside_expr;
-    attach t.trailing expr_loc after_expr)
+  match vb.Parsetree.pvb_constraint with
+  | Some {pvc_newtypes; pvc_type} ->
+    let comments = walk_pattern vb.pvb_pat comments in
+    let comments =
+      visit_list_but_continue_with_remaining_comments
+        ~get_loc:(fun (newtype : string loc) -> newtype.loc)
+        ~walk_node:(fun (newtype : string loc) t comments ->
+          let leading, trailing =
+            partition_leading_trailing comments newtype.loc
+          in
+          attach t.leading newtype.loc leading;
+          attach t.trailing newtype.loc trailing)
+        ~newline_delimited:false pvc_newtypes t comments
+    in
+    let before_type, inside_type, after_type =
+      partition_by_loc comments pvc_type.ptyp_loc
+    in
+    attach t.leading pvc_type.ptyp_loc before_type;
+    walk_core_type pvc_type t inside_type;
+    walk_expression_after pvc_type.ptyp_loc vb.pvb_expr after_type
+  | None ->
+    let vb =
+      let open Parsetree in
+      match (vb.pvb_pat, vb.pvb_expr) with
+      | ( {ppat_desc = Ppat_constraint (pat, {ptyp_desc = Ptyp_poly ([], t)})},
+          {pexp_desc = Pexp_constraint (expr, _typ)} ) ->
+        {
+          vb with
+          pvb_pat =
+            Ast_helper.Pat.constraint_
+              ~loc:{pat.ppat_loc with loc_end = t.Parsetree.ptyp_loc.loc_end}
+              pat t;
+          pvb_expr = expr;
+        }
+      | ( {
+            ppat_desc =
+              Ppat_constraint (pat, {ptyp_desc = Ptyp_poly (_ :: _, t)});
+          },
+          {pexp_desc = Pexp_fun _} ) ->
+        {
+          vb with
+          pvb_pat =
+            {
+              vb.pvb_pat with
+              ppat_loc = {pat.ppat_loc with loc_end = t.ptyp_loc.loc_end};
+            };
+        }
+      | _ -> vb
+    in
+    let comments = walk_pattern vb.pvb_pat comments in
+    walk_expression_after vb.pvb_pat.ppat_loc vb.pvb_expr comments
 
 and walk_expression expr t comments =
   let open Location in
@@ -1574,7 +1547,7 @@ and walk_expression expr t comments =
     | _ ->
       (* Regular apply handling *)
       walk_apply_expr call_expr arguments t comments)
-  | Pexp_fun _ | Pexp_newtype _ -> (
+  | Pexp_fun _ -> (
     let _, parameters, return_expr = fun_expr expr in
     let comments =
       visit_list_but_continue_with_remaining_comments ~newline_delimited:false
diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml
index 8e99345b19c..5d6acf97ee4 100644
--- a/compiler/syntax/src/res_core.ml
+++ b/compiler/syntax/src/res_core.ml
@@ -611,27 +611,6 @@ let lident_of_path longident =
   | [] -> ""
   | ident :: _ -> ident
 
-let make_newtypes ~loc newtypes exp =
-  List.fold_right
-    (fun newtype exp -> Ast_helper.Exp.mk ~loc (Pexp_newtype (newtype, exp)))
-    newtypes exp
-
-(* locally abstract types syntax sugar
- * Transforms
- *  let f: type t u v. = (foo : list</t, u, v/>) => ...
- * into
- *  let f = (type t u v. foo : list</t, u, v/>) => ...
- *)
-let wrap_type_annotation ~loc newtypes core_type body =
-  let exp =
-    make_newtypes ~loc newtypes (Ast_helper.Exp.constraint_ ~loc body core_type)
-  in
-  let typ =
-    Ast_helper.Typ.poly ~loc newtypes
-      (Ast_helper.Typ.varify_constructors newtypes core_type)
-  in
-  (exp, typ)
-
 (**
   * process the occurrence of _ in the arguments of a function application
   * replace _ with a new variable, currently __x, in the arguments
@@ -2711,7 +2690,7 @@ and over_parse_constrained_or_coerced_or_arrow_expression p expr =
 and parse_let_binding_body ~start_pos ~attrs p =
   Parser.begin_region p;
   Parser.leave_breadcrumb p Grammar.LetBinding;
-  let pat, exp =
+  let pat, exp, constraint_ =
     Parser.leave_breadcrumb p Grammar.Pattern;
     let pat = parse_pattern p in
     Parser.eat_breadcrumb p;
@@ -2727,10 +2706,7 @@ and parse_let_binding_body ~start_pos ~attrs p =
         let typ = parse_typ_expr p in
         Parser.expect Equal p;
         let expr = parse_expr p in
-        let loc = mk_loc start_pos p.prev_end_pos in
-        let exp, poly = wrap_type_annotation ~loc newtypes typ expr in
-        let pat = Ast_helper.Pat.constraint_ ~loc pat poly in
-        (pat, exp)
+        (pat, expr, Some {Parsetree.pvc_newtypes = newtypes; pvc_type = typ})
       | _ ->
         let poly_type = parse_poly_type_expr p in
         let loc =
@@ -2740,16 +2716,16 @@ and parse_let_binding_body ~start_pos ~attrs p =
         Parser.expect Token.Equal p;
         let exp = parse_expr p in
         let exp = over_parse_constrained_or_coerced_or_arrow_expression p exp in
-        (pat, exp))
+        (pat, exp, None))
     | _ ->
       Parser.expect Token.Equal p;
       let exp =
         over_parse_constrained_or_coerced_or_arrow_expression p (parse_expr p)
       in
-      (pat, exp)
+      (pat, exp, None)
   in
   let loc = mk_loc start_pos p.prev_end_pos in
-  let vb = Ast_helper.Vb.mk ~loc ~attrs pat exp in
+  let vb = Ast_helper.Vb.mk ~loc ~attrs ?constraint_ pat exp in
   Parser.eat_breadcrumb p;
   Parser.end_region p;
   vb
diff --git a/compiler/syntax/src/res_parens.ml b/compiler/syntax/src/res_parens.ml
index 2316399f3f7..d35777628b4 100644
--- a/compiler/syntax/src/res_parens.ml
+++ b/compiler/syntax/src/res_parens.ml
@@ -50,9 +50,9 @@ let call_expr expr =
       Nothing
     | {
      pexp_desc =
-       ( Pexp_assert _ | Pexp_fun _ | Pexp_newtype _ | Pexp_constraint _
-       | Pexp_setfield _ | Pexp_match _ | Pexp_try _ | Pexp_while _ | Pexp_for _
-       | Pexp_for_of _ | Pexp_for_await_of _ | Pexp_ifthenelse _ );
+       ( Pexp_assert _ | Pexp_fun _ | Pexp_constraint _ | Pexp_setfield _
+       | Pexp_match _ | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_for_of _
+       | Pexp_for_await_of _ | Pexp_ifthenelse _ );
     } ->
       Parenthesized
     | _ when Parsetree_viewer.expr_is_await expr -> Parenthesized
@@ -100,9 +100,9 @@ let unary_expr_operand expr =
       Nothing
     | {
      pexp_desc =
-       ( Pexp_assert _ | Pexp_fun _ | Pexp_newtype _ | Pexp_constraint _
-       | Pexp_setfield _ | Pexp_extension _ (* readability? maybe remove *)
-       | Pexp_match _ | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_for_of _
+       ( Pexp_assert _ | Pexp_fun _ | Pexp_constraint _ | Pexp_setfield _
+       | Pexp_extension _ (* readability? maybe remove *) | Pexp_match _
+       | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_for_of _
        | Pexp_for_await_of _ | Pexp_ifthenelse _ );
     } ->
       Parenthesized
@@ -123,8 +123,7 @@ let binary_expr_operand ~is_lhs expr =
     | {pexp_desc = Pexp_fun _}
       when Parsetree_viewer.is_underscore_apply_sugar expr ->
       Nothing
-    | {pexp_desc = Pexp_constraint _ | Pexp_fun _ | Pexp_newtype _} ->
-      Parenthesized
+    | {pexp_desc = Pexp_constraint _ | Pexp_fun _} -> Parenthesized
     | expr when Parsetree_viewer.is_binary_expression expr -> Parenthesized
     | expr when Parsetree_viewer.is_ternary_expr expr -> Parenthesized
     | {pexp_desc = Pexp_assert _} when is_lhs -> Parenthesized
@@ -181,7 +180,7 @@ let flatten_operand_rhs parent_operator rhs =
     false
   | Pexp_fun {params = {p_pat = {ppat_desc = Ppat_var {txt = "__x"}}} :: _} ->
     false
-  | Pexp_fun _ | Pexp_newtype _ | Pexp_setfield _ | Pexp_constraint _ -> true
+  | Pexp_fun _ | Pexp_setfield _ | Pexp_constraint _ -> true
   | _ when Parsetree_viewer.is_ternary_expr rhs -> true
   | _ -> false
 
@@ -219,9 +218,9 @@ let assert_or_await_expr_rhs ?(in_await = false) expr =
       Nothing
     | {
      pexp_desc =
-       ( Pexp_assert _ | Pexp_fun _ | Pexp_newtype _ | Pexp_constraint _
-       | Pexp_setfield _ | Pexp_match _ | Pexp_try _ | Pexp_while _ | Pexp_for _
-       | Pexp_for_of _ | Pexp_for_await_of _ | Pexp_ifthenelse _ );
+       ( Pexp_assert _ | Pexp_fun _ | Pexp_constraint _ | Pexp_setfield _
+       | Pexp_match _ | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_for_of _
+       | Pexp_for_await_of _ | Pexp_ifthenelse _ );
     } ->
       Parenthesized
     | _ when (not in_await) && Parsetree_viewer.expr_is_await expr ->
@@ -265,8 +264,8 @@ let field_expr expr =
     | {
      pexp_desc =
        ( Pexp_assert _ | Pexp_extension _ (* %extension.x vs (%extension).x *)
-       | Pexp_fun _ | Pexp_newtype _ | Pexp_constraint _ | Pexp_setfield _
-       | Pexp_match _ | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_for_of _
+       | Pexp_fun _ | Pexp_constraint _ | Pexp_setfield _ | Pexp_match _
+       | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_for_of _
        | Pexp_for_await_of _ | Pexp_ifthenelse _ );
     } ->
       Parenthesized
@@ -299,7 +298,7 @@ let ternary_operand expr =
     } ->
       Nothing
     | {pexp_desc = Pexp_constraint _} -> Parenthesized
-    | _ when Res_parsetree_viewer.is_fun_newtype expr -> (
+    | _ when Res_parsetree_viewer.is_fun_expr expr -> (
       let _, _parameters, return_expr = Parsetree_viewer.fun_expr expr in
       match return_expr.pexp_desc with
       | Pexp_constraint _ -> Parenthesized
diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml
index fe63d5b9889..083c8b3a4e2 100644
--- a/compiler/syntax/src/res_parsetree_viewer.ml
+++ b/compiler/syntax/src/res_parsetree_viewer.ml
@@ -210,31 +210,7 @@ let fun_expr expr_ =
     group_newtypes newtypes
     |> List.map (fun (attrs, locs) -> NewTypes {attrs; locs})
   in
-  (* Turns (type t, type u, type z) into "type t u z". An attribute on a
-     nested node (only constructible via PPX) stops the merge so the
-     attribute is printed on the node carrying it instead of dropped. *)
-  let rec collect_new_types acc return_expr =
-    match return_expr with
-    | {pexp_desc = Pexp_newtype (string_loc, return_expr); pexp_attributes = []}
-      ->
-      collect_new_types (string_loc :: acc) return_expr
-    | return_expr -> (List.rev acc, return_expr)
-  in
   match expr_ with
-  | {pexp_desc = Pexp_newtype (string_loc, rest)} -> (
-    (* PPX-authored wrapper chains; the parser puts a function's newtypes
-       in the [newtypes] field instead. *)
-    let string_locs, return_expr = collect_new_types [string_loc] rest in
-    let newtype_param = NewTypes {attrs = []; locs = string_locs} in
-    match return_expr with
-    | {
-     pexp_desc = Pexp_fun {newtypes; params; body; async};
-     pexp_attributes = [];
-    } ->
-      ( async,
-        (newtype_param :: newtype_params newtypes) @ params_of_fun params,
-        body )
-    | _ -> (false, [newtype_param], return_expr))
   | {pexp_desc = Pexp_fun {newtypes; params; body; async}} ->
     (async, newtype_params newtypes @ params_of_fun params, body)
   | _ -> (false, [], expr_)
@@ -619,17 +595,17 @@ let partition_doc_comment_attributes attrs =
       | _ -> false)
     attrs
 
-let is_fun_newtype expr =
+let is_fun_expr expr =
   match expr.pexp_desc with
-  | Pexp_fun _ | Pexp_newtype _ -> true
+  | Pexp_fun _ -> true
   | _ -> false
 
 let requires_special_callback_printing_last_arg args =
   let rec loop args =
     match args with
     | [] -> false
-    | [(_, expr)] when is_fun_newtype expr -> true
-    | (_, expr) :: _ when is_fun_newtype expr -> false
+    | [(_, expr)] when is_fun_expr expr -> true
+    | (_, expr) :: _ when is_fun_expr expr -> false
     | _ :: rest -> loop rest
   in
   loop args
@@ -638,12 +614,12 @@ let requires_special_callback_printing_first_arg args =
   let rec loop args =
     match args with
     | [] -> true
-    | (_, expr) :: _ when is_fun_newtype expr -> false
+    | (_, expr) :: _ when is_fun_expr expr -> false
     | _ :: rest -> loop rest
   in
   match args with
-  | [(_, expr)] when is_fun_newtype expr -> false
-  | (_, expr) :: rest when is_fun_newtype expr -> loop rest
+  | [(_, expr)] when is_fun_expr expr -> false
+  | (_, expr) :: rest when is_fun_expr expr -> loop rest
   | _ -> false
 
 let mod_expr_apply mod_expr =
diff --git a/compiler/syntax/src/res_parsetree_viewer.mli b/compiler/syntax/src/res_parsetree_viewer.mli
index e546abfa074..d95ad69a4d7 100644
--- a/compiler/syntax/src/res_parsetree_viewer.mli
+++ b/compiler/syntax/src/res_parsetree_viewer.mli
@@ -169,7 +169,7 @@ val has_if_let_attribute : Parsetree.attributes -> bool
 
 val is_rewritten_underscore_apply_sugar : Parsetree.expression -> bool
 
-val is_fun_newtype : Parsetree.expression -> bool
+val is_fun_expr : Parsetree.expression -> bool
 
 val is_tuple_array : Parsetree.expression -> bool
 
diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml
index 0ed2a1724bf..cadab56f4de 100644
--- a/compiler/syntax/src/res_printer.ml
+++ b/compiler/syntax/src/res_printer.ml
@@ -2349,14 +2349,46 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl
     else Doc.text "and "
   in
   match vb with
+  | {
+   pvb_pat = pattern;
+   pvb_expr = expr;
+   pvb_constraint = Some {pvc_newtypes; pvc_type};
+  } ->
+    let newtypes =
+      Doc.join ~sep:Doc.space
+        (List.map
+           (fun ({Asttypes.txt; loc} : string Asttypes.loc) ->
+             print_comments (print_ident_like txt) cmt_tbl loc)
+           pvc_newtypes)
+    in
+    Doc.group
+      (Doc.concat
+         [
+           attrs;
+           header;
+           print_pattern ~state pattern cmt_tbl;
+           Doc.text ":";
+           Doc.indent
+             (Doc.concat
+                [
+                  Doc.line;
+                  Doc.text "type ";
+                  newtypes;
+                  Doc.dot;
+                  Doc.space;
+                  print_typ_expr ~state pvc_type cmt_tbl;
+                  Doc.text " =";
+                  Doc.line;
+                  print_expression_with_comments ~state expr cmt_tbl;
+                ]);
+         ])
   | {
    pvb_pat =
      {
        ppat_desc =
          Ppat_constraint (pattern, ({ptyp_desc = Ptyp_poly _} as pat_typ));
      };
-   pvb_expr =
-     {pexp_desc = Pexp_newtype _ | Pexp_fun {newtypes = _ :: _}} as expr;
+   pvb_expr = {pexp_desc = Pexp_fun {newtypes = _ :: _}} as expr;
   } -> (
     let _, parameters, return_expr = Parsetree_viewer.fun_expr expr in
     let abstract_type =
@@ -2482,7 +2514,6 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl
           } ->
             Parsetree_viewer.is_binary_expression if_expr
             || Parsetree_viewer.has_attributes if_expr.pexp_attributes
-          | {pexp_desc = Pexp_newtype _} -> false
           | {pexp_attributes = [({Location.txt = "res.taggedTemplate"}, _)]} ->
             false
           | {pexp_desc = Pexp_jsx_element _} -> true
@@ -3188,7 +3219,7 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
       print_expression_with_comments ~state
         (Parsetree_viewer.rewrite_underscore_apply e)
         cmt_tbl
-    | Pexp_fun _ | Pexp_newtype _ -> print_arrow e
+    | Pexp_fun _ -> print_arrow e
     | Parsetree.Pexp_constant c ->
       print_constant
         ~template_literal:(Parsetree_viewer.is_template_literal e)
@@ -3877,9 +3908,7 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
   in
   let should_print_its_own_attributes =
     match e.pexp_desc with
-    | Pexp_apply _ | Pexp_fun _ | Pexp_newtype _ | Pexp_setfield _
-    | Pexp_ifthenelse _ ->
-      true
+    | Pexp_apply _ | Pexp_fun _ | Pexp_setfield _ | Pexp_ifthenelse _ -> true
     | Pexp_match _ when Parsetree_viewer.is_if_let_expr e -> true
     | Pexp_jsx_element _ -> true
     | _ -> false
@@ -4687,7 +4716,6 @@ and print_pexp_apply ~state expr cmt_tbl =
         } ->
           Parsetree_viewer.is_binary_expression if_expr
           || Parsetree_viewer.has_attributes if_expr.pexp_attributes
-        | {pexp_desc = Pexp_newtype _} -> false
         | e ->
           Parsetree_viewer.has_attributes e.pexp_attributes
           || Parsetree_viewer.is_array_access e
diff --git a/tests/ounit_tests/ounit_ast_mapper0_tests.ml b/tests/ounit_tests/ounit_ast_mapper0_tests.ml
index 1f0479e5483..bf4a6076a52 100644
--- a/tests/ounit_tests/ounit_ast_mapper0_tests.ml
+++ b/tests/ounit_tests/ounit_ast_mapper0_tests.ml
@@ -70,6 +70,78 @@ let test_record_rest_roundtrips_through_ast0 _ =
 let map_expr0 e =
   Ast_mapper_from0.default_mapper.expr Ast_mapper_from0.default_mapper e
 
+let map_value_binding0 vb =
+  Ast_mapper_from0.default_mapper.value_binding Ast_mapper_from0.default_mapper
+    vb
+
+let to_value_binding0 vb =
+  Ast_mapper_to0.default_mapper.value_binding Ast_mapper_to0.default_mapper vb
+
+let test_value_constraint_roundtrips_through_ast0 _ =
+  let newtype = Location.mknoloc "a" in
+  let typ =
+    Ast_helper.Typ.constr ~loc (Location.mknoloc (Longident.Lident "a")) []
+  in
+  let constraint_ = {Parsetree.pvc_newtypes = [newtype]; pvc_type = typ} in
+  let vb =
+    Ast_helper.Vb.mk ~loc ~constraint_
+      (Ast_helper.Pat.var ~loc (Location.mknoloc "f"))
+      (Ast_helper.Exp.ident ~loc (Location.mknoloc (Longident.Lident "x")))
+  in
+  let vb0 = to_value_binding0 vb in
+  (match (vb0.pvb_pat.ppat_desc, vb0.pvb_expr.pexp_desc) with
+  | ( Parsetree0.Ppat_constraint
+        (_, {ptyp_desc = Ptyp_poly ([{txt = "a"}], {ptyp_desc = Ptyp_var "a"})}),
+      Pexp_newtype
+        ( {txt = "a"},
+          {
+            pexp_desc =
+              Pexp_constraint
+                (_, {ptyp_desc = Ptyp_constr ({txt = Lident "a"}, [])});
+          } ) ) ->
+    ()
+  | _ ->
+    assert_failure
+      "Expected the locally abstract value constraint's v0 wrapper encoding");
+  let mismatched_vb0 =
+    match vb0.pvb_expr.pexp_desc with
+    | Pexp_newtype (name, expr) ->
+      {
+        vb0 with
+        pvb_expr =
+          {
+            vb0.pvb_expr with
+            pexp_desc = Pexp_newtype ({name with txt = "b"}, expr);
+          };
+      }
+    | _ -> assert_failure "Expected a leading legacy newtype"
+  in
+  let mismatched_vb = map_value_binding0 mismatched_vb0 in
+  (match
+     ( mismatched_vb.pvb_pat.ppat_desc,
+       mismatched_vb.pvb_expr.pexp_desc,
+       mismatched_vb.pvb_constraint )
+   with
+  | Ppat_constraint _, Pexp_extension extension, None ->
+    let error = Builtin_attributes.error_of_extension extension in
+    OUnit.assert_equal
+      "A PPX returned a locally abstract type wrapper that does not enclose a \
+       ReScript function. This v0 AST form is not supported."
+      error.msg
+  | _ -> assert_failure "A mismatched v0 wrapper structure must become an error");
+  let vb = map_value_binding0 vb0 in
+  match (vb.pvb_pat.ppat_desc, vb.pvb_expr.pexp_desc, vb.pvb_constraint) with
+  | ( Ppat_var {txt = "f"},
+      Pexp_ident {txt = Lident "x"},
+      Some
+        {
+          pvc_newtypes = [{txt = "a"}];
+          pvc_type = {ptyp_desc = Ptyp_constr ({txt = Lident "a"}, [])};
+        } ) ->
+    ()
+  | _ ->
+    assert_failure "Expected the structural value constraint after roundtrip"
+
 (* A PPX can emit OCaml-style [function | p -> e]; the bridge must desugar it
    to [fun x -> match x with | p -> e] rather than crash. *)
 let test_function_cases_desugar_to_fun_match _ =
@@ -103,48 +175,17 @@ let test_function_cases_desugar_to_fun_match _ =
       scrutinee
   | _ -> assert_failure "Expected fun x -> match x with ... after desugaring"
 
-(* Only a PPX can put an attribute on the function nested under a newtype
-   (the parser attaches source attributes to the outer node), and the bridge
-   deliberately preserves such attributes. The printer must not drop them
-   when merging the newtype and the function into one parameter list. *)
-let test_attributed_fun_under_newtype_prints_attribute _ =
-  let fun_expr =
-    Ast_helper.Exp.fun_ ~loc
-      ~attrs:[attr "foo" (Parsetree.PStr [])]
-      [
-        Ast_helper.Exp.fun_param Asttypes.Nolabel
-          (Ast_helper.Pat.var ~loc (Location.mknoloc "x"));
-      ]
-      (Ast_helper.Exp.ident ~loc (Location.mknoloc (Longident.Lident "x")))
-  in
-  let expr = Ast_helper.Exp.newtype ~loc (Location.mknoloc "t") fun_expr in
-  let structure =
-    [
-      Ast_helper.Str.value ~loc Asttypes.Nonrecursive
-        [
-          Ast_helper.Vb.mk ~loc
-            (Ast_helper.Pat.var ~loc (Location.mknoloc "f"))
-            expr;
-        ];
-    ]
-  in
-  let printed =
-    Res_printer.print_implementation ~width:80 structure ~comments:[]
-  in
-  OUnit.assert_bool "attribute on the fun under a newtype is printed"
-    (Ext_string.contain_substring printed "@foo")
-
 let suites =
   __FILE__
   >::: [
          "public_record_rest_attr_is_not_internal"
          >:: test_public_record_rest_attr_is_not_internal;
-         "attributed_fun_under_newtype_prints_attribute"
-         >:: test_attributed_fun_under_newtype_prints_attribute;
          "malformed_internal_record_rest_attr_fails"
          >:: test_malformed_internal_record_rest_attr_fails;
          "record_rest_roundtrips_through_ast0"
          >:: test_record_rest_roundtrips_through_ast0;
+         "value_constraint_roundtrips_through_ast0"
+         >:: test_value_constraint_roundtrips_through_ast0;
          "function_cases_desugar_to_fun_match"
          >:: test_function_cases_desugar_to_fun_match;
        ]
diff --git a/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res b/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res
index 25936d60424..6645fe2d351 100644
--- a/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res
+++ b/tests/syntax_tests/data/ast-mapping/FunctionsAndArrows.res
@@ -51,3 +51,6 @@ external phantom: (~a: int, @as(json`false`) _, ~c: string) => unit = "phantom"
 
 // attributed newtype groups: attribute ownership must survive the v0 bridge
 let grouped = @fn (@one type a b, x: a, @two type c, y: c) => (x, y)
+
+// locally abstract value constraints survive v0 AST conversion and re-fuse
+let choose: type a b. (a, b) => a = (x, _) => x
diff --git a/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt b/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt
index 7605b4147ed..508c2860fb2 100644
--- a/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt
+++ b/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt
@@ -51,3 +51,6 @@ external phantom: (~a: int, @as(json`false`) _, ~c: string) => unit = "phantom"
 
 // attributed newtype groups: attribute ownership must survive the v0 bridge
 let grouped = @fn (@one type a b, @two type c, x: a, y: c) => (x, y)
+
+// locally abstract value constraints survive v0 AST conversion and re-fuse
+let choose: type a b. (a, b) => a = (x, _) => x
diff --git a/tests/syntax_tests/data/printer/comments/expected/valueBindingSugar.res.txt b/tests/syntax_tests/data/printer/comments/expected/valueBindingSugar.res.txt
index 27d5bdb6ad8..cee944d555f 100644
--- a/tests/syntax_tests/data/printer/comments/expected/valueBindingSugar.res.txt
+++ b/tests/syntax_tests/data/printer/comments/expected/valueBindingSugar.res.txt
@@ -1,6 +1,8 @@
 let /* before */ x /* after */:
-  type t. (/* a */ int /* b */, /* c */ int /* d */) => /* e */ int =
+  type t. (/* a */ int /* b */, /* c */ int /* d */) => /* e */ int /* f */ =
   (/* c0 */ a /* c1 */, /* c2 */ b /* c3 */) => {
     // comment
     a + b
   }
+
+let y: type /* before t */ t /* after t */ /* before u */ u /* after u */. (t, u) => t = (x, _) => x
diff --git a/tests/syntax_tests/data/printer/comments/valueBindingSugar.res b/tests/syntax_tests/data/printer/comments/valueBindingSugar.res
index ac774ab209d..09dc802b22b 100644
--- a/tests/syntax_tests/data/printer/comments/valueBindingSugar.res
+++ b/tests/syntax_tests/data/printer/comments/valueBindingSugar.res
@@ -4,3 +4,8 @@ let /* before */ x /* after */:
     // comment
     a + b
   }
+
+let y:
+  type /* before t */ t /* after t */ /* before u */ u /* after u */.
+  (t, u) => t =
+  (x, _) => x
diff --git a/tests/tests/src/value_binding_constraint.mjs b/tests/tests/src/value_binding_constraint.mjs
new file mode 100644
index 00000000000..9273bd24a19
--- /dev/null
+++ b/tests/tests/src/value_binding_constraint.mjs
@@ -0,0 +1,21 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+
+function defaultValue(witness) {
+  if (witness === "Int") {
+    return 42;
+  } else {
+    return "value";
+  }
+}
+
+let intDefault = 42;
+
+let stringDefault = "value";
+
+export {
+  defaultValue,
+  intDefault,
+  stringDefault,
+}
+/* No side effect */
diff --git a/tests/tests/src/value_binding_constraint.res b/tests/tests/src/value_binding_constraint.res
new file mode 100644
index 00000000000..aeba636e5e7
--- /dev/null
+++ b/tests/tests/src/value_binding_constraint.res
@@ -0,0 +1,14 @@
+type rec witness<'a> =
+  | Int: witness<int>
+  | String: witness<string>
+
+let defaultValue:
+  type a. witness<a> => a =
+  witness =>
+    switch witness {
+    | Int => 42
+    | String => "value"
+    }
+
+let intDefault: int = defaultValue(Int)
+let stringDefault: string = defaultValue(String)

From c2a8f61e835da7aba4079f2edad46512cac5c323 Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Mon, 17 Aug 2026 14:41:33 +0200
Subject: [PATCH 6/6] Preserve structure in docgen function details

Function labels in Outcometree were strings, with optionality encoded by a leading question mark. That forced printers to decode the spelling and left downstream consumers without the label structure already known by the type system. Store Noloc.arg_label directly on Otyp_arrow, update both printers to match it exhaustively, and remove the unproduced Octy_arrow constructor.

The doc generator previously walked Types.type_expr independently and flattened every reachable constructor into one list. Nested arrows became outer parameters, tuples and type variables disappeared, labels and optionality were lost, and non-function values acquired fabricated zero-parameter signatures. Build details from the normalized Outcometree instead: parameters retain their metadata, constructors, variables, tuples, and functions form recursive nodes, uncommon forms remain visible through a rendered fallback, and only top-level arrows receive signature details.

Update the published RescriptTools.Docgen types and snapshots for the intentionally breaking JSON shape, and correct the implementation's stale alias tag to match the signature tag declared by its interface. The documentation site drops value details before publishing its data, but third-party consumers of rescript-tools doc need the changelog warning.

Focused fixtures cover labeled and optional parameters, generic variables, callbacks, tuple returns, returned functions, fallback rendering, and non-function values. Compiler, tools, analysis, syntax, roundtrip, and full test suites remain green.

Signed-off-by: Cristiano Calcagno <cristianoc@users.noreply.github.com>
---
 CHANGELOG.md                                  |   1 +
 compiler/ml/oprint.ml                         |  11 +-
 compiler/ml/outcometree.ml                    |   3 +-
 compiler/ml/printtyp.ml                       |   3 +-
 compiler/syntax/src/res_outcome_printer.ml    |  35 ++-
 .../runtime/RescriptTools_Docgen.res          |  18 +-
 .../runtime/RescriptTools_Docgen.resi         |  16 +-
 .../src/DocgenSignatureDetails.res            |  17 ++
 .../src/DocgenSignatureDetails.resi           |  17 ++
 .../src/expected/DocExtraction2.res.json      |  45 +++-
 .../src/expected/DocExtraction2.resi.json     |  45 +++-
 .../src/expected/DocExtractionRes.res.json    | 126 +++++----
 .../expected/DocgenSignatureDetails.res.json  | 243 ++++++++++++++++++
 .../expected/DocgenSignatureDetails.resi.json | 243 ++++++++++++++++++
 tests/tools_tests/src/expected/ModC.res.json  |   9 +-
 tests/tools_tests/src/expected/ModC.resi.json |   9 +-
 tools/src/tools.ml                            | 162 +++++++-----
 17 files changed, 824 insertions(+), 179 deletions(-)
 create mode 100644 tests/tools_tests/src/DocgenSignatureDetails.res
 create mode 100644 tests/tools_tests/src/DocgenSignatureDetails.resi
 create mode 100644 tests/tools_tests/src/expected/DocgenSignatureDetails.res.json
 create mode 100644 tests/tools_tests/src/expected/DocgenSignatureDetails.resi.json

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 6766ae0a811..ea22f4bbdf3 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -16,6 +16,7 @@
 
 - Remove the deprecated `Js` namespace and its runtime modules. https://github.com/rescript-lang/rescript/pull/8531
 - Move Belt into the separately installed `@rescript/belt` package. Projects using Belt must install the package and list it in their `rescript.json` dependencies. https://github.com/rescript-lang/rescript/pull/8554
+- Correct the structured function details produced by `rescript-tools doc` and exposed by `RescriptTools.Docgen`: parameters now retain labels and optionality, nested functions, tuples, variables, and generic arguments retain their type structure, return types are identified correctly, and non-function values no longer receive fake function details. This changes the published docgen detail schema.
 
 #### :eyeglasses: Spec Compliance
 
diff --git a/compiler/ml/oprint.ml b/compiler/ml/oprint.ml
index 6d0b764d500..795a1b30fb0 100644
--- a/compiler/ml/oprint.ml
+++ b/compiler/ml/oprint.ml
@@ -253,9 +253,10 @@ and print_out_type_1 ppf = function
     pp_open_box ppf 0;
     List.iter
       (fun (lab, ty1) ->
-        if lab <> "" then (
-          pp_print_string ppf lab;
-          pp_print_char ppf ':');
+        (match lab with
+        | Asttypes.Noloc.Nolabel -> ()
+        | Asttypes.Noloc.Labelled label -> fprintf ppf "%s:" label
+        | Asttypes.Noloc.Optional label -> fprintf ppf "?%s:" label);
         print_out_type_2 ppf ty1;
         pp_print_string ppf " ->";
         pp_print_space ppf ())
@@ -406,10 +407,6 @@ let rec print_out_class_type ppf = function
       | tyl -> fprintf ppf "@[<1>[%a]@]@ " (print_typlist !out_type ",") tyl
     in
     fprintf ppf "@[%a%a@]" pr_tyl tyl print_ident id
-  | Octy_arrow (lab, ty, cty) ->
-    fprintf ppf "@[%s%a ->@ %a@]"
-      (if lab <> "" then lab ^ ":" else "")
-      print_out_type_2 ty print_out_class_type cty
   | Octy_signature (self_ty, csil) ->
     let pr_param ppf = function
       | Some ty -> fprintf ppf "@ @[(%a)@]" !out_type ty
diff --git a/compiler/ml/outcometree.ml b/compiler/ml/outcometree.ml
index d2e02e036e9..4d6e4190eb4 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) list * out_type
+  | Otyp_arrow of (Asttypes.Noloc.arg_label * 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
@@ -74,7 +74,6 @@ and out_variant =
 
 type out_class_type =
   | Octy_constr of out_ident * out_type list
-  | Octy_arrow of string * out_type * out_class_type
   | Octy_signature of out_type option * out_class_sig_item list
 and out_class_sig_item =
   | Ocsg_constraint of out_type * out_type
diff --git a/compiler/ml/printtyp.ml b/compiler/ml/printtyp.ml
index 624a3b75a0e..3f79ca004a8 100644
--- a/compiler/ml/printtyp.ml
+++ b/compiler/ml/printtyp.ml
@@ -616,7 +616,6 @@ let rec tree_of_typexp ?(printing_context : printing_context option) sch ty =
         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
@@ -626,7 +625,7 @@ let rec tree_of_typexp ?(printing_context : printing_context option) sch ty =
                   | _ -> Otyp_stuff "<hidden>"
                 else tree_of_typexp ?printing_context sch arg.typ
               in
-              (lab, t1))
+              (Asttypes.to_noloc arg.lbl, t1))
             params
         in
         Otyp_arrow (args, tree_of_typexp ?printing_context sch ret)
diff --git a/compiler/syntax/src/res_outcome_printer.ml b/compiler/syntax/src/res_outcome_printer.ml
index ac723459952..684b3006689 100644
--- a/compiler/syntax/src/res_outcome_printer.ml
+++ b/compiler/syntax/src/res_outcome_printer.ml
@@ -238,29 +238,26 @@ 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 print_labeled_arg label optional_indicator typ =
+    Doc.group
+      (Doc.concat
+         [
+           Doc.text ("~" ^ label ^ ": ");
+           print_out_type_doc typ;
+           optional_indicator;
+         ])
+  in
   let args =
     Doc.join
       ~sep:(Doc.concat [Doc.comma; Doc.line])
       (List.map
          (fun (lbl, typ) ->
-           let lbl_len = String.length lbl in
-           if lbl_len = 0 then print_out_type_doc typ
-           else
-             let lbl, optional_indicator =
-               (* the ocaml compiler hardcodes the optional label inside the string of the label in printtyp.ml *)
-               match String.unsafe_get lbl 0 with
-               | '?' ->
-                 ( (String.sub [@doesNotRaise]) lbl 1 (lbl_len - 1),
-                   Doc.text "=?" )
-               | _ -> (lbl, Doc.nil)
-             in
-             Doc.group
-               (Doc.concat
-                  [
-                    Doc.text ("~" ^ lbl ^ ": ");
-                    print_out_type_doc typ;
-                    optional_indicator;
-                  ]))
+           match lbl with
+           | Asttypes.Noloc.Nolabel -> print_out_type_doc typ
+           | Asttypes.Noloc.Labelled label ->
+             print_labeled_arg label Doc.nil typ
+           | Asttypes.Noloc.Optional label ->
+             print_labeled_arg label (Doc.text "=?") typ)
          typ_args)
   in
   let args_doc =
@@ -268,7 +265,7 @@ and print_out_arrow_type typ =
       match typ_args with
       | [(_, (Otyp_tuple _ | Otyp_arrow _))] -> true
       (* single argument should not be wrapped *)
-      | [("", _)] -> false
+      | [(Asttypes.Noloc.Nolabel, _)] -> false
       | _ -> true
     in
     if needs_parens then
diff --git a/packages/@rescript/runtime/RescriptTools_Docgen.res b/packages/@rescript/runtime/RescriptTools_Docgen.res
index 6dd74547473..8dd1cc2e880 100644
--- a/packages/@rescript/runtime/RescriptTools_Docgen.res
+++ b/packages/@rescript/runtime/RescriptTools_Docgen.res
@@ -17,13 +17,21 @@ type constructor = {
   payload?: constructorPayload,
 }
 
-type rec typeInSignature = {
-  path: string,
-  genericTypeParameters: array<typeInSignature>,
+@tag("kind")
+type rec typeInSignature =
+  | @as("constructor") Constructor({path: string, genericTypeParameters: array<typeInSignature>})
+  | @as("variable") Variable({name: string, weak: bool})
+  | @as("tuple") Tuple({elements: array<typeInSignature>})
+  | @as("function") Function({parameters: array<signatureParameter>, returnType: typeInSignature})
+  | @as("rendered") Rendered({signature: string})
+and signatureParameter = {
+  label?: string,
+  optional: bool,
+  @as("type") type_: typeInSignature,
 }
 
 type signatureDetails = {
-  parameters: array<typeInSignature>,
+  parameters: array<signatureParameter>,
   returnType: typeInSignature,
 }
 
@@ -31,7 +39,7 @@ type signatureDetails = {
 type detail =
   | @as("record") Record({items: array<field>})
   | @as("variant") Variant({items: array<constructor>})
-  | @as("alias") Signature({details: signatureDetails})
+  | @as("signature") Signature({details: signatureDetails})
 
 type source = {
   filepath: string,
diff --git a/packages/@rescript/runtime/RescriptTools_Docgen.resi b/packages/@rescript/runtime/RescriptTools_Docgen.resi
index 2c8b1d4ad10..ae20015090f 100644
--- a/packages/@rescript/runtime/RescriptTools_Docgen.resi
+++ b/packages/@rescript/runtime/RescriptTools_Docgen.resi
@@ -17,13 +17,21 @@ type constructor = {
   payload?: constructorPayload,
 }
 
-type rec typeInSignature = {
-  path: string,
-  genericTypeParameters: array<typeInSignature>,
+@tag("kind")
+type rec typeInSignature =
+  | @as("constructor") Constructor({path: string, genericTypeParameters: array<typeInSignature>})
+  | @as("variable") Variable({name: string, weak: bool})
+  | @as("tuple") Tuple({elements: array<typeInSignature>})
+  | @as("function") Function({parameters: array<signatureParameter>, returnType: typeInSignature})
+  | @as("rendered") Rendered({signature: string})
+and signatureParameter = {
+  label?: string,
+  optional: bool,
+  @as("type") type_: typeInSignature,
 }
 
 type signatureDetails = {
-  parameters: array<typeInSignature>,
+  parameters: array<signatureParameter>,
   returnType: typeInSignature,
 }
 
diff --git a/tests/tools_tests/src/DocgenSignatureDetails.res b/tests/tools_tests/src/DocgenSignatureDetails.res
new file mode 100644
index 00000000000..b52a9a8a4a6
--- /dev/null
+++ b/tests/tools_tests/src/DocgenSignatureDetails.res
@@ -0,0 +1,17 @@
+let labeledOptional: (~required: 'a, ~optional: array<'a>=?) => result<'a, string> = (
+  ~required,
+  ~optional=?,
+) => {
+  ignore(optional)
+  Ok(required)
+}
+
+let takesCallback: ('a => string) => bool = _callback => true
+
+let returnsTuple: int => (string, int) = value => ("value", value)
+
+let returnsFunction: int => string => bool = _value => _text => true
+
+let takesVariant: [#enabled | #count(int)] => unit = _variant => ()
+
+let constant = 42
diff --git a/tests/tools_tests/src/DocgenSignatureDetails.resi b/tests/tools_tests/src/DocgenSignatureDetails.resi
new file mode 100644
index 00000000000..d6c6a598c41
--- /dev/null
+++ b/tests/tools_tests/src/DocgenSignatureDetails.resi
@@ -0,0 +1,17 @@
+/** Labeled and optional parameters keep their parameter metadata. */
+let labeledOptional: (~required: 'a, ~optional: array<'a>=?) => result<'a, string>
+
+/** A callback remains one parameter instead of becoming outer parameters. */
+let takesCallback: ('a => string) => bool
+
+/** A tuple remains one return-type node. */
+let returnsTuple: int => (string, int)
+
+/** A returned function remains nested in the return type. */
+let returnsFunction: int => string => bool
+
+/** Less common type forms remain visible through an explicit fallback. */
+let takesVariant: [#enabled | #count(int)] => unit
+
+/** Non-functions do not receive function signature details. */
+let constant: int
diff --git a/tests/tools_tests/src/expected/DocExtraction2.res.json b/tests/tools_tests/src/expected/DocExtraction2.res.json
index 79eac3729cf..1221c0b1b39 100644
--- a/tests/tools_tests/src/expected/DocExtraction2.res.json
+++ b/tests/tools_tests/src/expected/DocExtraction2.res.json
@@ -29,8 +29,21 @@
       "detail": {
         "kind": "signature",
         "details": {
-          "parameters": [ { "path": "unit", "genericTypeParameters": [] } ],
-          "returnType": { "path": "t", "genericTypeParameters": [] }
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "constructor",
+                "path": "unit",
+                "genericTypeParameters": []
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "t",
+            "genericTypeParameters": []
+          }
         }
       }
     },
@@ -72,9 +85,20 @@
             "kind": "signature",
             "details": {
               "parameters": [
-                { "path": "unit", "genericTypeParameters": [] }
+                {
+                  "optional": false,
+                  "type": {
+                    "kind": "constructor",
+                    "path": "unit",
+                    "genericTypeParameters": []
+                  }
+                }
               ],
-              "returnType": { "path": "t", "genericTypeParameters": [] }
+              "returnType": {
+                "kind": "constructor",
+                "path": "t",
+                "genericTypeParameters": []
+              }
             }
           }
         }
@@ -95,8 +119,17 @@
       "detail": {
         "kind": "signature",
         "details": {
-          "parameters": [],
-          "returnType": { "path": "unit", "genericTypeParameters": [] }
+          "parameters": [
+            {
+              "optional": false,
+              "type": { "kind": "variable", "name": "a", "weak": false }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "unit",
+            "genericTypeParameters": []
+          }
         }
       }
     }
diff --git a/tests/tools_tests/src/expected/DocExtraction2.resi.json b/tests/tools_tests/src/expected/DocExtraction2.resi.json
index 79eac3729cf..1221c0b1b39 100644
--- a/tests/tools_tests/src/expected/DocExtraction2.resi.json
+++ b/tests/tools_tests/src/expected/DocExtraction2.resi.json
@@ -29,8 +29,21 @@
       "detail": {
         "kind": "signature",
         "details": {
-          "parameters": [ { "path": "unit", "genericTypeParameters": [] } ],
-          "returnType": { "path": "t", "genericTypeParameters": [] }
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "constructor",
+                "path": "unit",
+                "genericTypeParameters": []
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "t",
+            "genericTypeParameters": []
+          }
         }
       }
     },
@@ -72,9 +85,20 @@
             "kind": "signature",
             "details": {
               "parameters": [
-                { "path": "unit", "genericTypeParameters": [] }
+                {
+                  "optional": false,
+                  "type": {
+                    "kind": "constructor",
+                    "path": "unit",
+                    "genericTypeParameters": []
+                  }
+                }
               ],
-              "returnType": { "path": "t", "genericTypeParameters": [] }
+              "returnType": {
+                "kind": "constructor",
+                "path": "t",
+                "genericTypeParameters": []
+              }
             }
           }
         }
@@ -95,8 +119,17 @@
       "detail": {
         "kind": "signature",
         "details": {
-          "parameters": [],
-          "returnType": { "path": "unit", "genericTypeParameters": [] }
+          "parameters": [
+            {
+              "optional": false,
+              "type": { "kind": "variable", "name": "a", "weak": false }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "unit",
+            "genericTypeParameters": []
+          }
         }
       }
     }
diff --git a/tests/tools_tests/src/expected/DocExtractionRes.res.json b/tests/tools_tests/src/expected/DocExtractionRes.res.json
index 5d3d3c2bdc2..da2ef13a178 100644
--- a/tests/tools_tests/src/expected/DocExtractionRes.res.json
+++ b/tests/tools_tests/src/expected/DocExtractionRes.res.json
@@ -48,8 +48,21 @@
       "detail": {
         "kind": "signature",
         "details": {
-          "parameters": [ { "path": "string", "genericTypeParameters": [] } ],
-          "returnType": { "path": "t", "genericTypeParameters": [] }
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "constructor",
+                "path": "string",
+                "genericTypeParameters": []
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "t",
+            "genericTypeParameters": []
+          }
         }
       }
     },
@@ -67,8 +80,21 @@
       "detail": {
         "kind": "signature",
         "details": {
-          "parameters": [ { "path": "t", "genericTypeParameters": [] } ],
-          "returnType": { "path": "t", "genericTypeParameters": [] }
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "constructor",
+                "path": "t",
+                "genericTypeParameters": []
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "t",
+            "genericTypeParameters": []
+          }
         }
       }
     },
@@ -82,13 +108,6 @@
         "filepath": "src/DocExtractionRes.res",
         "line": 26,
         "col": 5
-      },
-      "detail": {
-        "kind": "signature",
-        "details": {
-          "parameters": [],
-          "returnType": { "path": "int", "genericTypeParameters": [] }
-        }
       }
     },
     {
@@ -211,11 +230,19 @@
             "details": {
               "parameters": [
                 {
-                  "path": "SomeInnerModule.status",
-                  "genericTypeParameters": []
+                  "optional": false,
+                  "type": {
+                    "kind": "constructor",
+                    "path": "SomeInnerModule.status",
+                    "genericTypeParameters": []
+                  }
                 }
               ],
-              "returnType": { "path": "bool", "genericTypeParameters": [] }
+              "returnType": {
+                "kind": "constructor",
+                "path": "bool",
+                "genericTypeParameters": []
+              }
             }
           }
         },
@@ -312,9 +339,20 @@
             "kind": "signature",
             "details": {
               "parameters": [
-                { "path": "unit", "genericTypeParameters": [] }
+                {
+                  "optional": false,
+                  "type": {
+                    "kind": "constructor",
+                    "path": "unit",
+                    "genericTypeParameters": []
+                  }
+                }
               ],
-              "returnType": { "path": "t", "genericTypeParameters": [] }
+              "returnType": {
+                "kind": "constructor",
+                "path": "t",
+                "genericTypeParameters": []
+              }
             }
           }
         }
@@ -357,8 +395,21 @@
           "detail": {
             "kind": "signature",
             "details": {
-              "parameters": [ { "path": "t", "genericTypeParameters": [] } ],
-              "returnType": { "path": "t", "genericTypeParameters": [] }
+              "parameters": [
+                {
+                  "optional": false,
+                  "type": {
+                    "kind": "constructor",
+                    "path": "t",
+                    "genericTypeParameters": []
+                  }
+                }
+              ],
+              "returnType": {
+                "kind": "constructor",
+                "path": "t",
+                "genericTypeParameters": []
+              }
             }
           }
         }
@@ -402,9 +453,20 @@
             "kind": "signature",
             "details": {
               "parameters": [
-                { "path": "int", "genericTypeParameters": [] }
+                {
+                  "optional": false,
+                  "type": {
+                    "kind": "constructor",
+                    "path": "int",
+                    "genericTypeParameters": []
+                  }
+                }
               ],
-              "returnType": { "path": "int", "genericTypeParameters": [] }
+              "returnType": {
+                "kind": "constructor",
+                "path": "int",
+                "genericTypeParameters": []
+              }
             }
           }
         }
@@ -432,13 +494,6 @@
             "filepath": "src/DocExtractionRes.res",
             "line": 138,
             "col": 3
-          },
-          "detail": {
-            "kind": "signature",
-            "details": {
-              "parameters": [],
-              "returnType": { "path": "int", "genericTypeParameters": [] }
-            }
           }
         }
       ]
@@ -464,13 +519,6 @@
             "filepath": "src/DocExtractionRes.res",
             "line": 142,
             "col": 7
-          },
-          "detail": {
-            "kind": "signature",
-            "details": {
-              "parameters": [],
-              "returnType": { "path": "int", "genericTypeParameters": [] }
-            }
           }
         }
       ],
@@ -508,16 +556,6 @@
                 "filepath": "src/DocExtractionRes.res",
                 "line": 147,
                 "col": 9
-              },
-              "detail": {
-                "kind": "signature",
-                "details": {
-                  "parameters": [],
-                  "returnType": {
-                    "path": "int",
-                    "genericTypeParameters": []
-                  }
-                }
               }
             }
           ],
diff --git a/tests/tools_tests/src/expected/DocgenSignatureDetails.res.json b/tests/tools_tests/src/expected/DocgenSignatureDetails.res.json
new file mode 100644
index 00000000000..381618d2709
--- /dev/null
+++ b/tests/tools_tests/src/expected/DocgenSignatureDetails.res.json
@@ -0,0 +1,243 @@
+{
+  "name": "DocgenSignatureDetails",
+  "docstrings": [],
+  "source": {
+    "filepath": "src/DocgenSignatureDetails.resi",
+    "line": 1,
+    "col": 1
+  },
+  "items": [
+    {
+      "id": "DocgenSignatureDetails.labeledOptional",
+      "kind": "value",
+      "name": "labeledOptional",
+      "signature": "let labeledOptional: (\n  ~required: 'a,\n  ~optional: array<'a>=?,\n) => result<'a, string>",
+      "docstrings": [
+        "Labeled and optional parameters keep their parameter metadata."
+      ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 2,
+        "col": 1
+      },
+      "detail": {
+        "kind": "signature",
+        "details": {
+          "parameters": [
+            {
+              "label": "required",
+              "optional": false,
+              "type": { "kind": "variable", "name": "a", "weak": false }
+            },
+            {
+              "label": "optional",
+              "optional": true,
+              "type": {
+                "kind": "constructor",
+                "path": "array",
+                "genericTypeParameters": [
+                  { "kind": "variable", "name": "a", "weak": false }
+                ]
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "result",
+            "genericTypeParameters": [
+              { "kind": "variable", "name": "a", "weak": false },
+              {
+                "kind": "constructor",
+                "path": "string",
+                "genericTypeParameters": []
+              }
+            ]
+          }
+        }
+      }
+    },
+    {
+      "id": "DocgenSignatureDetails.takesCallback",
+      "kind": "value",
+      "name": "takesCallback",
+      "signature": "let takesCallback: ('a => string) => bool",
+      "docstrings": [
+        "A callback remains one parameter instead of becoming outer parameters."
+      ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 5,
+        "col": 1
+      },
+      "detail": {
+        "kind": "signature",
+        "details": {
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "function",
+                "parameters": [
+                  {
+                    "optional": false,
+                    "type": {
+                      "kind": "variable",
+                      "name": "a",
+                      "weak": false
+                    }
+                  }
+                ],
+                "returnType": {
+                  "kind": "constructor",
+                  "path": "string",
+                  "genericTypeParameters": []
+                }
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "bool",
+            "genericTypeParameters": []
+          }
+        }
+      }
+    },
+    {
+      "id": "DocgenSignatureDetails.returnsTuple",
+      "kind": "value",
+      "name": "returnsTuple",
+      "signature": "let returnsTuple: int => (string, int)",
+      "docstrings": [ "A tuple remains one return-type node." ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 8,
+        "col": 1
+      },
+      "detail": {
+        "kind": "signature",
+        "details": {
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "constructor",
+                "path": "int",
+                "genericTypeParameters": []
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "tuple",
+            "elements": [
+              {
+                "kind": "constructor",
+                "path": "string",
+                "genericTypeParameters": []
+              },
+              {
+                "kind": "constructor",
+                "path": "int",
+                "genericTypeParameters": []
+              }
+            ]
+          }
+        }
+      }
+    },
+    {
+      "id": "DocgenSignatureDetails.returnsFunction",
+      "kind": "value",
+      "name": "returnsFunction",
+      "signature": "let returnsFunction: int => string => bool",
+      "docstrings": [
+        "A returned function remains nested in the return type."
+      ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 11,
+        "col": 1
+      },
+      "detail": {
+        "kind": "signature",
+        "details": {
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "constructor",
+                "path": "int",
+                "genericTypeParameters": []
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "function",
+            "parameters": [
+              {
+                "optional": false,
+                "type": {
+                  "kind": "constructor",
+                  "path": "string",
+                  "genericTypeParameters": []
+                }
+              }
+            ],
+            "returnType": {
+              "kind": "constructor",
+              "path": "bool",
+              "genericTypeParameters": []
+            }
+          }
+        }
+      }
+    },
+    {
+      "id": "DocgenSignatureDetails.takesVariant",
+      "kind": "value",
+      "name": "takesVariant",
+      "signature": "let takesVariant: [#count(int) | #enabled] => unit",
+      "docstrings": [
+        "Less common type forms remain visible through an explicit fallback."
+      ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 14,
+        "col": 1
+      },
+      "detail": {
+        "kind": "signature",
+        "details": {
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "rendered",
+                "signature": "[#count(int) | #enabled]"
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "unit",
+            "genericTypeParameters": []
+          }
+        }
+      }
+    },
+    {
+      "id": "DocgenSignatureDetails.constant",
+      "kind": "value",
+      "name": "constant",
+      "signature": "let constant: int",
+      "docstrings": [
+        "Non-functions do not receive function signature details."
+      ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 17,
+        "col": 1
+      }
+    }
+  ]
+}
diff --git a/tests/tools_tests/src/expected/DocgenSignatureDetails.resi.json b/tests/tools_tests/src/expected/DocgenSignatureDetails.resi.json
new file mode 100644
index 00000000000..381618d2709
--- /dev/null
+++ b/tests/tools_tests/src/expected/DocgenSignatureDetails.resi.json
@@ -0,0 +1,243 @@
+{
+  "name": "DocgenSignatureDetails",
+  "docstrings": [],
+  "source": {
+    "filepath": "src/DocgenSignatureDetails.resi",
+    "line": 1,
+    "col": 1
+  },
+  "items": [
+    {
+      "id": "DocgenSignatureDetails.labeledOptional",
+      "kind": "value",
+      "name": "labeledOptional",
+      "signature": "let labeledOptional: (\n  ~required: 'a,\n  ~optional: array<'a>=?,\n) => result<'a, string>",
+      "docstrings": [
+        "Labeled and optional parameters keep their parameter metadata."
+      ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 2,
+        "col": 1
+      },
+      "detail": {
+        "kind": "signature",
+        "details": {
+          "parameters": [
+            {
+              "label": "required",
+              "optional": false,
+              "type": { "kind": "variable", "name": "a", "weak": false }
+            },
+            {
+              "label": "optional",
+              "optional": true,
+              "type": {
+                "kind": "constructor",
+                "path": "array",
+                "genericTypeParameters": [
+                  { "kind": "variable", "name": "a", "weak": false }
+                ]
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "result",
+            "genericTypeParameters": [
+              { "kind": "variable", "name": "a", "weak": false },
+              {
+                "kind": "constructor",
+                "path": "string",
+                "genericTypeParameters": []
+              }
+            ]
+          }
+        }
+      }
+    },
+    {
+      "id": "DocgenSignatureDetails.takesCallback",
+      "kind": "value",
+      "name": "takesCallback",
+      "signature": "let takesCallback: ('a => string) => bool",
+      "docstrings": [
+        "A callback remains one parameter instead of becoming outer parameters."
+      ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 5,
+        "col": 1
+      },
+      "detail": {
+        "kind": "signature",
+        "details": {
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "function",
+                "parameters": [
+                  {
+                    "optional": false,
+                    "type": {
+                      "kind": "variable",
+                      "name": "a",
+                      "weak": false
+                    }
+                  }
+                ],
+                "returnType": {
+                  "kind": "constructor",
+                  "path": "string",
+                  "genericTypeParameters": []
+                }
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "bool",
+            "genericTypeParameters": []
+          }
+        }
+      }
+    },
+    {
+      "id": "DocgenSignatureDetails.returnsTuple",
+      "kind": "value",
+      "name": "returnsTuple",
+      "signature": "let returnsTuple: int => (string, int)",
+      "docstrings": [ "A tuple remains one return-type node." ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 8,
+        "col": 1
+      },
+      "detail": {
+        "kind": "signature",
+        "details": {
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "constructor",
+                "path": "int",
+                "genericTypeParameters": []
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "tuple",
+            "elements": [
+              {
+                "kind": "constructor",
+                "path": "string",
+                "genericTypeParameters": []
+              },
+              {
+                "kind": "constructor",
+                "path": "int",
+                "genericTypeParameters": []
+              }
+            ]
+          }
+        }
+      }
+    },
+    {
+      "id": "DocgenSignatureDetails.returnsFunction",
+      "kind": "value",
+      "name": "returnsFunction",
+      "signature": "let returnsFunction: int => string => bool",
+      "docstrings": [
+        "A returned function remains nested in the return type."
+      ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 11,
+        "col": 1
+      },
+      "detail": {
+        "kind": "signature",
+        "details": {
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "constructor",
+                "path": "int",
+                "genericTypeParameters": []
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "function",
+            "parameters": [
+              {
+                "optional": false,
+                "type": {
+                  "kind": "constructor",
+                  "path": "string",
+                  "genericTypeParameters": []
+                }
+              }
+            ],
+            "returnType": {
+              "kind": "constructor",
+              "path": "bool",
+              "genericTypeParameters": []
+            }
+          }
+        }
+      }
+    },
+    {
+      "id": "DocgenSignatureDetails.takesVariant",
+      "kind": "value",
+      "name": "takesVariant",
+      "signature": "let takesVariant: [#count(int) | #enabled] => unit",
+      "docstrings": [
+        "Less common type forms remain visible through an explicit fallback."
+      ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 14,
+        "col": 1
+      },
+      "detail": {
+        "kind": "signature",
+        "details": {
+          "parameters": [
+            {
+              "optional": false,
+              "type": {
+                "kind": "rendered",
+                "signature": "[#count(int) | #enabled]"
+              }
+            }
+          ],
+          "returnType": {
+            "kind": "constructor",
+            "path": "unit",
+            "genericTypeParameters": []
+          }
+        }
+      }
+    },
+    {
+      "id": "DocgenSignatureDetails.constant",
+      "kind": "value",
+      "name": "constant",
+      "signature": "let constant: int",
+      "docstrings": [
+        "Non-functions do not receive function signature details."
+      ],
+      "source": {
+        "filepath": "src/DocgenSignatureDetails.resi",
+        "line": 17,
+        "col": 1
+      }
+    }
+  ]
+}
diff --git a/tests/tools_tests/src/expected/ModC.res.json b/tests/tools_tests/src/expected/ModC.res.json
index cc4cce09bba..db9cdf11e52 100644
--- a/tests/tools_tests/src/expected/ModC.res.json
+++ b/tests/tools_tests/src/expected/ModC.res.json
@@ -16,14 +16,7 @@
           "name": "name",
           "signature": "let name: string",
           "docstrings": [],
-          "source": { "filepath": "src/ModC.resi", "line": 5, "col": 3 },
-          "detail": {
-            "kind": "signature",
-            "details": {
-              "parameters": [],
-              "returnType": { "path": "string", "genericTypeParameters": [] }
-            }
-          }
+          "source": { "filepath": "src/ModC.resi", "line": 5, "col": 3 }
         }
       ]
     }
diff --git a/tests/tools_tests/src/expected/ModC.resi.json b/tests/tools_tests/src/expected/ModC.resi.json
index cc4cce09bba..db9cdf11e52 100644
--- a/tests/tools_tests/src/expected/ModC.resi.json
+++ b/tests/tools_tests/src/expected/ModC.resi.json
@@ -16,14 +16,7 @@
           "name": "name",
           "signature": "let name: string",
           "docstrings": [],
-          "source": { "filepath": "src/ModC.resi", "line": 5, "col": 3 },
-          "detail": {
-            "kind": "signature",
-            "details": {
-              "parameters": [],
-              "returnType": { "path": "string", "genericTypeParameters": [] }
-            }
-          }
+          "source": { "filepath": "src/ModC.resi", "line": 5, "col": 3 }
         }
       ]
     }
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index d7787073952..f893f81f986 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -20,8 +20,19 @@ type constructor_doc = {
   items: constructor_payload option;
 }
 
-type type_doc = {path: string; generic_parameters: type_doc list}
-type value_signature = {parameters: type_doc list; return_type: type_doc}
+type type_doc =
+  | Constructor of {path: string; generic_parameters: type_doc list}
+  | Variable of {name: string; weak: bool}
+  | Tuple of type_doc list
+  | Function of value_signature
+  | Rendered of string
+
+and signature_parameter = {label: string option; optional: bool; typ: type_doc}
+
+and value_signature = {
+  parameters: signature_parameter list;
+  return_type: type_doc;
+}
 
 type source = {filepath: string; line: int; col: int}
 
@@ -103,13 +114,45 @@ let stringify_constructor_payload (constructor_payload : constructor_payload) =
         ("fields", `List (field_docs |> List.map stringify_field_doc));
       ]
 
-let rec stringify_type_doc (td : type_doc) =
-  let ps =
-    match td.generic_parameters with
-    | [] -> `List []
-    | ts -> ts |> List.map stringify_type_doc |> fun ts -> `List ts
-  in
-  `Assoc [("path", `String td.path); ("genericTypeParameters", ps)]
+let rec stringify_type_doc = function
+  | Constructor {path; generic_parameters} ->
+    `Assoc
+      [
+        ("kind", `String "constructor");
+        ("path", `String path);
+        ( "genericTypeParameters",
+          `List (List.map stringify_type_doc generic_parameters) );
+      ]
+  | Variable {name; weak} ->
+    `Assoc
+      [
+        ("kind", `String "variable");
+        ("name", `String name);
+        ("weak", `Bool weak);
+      ]
+  | Tuple elements ->
+    `Assoc
+      [
+        ("kind", `String "tuple");
+        ("elements", `List (List.map stringify_type_doc elements));
+      ]
+  | Function signature ->
+    `Assoc (("kind", `String "function") :: stringify_value_signature signature)
+  | Rendered signature ->
+    `Assoc [("kind", `String "rendered"); ("signature", `String signature)]
+
+and stringify_signature_parameter {label; optional; typ} =
+  `Assoc
+    ((match label with
+     | Some label -> [("label", `String label)]
+     | None -> [])
+    @ [("optional", `Bool optional); ("type", stringify_type_doc typ)])
+
+and stringify_value_signature {parameters; return_type} =
+  [
+    ("parameters", `List (List.map stringify_signature_parameter parameters));
+    ("returnType", stringify_type_doc return_type);
+  ]
 
 let stringify_detail (detail : doc_item_detail) =
   match detail with
@@ -147,18 +190,10 @@ let stringify_detail (detail : doc_item_detail) =
                      | None -> []))) );
       ]
   | Signature {parameters; return_type} ->
-    let ps =
-      match parameters with
-      | [] -> `List []
-      | ps -> ps |> List.map stringify_type_doc |> fun ps -> `List ps
-    in
     `Assoc
       [
         ("kind", `String "signature");
-        ( "details",
-          `Assoc
-            [("parameters", ps); ("returnType", stringify_type_doc return_type)]
-        );
+        ("details", `Assoc (stringify_value_signature {parameters; return_type}));
       ]
 
 let stringify_source source =
@@ -309,60 +344,51 @@ let type_detail typ ~env ~full ~state =
          })
   | _ -> None
 
-(* split a list into two parts all the items except the last one and the last item *)
-let split_last l =
-  let rec splitLast' acc = function
-    | [] -> failwith "splitLast: empty list"
-    | [x] -> (List.rev acc, x)
-    | x :: xs -> splitLast' (x :: acc) xs
-  in
-  splitLast' [] l
+let rec string_of_out_ident = function
+  | Outcometree.Oide_ident name -> name
+  | Oide_dot (path, name) -> string_of_out_ident path ^ "." ^ name
+  | Oide_apply (functor_, argument) ->
+    string_of_out_ident functor_ ^ "(" ^ string_of_out_ident argument ^ ")"
+
+let render_out_type typ =
+  Res_doc.to_string ~width:80 (Res_outcome_printer.print_out_type_doc typ)
+
+let rec type_doc_of_out_type (typ : Outcometree.out_type) =
+  match typ with
+  | Otyp_constr (path, generic_parameters) ->
+    Constructor
+      {
+        path = string_of_out_ident path;
+        generic_parameters = List.map type_doc_of_out_type generic_parameters;
+      }
+  | Otyp_var (weak, name) -> Variable {name; weak}
+  | Otyp_tuple elements -> Tuple (List.map type_doc_of_out_type elements)
+  | Otyp_arrow (parameters, return_type) ->
+    Function (value_signature_of_arrow parameters return_type)
+  | _ -> Rendered (render_out_type typ)
 
-let path_to_string path =
-  let buf = Buffer.create 64 in
-  let rec aux = function
-    | Path.Pident id -> Buffer.add_string buf (Ident.name id)
-    | Path.Pdot (p, s, _) ->
-      aux p;
-      Buffer.add_char buf '.';
-      Buffer.add_string buf s
-    | Path.Papply (p1, p2) ->
-      aux p1;
-      Buffer.add_char buf '(';
-      aux p2;
-      Buffer.add_char buf ')'
+and signature_parameter_of_out_type (label, typ) =
+  let label, optional =
+    match label with
+    | Asttypes.Noloc.Nolabel -> (None, false)
+    | Asttypes.Noloc.Labelled label -> (Some label, false)
+    | Asttypes.Noloc.Optional label -> (Some label, true)
   in
-  aux path;
-  Buffer.contents buf
+  {label; optional; typ = type_doc_of_out_type typ}
+
+and value_signature_of_arrow parameters return_type =
+  {
+    parameters = List.map signature_parameter_of_out_type parameters;
+    return_type = type_doc_of_out_type return_type;
+  }
 
 let value_detail (typ : Types.type_expr) =
-  let rec collect_signature_types (typ : Types.type_expr) =
-    match typ.desc with
-    | Tlink t | Tsubst t | Tpoly (t, []) -> collect_signature_types t
-    | Tconstr (path, ts, _) -> (
-      let p = path_to_string path in
-      match ts with
-      | [] -> [{path = p; generic_parameters = []}]
-      | ts ->
-        let ts =
-          ts
-          |> List.concat_map (fun (t : Types.type_expr) ->
-                 collect_signature_types t)
-        in
-        [{path = p; generic_parameters = ts}])
-    | 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
-  match collect_signature_types typ with
-  | [] -> None
-  | ts ->
-    let parameters, return_type = split_last ts in
-    Some (Signature {parameters; return_type})
+  Printtyp.reset_names ();
+  Printtyp.reset_and_mark_loops typ;
+  match Printtyp.tree_of_typexp false typ with
+  | Otyp_arrow (parameters, return_type) ->
+    Some (Signature (value_signature_of_arrow parameters return_type))
+  | _ -> None
 
 let make_id module_path ~identifier =
   identifier :: module_path |> List.rev |> Shared_types.ident