From 00a47acb385d261eaa5590e368ce7532f2164ef1 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] 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.
- Delete Ast_compatible outright. Every member was a thin veneer over
  an existing Ast_helper constructor (rec_type_str/rec_type_sig had
  byte-identical signatures to Str.type_/Sig.type_), hand-rolling the
  records the canonical constructors build; the OCaml-version
  compatibility it existed for is long gone, and its fun_ silently
  hard-coded arity 1. Call sites use Ast_helper directly, with two
  let-bound app1/app2 shorthands kept local to ast_derive_js_mapper.

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_comb.ml                 |   9 --
 compiler/frontend/ast_compatible.ml           | 126 ------------------
 compiler/frontend/ast_compatible.mli          |  97 --------------
 compiler/frontend/ast_core_type.ml            |   8 +-
 compiler/frontend/ast_core_type.mli           |   3 +-
 compiler/frontend/ast_core_type_class_type.ml |  14 +-
 compiler/frontend/ast_derive_abstract.ml      |   4 +-
 compiler/frontend/ast_derive_js_mapper.ml     |  32 ++---
 compiler/frontend/ast_derive_projector.ml     |   7 +-
 compiler/frontend/ast_exp_apply.ml            |   8 +-
 compiler/frontend/ast_external_mk.ml          |   9 +-
 compiler/frontend/ast_tdcls.ml                |   7 +-
 compiler/ml/ast_async.ml                      |  11 +-
 compiler/ml/ctype.ml                          |   9 --
 compiler/ml/ctype.mli                         |   1 -
 compiler/ml/typecore.ml                       |  61 +++------
 compiler/ml/typecore.mli                      |   1 -
 compiler/syntax/src/res_core.ml               |   4 +-
 tests/ERROR_VARIANTS.md                       |   6 +-
 21 files changed, 87 insertions(+), 355 deletions(-)
 delete mode 100644 compiler/frontend/ast_compatible.ml
 delete mode 100644 compiler/frontend/ast_compatible.mli

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 6bdb979a3ea..69409487802 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -48,6 +48,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. https://github.com/rescript-lang/rescript/pull/8569
+
 - Make the typed layers n-ary as well: `Types.Tarrow` carries a parameter list, `Texp_function` carries typed parameters (label, ident, pattern, per-parameter exhaustiveness) and a body, and `Ttyp_arrow`/`Otyp_arrow` follow. The `arity` annotation and its `int option` phantom state are gone from the compiler entirely; `push_defaults` in translcore and the hand-rolled gather-until-arity walks in gentype, reanalyze, and the outcome printer are deleted. The cmi and cmt magic numbers are bumped (`Caml1999I023`/`Caml1999T023`). Generated JavaScript is byte-identical across the test suite (optional-parameter internals are named `*opt_<label>*` instead of `*opt*`, visible only in the rare unprettified case); reanalyze no longer emits spurious empty optional-argument references, and genType recovers real parameter names after defaulted parameters. https://github.com/rescript-lang/rescript/pull/8568
 - Make functions and arrow types n-ary in the parsetree: `Pexp_fun` carries a parameter list and `Ptyp_arrow` a parameter list, replacing the curried one-parameter-per-node chains with an `arity` annotation on the head. Arity is now structural (`List.length params`) and `ast_uncurried.ml` is deleted. The typed layers, cmt format, printed output, and the external-PPX wire format are unchanged. Generated JavaScript is unchanged with one deliberate exception: `@this this => async arg => ...` now means what it says (a method returning an async function) instead of absorbing the nested parameter into the method; write `@this async (this, arg) => ...` for the old meaning. https://github.com/rescript-lang/rescript/pull/8566
 - Give marshaled current-parsetree streams (`-as-pp`, `res_parser -print binary`) their own magic numbers, distinct from the frozen Parsetree0 wire format used for external PPXes. https://github.com/rescript-lang/rescript/pull/8561
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_comb.ml b/compiler/frontend/ast_comb.ml
index b4a95969e5a..a049a04cf98 100644
--- a/compiler/frontend/ast_comb.ml
+++ b/compiler/frontend/ast_comb.ml
@@ -24,15 +24,6 @@
 
 open Ast_helper
 
