Remove dead code enabled by structural arity

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

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}}}) ->

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} []

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

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

compiler/frontend/ast_core_type_class_type.ml

@@ -95,26 +95,28 @@ 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 =
                 match Ast_attributes.process_attributes_rev attrs with
                 | 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 =
                 match Ast_attributes.process_attributes_rev ptyp_attrs with
                 | 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)

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