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>

Author: cristianoc

CHANGELOG.md

@@ -30,6 +30,7 @@
 - Fix argument evaluation order when a function call is inlined: the beta reducer stacked argument bindings in reverse parameter order, so the last argument was evaluated first when arguments could not be substituted directly. https://github.com/rescript-lang/rescript/pull/8572
 - Preserve parentheses around multiplication, division, and modulo expressions used as exponents. https://github.com/rescript-lang/rescript/pull/8550
 - Enforce function arity in interface/module inclusion and type coercion. Previously a curried implementation (e.g. `int => int => int`) could satisfy an uncurried interface (`(int, int) => int`) or be coerced to it, which could miscompile calls made through the interface type. Such mismatches are now compile errors with an explanatory hint. https://github.com/rescript-lang/rescript/pull/8559
+- Fix default values of optional parameters being computed at the wrong time for curried functions: in `(~x=default, y) => (~z=default, w) => ...`, `x`'s default was only computed when the *inner* function was applied. Each default is now computed when its own parameter group is applied. https://github.com/rescript-lang/rescript/pull/8568
 - Fix bare labeled arrow types (`~x: int => string`) getting no arity: they printed identically to their parenthesized form (`(~x: int) => string`) but did not unify with it. https://github.com/rescript-lang/rescript/pull/8563
 - Fix losses of fidelity when code passes through an external PPX: the internal `@res.async` marker no longer leaks into the program, attributes on an arrow type or on an `await` expression are no longer dropped or relocated (previously this could crash the formatter), JSX elements keep their closing tag, and PPX-emitted OCaml-style `function` is desugared instead of crashing the compiler. https://github.com/rescript-lang/rescript/pull/8561
 - Preserve multibyte characters when wrapping long source lines in compiler code frames. https://github.com/rescript-lang/rescript/pull/8520
@@ -46,6 +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 the typed layers n-ary as well: `Types.Tarrow` carries a parameter list, `Texp_function` carries typed parameters (label, ident, pattern, per-parameter exhaustiveness) and a body, and `Ttyp_arrow`/`Otyp_arrow` follow. The `arity` annotation and its `int option` phantom state are gone from the compiler entirely; `push_defaults` in translcore and the hand-rolled gather-until-arity walks in gentype, reanalyze, and the outcome printer are deleted. The cmi and cmt magic numbers are bumped (`Caml1999I023`/`Caml1999T023`). Generated JavaScript is byte-identical across the test suite (optional-parameter internals are named `*opt_<label>*` instead of `*opt*`, visible only in the rare unprettified case); reanalyze no longer emits spurious empty optional-argument references, and genType recovers real parameter names after defaulted parameters. https://github.com/rescript-lang/rescript/pull/8568
 - Make functions and arrow types n-ary in the parsetree: `Pexp_fun` carries a parameter list and `Ptyp_arrow` a parameter list, replacing the curried one-parameter-per-node chains with an `arity` annotation on the head. Arity is now structural (`List.length params`) and `ast_uncurried.ml` is deleted. The typed layers, cmt format, printed output, and the external-PPX wire format are unchanged. Generated JavaScript is unchanged with one deliberate exception: `@this this => async arg => ...` now means what it says (a method returning an async function) instead of absorbing the nested parameter into the method; write `@this async (this, arg) => ...` for the old meaning. https://github.com/rescript-lang/rescript/pull/8566
 - Give marshaled current-parsetree streams (`-as-pp`, `res_parser -print binary`) their own magic numbers, distinct from the frozen Parsetree0 wire format used for external PPXes. https://github.com/rescript-lang/rescript/pull/8561
 - Record the written parameter count in parsed arrow arity for externals with phantom `@as(...) _` arguments. External processing recounts after erasing phantoms, so the parser no longer needs to pre-decrement the arity or the printer to compensate for it. https://github.com/rescript-lang/rescript/pull/8563

analysis/reanalyze/src/arnold.ml

@@ -530,31 +530,6 @@ module Function_table = struct
     | exception Not_found -> None
 end
 