-(* let fun_no_label ?loc ?attrs  pat body =
-   Ast_compatible.fun_ ?loc ?attrs  pat body *)
-
-(* let discard_exp_as_unit loc e =
-   Ast_compatible.apply_simple ~loc
-    (Exp.ident ~loc {txt = Ast_literal.Lid.ignore_id; loc})
-    [Exp.constraint_ ~loc e
-       (Ast_literal.type_unit ~loc ())] *)
-
 let regexp_id = Ast_literal.Lid.regexp_id
 
 let to_regexp_type loc = Typ.constr ~loc {txt = regexp_id; loc} []
diff --git a/compiler/frontend/ast_compatible.ml b/compiler/frontend/ast_compatible.ml
deleted file mode 100644
index 8769bd1ab5d..00000000000
--- a/compiler/frontend/ast_compatible.ml
+++ /dev/null
@@ -1,126 +0,0 @@
-(* Copyright (C) 2018 Hongbo Zhang, Authors of ReScript
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type loc = Location.t
-
-type attrs = Parsetree.attribute list
-
-open Parsetree
-
-let default_loc = Location.none
-
-let apply_simple ?(loc = default_loc) ?(attrs = []) (fn : expression)
-    (args : expression list) : expression =
-  {
-    pexp_loc = loc;
-    pexp_attributes = attrs;
-    pexp_desc =
-      Pexp_apply
-        {
-          funct = fn;
-          args = Ext_list.map args (fun x -> (Asttypes.Nolabel, x));
-          partial = false;
-          transformed_jsx = false;
-        };
-  }
-
-let app1 ?(loc = default_loc) ?(attrs = []) fn arg1 : expression =
-  {
-    pexp_loc = loc;
-    pexp_attributes = attrs;
-    pexp_desc =
-      Pexp_apply
-        {
-          funct = fn;
-          args = [(Nolabel, arg1)];
-          partial = false;
-          transformed_jsx = false;
-        };
-  }
-
-let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression =
-  {
-    pexp_loc = loc;
-    pexp_attributes = attrs;
-    pexp_desc =
-      Pexp_apply
-        {
-          funct = fn;
-          args = [(Nolabel, arg1); (Nolabel, arg2)];
-          partial = false;
-          transformed_jsx = false;
-        };
-  }
-
-let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) pat exp =
-  {
-    pexp_loc = loc;
-    pexp_attributes = attrs;
-    pexp_desc =
-      Pexp_fun
-        {
-          params =
-            [{p_attrs = []; p_lbl = Nolabel; p_default = None; p_pat = pat}];
-          body = exp;
-          async;
-        };
-  }
-
-let apply_labels ?(loc = default_loc) ?(attrs = []) fn
-    (args : (string * expression) list) : expression =
-  {
-    pexp_loc = loc;
-    pexp_attributes = attrs;
-    pexp_desc =
-      Pexp_apply
-        {
-          funct = fn;
-          args =
-            Ext_list.map args (fun (l, a) ->
-                (Asttypes.Labelled {txt = l; loc = Location.none}, a));
-          partial = false;
-          transformed_jsx = false;
-        };
-  }
-
-let rec_type_str ?(loc = default_loc) rf tds : structure_item =
-  {pstr_loc = loc; pstr_desc = Pstr_type (rf, tds)}
-
-let rec_type_sig ?(loc = default_loc) rf tds : signature_item =
-  {psig_loc = loc; psig_desc = Psig_type (rf, tds)}
-
-(* FIXME: need address migration of `[@nonrec]` attributes in older ocaml *)
-(* let nonrec_type_sig ?(loc=default_loc)  tds : signature_item =
-   {
-    psig_loc = loc;
-    psig_desc = Psig_type (
-      Nonrecursive,
-      tds)
-   } *)
-
-type object_field = Parsetree.object_field
-
-let object_field l attrs ty = Parsetree.Otag (l, attrs, ty)
-
-type args = (Asttypes.arg_label * Parsetree.expression) list
diff --git a/compiler/frontend/ast_compatible.mli b/compiler/frontend/ast_compatible.mli
deleted file mode 100644
index 42b33b188c4..00000000000
--- a/compiler/frontend/ast_compatible.mli
+++ /dev/null
@@ -1,97 +0,0 @@
-(* Copyright (C) 2018 Authors of ReScript
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type loc = Location.t
-
-type attrs = Parsetree.attribute list
-
-open Parsetree
-
-val apply_simple :
-  ?loc:Location.t -> ?attrs:attrs -> expression -> expression list -> expression
-
-val app1 :
-  ?loc:Location.t -> ?attrs:attrs -> expression -> expression -> expression
-
-val app2 :
-  ?loc:Location.t ->
-  ?attrs:attrs ->
-  expression ->
-  expression ->
-  expression ->
-  expression
-
-val apply_labels :
-  ?loc:Location.t ->
-  ?attrs:attrs ->
-  expression ->
-  (string * expression) list ->
-  (* [(label,e)] [label] is strictly interpreted as label *)
-  expression
-(** Note this function would slightly 
-    change its semantics depending on compiler versions
-    for newer version: it means always label
-    for older version: it could be optional (which we should avoid)
-*)
-
-val fun_ :
-  ?loc:Location.t ->
-  ?attrs:attrs ->
-  ?async:bool ->
-  pattern ->
-  expression ->
-  expression
-
-(* val opt_label : string -> Asttypes.arg_label *)
-
-(* val label_fun :
-   ?loc:Location.t ->
-   ?attrs:attrs ->
-   label:Asttypes.arg_label ->
-   pattern ->
-   expression ->
-   expression *)
-
-(* val nonrec_type_str:
-   ?loc:loc ->
-   type_declaration list ->
-   structure_item *)
-
-val rec_type_str :
-  ?loc:loc -> Asttypes.rec_flag -> type_declaration list -> structure_item
-
-(* val nonrec_type_sig:
-   ?loc:loc ->
-   type_declaration list ->
-   signature_item *)
-
-val rec_type_sig :
-  ?loc:loc -> Asttypes.rec_flag -> type_declaration list -> signature_item
-
-type object_field = Parsetree.object_field
-
-val object_field :
-  Asttypes.label Asttypes.loc -> attributes -> core_type -> object_field
-
-type args = (Asttypes.arg_label * Parsetree.expression) list
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/frontend/ast_core_type_class_type.ml b/compiler/frontend/ast_core_type_class_type.ml
index 3f43e81d3f9..fccd2f0f550 100644
--- a/compiler/frontend/ast_core_type_class_type.ml
+++ b/compiler/frontend/ast_core_type_class_type.ml
@@ -95,7 +95,7 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
                 | Nothing, attrs -> (attrs, ty) (* #1678 *)
                 | Meth_callback attr, attrs -> (attrs, attr +> ty)
               in
-              Ast_compatible.object_field name attrs (self.typ self core_type)
+              Parsetree.Otag (name, attrs, self.typ self core_type)
             in
             let set ty name attrs =
               let attrs, core_type =
@@ -103,10 +103,12 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
                 | Nothing, attrs -> (attrs, ty)
                 | Meth_callback attr, attrs -> (attrs, attr +> ty)
               in
-              Ast_compatible.object_field name attrs
-                (Ast_helper.Typ.arrow ~loc
-                   [{attrs = []; lbl = Nolabel; typ = self.typ self core_type}]
-                   (Ast_literal.type_unit ~loc ()))
+              Parsetree.Otag
+                ( name,
+                  attrs,
+                  Ast_helper.Typ.arrow ~loc
+                    [{attrs = []; lbl = Nolabel; typ = self.typ self core_type}]
+                    (Ast_literal.type_unit ~loc ()) )
             in
             let not_getter_setter ty =
               let attrs, core_type =
@@ -114,7 +116,7 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
                 | Nothing, attrs -> (attrs, ty)
                 | Meth_callback attr, attrs -> (attrs, attr +> ty)
               in
-              Ast_compatible.object_field label attrs (self.typ self core_type)
+              Parsetree.Otag (label, attrs, self.typ self core_type)
             in
             process_getter_setter ~not_getter_setter ~get ~set loc label
               ptyp_attrs core_type acc)
diff --git a/compiler/frontend/ast_derive_abstract.ml b/compiler/frontend/ast_derive_abstract.ml
index 9f11354b8e9..7cb0c1bb5fb 100644
--- a/compiler/frontend/ast_derive_abstract.ml
+++ b/compiler/frontend/ast_derive_abstract.ml
@@ -209,7 +209,7 @@ let handle_tdcls_in_str ~light rf tdcls =
             Ext_list.map_append value_descriptions sts (fun x ->
                 Str.primitive x) ))
   in
