Make functions and arrow types n-ary in the parsetree

Replace the curried one-parameter-per-node encoding with n-ary nodes:

  Ptyp_arrow of {params: arg list; ret: core_type}
  Pexp_fun of {params: fun_param list; body: expression; async: bool}

where fun_param carries per-parameter attributes, label, default, and
pattern. The arity annotation is gone from the parsetree: a function's
arity is List.length params, unrepresentable wrong. ast_uncurried.ml is
deleted; Ast_helper.Typ.arrow and Exp.fun_ are list-first and assert
non-empty parameter lists.

The typed layers are unchanged: typetexp folds the params list into the
existing curried Tarrow/Ttyp_arrow chains (Some arity on the head, None
inside), and typecore peels parameters one at a time, reproducing the
legacy per-level type_function calls; synthesized rest-functions carry
an internal #res.fun_rest attribute consumed immediately on re-entry.

The Parsetree0 bridge re-curries on the way out (byte-identical wire
format for external PPXes) and gathers Has_arityN / res.arity groups
back into one node on the way in; bare PPX-fabricated v0 funs decode as
one-parameter functions instead of the old, mostly unusable arity-None
encoding.

Attribute contract: in-parens parameter attributes stay on the
patterns (as before); arrow-level attributes (@attr (a, b) => ...) live
on the function node; p_attrs is populated only by the PPX bridge.

Printing is byte-identical across the syntax test corpus; generated
JavaScript is byte-identical across the test suite except
UncurriedExternals.res, where `@this this => async arg => ...` now
honors the written nesting (a method returning an async function)
instead of absorbing the nested lambda's parameter into the method -
the group-boundary ambiguity this representation removes. Signature
help no longer includes the opening paren in the first parameter's
highlight range, and completion debug traces lose their synthetic
chain-node lines.

Also fixes three latent Typ.arrow-on-empty-params paths (zero-argument
externals, @deriving(accessors) zero-argument constructors in
signatures, parser error recovery) that the old arrows helper silently
absorbed.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
Signed-off-by: Cristiano Calcagno <cristianoc@users.noreply.github.com>

Author: cristianoc

CHANGELOG.md

@@ -44,6 +44,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 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
 - Add the `-check-lam` compiler option, enable Lambda invariant checking in compiler tests, and remove build-profile-dependent checking. https://github.com/rescript-lang/rescript/pull/8534

analysis/src/completion_front_end.ml

@@ -1601,42 +1601,63 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
             | Some context_path ->
               set_result (Cpath (CPObj (context_path, label)))
             | None -> ())
-        | Pexp_fun
-            {arg_label = lbl; default = default_exp_opt; lhs = pat; rhs = e} ->
+        | Pexp_fun {params; body = e} ->
           let old_scope = !scope in
           (match (!processing_fun, !current_ctx_path) with
           | None, Some ctx_path -> processing_fun := Some (ctx_path, 0)
           | _ -> ());
-          let arg_context_path =
-            match !processing_fun with
-            | None -> None
-            | Some (ctx_path, current_unlabelled_count) ->
-              (processing_fun :=
-                 match lbl with
-                 | Nolabel -> Some (ctx_path, current_unlabelled_count + 1)
-                 | _ -> Some (ctx_path, current_unlabelled_count));
-              if Debug.verbose () then
-                print_endline "[expr_iter] Completing for argument value";
-              Some
-                (Completable.CArgument
-                   {
-                     function_context_path = ctx_path;
-                     argument_label =
-                       (match lbl with
-                       | Nolabel ->
-                         Unlabelled
-                           {argument_position = current_unlabelled_count}
-                       | Optional {txt = name} -> Optional name
-                       | Labelled {txt = name} -> Labelled name);
-                   })
+          let param_has_cursor ({p_default; p_pat} : Parsetree.fun_param) =
+            loc_has_cursor p_pat.ppat_loc
+            || loc_is_empty p_pat.ppat_loc
+            ||
+            match p_default with
+            | Some default_exp -> loc_has_cursor default_exp.pexp_loc
+            | None -> false
           in