-module Find_functions_called = struct
-  let traverse_expr ~callees =
-    let super = Tast_mapper.default in
-    let expr (self : Tast_mapper.mapper) (e : Typedtree.expression) =
-      (match e.exp_desc with
-      | Texp_apply {funct = {exp_desc = Texp_ident (callee, _, _)}} ->
-        let function_name = Path.name callee in
-        callees := !callees |> String_set.add function_name
-      | _ -> ());
-      super.expr self e
-    in
-    {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
-end
-
 module Extend_function_table = struct
   (* Add functions passed a recursive function via a labeled argument,
      and functions calling progress functions, to the function table. *)
@@ -592,39 +567,10 @@ module Extend_function_table = struct
       if args |> List.for_all check_arg then Some (path, loc) else None
     | _ -> None
 
-  let traverse_expr ~config ~function_table ~progress_functions
-      ~value_bindings_table =
+  let traverse_expr ~config ~function_table =
     let super = Tast_mapper.default in
     let expr (self : Tast_mapper.mapper) (e : Typedtree.expression) =
       (match e.exp_desc with
-      | Texp_ident (callee, _, _) -> (
-        let loc = e.exp_loc in
-        match Hashtbl.find_opt value_bindings_table (Path.name callee) with
-        | None -> ()
-        | Some (id_pos, _, callees) ->
-          if
-            not
-              (String_set.is_empty
-                 (String_set.inter (Lazy.force callees) progress_functions))
-          then
-            let function_name = Path.name callee in
-            if
-              not
-                (callee
-                |> Function_table.is_in_function_in_table ~function_table)
-            then (
-              function_table |> Function_table.add_function ~function_name;
-              if config.Dce_config.cli.debug then
-                Log_.warning ~for_stats:false ~loc
-                  (Termination
-                     {
-                       termination = TerminationAnalysisInternal;
-                       message =
-                         Format.asprintf
-                           "Extend Function Table with @{<info>%s@} (%a) as it \
-                            calls a progress function"
-                           function_name print_pos id_pos;
-                     })))
       | Texp_apply {funct = {exp_desc = Texp_ident (callee, _, _)}; args}
         when callee |> Function_table.is_in_function_in_table ~function_table ->
         let function_name = Path.name callee in
@@ -654,12 +600,8 @@ module Extend_function_table = struct
     in
     {super with Tast_mapper.expr}
 
-  let run ~config ~function_table ~progress_functions ~value_bindings_table
-      (expression : Typedtree.expression) =
-    let traverse_expr =
-      traverse_expr ~config ~function_table ~progress_functions
-        ~value_bindings_table
-    in
+  let run ~config ~function_table (expression : Typedtree.expression) =
+    let traverse_expr = traverse_expr ~config ~function_table in
     expression |> traverse_expr.expr traverse_expr |> ignore
 end
 
@@ -696,7 +638,7 @@ module Check_expression_well_formed = struct
                      match
                        Hashtbl.find_opt value_bindings_table function_name
                      with
-                     | Some (_pos, (body : Typedtree.expression), _)
+                     | Some (_pos, (body : Typedtree.expression))
                        when path
                             |> Function_table.is_in_function_in_table
                                  ~function_table ->
@@ -937,7 +879,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
@@ -1327,11 +1269,8 @@ let traverse_ast ~config ~value_bindings_table =
     |> List.iter (fun (vb : Typedtree.value_binding) ->
            match vb.vb_pat.pat_desc with
            | Tpat_var (id, {loc = {loc_start = pos}}) ->
-             let callees =
-               lazy (Find_functions_called.find_callees vb.vb_expr)
-             in
              Hashtbl.replace value_bindings_table (Ident.name id)
-               (pos, vb.vb_expr, callees)
+               (pos, vb.vb_expr)
            | _ -> ());
     let progress_functions, functions_to_analyze =
       if rec_flag = Asttypes.Nonrecursive then (String_set.empty, [])
@@ -1378,7 +1317,7 @@ let traverse_ast ~config ~value_bindings_table =
         |> List.fold_left
              (fun acc function_name ->
                match Hashtbl.find_opt value_bindings_table function_name with
-               | Some (_pos, e, _set) -> (function_name, e) :: acc
+               | Some (_pos, e) -> (function_name, e) :: acc
                | None -> acc)
              []
         |> List.rev
@@ -1388,9 +1327,7 @@ let traverse_ast ~config ~value_bindings_table =
              function_table |> Function_table.add_function ~function_name);
       recursive_definitions
       |> List.iter (fun (_, body) ->
-             body
-             |> Extend_function_table.run ~config ~function_table
-                  ~progress_functions ~value_bindings_table);
+             body |> Extend_function_table.run ~config ~function_table);
       recursive_definitions
       |> List.iter (fun (_, body) ->
              body
@@ -1405,7 +1342,7 @@ let traverse_ast ~config ~value_bindings_table =
              if function_definition.body = None then
                match Hashtbl.find_opt value_bindings_table function_name with
                | None -> ()
-               | Some (_pos, body, _) ->
+               | Some (_pos, body) ->
                  function_table
                  |> Function_table.add_body
                       ~body:

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

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 =

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

analysis/src/completion_jsx.ml

@@ -246,15 +246,15 @@ 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, _)}; _], _)
         when Path.name cl_path = "React.componentLike"
              && 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 =

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

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