-  Ast_compatible.rec_type_str rf tdcls :: code
+  Str.type_ rf tdcls :: code
 (* still need perform transformation for non-abstract type*)
 
 let handle_tdcls_in_sig ~light rf tdcls =
@@ -220,4 +220,4 @@ let handle_tdcls_in_sig ~light rf tdcls =
           ( ntdcl :: tdcls,
             Ext_list.map_append value_descriptions sts (fun x -> Sig.value x) ))
   in
-  Ast_compatible.rec_type_sig rf tdcls :: code
+  Sig.type_ rf tdcls :: code
diff --git a/compiler/frontend/ast_derive_js_mapper.ml b/compiler/frontend/ast_derive_js_mapper.ml
index c46fc23b3aa..278097551d8 100644
--- a/compiler/frontend/ast_derive_js_mapper.ml
+++ b/compiler/frontend/ast_derive_js_mapper.ml
@@ -27,10 +27,11 @@ module U = Ast_derive_util
 
 type tdcls = Parsetree.type_declaration list
 
+let app1 f arg1 = Exp.apply f [(Nolabel, arg1)]
+let app2 f arg1 arg2 = Exp.apply f [(Nolabel, arg1); (Nolabel, arg2)]
+
 let js_field (o : Parsetree.expression) m =
-  Ast_compatible.app2
-    (Exp.ident {txt = Lident "##"; loc = o.pexp_loc})
-    o (Exp.ident m)
+  app2 (Exp.ident {txt = Lident "##"; loc = o.pexp_loc}) o (Exp.ident m)
 
 let handle_config (config : Parsetree.expression option) =
   match config with
