Begin adding an arrow construction to Ast_helper that takes a list of arguments.

The arity is inferred, by just the length of the list of arguments.

Author: cristianoc

compiler/frontend/ast_core_type.ml

@@ -93,11 +93,11 @@ let from_labels ~loc arity labels : t =
       (Ext_list.map2 labels tyvars (fun x y -> Parsetree.Otag (x, [], y)))
       Closed
   in
-  Ext_list.fold_right2 labels tyvars result_type
-    (fun label (* {loc ; txt = label }*) tyvar acc ->
-      Ast_helper.Typ.arrow ~loc:label.loc ~arity:(Some arity)
-        {lbl = Asttypes.Labelled label; typ = tyvar}
-        acc)
+  let args =
+    Ext_list.map2 labels tyvars (fun label tyvar ->
+        {Parsetree.lbl = Asttypes.Labelled label; typ = tyvar})
+  in
+  Typ.arrows ~loc args result_type
 
 let make_obj ~loc xs = Typ.object_ ~loc xs Closed
 

compiler/ml/ast_helper.ml

@@ -56,6 +56,15 @@ module Typ = struct
   let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a)
   let arrow ?loc ?attrs ~arity arg ret =
     mk ?loc ?attrs (Ptyp_arrow {arg; ret; arity})
+  let arrows ?loc ?attrs args ret =
+    let arity = Some (List.length args) in
+    let rec build_arrows arity_to_use = function
+      | [] -> ret
+      | [arg] -> arrow ?loc ?attrs ~arity:arity_to_use arg ret
+      | arg :: rest ->
+        arrow ?loc ?attrs ~arity:arity_to_use arg (build_arrows None rest)
+    in
+    build_arrows arity args
   let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)
   let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))
   let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))

compiler/ml/ast_helper.mli

@@ -56,6 +56,7 @@ module Typ : sig
   val var : ?loc:loc -> ?attrs:attrs -> string -> core_type
   val arrow :
     ?loc:loc -> ?attrs:attrs -> arity:arity -> arg -> core_type -> core_type
+  val arrows : ?loc:loc -> ?attrs:attrs -> arg list -> core_type -> core_type
   val tuple : ?loc:loc -> ?attrs:attrs -> core_type list -> core_type
   val constr : ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
   val object_ :