-          (match default_exp_opt with
-          | None -> ()
-          | Some default_exp -> iterator.expr iterator default_exp);
-          if loc_has_cursor e.pexp_loc = false then
-            complete_pattern ?context_path:arg_context_path pat;
-          scope_pattern ?context_path:arg_context_path pat;
-          iterator.pat iterator pat;
+          let rec iter_params params =
+            match params with
+            | [] -> ()
+            | (({p_lbl = lbl; p_default = default_exp_opt; p_pat = pat} :
+                 Parsetree.fun_param) as param)
+              :: rest ->
+              let arg_context_path =
+                match !processing_fun with
+                | None -> None
+                | Some (ctx_path, current_unlabelled_count) ->
+                  (processing_fun :=
+                     match lbl with
+                     | Nolabel -> Some (ctx_path, current_unlabelled_count + 1)
+                     | _ -> Some (ctx_path, current_unlabelled_count));
+                  if Debug.verbose () then
+                    print_endline "[expr_iter] Completing for argument value";
+                  Some
+                    (Completable.CArgument
+                       {
+                         function_context_path = ctx_path;
+                         argument_label =
+                           (match lbl with
+                           | Nolabel ->
+                             Unlabelled
+                               {argument_position = current_unlabelled_count}
+                           | Optional {txt = name} -> Optional name
+                           | Labelled {txt = name} -> Labelled name);
+                       })
+              in
+              (match default_exp_opt with
+              | None -> ()
+              | Some default_exp -> iterator.expr iterator default_exp);
+              (* Only complete the pattern if the cursor is not in a later
+                 part of the function: a following parameter or the body. *)
+              if
+                loc_has_cursor e.pexp_loc = false
+                && (param_has_cursor param
+                   || not (List.exists param_has_cursor rest))
+              then complete_pattern ?context_path:arg_context_path pat;
+              scope_pattern ?context_path:arg_context_path pat;
+              iterator.pat iterator pat;
+              iter_params rest
+          in
+          iter_params params;
           iterator.expr iterator e;
           scope := old_scope;
           processed := true

analysis/src/dump_ast.ml

@@ -242,7 +242,7 @@ and print_expr_item expr ~pos ~indentation =
       | None -> ""
       | Some expr -> "," ^ print_expr_item expr ~pos ~indentation)
     ^ ")"
-  | Pexp_fun {arg_label = arg; lhs = pattern; rhs = next_expr} ->
+  | Pexp_fun {params = {p_lbl = arg; p_pat = pattern} :: _; body = next_expr} ->
     "Pexp_fun(\n"
     ^ add_indentation (indentation + 1)
     ^ "arg: "

analysis/src/hint.ml

@@ -62,8 +62,7 @@ let inlay ~source ~kind_file ~pos ~max_length ~full ~state ~debug =
            ( Pexp_constant _ | Pexp_tuple _ | Pexp_record _ | Pexp_variant _
            | Pexp_apply _ | Pexp_match _ | Pexp_construct _ | Pexp_ifthenelse _
            | Pexp_array _ | Pexp_ident _ | Pexp_try _ | Pexp_send _
-           | Pexp_field _ | Pexp_open _
-           | Pexp_fun {arity = Some _} );
+           | Pexp_field _ | Pexp_open _ | Pexp_fun _ );
        };
     } ->
       push vb.pvb_pat.ppat_loc Type

analysis/src/signature_help.ml

@@ -103,24 +103,27 @@ let find_function_type ~debug ~source ~kind_file ~pos ~full ~state =
         Some (args, docstring, type_expr, package, env, file)
       | _ -> None))
 
-(* Extracts all parameters from a parsed function signature *)
+(* Extracts all parameters from a parsed function signature. The result type
+   is not entered: a returned function's parameters cannot be passed at this
+   call site. *)
 let extract_parameters ~signature ~type_str_for_parser ~label_prefix_len =
   match signature with
