feat: uncurry 0

ppx/ast_attributes.ml

@@ -109,15 +109,20 @@ let process_method_attributes_rev (attrs : t) =
 type attr_kind =
   | Nothing
   | Meth_callback of attr
-  | Uncurry of attr
+  | Uncurry of { attr : attr; zero_arity : bool }
   | Method of attr
 
 let process_attributes_rev (attrs : t) : attr_kind * t =
   List.fold_left
     ~f:(fun (st, acc) ({ attr_name = { txt; loc }; _ } as attr) ->
       match (txt, st) with
       | "u", (Nothing | Uncurry _) ->
-          (Uncurry attr, acc) (* TODO: warn unused/duplicated attribute *)
+          (Uncurry { attr; zero_arity = false }, acc)
+          (* TODO: warn unused/duplicated attribute *)
+      | "u0", (Nothing | Uncurry { zero_arity = true; _ }) ->
+          (Uncurry { attr; zero_arity = true }, acc)
+      | "u0", Uncurry { zero_arity = false; _ } ->
+          Location.raise_errorf ~loc "Cannot use both `[@u0]' and `[@u]'"
       | ("mel.this" | "this"), (Nothing | Meth_callback _) ->
           warn_if_non_namespaced ~loc txt;
           (Meth_callback attr, acc)
@@ -129,7 +134,7 @@ let process_attributes_rev (attrs : t) : attr_kind * t =
       | _, _ -> (st, attr :: acc))
     ~init:(Nothing, []) attrs
 
-let process_pexp_fun_attributes_rev (attrs : t) =
+let process_pexp_function_attributes_rev (attrs : t) =
   List.fold_left
     ~f:(fun (st, acc) ({ attr_name = { txt; _ }; _ } as attr) ->
       match txt with "mel.open" -> (true, acc) | _ -> (st, attr :: acc))

ppx/ast_attributes.mli

@@ -34,12 +34,12 @@ val process_method_attributes_rev :
 type attr_kind =
   | Nothing
   | Meth_callback of attr
-  | Uncurry of attr
+  | Uncurry of { attr : attr; zero_arity : bool }
   | Method of attr
 
 val warn_if_non_namespaced : loc:location -> label -> unit
 val process_attributes_rev : t -> attr_kind * t
-val process_pexp_fun_attributes_rev : t -> bool * t
+val process_pexp_function_attributes_rev : t -> bool * t
 val process_uncurried : t -> bool * t
 val is_uncurried : attr -> bool
 val mel_get : attr

ppx/ast_core_type_class_type.ml

@@ -107,7 +107,7 @@ let typ_mapper ((self, super) : Ast_traverse.map * (core_type -> core_type))
                     let attrs, core_type =
                       match Ast_attributes.process_attributes_rev attrs with
                       | Nothing, attrs -> (attrs, ty) (* #1678 *)
-                      | Uncurry attr, attrs -> (attrs, attr +> ty)
+                      | Uncurry { attr; _ }, attrs -> (attrs, attr +> ty)
                       | Method _, _ ->
                           Location.raise_errorf ~loc
                             "`%@mel.get' / `%@mel.set' cannot be used with \
@@ -120,7 +120,7 @@ let typ_mapper ((self, super) : Ast_traverse.map * (core_type -> core_type))
                     let attrs, core_type =
                       match Ast_attributes.process_attributes_rev attrs with
                       | Nothing, attrs -> (attrs, ty)
-                      | Uncurry attr, attrs -> (attrs, attr +> ty)
+                      | Uncurry { attr; _ }, attrs -> (attrs, attr +> ty)
                       | Method _, _ ->
                           Location.raise_errorf ~loc
                             "`%@mel.get' / `%@mel.set' cannot be used with \
@@ -138,7 +138,7 @@ let typ_mapper ((self, super) : Ast_traverse.map * (core_type -> core_type))
                           meth_.pof_attributes
                       with
                       | Nothing, attrs -> (attrs, ty)
-                      | Uncurry attr, attrs -> (attrs, attr +> ty)
+                      | Uncurry { attr; _ }, attrs -> (attrs, attr +> ty)
                       | Method attr, attrs -> (attrs, attr +> ty)
                       | Meth_callback attr, attrs -> (attrs, attr +> ty)
                     in

ppx/ast_uncurry_gen.ml

@@ -66,8 +66,8 @@ let to_method_callback loc (self : Ast_traverse.map) label pat body :
                [ Typ.any ~loc () ]) );
       ] )
 
-let to_uncurry_fn loc (self : Ast_traverse.map) (label : Asttypes.arg_label) pat
-    body : Parsetree.expression_desc =
+let to_uncurry_fn loc (self : Ast_traverse.map) ~zero_arity
+    (label : Asttypes.arg_label) pat body : Parsetree.expression_desc =
   Error.optional_err ~loc label;
   let rec aux acc (body : Parsetree.expression) =
     match Ast_attributes.process_attributes_rev body.pexp_attributes with
@@ -89,11 +89,14 @@ let to_uncurry_fn loc (self : Ast_traverse.map) (label : Asttypes.arg_label) pat
   in
   let len = List.length rev_extra_args in
   let arity =
-    match rev_extra_args with
-    | [ (_, p) ] -> Ast_pat.is_unit_cont ~yes:0 ~no:len p
-    | _ -> len
+    let arity =
+      match (rev_extra_args, zero_arity) with
+      | [ (_, _) ], true -> 0
+      | [ _ ], false -> len (* Ast_pat.is_unit_cont ~yes:0 ~no:len p *)
+      | _ -> len
+    in
+    Error.err_large_arity ~loc arity;
+    string_of_int arity
   in
-  Error.err_large_arity ~loc arity;
-  let arity_s = string_of_int arity in
   Pexp_record
-    ([ ({ txt = Ldot (Ast_literal.js_fn, "I" ^ arity_s); loc }, body) ], None)
+    ([ ({ txt = Ldot (Ast_literal.js_fn, "I" ^ arity); loc }, body) ], None)

ppx/ast_uncurry_gen.mli

@@ -27,6 +27,7 @@ open Ppxlib
 val to_uncurry_fn :
   Location.t ->
   Ast_traverse.map ->
+  zero_arity:bool ->
   Asttypes.arg_label ->
   Parsetree.pattern ->
   Parsetree.expression ->

ppx/melange_ppx.ml

@@ -414,7 +414,8 @@ module Mapper = struct
                   | Invalid_argument -> 1
                 ]}*)
             match
-              Ast_attributes.process_pexp_fun_attributes_rev e.pexp_attributes
+              Ast_attributes.process_pexp_function_attributes_rev
+                e.pexp_attributes
             with
             | false, _ -> super#expression e
             | true, pexp_attributes ->
@@ -423,11 +424,12 @@ module Mapper = struct
         | Pexp_fun (label, _, pat, body) -> (
             match Ast_attributes.process_attributes_rev e.pexp_attributes with
             | Nothing, _ -> super#expression e
-            | Uncurry _, pexp_attributes ->
+            | Uncurry { zero_arity; _ }, pexp_attributes ->
                 {
                   e with
                   pexp_desc =
-                    Ast_uncurry_gen.to_uncurry_fn e.pexp_loc self label pat body;
+                    Ast_uncurry_gen.to_uncurry_fn e.pexp_loc self ~zero_arity
+                      label pat body;
                   pexp_attributes;
                 }
             | Method _, _ ->