@@ -62,7 +63,7 @@ let erase_type_lit = "_eraseType"
 
 let erase_type_exp = Exp.ident {loc = noloc; txt = Lident erase_type_lit}
 
-let erase_type x = Ast_compatible.app1 erase_type_exp x
+let erase_type x = app1 erase_type_exp x
 
 let erase_type_str =
   let any = Typ.any () in
@@ -131,10 +132,6 @@ let build_map (row_fields : Parsetree.row_field list) =
   in
   (data, rev_data, !has_bs_as)
 
-let app1 = Ast_compatible.app1
-
-let app2 = Ast_compatible.app2
-
 let ( ->~ ) a b = Ast_helper.Typ.arrow [{attrs = []; lbl = Nolabel; typ = a}] b
 
 let raise_when_not_found_ident =
@@ -170,12 +167,15 @@ let init () =
               in
               let new_type_str =
                 (* Abstract type *)
-                Ast_compatible.rec_type_str Nonrecursive [new_tdcl]
+                Str.type_ Nonrecursive [new_tdcl]
               in
               let to_js_body body =
                 Ast_comb.single_non_rec_value pat_to_js
-                  (Ast_compatible.fun_
-                     (Pat.constraint_ (Pat.var pat_param) core_type)
+                  (Exp.fun_
+                     [
+                       Exp.fun_param Nolabel
+                         (Pat.constraint_ (Pat.var pat_param) core_type);
+                     ]
                      body)
               in
               let ( +> ) a ty = Exp.constraint_ (erase_type a) ty in
@@ -226,7 +226,8 @@ let init () =
                 in
                 let from_js =
                   Ast_comb.single_non_rec_value pat_from_js
-                    (Ast_compatible.fun_ (Pat.var pat_param)
+                    (Exp.fun_
+                       [Exp.fun_param Nolabel (Pat.var pat_param)]
                        (if create_type then
                           Exp.let_ Nonrecursive
                             [Vb.mk (Pat.var pat_param) (exp_param +: new_type)]
@@ -268,7 +269,8 @@ let init () =
                            app2 unsafe_index_get_exp exp_map exp_param
                          else app1 erase_type_exp exp_param);
                       Ast_comb.single_non_rec_value pat_from_js
-                        (Ast_compatible.fun_ (Pat.var pat_param)
+                        (Exp.fun_
+                           [Exp.fun_param Nolabel (Pat.var pat_param)]
                            (let result =
                               app2 unsafe_index_get_exp rev_exp_map exp_param
                             in
@@ -307,9 +309,7 @@ let init () =
               let new_type, new_tdcl =
                 U.new_type_of_type_declaration tdcl ("abs_" ^ name)
               in
-              let new_type_str =
-                Ast_compatible.rec_type_sig Nonrecursive [new_tdcl]
-              in
+              let new_type_str = Sig.type_ Nonrecursive [new_tdcl] in
               let ( +? ) v rest = if create_type then v :: rest else rest in
               match tdcl.ptype_kind with
               | Ptype_record label_declarations ->
diff --git a/compiler/frontend/ast_derive_projector.ml b/compiler/frontend/ast_derive_projector.ml
index abfe8209398..3203b116087 100644
--- a/compiler/frontend/ast_derive_projector.ml
+++ b/compiler/frontend/ast_derive_projector.ml
@@ -42,8 +42,11 @@ let init () =
                     let txt = "param" in
                     Ast_comb.single_non_rec_value ?attrs:gentype_attrs pld_name
                       (* arity will always be 1 since these are single param functions *)
-                      (Ast_compatible.fun_
-                         (Pat.constraint_ (Pat.var {txt; loc}) core_type)
+                      (Exp.fun_
+                         [
+                           Exp.fun_param Nolabel
+                             (Pat.constraint_ (Pat.var {txt; loc}) core_type);
+                         ]
                          (Exp.field
                             (Exp.ident {txt = Lident txt; loc})
                             {txt = Longident.Lident pld_label; loc})))
diff --git a/compiler/frontend/ast_exp_apply.ml b/compiler/frontend/ast_exp_apply.ml
index 04034fad51e..44d751a7645 100644
--- a/compiler/frontend/ast_exp_apply.ml
+++ b/compiler/frontend/ast_exp_apply.ml
@@ -44,7 +44,8 @@ let bound (e : exp) (cb : exp -> _) =
 
 let default_expr_mapper = Bs_ast_mapper.default_mapper.expr
 
-let check_and_discard (args : Ast_compatible.args) =
+let check_and_discard (args : (Asttypes.arg_label * Parsetree.expression) list)
+    =
   Ext_list.map args (fun (label, x) ->
       Bs_syntaxerr.err_if_label x.pexp_loc label;
       x)
@@ -125,11 +126,12 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
                          pexp_loc = fn.pexp_loc;
                        }
                      | _ ->
-                       Ast_compatible.app1 ~loc:fn.pexp_loc fn bounded_obj_arg));
+                       Exp.apply ~loc:fn.pexp_loc fn
+                         [(Nolabel, bounded_obj_arg)]));
             pexp_attributes = f.pexp_attributes;
             pexp_loc = f.pexp_loc;
           })