-  | [{Parsetree.psig_desc = Psig_value {pval_type = expr}}]
-    when match expr.ptyp_desc with
-         | Ptyp_arrow _ -> true
-         | _ -> false ->
-    let rec extract_params expr params =
-      match expr with
-      | {
-       (* Gotcha: functions with multiple arugments are modelled as a series of single argument functions. *)
-       Parsetree.ptyp_desc = Ptyp_arrow {arg; ret = next_function_expr};
-       ptyp_loc;
-      } ->
+  | [
+   {
+     Parsetree.psig_desc =
+       Psig_value {pval_type = {ptyp_desc = Ptyp_arrow {params = args}}};
+   };
+  ] ->
+    List.map
+      (fun (arg : Parsetree.arg) ->
+        let start_loc =
+          (* For a labeled argument the label precedes the type. *)
+          match arg.lbl with
+          | Asttypes.Labelled {loc} | Optional {loc} -> loc |> Loc.start
+          | Nolabel -> arg.typ.ptyp_loc |> Loc.start
+        in
         let start_offset =
-          ptyp_loc |> Loc.start
-          |> Pos.position_to_offset type_str_for_parser
-          |> Option.get
+          start_loc |> Pos.position_to_offset type_str_for_parser |> Option.get
         in
         let end_offset =
           arg.typ.ptyp_loc |> Loc.end_
@@ -133,18 +136,12 @@ let extract_parameters ~signature ~type_str_for_parser ~label_prefix_len =
           | Asttypes.Optional _ -> end_offset + 2
           | _ -> end_offset
         in
-        extract_params next_function_expr
-          (params
-          @ [
-              ( arg.lbl,
-                (* Remove the label prefix offset here, since we're not showing
-                   that to the end user. *)
-                start_offset - label_prefix_len,
-                end_offset - label_prefix_len );
-            ])
-      | _ -> params
-    in
-    extract_params expr []
+        ( arg.lbl,
+          (* Remove the label prefix offset here, since we're not
+             showing that to the end user. *)
+          start_offset - label_prefix_len,
+          end_offset - label_prefix_len ))
+      args
   | _ -> []
 
 (* Finds what parameter is active, if any *)

analysis/src/xform.ml

@@ -261,7 +261,7 @@ module Add_braces_to_fn = struct
         | _ -> false
       in
       (match e.pexp_desc with
-      | Pexp_fun {rhs = body_expr}
+      | Pexp_fun {body = body_expr}
         when Loc.has_pos ~pos body_expr.pexp_loc
              && is_braced_expr body_expr = false
              && is_function body_expr = false ->
@@ -303,18 +303,18 @@ module Add_type_annotation = struct
         result := Some (if is_unlabeled_only_arg then WithParens else Plain)
       | _ -> ()
     in
-    let rec process_function ~arg_num (e : Parsetree.expression) =
+    let process_function (e : Parsetree.expression) =
       match e.pexp_desc with
-      | Pexp_fun {arg_label; lhs = pat; rhs = e} ->
-        let is_unlabeled_only_arg =
-          arg_num = 1 && arg_label = Nolabel
-          &&
-          match e.pexp_desc with
-          | Pexp_fun _ -> false
-          | _ -> true
+      | Pexp_fun {params} ->
+        let single_param =
+          match params with
+          | [_] -> true
+          | _ -> false
         in
-        process_pattern ~is_unlabeled_only_arg pat;
-        process_function ~arg_num:(arg_num + 1) e
+        params
+        |> List.iter (fun ({p_lbl; p_pat} : Parsetree.fun_param) ->
+               let is_unlabeled_only_arg = single_param && p_lbl = Nolabel in
+               process_pattern ~is_unlabeled_only_arg p_pat)
       | _ -> ()
     in
     let structure_item (iterator : Ast_iterator.iterator)
@@ -327,7 +327,7 @@ module Add_type_annotation = struct
           if not is_jsx_component then process_pattern vb.pvb_pat;
           process_function vb.pvb_expr
         in
-        bindings |> List.iter (process_binding ~arg_num:1);
+        bindings |> List.iter process_binding;
         Ast_iterator.default_iterator.structure_item iterator si
       | _ -> Ast_iterator.default_iterator.structure_item iterator si
     in

compiler/frontend/ast_compatible.ml

@@ -73,18 +73,16 @@ let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression =
         };
   }
 
-let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) ~arity pat exp =
+let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) pat exp =
   {
     pexp_loc = loc;
     pexp_attributes = attrs;
     pexp_desc =
       Pexp_fun
         {
-          arg_label = Nolabel;
-          default = None;
-          lhs = pat;
-          rhs = exp;
-          arity;
+          params =
+            [{p_attrs = []; p_lbl = Nolabel; p_default = None; p_pat = pat}];
+          body = exp;
           async;
         };
   }

compiler/frontend/ast_compatible.mli

@@ -59,7 +59,6 @@ val fun_ :
   ?loc:Location.t ->
   ?attrs:attrs ->
   ?async:bool ->
-  arity:int option ->
   pattern ->
   expression ->
   expression

