More Typ.arrows

Author: cristianoc

compiler/frontend/ast_derive_abstract.ml

@@ -125,12 +125,12 @@ let handle_tdcl light (tdcl : Parsetree.type_declaration) :
           let accessor_type =
             if is_optional then
               let optional_type = Ast_core_type.lift_option_type pld_type in
-              Ast_helper.Typ.arrow ~loc ~arity:(Some 1)
-                {attrs = []; lbl = Nolabel; typ = core_type}
+              Ast_helper.Typ.arrows ~loc
+                [{attrs = []; lbl = Nolabel; typ = core_type}]
                 optional_type
             else
-              Ast_helper.Typ.arrow ~loc ~arity:(Some 1)
-                {attrs = []; lbl = Nolabel; typ = core_type}
+              Ast_helper.Typ.arrows ~loc
+                [{attrs = []; lbl = Nolabel; typ = core_type}]
                 pld_type
           in
           let accessor_prim =

compiler/frontend/ast_derive_js_mapper.ml

@@ -69,9 +69,7 @@ let erase_type_str =
   Str.primitive
     (Val.mk ~prim:["%identity"]
        {loc = noloc; txt = erase_type_lit}
-       (Ast_helper.Typ.arrow ~arity:(Some 1)
-          {attrs = []; lbl = Nolabel; typ = any}
-          any))
+       (Ast_helper.Typ.arrows [{attrs = []; lbl = Nolabel; typ = any}] any))
 
 let unsafe_index = "_index"
 
@@ -81,11 +79,12 @@ let unsafe_index_get =
     (Val.mk ~prim:[""]
        {loc = noloc; txt = unsafe_index}
        ~attrs:[Ast_attributes.get_index]
-       (Ast_helper.Typ.arrow ~arity:None
-          {attrs = []; lbl = Nolabel; typ = any}
-          (Ast_helper.Typ.arrow ~arity:None
-             {attrs = []; lbl = Nolabel; typ = any}
-             any)))
+       (Ast_helper.Typ.arrows
+          [
+            {attrs = []; lbl = Nolabel; typ = any};
+            {attrs = []; lbl = Nolabel; typ = any};
+          ]
+          any))
 
 let unsafe_index_get_exp = Exp.ident {loc = noloc; txt = Lident unsafe_index}
 
@@ -136,8 +135,7 @@ let app1 = Ast_compatible.app1
 
 let app2 = Ast_compatible.app2
 
-let ( ->~ ) a b =
-  Ast_helper.Typ.arrow ~arity:(Some 1) {attrs = []; lbl = Nolabel; typ = a} b
+let ( ->~ ) a b = Ast_helper.Typ.arrows [{attrs = []; lbl = Nolabel; typ = a}] b
 
 let raise_when_not_found_ident =
   Longident.Ldot (Lident Primitive_modules.util, "raiseWhenNotFound")
@@ -309,8 +307,8 @@ let init () =
               let pat_from_js = {Asttypes.loc; txt = from_js} in
               let to_js_type result =
                 Ast_comb.single_non_rec_val pat_to_js
-                  (Ast_helper.Typ.arrow ~arity:(Some 1)
-                     {attrs = []; lbl = Nolabel; typ = core_type}
+                  (Ast_helper.Typ.arrows
+                     [{attrs = []; lbl = Nolabel; typ = core_type}]
                      result)
               in
               let new_type, new_tdcl =

compiler/frontend/ast_derive_projector.ml

@@ -136,8 +136,8 @@ let init () =
               | Ptype_record label_declarations ->
                 Ext_list.map label_declarations (fun {pld_name; pld_type} ->
                     Ast_comb.single_non_rec_val ?attrs:gentype_attrs pld_name
-                      (Ast_helper.Typ.arrow ~arity:(Some 1)
-                         {attrs = []; lbl = Nolabel; typ = core_type}
+                      (Ast_helper.Typ.arrows
+                         [{attrs = []; lbl = Nolabel; typ = core_type}]
                          pld_type
                          (*arity will alwys be 1 since these are single param functions*)))
               | Ptype_variant constructor_declarations ->
@@ -156,23 +156,19 @@ let init () =
                       | Pcstr_record _ ->
                         raise_unsupported_vaiant_record_arg pcd_loc
                     in
-                    let arity = pcd_args |> List.length in
                     let annotate_type =
                       match pcd_res with
                       | Some x -> x
                       | None -> core_type
                     in
-                    let add_arity ~arity t =
-                      if arity > 0 then Ast_uncurried.uncurried_type ~arity t
-                      else t
-                    in
                     Ast_comb.single_non_rec_val ?attrs:gentype_attrs
                       {loc; txt = Ext_string.uncapitalize_ascii con_name}
-                      (Ext_list.fold_right pcd_args annotate_type (fun x acc ->
-                           Ast_helper.Typ.arrow ~arity:None
-                             {attrs = []; lbl = Nolabel; typ = x}
-                             acc)
-                      |> add_arity ~arity))
+                      (let args =
+                         Ext_list.map pcd_args (fun x ->
+                             ({attrs = []; lbl = Nolabel; typ = x}
+                               : Parsetree.arg))
+                       in
+                       Ast_helper.Typ.arrows ~loc args annotate_type))
               | Ptype_open | Ptype_abstract ->
                 Ast_derive_util.not_applicable tdcl.ptype_loc deriving_name;
                 []