-    | _ -> Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a)
+    | _ -> Exp.apply ~loc ~attrs:e.pexp_attributes f [(Nolabel, a)])
   | Some {op = "##"; loc; args = [obj; rest]} -> (
     (* - obj##property
        - obj#(method a b )
diff --git a/compiler/frontend/ast_external_mk.ml b/compiler/frontend/ast_external_mk.ml
index 2bc325e24b5..da95884d457 100644
--- a/compiler/frontend/ast_external_mk.ml
+++ b/compiler/frontend/ast_external_mk.ml
@@ -48,7 +48,7 @@ let local_external_apply loc ?(pval_attributes = []) ~(pval_prim : string list)
         pmod_loc = loc;
         pmod_attributes = [];
       },
-      Ast_compatible.apply_simple
+      Ast_helper.Exp.apply ~loc
         ({
            pexp_desc =
              Pexp_ident
@@ -57,7 +57,7 @@ let local_external_apply loc ?(pval_attributes = []) ~(pval_prim : string list)
            pexp_loc = loc;
          }
           : Parsetree.expression)
-        args ~loc )
+        (Ext_list.map args (fun x -> (Asttypes.Nolabel, x))) )
 
 let local_external_obj loc ?(pval_attributes = []) ~pval_prim ~pval_type
     ?(local_module_name = "J") ?(local_fun_name = "unsafe_expr") args :