compiler/frontend/ast_core_type.ml

@@ -97,7 +97,9 @@ let from_labels ~loc arity labels : t =
     Ext_list.map2 labels tyvars (fun label tyvar ->
         {Parsetree.attrs = []; lbl = Asttypes.Labelled label; typ = tyvar})
   in
-  Typ.arrows ~loc args result_type
+  match args with
+  | [] -> result_type
+  | _ -> Typ.arrow ~loc args result_type
 
 let make_obj ~loc xs = Typ.object_ ~loc xs Closed
 
@@ -108,40 +110,14 @@ let make_obj ~loc xs = Typ.object_ ~loc xs Closed
    {[ 'a -> ('a. 'a -> 'b) ]}
 
 *)
-let rec get_uncurry_arity_aux (ty : t) acc =
-  match ty.ptyp_desc with
-  | Ptyp_arrow {ret = new_ty} -> get_uncurry_arity_aux new_ty (succ acc)
-  | Ptyp_poly (_, ty) -> get_uncurry_arity_aux ty acc
-  | _ -> acc
-
-(**
-   {[ unit -> 'b ]} return arity 1
-   {[ unit -> 'a1 -> a2']} arity 2
-   {[ 'a1 -> 'a2 -> ... 'aN -> 'b ]} return arity N
-*)
 let get_curry_arity (ty : t) =
   match ty.ptyp_desc with
-  | Ptyp_arrow {arity = Some arity} -> arity
-  | _ -> get_uncurry_arity_aux ty 0
+  | Ptyp_arrow {params} -> List.length params
+  | _ -> 0
 
 let is_arity_one ty = get_curry_arity ty = 1
 
 let list_of_arrow (ty : t) : t * Parsetree.arg list =
-  let rec aux (ty : t) acc =
-    match ty.ptyp_desc with
-    | Ptyp_arrow {arg; ret; arity} when arity = None || acc = [] ->
-      aux ret (arg :: acc)
-    | Ptyp_poly _ ->
-      (* unreachable: [list_of_arrow] only recurses into an arrow's return
-         (and is only ever called on an external's type annotation), so to get
-         here a [Ptyp_poly] would have to sit in an external's arg/return
-         position. The external type — and every arrow arg/return — is parsed
-         by [parse_typ_expr], which never routes to [parse_poly_type_expr]; an
-         inline `'a. …` there is a plain syntax error ("Did you forget a `=`").
-         [Ptyp_poly] is produced only for record/object field types and
-         signature `val` descriptions, and a field-nested poly is a non-arrow
-         leaf that [list_of_arrow] stops at, never the recursed return. *)
-      assert false
-    | _ -> (ty, List.rev acc)
-  in
-  aux ty []
+  match ty.ptyp_desc with
+  | Ptyp_arrow {params; ret} -> (ret, params)
+  | _ -> (ty, [])

compiler/frontend/ast_core_type_class_type.ml

@@ -67,14 +67,18 @@ let default_typ_mapper = Bs_ast_mapper.default_mapper.typ
 let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
   let loc = ty.ptyp_loc in
   match ty.ptyp_desc with
-  | Ptyp_arrow {arity}
+  | Ptyp_arrow {params = _}
   (* let it go without regard label names,
      it will report error later when the label is not empty
   *)
     -> (
     match fst (Ast_attributes.process_attributes_rev ty.ptyp_attributes) with
-    | Meth_callback _ ->
-      Ast_typ_uncurry.to_method_callback_type loc self ~arity ty
+    | Meth_callback _ -> (
+      match ty.ptyp_desc with
+      | Ptyp_arrow {params} ->
+        Ast_typ_uncurry.to_method_callback_type loc self
+          ~arity:(List.length params) ty
+      | _ -> assert false)
     | Nothing -> Bs_ast_mapper.default_mapper.typ self ty)
   | Ptyp_object (methods, closed_flag) ->
     let ( +> ) attr (typ : Parsetree.core_type) =
@@ -100,7 +104,7 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
                 | Meth_callback attr, attrs -> (attrs, attr +> ty)
               in
               Ast_compatible.object_field name attrs
-                (Ast_helper.Typ.arrows ~loc
+                (Ast_helper.Typ.arrow ~loc
                    [{attrs = []; lbl = Nolabel; typ = self.typ self core_type}]
                    (Ast_literal.type_unit ~loc ()))
             in