feat: uncurry 0

ppx/ast_attributes.ml

@@ -107,24 +107,29 @@ let process_method_attributes_rev attrs =
 type attr_kind =
   | Nothing
   | Meth_callback of attribute
-  | Uncurry of attribute
+  | Uncurry of { attribute : attribute; zero_arity : bool }
   | Method of attribute
 
 let process_attributes_rev attrs : attr_kind * attribute list =
   List.fold_left
-    ~f:(fun (st, acc) ({ attr_name = { txt; loc }; _ } as attr) ->
+    ~f:(fun (st, acc) ({ attr_name = { txt; loc }; _ } as attribute) ->
       match (txt, st) with
       | "u", (Nothing | Uncurry _) ->
-          (Uncurry attr, acc) (* TODO: warn unused/duplicated attribute *)
+          (Uncurry { attribute; zero_arity = false }, acc)
+          (* TODO: warn unused/duplicated attribute *)
+      | "u0", (Nothing | Uncurry { zero_arity = true; _ }) ->
+          (Uncurry { attribute; 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)
+          (Meth_callback attribute, acc)
       | ("mel.meth" | "meth"), (Nothing | Method _) ->
           warn_if_non_namespaced ~loc txt;
-          (Method attr, acc)
+          (Method attribute, acc)
       | ("u" | "mel.this" | "this"), _ ->
           Error.err ~loc Conflict_u_mel_this_mel_meth
-      | _, _ -> (st, attr :: acc))
+      | _, _ -> (st, attribute :: acc))
     ~init:(Nothing, []) attrs
 
 let process_pexp_fun_attributes_rev attrs =

ppx/ast_attributes.mli

@@ -35,7 +35,7 @@ val process_method_attributes_rev :
 type attr_kind =
   | Nothing
   | Meth_callback of attribute
-  | Uncurry of attribute
+  | Uncurry of { attribute : attribute; zero_arity : bool }
   | Method of attribute
 
 val warn_if_non_namespaced : loc:location -> label -> unit

ppx/ast_core_type_class_type.ml

@@ -107,7 +107,8 @@ 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 { attribute; _ }, attrs ->
+                          (attrs, attribute +> ty)
                       | Method _, _ ->
                           Location.raise_errorf ~loc
                             "`%@mel.get' / `%@mel.set' cannot be used with \
@@ -120,7 +121,8 @@ 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 { attribute; _ }, attrs ->
+                          (attrs, attribute +> ty)
                       | Method _, _ ->
                           Location.raise_errorf ~loc
                             "`%@mel.get' / `%@mel.set' cannot be used with \
@@ -138,7 +140,8 @@ 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 { attribute; _ }, attrs ->
+                          (attrs, attribute +> 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 : expression_desc =
+let to_uncurry_fn loc (self : Ast_traverse.map) ~zero_arity
+    (label : Asttypes.arg_label) pat body : expression_desc =
   Error.optional_err ~loc label;
   let rec aux acc (body : 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 Import
 val to_uncurry_fn :
   Location.t ->
   Ast_traverse.map ->
+  zero_arity:bool ->
   Asttypes.arg_label ->
   pattern ->
   expression ->

ppx/melange_ppx.ml

@@ -416,11 +416,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 _, _ ->