@@ -84,7 +84,7 @@ let local_external_obj loc ?(pval_attributes = []) ~pval_prim ~pval_type
         pmod_loc = loc;
         pmod_attributes = [];
       },
-      Ast_compatible.apply_labels
+      Ast_helper.Exp.apply ~loc
         ({
            pexp_desc =
              Pexp_ident
@@ -93,4 +93,5 @@ let local_external_obj loc ?(pval_attributes = []) ~pval_prim ~pval_type
            pexp_loc = loc;
          }
           : Parsetree.expression)
-        args ~loc )
+        (Ext_list.map args (fun (l, a) ->
+             (Asttypes.Labelled {txt = l; loc = Location.none}, a))) )
diff --git a/compiler/frontend/ast_tdcls.ml b/compiler/frontend/ast_tdcls.ml
index 8326c20fd35..f0effb7e5b5 100644
--- a/compiler/frontend/ast_tdcls.ml
+++ b/compiler/frontend/ast_tdcls.ml
@@ -59,14 +59,13 @@ let handle_tdcls_in_sigi (self : Bs_ast_mapper.mapper)
            (Incl.mk ~loc
               (Mty.typeof_ ~loc
                  (Mod.constraint_ ~loc
-                    (Mod.structure ~loc
-                       [Ast_compatible.rec_type_str ~loc rf new_tdcls_new_attrs])
+                    (Mod.structure ~loc [Str.type_ ~loc rf new_tdcls_new_attrs])
                     (Mty.signature ~loc []))))
         :: (* include module type of struct [processed_code for checking like invariance ]end *)
            self.signature self codes)
     else
       Ast_signature.fuse_all ~loc
-        (Ast_compatible.rec_type_sig ~loc rf new_tdcls_new_attrs
+        (Sig.type_ ~loc rf new_tdcls_new_attrs
         :: self.signature self (Ast_derive.gen_signature tdcls actions rf))
   | {bs_deriving = None}, _ ->
     Bs_ast_mapper.default_mapper.signature_item self sigi
@@ -81,7 +80,7 @@ let handle_tdcls_in_stru (self : Bs_ast_mapper.mapper)
     let loc = str.pstr_loc in
     let original_tdcls_new_attrs = new_tdcls tdcls new_attrs in
     let new_str : Parsetree.structure_item =
-      Ast_compatible.rec_type_str ~loc rf
+      Str.type_ ~loc rf
         (self.type_declaration_list self original_tdcls_new_attrs)
     in
     let kind = Ast_derive_abstract.is_abstract actions in
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 13f247059eb..902dc84281a 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,15 @@ 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 =
-    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))))
+    (* [ty_expected] was just committed to an arrow with exactly these
+       labels, so it can only expand to an arrow. *)
+    match (expand_head env (instance env ty_expected)).desc with
+    | Tarrow (params, ret) ->
+      (List.map (fun (a : Types.arg) -> a.typ) params, ret)
+    | _ -> assert false
   in
   let ty_params =
     List.map2
@@ -3738,10 +3728,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
@@ -4330,9 +4317,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
@@ -4425,7 +4411,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} ->
@@ -4452,7 +4437,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;
@@ -4961,16 +4946,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. |