diff --git a/analysis/reanalyze/src/DeadOptionalArgs.ml b/analysis/reanalyze/src/DeadOptionalArgs.ml
index 4b825a6f2b..7bfb3969dd 100644
--- a/analysis/reanalyze/src/DeadOptionalArgs.ml
+++ b/analysis/reanalyze/src/DeadOptionalArgs.ml
@@ -31,8 +31,8 @@ let addFunctionReference ~(locFrom : Location.t) ~(locTo : Location.t) =
 let rec hasOptionalArgs (texpr : Types.type_expr) =
   match texpr.desc with
   | _ when not (active ()) -> false
-  | Tarrow (Optional _, _tFrom, _tTo, _, _) -> true
-  | Tarrow (_, _tFrom, tTo, _, _) -> hasOptionalArgs tTo
+  | Tarrow ({lbl = Optional _}, _tTo, _, _) -> true
+  | Tarrow (_, tTo, _, _) -> hasOptionalArgs tTo
   | Tlink t -> hasOptionalArgs t
   | Tsubst t -> hasOptionalArgs t
   | _ -> false
@@ -40,8 +40,8 @@ let rec hasOptionalArgs (texpr : Types.type_expr) =
 let rec fromTypeExpr (texpr : Types.type_expr) =
   match texpr.desc with
   | _ when not (active ()) -> []
-  | Tarrow (Optional s, _tFrom, tTo, _, _) -> s :: fromTypeExpr tTo
-  | Tarrow (_, _tFrom, tTo, _, _) -> fromTypeExpr tTo
+  | Tarrow ({lbl = Optional s}, tTo, _, _) -> s :: fromTypeExpr tTo
+  | Tarrow (_, tTo, _, _) -> fromTypeExpr tTo
   | Tlink t -> fromTypeExpr t
   | Tsubst t -> fromTypeExpr t
   | _ -> []
diff --git a/analysis/src/CompletionBackEnd.ml b/analysis/src/CompletionBackEnd.ml
index b051f6be0c..6a3cbb1424 100644
--- a/analysis/src/CompletionBackEnd.ml
+++ b/analysis/src/CompletionBackEnd.ml
@@ -978,7 +978,10 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
         | [] -> tRet
         | (label, tArg) :: rest ->
           let restType = reconstructFunctionType rest tRet in
-          {typ with desc = Tarrow (label, tArg, restType, Cok, None)}
+          {
+            typ with
+            desc = Tarrow ({lbl = label; typ = tArg}, restType, Cok, None);
+          }
       in
       let rec processApply args labels =
         match (args, labels) with
diff --git a/analysis/src/CompletionJsx.ml b/analysis/src/CompletionJsx.ml
index 0c49ae0086..0dcadf7e5b 100644
--- a/analysis/src/CompletionJsx.ml
+++ b/analysis/src/CompletionJsx.ml
@@ -247,7 +247,8 @@ let getJsxLabels ~componentPath ~findTypeOfValue ~package =
         match propsType |> getPropsType with
         | Some (path, typeArgs) -> getFields ~path ~typeArgs
         | None -> [])
-      | Tarrow (Nolabel, {desc = Tconstr (path, typeArgs, _)}, _, _, _)
+      | Tarrow
+          ({lbl = Nolabel; typ = {desc = Tconstr (path, typeArgs, _)}}, _, _, _)
         when Path.last path = "props" ->
         getFields ~path ~typeArgs
       | Tconstr (clPath, [{desc = Tconstr (path, typeArgs, _)}; _], _)
@@ -255,7 +256,7 @@ let getJsxLabels ~componentPath ~findTypeOfValue ~package =
              && Path.last path = "props" ->
         (* JSX V4 external or interface *)
         getFields ~path ~typeArgs
-      | Tarrow (Nolabel, typ, _, _, _) -> (
+      | Tarrow ({lbl = Nolabel; typ}, _, _, _) -> (
         (* Component without the JSX PPX, like a make fn taking a hand-written
            type props. *)
         let rec digToConstr typ =
diff --git a/analysis/src/CreateInterface.ml b/analysis/src/CreateInterface.ml
index 5cfd2c2d88..1bbb3632fe 100644
--- a/analysis/src/CreateInterface.ml
+++ b/analysis/src/CreateInterface.ml
@@ -124,7 +124,10 @@ let printSignature ~extractor ~signature =
     in
     match typ.desc with
     | Tarrow
-        (_, {desc = Tconstr (Path.Pident propsId, typeArgs, _)}, retType, _, _)
+        ( {typ = {desc = Tconstr (Path.Pident propsId, typeArgs, _)}},
+          retType,
+          _,
+          _ )
       when Ident.name propsId = "props" ->
       Some (typeArgs, retType)
     | Tconstr
@@ -175,7 +178,7 @@ let printSignature ~extractor ~signature =
             in
             {
               retType with
-              desc = Tarrow (lbl, propType, mkFunType rest, Cok, None);
+              desc = Tarrow ({lbl; typ = propType}, mkFunType rest, Cok, None);
             }
         in
         let funType =
@@ -183,7 +186,10 @@ let printSignature ~extractor ~signature =
             let tUnit =
               Ctype.newconstr (Path.Pident (Ident.create "unit")) []
             in
-            {retType with desc = Tarrow (Nolabel, tUnit, retType, Cok, None)}
+            {
+              retType with
+              desc = Tarrow ({lbl = Nolabel; typ = tUnit}, retType, Cok, None);
+            }
           else mkFunType labelDecls
         in
         sigItemToString
diff --git a/analysis/src/Shared.ml b/analysis/src/Shared.ml
index ffd74f9888..b2d7edf76e 100644
--- a/analysis/src/Shared.ml
+++ b/analysis/src/Shared.ml
@@ -48,9 +48,9 @@ let findTypeConstructors (tel : Types.type_expr list) =
     | Tconstr (path, args, _) ->
       addPath path;
       args |> List.iter loop
-    | Tarrow (_, te1, te2, _, _) ->
-      loop te1;
-      loop te2
+    | Tarrow (arg, ret, _, _) ->
+      loop arg.typ;
+      loop ret
     | Ttuple tel -> tel |> List.iter loop
     | Tnil | Tvar _ | Tobject _ | Tfield _ | Tvariant _ | Tunivar _ | Tpackage _
       ->
diff --git a/analysis/src/SignatureHelp.ml b/analysis/src/SignatureHelp.ml
index da9dc6865a..8a4ede7a77 100644
--- a/analysis/src/SignatureHelp.ml
+++ b/analysis/src/SignatureHelp.ml
@@ -112,9 +112,7 @@ let extractParameters ~signature ~typeStrForParser ~labelPrefixLen =
       match expr with
       | {
        (* Gotcha: functions with multiple arugments are modelled as a series of single argument functions. *)
-       Parsetree.ptyp_desc =
-         Ptyp_arrow
-           {lbl = argumentLabel; arg = argumentTypeExpr; ret = nextFunctionExpr};
+       Parsetree.ptyp_desc = Ptyp_arrow {arg; ret = nextFunctionExpr};
        ptyp_loc;
       } ->
         let startOffset =
@@ -123,20 +121,20 @@ let extractParameters ~signature ~typeStrForParser ~labelPrefixLen =
           |> Option.get
         in
         let endOffset =
-          argumentTypeExpr.ptyp_loc |> Loc.end_
+          arg.typ.ptyp_loc |> Loc.end_
           |> Pos.positionToOffset typeStrForParser
           |> Option.get
         in
         (* The AST locations does not account for "=?" of optional arguments, so add that to the offset here if needed. *)
         let endOffset =
-          match argumentLabel with
+          match arg.lbl with
           | Asttypes.Optional _ -> endOffset + 2
           | _ -> endOffset
         in
         extractParams nextFunctionExpr
           (params
           @ [
-              ( argumentLabel,
+              ( arg.lbl,
                 (* Remove the label prefix offset here, since we're not showing
                    that to the end user. *)
                 startOffset - labelPrefixLen,
diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml
index 99ffca3f28..e6c7e8bc71 100644
--- a/analysis/src/TypeUtils.ml
+++ b/analysis/src/TypeUtils.ml
@@ -30,7 +30,7 @@ let debugLogTypeArgContext {env; typeArgs; typeParams} =
 let rec hasTvar (ty : Types.type_expr) : bool =
   match ty.desc with
   | Tvar _ -> true
-  | Tarrow (_, ty1, ty2, _, _) -> hasTvar ty1 || hasTvar ty2
+  | Tarrow (arg, ret, _, _) -> hasTvar arg.typ || hasTvar ret
   | Ttuple tyl -> List.exists hasTvar tyl
   | Tconstr (_, tyl, _) -> List.exists hasTvar tyl
   | Tobject (ty, _) -> hasTvar ty
@@ -135,8 +135,11 @@ let instantiateType ~typeParams ~typeArgs (t : Types.type_expr) =
       | Tsubst t -> loop t
       | Tvariant rd -> {t with desc = Tvariant (rowDesc rd)}
       | Tnil -> t
-      | Tarrow (lbl, t1, t2, c, arity) ->
-        {t with desc = Tarrow (lbl, loop t1, loop t2, c, arity)}
+      | Tarrow (arg, ret, c, arity) ->
+        {
+          t with
+          desc = Tarrow ({arg with typ = loop arg.typ}, loop ret, c, arity);
+        }
       | Ttuple tl -> {t with desc = Ttuple (tl |> List.map loop)}
       | Tobject (t, r) -> {t with desc = Tobject (loop t, r)}
       | Tfield (n, k, t1, t2) -> {t with desc = Tfield (n, k, loop t1, loop t2)}
@@ -188,8 +191,11 @@ let instantiateType2 ?(typeArgContext : typeArgContext option)
       | Tsubst t -> loop t
       | Tvariant rd -> {t with desc = Tvariant (rowDesc rd)}
       | Tnil -> t
-      | Tarrow (lbl, t1, t2, c, arity) ->
-        {t with desc = Tarrow (lbl, loop t1, loop t2, c, arity)}
+      | Tarrow (arg, ret, c, arity) ->
+        {
+          t with
+          desc = Tarrow ({arg with typ = loop arg.typ}, loop ret, c, arity);
+        }
       | Ttuple tl -> {t with desc = Ttuple (tl |> List.map loop)}
       | Tobject (t, r) -> {t with desc = Tobject (loop t, r)}
       | Tfield (n, k, t1, t2) -> {t with desc = Tfield (n, k, loop t1, loop t2)}
@@ -261,7 +267,7 @@ let extractFunctionType ~env ~package ?(digInto = true) typ =
   let rec loop ~env acc (t : Types.type_expr) =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ~env acc t1
-    | Tarrow (label, tArg, tRet, _, _) -> loop ~env ((label, tArg) :: acc) tRet
+    | Tarrow (arg, tRet, _, _) -> loop ~env ((arg.lbl, arg.typ) :: acc) tRet
     | Tconstr (path, typeArgs, _) when digInto -> (
       match References.digConstructor ~env ~package path with
       | Some
@@ -280,7 +286,7 @@ let extractFunctionTypeWithEnv ~env ~package typ =
   let rec loop ~env acc (t : Types.type_expr) =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ~env acc t1
-    | Tarrow (label, tArg, tRet, _, _) -> loop ~env ((label, tArg) :: acc) tRet
+    | Tarrow (arg, tRet, _, _) -> loop ~env ((arg.lbl, arg.typ) :: acc) tRet
     | Tconstr (path, typeArgs, _) -> (
       match References.digConstructor ~env ~package path with
       | Some
@@ -318,8 +324,8 @@ let extractFunctionType2 ?typeArgContext ~env ~package typ =
   let rec loop ?typeArgContext ~env acc (t : Types.type_expr) =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ?typeArgContext ~env acc t1
-    | Tarrow (label, tArg, tRet, _, _) ->
-      loop ?typeArgContext ~env ((label, tArg) :: acc) tRet
+    | Tarrow (arg, tRet, _, _) ->
+      loop ?typeArgContext ~env ((arg.lbl, arg.typ) :: acc) tRet
     | Tconstr (path, typeArgs, _) -> (
       match References.digConstructor ~env ~package path with
       | Some
@@ -895,12 +901,12 @@ let getArgs ~env (t : Types.type_expr) ~full =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
       getArgsLoop ~full ~env ~currentArgumentPosition t1
-    | Tarrow (Labelled l, tArg, tRet, _, _) ->
+    | Tarrow ({lbl = Labelled l; typ = tArg}, tRet, _, _) ->
       (SharedTypes.Completable.Labelled l, tArg)
       :: getArgsLoop ~full ~env ~currentArgumentPosition tRet
-    | Tarrow (Optional l, tArg, tRet, _, _) ->
+    | Tarrow ({lbl = Optional l; typ = tArg}, tRet, _, _) ->
       (Optional l, tArg) :: getArgsLoop ~full ~env ~currentArgumentPosition tRet
-    | Tarrow (Nolabel, tArg, tRet, _, _) ->
+    | Tarrow ({lbl = Nolabel; typ = tArg}, tRet, _, _) ->
       (Unlabelled {argumentPosition = currentArgumentPosition}, tArg)
       :: getArgsLoop ~full ~env
            ~currentArgumentPosition:(currentArgumentPosition + 1)
diff --git a/compiler/frontend/ast_compatible.ml b/compiler/frontend/ast_compatible.ml
index 0610abb015..c219729716 100644
--- a/compiler/frontend/ast_compatible.ml
+++ b/compiler/frontend/ast_compatible.ml
@@ -30,8 +30,8 @@ open Parsetree
 
 let default_loc = Location.none
 
-let arrow ?loc ?attrs ~arity a b =
-  Ast_helper.Typ.arrow ?loc ?attrs ~arity Nolabel a b
+let arrow ?loc ?attrs ~arity typ ret =
+  Ast_helper.Typ.arrow ?loc ?attrs ~arity {lbl = Nolabel; typ} ret
 
 let apply_simple ?(loc = default_loc) ?(attrs = []) (fn : expression)
     (args : expression list) : expression =
@@ -138,22 +138,30 @@ let apply_labels ?(loc = default_loc) ?(attrs = []) fn
         };
   }
 
-let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity txt arg ret :
+let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity txt typ ret :
     core_type =
   {
     ptyp_desc =
       Ptyp_arrow
-        {lbl = Asttypes.Labelled {txt; loc = default_loc}; arg; ret; arity};
+        {
+          arg = {lbl = Asttypes.Labelled {txt; loc = default_loc}; typ};
+          ret;
+          arity;
+        };
     ptyp_loc = loc;
     ptyp_attributes = attrs;
   }
 
-let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity txt arg ret : core_type
+let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity txt typ ret : core_type
     =
   {
     ptyp_desc =
       Ptyp_arrow
-        {lbl = Asttypes.Optional {txt; loc = default_loc}; arg; ret; arity};
+        {
+          arg = {lbl = Asttypes.Optional {txt; loc = default_loc}; typ};
+          ret;
+          arity;
+        };
     ptyp_loc = loc;
     ptyp_attributes = attrs;
   }
diff --git a/compiler/frontend/ast_core_type.ml b/compiler/frontend/ast_core_type.ml
index a16bf2327a..5637adfd0d 100644
--- a/compiler/frontend/ast_core_type.ml
+++ b/compiler/frontend/ast_core_type.ml
@@ -142,7 +142,8 @@ let mk_fn_type (new_arg_types_ty : param_type list) (result : t) : t =
     Ext_list.fold_right new_arg_types_ty result
       (fun {label; ty; attr; loc} acc ->
         {
-          ptyp_desc = Ptyp_arrow {lbl = label; arg = ty; ret = acc; arity = None};
+          ptyp_desc =
+            Ptyp_arrow {arg = {lbl = label; typ = ty}; ret = acc; arity = None};
           ptyp_loc = loc;
           ptyp_attributes = attr;
         })
@@ -156,9 +157,14 @@ let mk_fn_type (new_arg_types_ty : param_type list) (result : t) : t =
 let list_of_arrow (ty : t) : t * param_type list =
   let rec aux (ty : t) acc =
     match ty.ptyp_desc with
-    | Ptyp_arrow {lbl = label; arg; ret; arity} when arity = None || acc = [] ->
+    | Ptyp_arrow {arg; ret; arity} when arity = None || acc = [] ->
       aux ret
-        (({label; ty = arg; attr = ty.ptyp_attributes; loc = ty.ptyp_loc}
+        (({
+            label = arg.lbl;
+            ty = arg.typ;
+            attr = ty.ptyp_attributes;
+            loc = ty.ptyp_loc;
+          }
            : param_type)
         :: acc)
     | Ptyp_poly (_, ty) ->
diff --git a/compiler/frontend/ast_core_type_class_type.ml b/compiler/frontend/ast_core_type_class_type.ml
index da39a122a3..85cf4386c7 100644
--- a/compiler/frontend/ast_core_type_class_type.ml
+++ b/compiler/frontend/ast_core_type_class_type.ml
@@ -67,17 +67,17 @@ 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 {lbl = label; arg = args; ret = body}
+  | Ptyp_arrow {arg; ret = body}
   (* 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 label args body
+      Ast_typ_uncurry.to_method_callback_type loc self arg.lbl arg.typ body
     | Method _ ->
       (* Treat @meth as making the type uncurried, for backwards compatibility *)
-      Ast_typ_uncurry.to_uncurry_type loc self label args body
+      Ast_typ_uncurry.to_uncurry_type loc self arg.lbl arg.typ body
     | Nothing -> Bs_ast_mapper.default_mapper.typ self ty)
   | Ptyp_object (methods, closed_flag) ->
     let ( +> ) attr (typ : Parsetree.core_type) =
diff --git a/compiler/frontend/ast_exp_handle_external.ml b/compiler/frontend/ast_exp_handle_external.ml
index f4a2ca5395..1a98b05f33 100644
--- a/compiler/frontend/ast_exp_handle_external.ml
+++ b/compiler/frontend/ast_exp_handle_external.ml
@@ -44,7 +44,9 @@ let handle_external loc (x : string) : Parsetree.expression =
       pexp_desc =
         Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_expr"]
           ~pval_type:
-            (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ()))
+            (Typ.arrow ~arity:(Some 1)
+               {lbl = Nolabel; typ = Typ.any ()}
+               (Typ.any ()))
           [str_exp];
     }
   in
@@ -70,7 +72,8 @@ let handle_debugger loc (payload : Ast_payload.t) =
   | PStr [] ->
     Ast_external_mk.local_external_apply loc ~pval_prim:["%debugger"]
       ~pval_type:
-        (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ())
+        (Typ.arrow ~arity:(Some 1)
+           {lbl = Nolabel; typ = Typ.any ()}
            (Ast_literal.type_unit ()))
       [Ast_literal.val_unit ~loc ()]
   | _ ->
@@ -96,7 +99,9 @@ let handle_raw ~kind loc payload =
       pexp_desc =
         Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_expr"]
           ~pval_type:
-            (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ()))
+            (Typ.arrow ~arity:(Some 1)
+               {lbl = Nolabel; typ = Typ.any ()}
+               (Typ.any ()))
           [exp];
       pexp_attributes =
         (match !is_function with
@@ -123,11 +128,12 @@ let handle_ffi ~loc ~payload =
       let any = Ast_helper.Typ.any ~loc:e.pexp_loc () in
       let unit = Ast_literal.type_unit ~loc () in
       let rec arrow ~arity =
-        if arity = 0 then Ast_helper.Typ.arrow ~arity:None ~loc Nolabel unit any
+        if arity = 0 then
+          Ast_helper.Typ.arrow ~arity:None ~loc {lbl = Nolabel; typ = unit} any
         else if arity = 1 then
-          Ast_helper.Typ.arrow ~arity:None ~loc Nolabel any any
+          Ast_helper.Typ.arrow ~arity:None ~loc {lbl = Nolabel; typ = any} any
         else
-          Ast_helper.Typ.arrow ~loc ~arity:None Nolabel any
+          Ast_helper.Typ.arrow ~loc ~arity:None {lbl = Nolabel; typ = any}
             (arrow ~arity:(arity - 1))
       in
       match !is_function with
@@ -146,7 +152,9 @@ let handle_ffi ~loc ~payload =
         pexp_desc =
           Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_expr"]
             ~pval_type:
-              (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ()))
+              (Typ.arrow ~arity:(Some 1)
+                 {lbl = Nolabel; typ = Typ.any ()}
+                 (Typ.any ()))
             [exp];
         pexp_attributes =
           (match !is_function with
@@ -163,7 +171,9 @@ let handle_raw_structure loc payload =
         pexp_desc =
           Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_stmt"]
             ~pval_type:
-              (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ()))
+              (Typ.arrow ~arity:(Some 1)
+                 {lbl = Nolabel; typ = Typ.any ()}
+                 (Typ.any ()))
             [exp];
       }
   | None ->
diff --git a/compiler/frontend/ast_typ_uncurry.ml b/compiler/frontend/ast_typ_uncurry.ml
index 0b8656e33c..8576aefb57 100644
--- a/compiler/frontend/ast_typ_uncurry.ml
+++ b/compiler/frontend/ast_typ_uncurry.ml
@@ -33,7 +33,9 @@ let to_method_callback_type loc (mapper : Bs_ast_mapper.mapper)
     (typ : Parsetree.core_type) =
   let first_arg = mapper.typ mapper first_arg in
   let typ = mapper.typ mapper typ in
-  let meth_type = Typ.arrow ~loc ~arity:None label first_arg typ in
+  let meth_type =
+    Typ.arrow ~loc ~arity:None {lbl = label; typ = first_arg} typ
+  in
   let arity = Ast_core_type.get_uncurry_arity meth_type in
   match arity with
   | Some n ->
@@ -57,7 +59,7 @@ let to_uncurry_type loc (mapper : Bs_ast_mapper.mapper)
   let first_arg = mapper.typ mapper first_arg in
   let typ = mapper.typ mapper typ in
 
-  let fn_type = Typ.arrow ~loc ~arity:None label first_arg typ in
+  let fn_type = Typ.arrow ~loc ~arity:None {lbl = label; typ = first_arg} typ in
   let arity = Ast_core_type.get_uncurry_arity fn_type in
   let fn_type =
     match fn_type.ptyp_desc with
diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml
index 03eab561d1..2a495320c2 100644
--- a/compiler/frontend/bs_ast_mapper.ml
+++ b/compiler/frontend/bs_ast_mapper.ml
@@ -100,8 +100,10 @@ module T = struct
     match desc with
     | Ptyp_any -> any ~loc ~attrs ()
     | Ptyp_var s -> var ~loc ~attrs s
-    | Ptyp_arrow {lbl; arg; ret; arity} ->
-      arrow ~loc ~attrs ~arity lbl (sub.typ sub arg) (sub.typ sub ret)
+    | Ptyp_arrow {arg; ret; arity} ->
+      arrow ~loc ~attrs ~arity
+        {arg with typ = sub.typ sub arg.typ}
+        (sub.typ sub ret)
     | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
     | Ptyp_constr (lid, tl) ->
       constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
@@ -151,7 +153,7 @@ module T = struct
     | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l)
     | Ptype_open -> Ptype_open
 
-  let map_constructor_arguments sub = function
+  let map_constructor_arguments (sub : mapper) = function
     | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l)
     | Pcstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l)
 
diff --git a/compiler/gentype/TranslateCoreType.ml b/compiler/gentype/TranslateCoreType.ml
index fe6354aaf5..f110d02b51 100644
--- a/compiler/gentype/TranslateCoreType.ml
+++ b/compiler/gentype/TranslateCoreType.ml
@@ -52,7 +52,7 @@ let rec translate_arrow_type ~config ~type_vars_gen
     ~no_function_return_dependencies ~type_env ~rev_arg_deps ~rev_args
     (core_type : Typedtree.core_type) =
   match core_type.ctyp_desc with
-  | Ttyp_arrow (Nolabel, core_type1, core_type2, arity)
+  | Ttyp_arrow ({lbl = Nolabel; typ = core_type1}, core_type2, arity)
     when arity = None || rev_args = [] ->
     let {dependencies; type_} =
       core_type1 |> fun __x ->
@@ -64,7 +64,9 @@ let rec translate_arrow_type ~config ~type_vars_gen
          ~no_function_return_dependencies ~type_env ~rev_arg_deps:next_rev_deps
          ~rev_args:((Nolabel, type_) :: rev_args)
   | Ttyp_arrow
-      (((Labelled lbl | Optional lbl) as label), core_type1, core_type2, arity)
+      ( {lbl = (Labelled lbl | Optional lbl) as label; typ = core_type1},
+        core_type2,
+        arity )
     when arity = None || rev_args = [] -> (
     let as_label =
       match core_type.ctyp_attributes |> Annotation.get_gentype_as_renaming with
diff --git a/compiler/gentype/TranslateTypeExprFromTypes.ml b/compiler/gentype/TranslateTypeExprFromTypes.ml
index 46ed3fe509..b6cdb8faff 100644
--- a/compiler/gentype/TranslateTypeExprFromTypes.ml
+++ b/compiler/gentype/TranslateTypeExprFromTypes.ml
@@ -290,7 +290,7 @@ let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps
   | Tlink t ->
     translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps
       ~rev_args t
-  | Tarrow (Nolabel, type_expr1, type_expr2, _, arity)
+  | Tarrow ({lbl = Nolabel; typ = type_expr1}, type_expr2, _, arity)
     when arity = None || rev_args = [] ->
     let {dependencies; type_} =
       type_expr1 |> fun __x ->
@@ -302,8 +302,7 @@ let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps
          ~rev_arg_deps:next_rev_deps
          ~rev_args:((Nolabel, type_) :: rev_args)
   | Tarrow
-      ( ((Labelled lbl | Optional lbl) as label),
-        type_expr1,
+      ( {lbl = (Labelled lbl | Optional lbl) as label; typ = type_expr1},
         type_expr2,
         _,
         arity )
diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml
index c5d903b138..820e786c03 100644
--- a/compiler/ml/ast_helper.ml
+++ b/compiler/ml/ast_helper.ml
@@ -54,8 +54,8 @@ module Typ = struct
 
   let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any
   let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a)
-  let arrow ?loc ?attrs ~arity lbl arg ret =
-    mk ?loc ?attrs (Ptyp_arrow {lbl; arg; ret; arity})
+  let arrow ?loc ?attrs ~arity arg ret =
+    mk ?loc ?attrs (Ptyp_arrow {arg; ret; arity})
   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))
@@ -83,7 +83,8 @@ module Typ = struct
           check_variable var_names t.ptyp_loc x;
           Ptyp_var x
         | Ptyp_arrow ({arg; ret} as arr) ->
-          Ptyp_arrow {arr with arg = loop arg; ret = loop ret}
+          Ptyp_arrow
+            {arr with arg = {arr.arg with typ = loop arg.typ}; ret = loop ret}
         | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
         | Ptyp_constr ({txt = Longident.Lident s}, []) when List.mem s var_names
           ->
diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli
index 20c601f4ee..a6785db5dc 100644
--- a/compiler/ml/ast_helper.mli
+++ b/compiler/ml/ast_helper.mli
@@ -55,13 +55,7 @@ module Typ : sig
   val any : ?loc:loc -> ?attrs:attrs -> unit -> core_type
   val var : ?loc:loc -> ?attrs:attrs -> string -> core_type
   val arrow :
-    ?loc:loc ->
-    ?attrs:attrs ->
-    arity:arity ->
-    arg_label ->
-    core_type ->
-    core_type ->
-    core_type
+    ?loc:loc -> ?attrs:attrs -> arity:arity -> arg -> 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_ :
diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml
index 285e7d2db6..4380ca1af2 100644
--- a/compiler/ml/ast_iterator.ml
+++ b/compiler/ml/ast_iterator.ml
@@ -97,7 +97,7 @@ module T = struct
     match desc with
     | Ptyp_any | Ptyp_var _ -> ()
     | Ptyp_arrow {arg; ret} ->
-      sub.typ sub arg;
+      sub.typ sub arg.typ;
       sub.typ sub ret
     | Ptyp_tuple tyl -> List.iter (sub.typ sub) tyl
     | Ptyp_constr (lid, tl) ->
diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml
index b26ad1e732..81f364f19a 100644
--- a/compiler/ml/ast_mapper.ml
+++ b/compiler/ml/ast_mapper.ml
@@ -92,8 +92,10 @@ module T = struct
     match desc with
     | Ptyp_any -> any ~loc ~attrs ()
     | Ptyp_var s -> var ~loc ~attrs s
-    | Ptyp_arrow {lbl; arg; ret; arity} ->
-      arrow ~loc ~attrs ~arity lbl (sub.typ sub arg) (sub.typ sub ret)
+    | Ptyp_arrow {arg; ret; arity} ->
+      arrow ~loc ~attrs ~arity
+        {arg with typ = sub.typ sub arg.typ}
+        (sub.typ sub ret)
     | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
     | Ptyp_constr (lid, tl) ->
       constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml
index 6afd493daf..220c2ee80e 100644
--- a/compiler/ml/ast_mapper_from0.ml
+++ b/compiler/ml/ast_mapper_from0.ml
@@ -98,9 +98,9 @@ module T = struct
     match desc with
     | Ptyp_any -> any ~loc ~attrs ()
     | Ptyp_var s -> var ~loc ~attrs s
-    | Ptyp_arrow (lab, t1, t2) ->
-      let lab = Asttypes.to_arg_label lab in
-      arrow ~loc ~attrs ~arity:None lab (sub.typ sub t1) (sub.typ sub t2)
+    | Ptyp_arrow (lbl, t1, t2) ->
+      let lbl = Asttypes.to_arg_label lbl in
+      arrow ~loc ~attrs ~arity:None {lbl; typ = sub.typ sub t1} (sub.typ sub t2)
     | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
     | Ptyp_constr (lid, tl) -> (
       let typ0 =
diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml
index 4d50704e48..57101ff671 100644
--- a/compiler/ml/ast_mapper_to0.ml
+++ b/compiler/ml/ast_mapper_to0.ml
@@ -98,9 +98,11 @@ module T = struct
     match desc with
     | Ptyp_any -> any ~loc ~attrs ()
     | Ptyp_var s -> var ~loc ~attrs s
-    | Ptyp_arrow {lbl; arg; ret; arity} -> (
-      let lbl = Asttypes.to_noloc lbl in
-      let typ0 = arrow ~loc ~attrs lbl (sub.typ sub arg) (sub.typ sub ret) in
+    | Ptyp_arrow {arg; ret; arity} -> (
+      let lbl = Asttypes.to_noloc arg.lbl in
+      let typ0 =
+        arrow ~loc ~attrs lbl (sub.typ sub arg.typ) (sub.typ sub ret)
+      in
       match arity with
       | None -> typ0
       | Some arity ->
diff --git a/compiler/ml/btype.ml b/compiler/ml/btype.ml
index 8b6046c095..08ce7014d0 100644
--- a/compiler/ml/btype.ml
+++ b/compiler/ml/btype.ml
@@ -260,7 +260,7 @@ let rec iter_row f row =
 let iter_type_expr f ty =
   match ty.desc with
   | Tvar _ -> ()
-  | Tarrow (_, ty1, ty2, _, _) ->
+  | Tarrow ({typ = ty1}, ty2, _, _) ->
     f ty1;
     f ty2
   | Ttuple l -> List.iter f l
@@ -428,8 +428,8 @@ let rec norm_univar ty =
 
 let rec copy_type_desc ?(keep_names = false) f = function
   | Tvar _ as ty -> if keep_names then ty else Tvar None
-  | Tarrow (p, ty1, ty2, c, arity) ->
-    Tarrow (p, f ty1, f ty2, copy_commu c, arity)
+  | Tarrow (arg, ret, c, arity) ->
+    Tarrow ({arg with typ = f arg.typ}, f ret, copy_commu c, arity)
   | Ttuple l -> Ttuple (List.map f l)
   | Tconstr (p, l, _) -> Tconstr (p, List.map f l, ref Mnil)
   | Tobject (ty, {contents = Some (p, tl)}) ->
diff --git a/compiler/ml/ctype.ml b/compiler/ml/ctype.ml
index 057b3dfbda..261f0ab905 100644
--- a/compiler/ml/ctype.ml
+++ b/compiler/ml/ctype.ml
@@ -732,9 +732,9 @@ let rec generalize_expansive env var_level visited ty =
           else generalize_expansive env var_level visited t)
         variance tyl
     | Tpackage (_, _, tyl) -> List.iter (generalize_structure var_level) tyl
-    | Tarrow (_, t1, t2, _, _) ->
-      generalize_structure var_level t1;
-      generalize_expansive env var_level visited t2
+    | Tarrow (arg, ret, _, _) ->
+      generalize_structure var_level arg.typ;
+      generalize_expansive env var_level visited ret
     | _ -> iter_type_expr (generalize_expansive env var_level visited) ty)
 
 let generalize_expansive env ty =
@@ -1926,11 +1926,11 @@ let rec mcomp type_pairs env t1 t2 =
             TypePairs.add type_pairs (t1', t2') ();
             match (t1'.desc, t2'.desc) with
             | Tvar _, Tvar _ -> assert false
-            | Tarrow (l1, t1, u1, _, _), Tarrow (l2, t2, u2, _, _)
-              when Asttypes.Noloc.same_arg_label l1 l2
-                   || not (is_optional l1 || is_optional l2) ->
-              mcomp type_pairs env t1 t2;
-              mcomp type_pairs env u1 u2
+            | Tarrow (arg1, ret1, _, _), Tarrow (arg2, ret2, _, _)
+              when Asttypes.Noloc.same_arg_label arg1.lbl arg2.lbl
+                   || not (is_optional arg1.lbl || is_optional arg2.lbl) ->
+              mcomp type_pairs env arg1.typ arg2.typ;
+              mcomp type_pairs env ret1 ret2
             | Ttuple tl1, Ttuple tl2 -> mcomp_list type_pairs env tl1 tl2
             | Tconstr (p1, tl1, _), Tconstr (p2, tl2, _) ->
               mcomp_type_decl type_pairs env p1 p2 tl1 tl2
@@ -2342,13 +2342,13 @@ and unify3 env t1 t1' t2 t2' =
     | Pattern -> add_type_equality t1' t2');
     try
       (match (d1, d2) with
-      | Tarrow (l1, t1, u1, c1, a1), Tarrow (l2, t2, u2, c2, a2)
+      | Tarrow (arg1, ret1, c1, a1), Tarrow (arg2, ret2, c2, a2)
         when a1 = a2
-             && (Asttypes.Noloc.same_arg_label l1 l2
-                || (!umode = Pattern && not (is_optional l1 || is_optional l2))
-                ) -> (
-        unify env t1 t2;
-        unify env u1 u2;
+             && (Asttypes.Noloc.same_arg_label arg1.lbl arg2.lbl
+                || !umode = Pattern
+                   && not (is_optional arg1.lbl || is_optional arg2.lbl)) -> (
+        unify env arg1.typ arg2.typ;
+        unify env ret1 ret2;
         match (commu_repr c1, commu_repr c2) with
         | Clink r, c2 -> set_commu r c2
         | c1, Clink r -> set_commu r c1
@@ -2796,10 +2796,11 @@ let filter_arrow ~env ~arity t l =
   | Tvar _ ->
     let lv = t.level in
     let t1 = newvar2 lv and t2 = newvar2 lv in
-    let t' = newty2 lv (Tarrow (l, t1, t2, Cok, arity)) in
+    let t' = newty2 lv (Tarrow ({lbl = l; typ = t1}, t2, Cok, arity)) in
     link_type t t';
     (t1, t2)
-  | Tarrow (l', t1, t2, _, _) when Asttypes.Noloc.same_arg_label l l' -> (t1, t2)
+  | Tarrow (arg, ret, _, _) when Asttypes.Noloc.same_arg_label l arg.lbl ->
+    (arg.typ, ret)
   | _ -> raise (Unify [])
 
 (* Used by [filter_method]. *)
@@ -2913,10 +2914,10 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
               | Tvar _, _ when may_instantiate inst_nongen t1' ->
                 moregen_occur env t1'.level t2;
                 link_type t1' t2
-              | Tarrow (l1, t1, u1, _, _), Tarrow (l2, t2, u2, _, _)
-                when Asttypes.Noloc.same_arg_label l1 l2 ->
-                moregen inst_nongen type_pairs env t1 t2;
-                moregen inst_nongen type_pairs env u1 u2
+              | Tarrow (arg1, ret1, _, _), Tarrow (arg2, ret2, _, _)
+                when Asttypes.Noloc.same_arg_label arg1.lbl arg2.lbl ->
+                moregen inst_nongen type_pairs env arg1.typ arg2.typ;
+                moregen inst_nongen type_pairs env ret1 ret2
               | Ttuple tl1, Ttuple tl2 ->
                 moregen_list inst_nongen type_pairs env tl1 tl2
               | Tconstr (p1, tl1, _), Tconstr (p2, tl2, _) when Path.same p1 p2
@@ -3183,10 +3184,10 @@ let rec eqtype rename type_pairs subst env t1 t2 =
                   if List.exists (fun (_, t) -> t == t2') !subst then
                     raise (Unify []);
                   subst := (t1', t2') :: !subst)
-              | Tarrow (l1, t1, u1, _, _), Tarrow (l2, t2, u2, _, _)
-                when Asttypes.Noloc.same_arg_label l1 l2 ->
-                eqtype rename type_pairs subst env t1 t2;
-                eqtype rename type_pairs subst env u1 u2
+              | Tarrow (arg1, ret1, _, _), Tarrow (arg2, ret2, _, _)
+                when Asttypes.Noloc.same_arg_label arg1.lbl arg2.lbl ->
+                eqtype rename type_pairs subst env arg1.typ arg2.typ;
+                eqtype rename type_pairs subst env ret1 ret2
               | Ttuple tl1, Ttuple tl2 ->
                 eqtype_list rename type_pairs subst env tl1 tl2
               | Tconstr (p1, tl1, _), Tconstr (p2, tl2, _) when Path.same p1 p2
@@ -3396,14 +3397,14 @@ let rec build_subtype env visited loops posi level t =
         (t', Equiv)
       with Not_found -> (t, Unchanged)
     else (t, Unchanged)
-  | Tarrow (l, t1, t2, _, a) ->
+  | Tarrow (arg, ret, _, a) ->
     if memq_warn t visited then (t, Unchanged)
     else
       let visited = t :: visited in
-      let t1', c1 = build_subtype env visited loops (not posi) level t1 in
-      let t2', c2 = build_subtype env visited loops posi level t2 in
+      let t1, c1 = build_subtype env visited loops (not posi) level arg.typ in
+      let t2, c2 = build_subtype env visited loops posi level ret in
       let c = max c1 c2 in
-      if c > Unchanged then (newty (Tarrow (l, t1', t2', Cok, a)), c)
+      if c > Unchanged then (newty (Tarrow ({arg with typ = t1}, t2, Cok, a)), c)
       else (t, Unchanged)
   | Ttuple tlist ->
     if memq_warn t visited then (t, Unchanged)
@@ -3596,10 +3597,14 @@ let rec subtype_rec env trace t1 t2 cstrs =
       TypePairs.add subtypes (t1, t2) ();
       match (t1.desc, t2.desc) with
       | Tvar _, _ | _, Tvar _ -> (trace, t1, t2, !univar_pairs, None) :: cstrs
-      | Tarrow (l1, t1, u1, _, _), Tarrow (l2, t2, u2, _, _)
-        when Asttypes.Noloc.same_arg_label l1 l2 ->
-        let cstrs = subtype_rec env ((t2, t1) :: trace) t2 t1 cstrs in
-        subtype_rec env ((u1, u2) :: trace) u1 u2 cstrs
+      | Tarrow (arg1, ret1, _, _), Tarrow (arg2, ret2, _, _)
+        when Asttypes.Noloc.same_arg_label arg1.lbl arg2.lbl ->
+        let cstrs =
+          subtype_rec env
+            ((arg2.typ, arg1.typ) :: trace)
+            arg2.typ arg1.typ cstrs
+        in
+        subtype_rec env ((ret1, ret2) :: trace) ret1 ret2 cstrs
       | Ttuple tl1, Ttuple tl2 ->
         (* TODO(subtype-errors) Tuple as context *)
         subtype_list env trace tl1 tl2 cstrs
@@ -4074,7 +4079,7 @@ let unalias ty =
 (* Return the arity (as for curried functions) of the given type. *)
 let rec arity ty =
   match (repr ty).desc with
-  | Tarrow (_, _t1, t2, _, _) -> 1 + arity t2
+  | Tarrow (_, ret, _, _) -> 1 + arity ret
   | _ -> 0
 
 (* Check whether an abbreviation expands to itself. *)
@@ -4440,5 +4445,5 @@ let maybe_pointer_type env typ =
 
 let get_arity env typ =
   match (expand_head env typ).desc with
-  | Tarrow (_, _, _, _, arity) -> arity
+  | Tarrow (_, _, _, arity) -> arity
   | _ -> None
diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml
index f72c7f9937..63be3846ba 100644
--- a/compiler/ml/depend.ml
+++ b/compiler/ml/depend.ml
@@ -106,7 +106,7 @@ let rec add_type bv ty =
   | Ptyp_any -> ()
   | Ptyp_var _ -> ()
   | Ptyp_arrow {arg; ret} ->
-    add_type bv arg;
+    add_type bv arg.typ;
     add_type bv ret
   | Ptyp_tuple tl -> List.iter (add_type bv) tl
   | Ptyp_constr (c, tl) ->
diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml
index 63b063214b..2f39035aed 100644
--- a/compiler/ml/parsetree.ml
+++ b/compiler/ml/parsetree.ml
@@ -73,10 +73,12 @@ and core_type = {
   ptyp_attributes: attributes; (* ... [@id1] [@id2] *)
 }
 
+and arg = {lbl: arg_label; typ: core_type}
+
 and core_type_desc =
   | Ptyp_any (*  _ *)
   | Ptyp_var of string (* 'a *)
-  | Ptyp_arrow of {lbl: arg_label; arg: core_type; ret: core_type; arity: arity}
+  | Ptyp_arrow of {arg: arg; ret: core_type; arity: arity}
     (* T1 -> T2       Simple
        ~l:T1 -> T2    Labelled
        ?l:T1 -> T2    Optional
diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml
index deeca5d3de..78b4a691b8 100644
--- a/compiler/ml/pprintast.ml
+++ b/compiler/ml/pprintast.ml
@@ -298,9 +298,9 @@ and core_type ctxt f x =
       (attributes ctxt) x.ptyp_attributes
   else
     match x.ptyp_desc with
-    | Ptyp_arrow {lbl = l; arg; ret; arity} ->
+    | Ptyp_arrow {arg; ret; arity} ->
       pp f "@[<2>%a@;->@;%a%s@]" (* FIXME remove parens later *)
-        (type_with_label ctxt) (l, arg) (core_type ctxt) ret
+        (type_with_label ctxt) (arg.lbl, arg.typ) (core_type ctxt) ret
         (match arity with
         | None -> ""
         | Some n -> " (a:" ^ string_of_int n ^ ")")
diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml
index d5c413139c..4d2ea003d0 100644
--- a/compiler/ml/printast.ml
+++ b/compiler/ml/printast.ml
@@ -123,15 +123,15 @@ let rec core_type i ppf x =
   match x.ptyp_desc with
   | Ptyp_any -> line i ppf "Ptyp_any\n"
   | Ptyp_var s -> line i ppf "Ptyp_var %s\n" s
-  | Ptyp_arrow {lbl; arg; ret; arity} ->
+  | Ptyp_arrow {arg; ret; arity} ->
     line i ppf "Ptyp_arrow\n";
     let () =
       match arity with
       | None -> ()
       | Some n -> line i ppf "arity = %d\n" n
     in
-    arg_label_loc i ppf lbl;
-    core_type i ppf arg;
+    arg_label_loc i ppf arg.lbl;
+    core_type i ppf arg.typ;
     core_type i ppf ret
   | Ptyp_tuple l ->
     line i ppf "Ptyp_tuple\n";
diff --git a/compiler/ml/printtyp.ml b/compiler/ml/printtyp.ml
index 8d04c0fccd..c4285a1fea 100644
--- a/compiler/ml/printtyp.ml
+++ b/compiler/ml/printtyp.ml
@@ -173,10 +173,10 @@ and raw_type_list tl = raw_list raw_type tl
 
 and raw_type_desc ppf = function
   | Tvar name -> fprintf ppf "Tvar %a" print_name name
-  | Tarrow (l, t1, t2, c, a) ->
+  | Tarrow (arg, ret, c, a) ->
     fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s,@,%s)@]"
-      (string_of_label l) raw_type t1 raw_type t2 (safe_commu_repr [] c)
-      (string_of_arity a)
+      (string_of_label arg.lbl) raw_type arg.typ raw_type ret
+      (safe_commu_repr [] c) (string_of_arity a)
   | Ttuple tl -> fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
   | Tconstr (p, tl, abbrev) ->
     fprintf ppf "@[<hov1>Tconstr(@,%a,@,%a,@,%a)@]" path p raw_type_list tl
@@ -516,9 +516,9 @@ let rec mark_loops_rec visited ty =
     let visited = px :: visited in
     match ty.desc with
     | Tvar _ -> add_named_var ty
-    | Tarrow (_, ty1, ty2, _, _) ->
-      mark_loops_rec visited ty1;
-      mark_loops_rec visited ty2
+    | Tarrow (arg, ret, _, _) ->
+      mark_loops_rec visited arg.typ;
+      mark_loops_rec visited ret
     | Ttuple tyl -> List.iter (mark_loops_rec visited) tyl
     | Tconstr (p, tyl, _) ->
       let _p', s = best_type_path p in
@@ -621,22 +621,18 @@ let rec tree_of_typexp ?(printing_context : printing_context option) sch ty =
         let non_gen = is_non_gen sch ty in
         let name_gen = if non_gen then new_weak_name ty else new_name in
         Otyp_var (non_gen, name_of_type name_gen ty)
-      | Tarrow (l, ty1, ty2, _, arity) ->
-        let pr_arrow l ty1 ty2 =
-          let lab = string_of_label l in
-          let t1 =
-            if is_optional l then
-              match (repr ty1).desc with
-              | Tconstr (path, [ty], _) when Path.same path Predef.path_option
-                ->
-                tree_of_typexp ?printing_context sch ty
-              | _ -> Otyp_stuff "<hidden>"
-            else tree_of_typexp ?printing_context sch ty1
-          in
-          (* should pass arity here? *)
-          Otyp_arrow (lab, t1, tree_of_typexp ?printing_context sch ty2, arity)
+      | Tarrow (arg, ret, _, arity) ->
+        let lab = string_of_label arg.lbl in
+        let t1 =
+          if is_optional arg.lbl then
+            match (repr arg.typ).desc with
+            | Tconstr (path, [ty], _) when Path.same path Predef.path_option ->
+              tree_of_typexp ?printing_context sch ty
+            | _ -> Otyp_stuff "<hidden>"
+          else tree_of_typexp ?printing_context sch arg.typ
         in
-        pr_arrow l ty1 ty2
+        (* should pass arity here? *)
+        Otyp_arrow (lab, t1, tree_of_typexp ?printing_context sch ret, arity)
       | Ttuple tyl -> Otyp_tuple (tree_of_typlist ?printing_context sch tyl)
       | Tconstr (p, _tyl, _abbrev)
         when printing_context
diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml
index a17ee3b80f..efcd560dcc 100644
--- a/compiler/ml/printtyped.ml
+++ b/compiler/ml/printtyped.ml
@@ -149,11 +149,11 @@ let rec core_type i ppf x =
   match x.ctyp_desc with
   | Ttyp_any -> line i ppf "Ttyp_any\n"
   | Ttyp_var s -> line i ppf "Ttyp_var %s\n" s
-  | Ttyp_arrow (l, ct1, ct2, _) ->
+  | Ttyp_arrow (arg, ret, _) ->
     line i ppf "Ttyp_arrow\n";
-    arg_label i ppf l;
-    core_type i ppf ct1;
-    core_type i ppf ct2
+    arg_label i ppf arg.lbl;
+    core_type i ppf arg.typ;
+    core_type i ppf ret
   | Ttyp_tuple l ->
     line i ppf "Ttyp_tuple\n";
     list i core_type ppf l
diff --git a/compiler/ml/record_type_spread.ml b/compiler/ml/record_type_spread.ml
index 82adebefeb..80dcbe9d5d 100644
--- a/compiler/ml/record_type_spread.ml
+++ b/compiler/ml/record_type_spread.ml
@@ -22,8 +22,11 @@ let substitute_types ~type_map (t : Types.type_expr) =
       | Tsubst t -> {t with desc = Tsubst (loop t)}
       | Tvariant rd -> {t with desc = Tvariant (row_desc rd)}
       | Tnil -> t
-      | Tarrow (lbl, t1, t2, c, arity) ->
-        {t with desc = Tarrow (lbl, loop t1, loop t2, c, arity)}
+      | Tarrow (arg, ret, c, arity) ->
+        {
+          t with
+          desc = Tarrow ({arg with typ = loop arg.typ}, loop ret, c, arity);
+        }
       | Ttuple tl -> {t with desc = Ttuple (tl |> List.map loop)}
       | Tobject (t, r) -> {t with desc = Tobject (loop t, r)}
       | Tfield (n, k, t1, t2) -> {t with desc = Tfield (n, k, loop t1, loop t2)}
diff --git a/compiler/ml/tast_iterator.ml b/compiler/ml/tast_iterator.ml
index 356df81a95..5c12d3da4d 100644
--- a/compiler/ml/tast_iterator.ml
+++ b/compiler/ml/tast_iterator.ml
@@ -284,9 +284,9 @@ let typ sub {ctyp_desc; ctyp_env; _} =
   match ctyp_desc with
   | Ttyp_any -> ()
   | Ttyp_var _ -> ()
-  | Ttyp_arrow (_, ct1, ct2, _) ->
-    sub.typ sub ct1;
-    sub.typ sub ct2
+  | Ttyp_arrow (arg, ret, _) ->
+    sub.typ sub arg.typ;
+    sub.typ sub ret
   | Ttyp_tuple list -> List.iter (sub.typ sub) list
   | Ttyp_constr (_, _, list) -> List.iter (sub.typ sub) list
   | Ttyp_object (list, _) -> List.iter (sub.object_field sub) list
diff --git a/compiler/ml/tast_mapper.ml b/compiler/ml/tast_mapper.ml
index 09c5dc8b8c..54eba02869 100644
--- a/compiler/ml/tast_mapper.ml
+++ b/compiler/ml/tast_mapper.ml
@@ -359,8 +359,8 @@ let typ sub x =
   let ctyp_desc =
     match x.ctyp_desc with
     | (Ttyp_any | Ttyp_var _) as d -> d
-    | Ttyp_arrow (label, ct1, ct2, arity) ->
-      Ttyp_arrow (label, sub.typ sub ct1, sub.typ sub ct2, arity)
+    | Ttyp_arrow (arg, ret, arity) ->
+      Ttyp_arrow ({arg with typ = sub.typ sub arg.typ}, sub.typ sub ret, arity)
     | Ttyp_tuple list -> Ttyp_tuple (List.map (sub.typ sub) list)
     | Ttyp_constr (path, lid, list) ->
       Ttyp_constr (path, lid, List.map (sub.typ sub) list)
diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml
index 78b5a1f5fa..078cbf133a 100644
--- a/compiler/ml/translcore.ml
+++ b/compiler/ml/translcore.ml
@@ -691,8 +691,8 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
       let prim =
         let expanded = Ctype.expand_head e.exp_env e.exp_type in
         match (Btype.repr expanded).desc with
-        | Tarrow (Nolabel, t, _, _, _) -> (
-          match (Ctype.expand_head e.exp_env t).desc with
+        | Tarrow ({lbl = Nolabel; typ}, _, _, _) -> (
+          match (Ctype.expand_head e.exp_env typ).desc with
           | Tconstr (Pident {name = "unit"}, [], _) -> Pjs_fn_make_unit
           | _ -> Pjs_fn_make arity)
         | _ -> Pjs_fn_make arity
diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml
index a1abc0dc4d..b57005e380 100644
--- a/compiler/ml/typecore.ml
+++ b/compiler/ml/typecore.ml
@@ -722,12 +722,11 @@ let show_extra_help ppf _env trace =
 let rec collect_missing_arguments env type1 type2 =
   match type1 with
   (* why do we use Ctype.matches here? Please see https://github.com/rescript-lang/rescript-compiler/pull/2554 *)
-  | {Types.desc = Tarrow (label, argtype, typ, _, _)}
-    when Ctype.matches env typ type2 ->
-    Some [(label, argtype)]
-  | {desc = Tarrow (label, argtype, typ, _, _)} -> (
-    match collect_missing_arguments env typ type2 with
-    | Some res -> Some ((label, argtype) :: res)
+  | {Types.desc = Tarrow (arg, ret, _, _)} when Ctype.matches env ret type2 ->
+    Some [(arg.lbl, arg.typ)]
+  | {desc = Tarrow (arg, ret, _, _)} -> (
+    match collect_missing_arguments env ret type2 with
+    | Some res -> Some ((arg.lbl, arg.typ) :: res)
     | None -> None)
   | _ -> None
 
@@ -1871,10 +1870,10 @@ and is_nonexpansive_opt = function
 
 let rec approx_type env sty =
   match sty.ptyp_desc with
-  | Ptyp_arrow {lbl = p; ret = sty; arity} ->
+  | Ptyp_arrow {arg = {lbl = p}; ret = sty; arity} ->
     let p = Asttypes.to_noloc p in
     let ty1 = if is_optional p then type_option (newvar ()) else newvar () in
-    newty (Tarrow (p, ty1, approx_type env sty, Cok, arity))
+    newty (Tarrow ({lbl = p; typ = ty1}, approx_type env sty, Cok, arity))
   | Ptyp_tuple args -> newty (Ttuple (List.map (approx_type env) args))
   | Ptyp_constr (lid, ctl) -> (
     try
@@ -1893,7 +1892,7 @@ let rec type_approx env sexp =
   | Pexp_fun {arg_label = p; rhs = e; arity} ->
     let p = Asttypes.to_noloc p in
     let ty = if is_optional p then type_option (newvar ()) else newvar () in
-    newty (Tarrow (p, ty, type_approx env e, Cok, arity))
+    newty (Tarrow ({lbl = p; typ = ty}, type_approx env e, Cok, arity))
   | Pexp_match (_, {pc_rhs = e} :: _) -> type_approx env e
   | Pexp_try (e, _) -> type_approx env e
   | Pexp_tuple l -> newty (Ttuple (List.map (type_approx env) l))
@@ -1928,8 +1927,8 @@ let rec list_labels_aux env visited ls ty_fun =
   if List.memq ty visited then (List.rev ls, false)
   else
     match ty.desc with
-    | Tarrow (l, _, ty_res, _, arity) when arity = None || visited = [] ->
-      list_labels_aux env (ty :: visited) (l :: ls) ty_res
+    | Tarrow (arg, ty_res, _, arity) when arity = None || visited = [] ->
+      list_labels_aux env (ty :: visited) (arg.lbl :: ls) ty_res
     | _ -> (List.rev ls, is_Tvar ty)
 
 let list_labels env ty =
@@ -2208,8 +2207,8 @@ let rec lower_args env seen ty_fun =
   if List.memq ty seen then ()
   else
     match ty.desc with
-    | Tarrow (_l, ty_arg, ty_fun, _com, _) ->
-      (try unify_var env (newvar ()) ty_arg with Unify _ -> assert false);
+    | Tarrow (arg, ty_fun, _com, _) ->
+      (try unify_var env (newvar ()) arg.typ with Unify _ -> assert false);
       lower_args env (ty :: seen) ty_fun
     | _ -> ()
 
@@ -3208,7 +3207,9 @@ and type_function ?in_function ~arity ~async loc attrs env ty_expected_ l
     match arity with
     | None -> ty_expected_
     | Some arity ->
-      let fun_t = newty (Tarrow (l, newvar (), newvar (), Cok, Some arity)) in
+      let fun_t =
+        newty (Tarrow ({lbl = l; typ = newvar ()}, newvar (), Cok, Some arity))
+      in
       unify_exp_types ~context:None loc env fun_t ty_expected_;
       fun_t
   in
@@ -3250,7 +3251,8 @@ and type_function ?in_function ~arity ~async loc attrs env ty_expected_ l
       Warnings.Unerasable_optional_argument;
   let param = name_pattern "param" cases in
   let exp_type =
-    instance env (newgenty (Tarrow (l, ty_arg, ty_res, Cok, arity)))
+    instance env
+      (newgenty (Tarrow ({lbl = l; typ = ty_arg}, ty_res, Cok, arity)))
   in
   Warnings.restore state;
   re
@@ -3466,7 +3468,8 @@ and type_application ~context total_app env funct (sargs : sargs) :
     targs * Types.type_expr * bool =
   let result_type omitted ty_fun =
     List.fold_left
-      (fun ty_fun (l, ty, lv) -> newty2 lv (Tarrow (l, ty, ty_fun, Cok, None)))
+      (fun ty_fun (l, ty, lv) ->
+        newty2 lv (Tarrow ({lbl = l; typ = ty}, ty_fun, Cok, None)))
       ty_fun omitted
   in
   let has_label l ty_fun =
@@ -3484,7 +3487,7 @@ and type_application ~context total_app env funct (sargs : sargs) :
     if force_tvar then Some (List.length sargs)
     else
       match (expand_head env funct.exp_type).desc with
-      | Tarrow (_, _, _, _, Some arity) -> Some arity
+      | Tarrow (_, _, _, Some arity) -> Some arity
       | _ -> None
   in
   let force_uncurried_type funct =
@@ -3532,8 +3535,8 @@ and type_application ~context total_app env funct (sargs : sargs) :
         if fully_applied then new_t
         else
           match new_t.desc with
-          | Tarrow (l, t1, t2, c, _) ->
-            {new_t with desc = Tarrow (l, t1, t2, c, Some newarity)}
+          | Tarrow (arg, ret, c, _) ->
+            {new_t with desc = Tarrow (arg, ret, c, Some newarity)}
           | _ -> new_t
       in
       (fully_applied, new_t)
@@ -3553,7 +3556,7 @@ and type_application ~context total_app env funct (sargs : sargs) :
       in
       if List.length args < max_arity && total_app then
         match (expand_head env ty_fun).desc with
-        | Tarrow (Optional l, t1, t2, _, _) ->
+        | Tarrow ({lbl = Optional l; typ = t1}, t2, _, _) ->
           ignored := (Noloc.Optional l, t1, ty_fun.level) :: !ignored;
           let arg =
             ( Noloc.Optional l,
@@ -3581,9 +3584,11 @@ and type_application ~context total_app env funct (sargs : sargs) :
           if ty_fun.level >= t1.level && not_identity funct.exp_desc then
             Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
           unify env ty_fun
-            (newty (Tarrow (l1, t1, t2, Clink (ref Cunknown), top_arity)));
+            (newty
+               (Tarrow
+                  ({lbl = l1; typ = t1}, t2, Clink (ref Cunknown), top_arity)));
           (t1, t2)
-        | Tarrow (l, t1, t2, _, _)
+        | Tarrow ({lbl = l; typ = t1}, t2, _, _)
           when Asttypes.Noloc.same_arg_label l l1 && arity_ok ->
           (t1, t2)
         | td -> (
@@ -3622,8 +3627,8 @@ and type_application ~context total_app env funct (sargs : sargs) :
   let rec type_args ~context max_arity args omitted ~ty_fun ty_fun0
       ~(sargs : sargs) ~top_arity =
     match (expand_head env ty_fun, expand_head env ty_fun0) with
-    | ( {desc = Tarrow (l, ty, ty_fun, com, _); level = lv},
-        {desc = Tarrow (_, ty0, ty_fun0, _, _)} )
+    | ( {desc = Tarrow ({lbl = l; typ = ty}, ty_fun, com, _); level = lv},
+        {desc = Tarrow ({typ = ty0}, ty_fun0, _, _)} )
       when sargs <> [] && commu_repr com = Cok && List.length args < max_arity
       ->
       let name = label_name l and optional = is_optional l in
@@ -4278,8 +4283,8 @@ let report_error env loc ppf error =
   | Expr_type_clash
       {
         trace =
-          (_, {desc = Tarrow (_, _, _, _, None)})
-          :: (_, {desc = Tarrow (_, _, _, _, Some _)})
+          (_, {desc = Tarrow (_, _, _, None)})
+          :: (_, {desc = Tarrow (_, _, _, Some _)})
           :: _;
       } ->
     fprintf ppf
@@ -4288,8 +4293,8 @@ let report_error env loc ppf error =
   | Expr_type_clash
       {
         trace =
-          (_, {desc = Tarrow (_, _, _, _, Some arity_a)})
-          :: (_, {desc = Tarrow (_, _, _, _, Some arity_b)})
+          (_, {desc = Tarrow (_, _, _, Some arity_a)})
+          :: (_, {desc = Tarrow (_, _, _, Some arity_b)})
           :: _;
       }
     when arity_a <> arity_b ->
@@ -4304,10 +4309,10 @@ let report_error env loc ppf error =
   | Apply_non_function typ -> (
     (* modified *)
     match (repr typ).desc with
-    | Tarrow (_, _inputType, return_type, _, _) ->
+    | Tarrow (_, return_type, _, _) ->
       let rec count_number_of_args count {Types.desc} =
         match desc with
-        | Tarrow (_, _inputType, return_type, _, _) ->
+        | Tarrow (_, return_type, _, _) ->
           count_number_of_args (count + 1) return_type
         | _ -> count
       in
@@ -4490,7 +4495,7 @@ let report_error env loc ppf error =
     *)
     let rec collect_args ?(acc = []) typ =
       match typ.desc with
-      | Tarrow (arg, _, next, _, _) -> collect_args ~acc:(arg :: acc) next
+      | Tarrow (arg, next, _, _) -> collect_args ~acc:(arg.lbl :: acc) next
       | _ -> acc
     in
     let args_from_type = collect_args typ in
diff --git a/compiler/ml/typedecl.ml b/compiler/ml/typedecl.ml
index 95dd5273ed..360354600c 100644
--- a/compiler/ml/typedecl.ml
+++ b/compiler/ml/typedecl.ml
@@ -1036,14 +1036,14 @@ let compute_variance env visited vari ty =
       visited := TypeMap.add ty vari !visited;
       let compute_same = compute_variance_rec vari in
       match ty.desc with
-      | Tarrow (_, ty1, ty2, _, _) ->
+      | Tarrow (arg, ret, _, _) ->
         let open Variance in
         let v = conjugate vari in
         let v1 =
           if mem May_pos v || mem May_neg v then set May_weak true v else v
         in
-        compute_variance_rec v1 ty1;
-        compute_same ty2
+        compute_variance_rec v1 arg.typ;
+        compute_same ret
       | Ttuple tl -> List.iter compute_same tl
       | Tconstr (path, tl, _) -> (
         let open Variance in
@@ -1842,8 +1842,8 @@ let transl_exception env sext =
 
 let rec arity_from_arrow_type env core_type ty =
   match (core_type.ptyp_desc, (Ctype.repr ty).desc) with
-  | Ptyp_arrow {ret = ct2}, Tarrow (_, _, t2, _, _) ->
-    1 + arity_from_arrow_type env ct2 t2
+  | Ptyp_arrow {ret = ct2}, Tarrow (_, ret, _, _) ->
+    1 + arity_from_arrow_type env ct2 ret
   | Ptyp_arrow _, _ | _, Tarrow _ -> assert false
   | _ -> 0
 
diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml
index 55707631dd..97bfe3848a 100644
--- a/compiler/ml/typedtree.ml
+++ b/compiler/ml/typedtree.ml
@@ -303,10 +303,12 @@ and core_type = {
   ctyp_attributes: attribute list;
 }
 
+and arg = {lbl: Noloc.arg_label; typ: core_type}
+
 and core_type_desc =
   | Ttyp_any
   | Ttyp_var of string
-  | Ttyp_arrow of Noloc.arg_label * core_type * core_type * arity
+  | Ttyp_arrow of arg * core_type * arity
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
   | Ttyp_object of object_field list * closed_flag
diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli
index bac990c35e..71292362dc 100644
--- a/compiler/ml/typedtree.mli
+++ b/compiler/ml/typedtree.mli
@@ -409,10 +409,12 @@ and core_type = {
   ctyp_attributes: attributes;
 }
 
+and arg = {lbl: Noloc.arg_label; typ: core_type}
+
 and core_type_desc =
   | Ttyp_any
   | Ttyp_var of string
-  | Ttyp_arrow of Noloc.arg_label * core_type * core_type * arity
+  | Ttyp_arrow of arg * core_type * arity
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
   | Ttyp_object of object_field list * closed_flag
diff --git a/compiler/ml/typedtreeIter.ml b/compiler/ml/typedtreeIter.ml
index a7597ea8d7..9a31b9b5b9 100644
--- a/compiler/ml/typedtreeIter.ml
+++ b/compiler/ml/typedtreeIter.ml
@@ -375,9 +375,9 @@ end = struct
     (match ct.ctyp_desc with
     | Ttyp_any -> ()
     | Ttyp_var _ -> ()
-    | Ttyp_arrow (_label, ct1, ct2, _) ->
-      iter_core_type ct1;
-      iter_core_type ct2
+    | Ttyp_arrow (arg, ret, _) ->
+      iter_core_type arg.typ;
+      iter_core_type ret
     | Ttyp_tuple list -> List.iter iter_core_type list
     | Ttyp_constr (_path, _, list) -> List.iter iter_core_type list
     | Ttyp_object (list, _o) -> List.iter iter_object_field list
diff --git a/compiler/ml/typeopt.ml b/compiler/ml/typeopt.ml
index 0118d6e4d4..7f2cfe72c7 100644
--- a/compiler/ml/typeopt.ml
+++ b/compiler/ml/typeopt.ml
@@ -93,7 +93,7 @@ let rec type_cannot_contain_undefined (typ : Types.type_expr) (env : Env.t) =
 
 let is_function_type env ty =
   match scrape env ty with
-  | Tarrow (_, lhs, rhs, _, _) -> Some (lhs, rhs)
+  | Tarrow (arg, rhs, _, _) -> Some (arg.typ, rhs)
   | _ -> None
 
 let is_base_type env ty base_ty_path =
diff --git a/compiler/ml/types.ml b/compiler/ml/types.ml
index 86ec0614e8..ae5a614853 100644
--- a/compiler/ml/types.ml
+++ b/compiler/ml/types.ml
@@ -21,9 +21,11 @@ open Asttypes
 
 type type_expr = {mutable desc: type_desc; mutable level: int; id: int}
 
+and arg = {lbl: Noloc.arg_label; typ: type_expr}
+
 and type_desc =
   | Tvar of string option
-  | Tarrow of Noloc.arg_label * type_expr * type_expr * commutable * arity
+  | Tarrow of arg * type_expr * commutable * arity
   | Ttuple of type_expr list
   | Tconstr of Path.t * type_expr list * abbrev_memo ref
   | Tobject of type_expr * (Path.t * type_expr list) option ref
diff --git a/compiler/ml/types.mli b/compiler/ml/types.mli
index a13d64885b..25ce43088f 100644
--- a/compiler/ml/types.mli
+++ b/compiler/ml/types.mli
@@ -57,11 +57,13 @@ type type_expr = {mutable desc: type_desc; mutable level: int; id: int}
     Note on mutability: TBD.
  *)
 
+and arg = {lbl: Noloc.arg_label; typ: type_expr}
+
 and type_desc =
   | Tvar of string option
       (** [Tvar (Some "a")] ==> ['a] or ['_a]
       [Tvar None]       ==> [_] *)
-  | Tarrow of Noloc.arg_label * type_expr * type_expr * commutable * arity
+  | Tarrow of arg * type_expr * commutable * arity
       (** [Tarrow (Nolabel,      e1, e2, c)] ==> [e1    -> e2]
       [Tarrow (Labelled "l", e1, e2, c)] ==> [l:e1  -> e2]
       [Tarrow (Optional "l", e1, e2, c)] ==> [?l:e1 -> e2]
diff --git a/compiler/ml/typetexp.ml b/compiler/ml/typetexp.ml
index a6940ff2b5..77cff06785 100644
--- a/compiler/ml/typetexp.ml
+++ b/compiler/ml/typetexp.ml
@@ -318,18 +318,18 @@ and transl_type_aux env policy styp =
           v)
     in
     ctyp (Ttyp_var name) ty
-  | Ptyp_arrow {lbl; arg = st1; ret = st2; arity} ->
-    let lbl = Asttypes.to_noloc lbl in
-    let cty1 = transl_type env policy st1 in
-    let cty2 = transl_type env policy st2 in
+  | Ptyp_arrow {arg; ret; arity} ->
+    let lbl = Asttypes.to_noloc arg.lbl in
+    let cty1 = transl_type env policy arg.typ in
+    let cty2 = transl_type env policy ret in
     let ty1 = cty1.ctyp_type in
     let ty1 =
       if Btype.is_optional lbl then
         newty (Tconstr (Predef.path_option, [ty1], ref Mnil))
       else ty1
     in
-    let ty = newty (Tarrow (lbl, ty1, cty2.ctyp_type, Cok, arity)) in
-    ctyp (Ttyp_arrow (lbl, cty1, cty2, arity)) ty
+    let ty = newty (Tarrow ({lbl; typ = ty1}, cty2.ctyp_type, Cok, arity)) in
+    ctyp (Ttyp_arrow ({lbl; typ = cty1}, cty2, arity)) ty
   | Ptyp_tuple stl ->
     assert (List.length stl >= 2);
     let ctys = List.map (transl_type env policy) stl in
diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml
index c56e512610..e3391a63f3 100644
--- a/compiler/syntax/src/jsx_v4.ml
+++ b/compiler/syntax/src/jsx_v4.ml
@@ -1,7 +1,7 @@
 open! Ast_helper
 open Ast_mapper
 open Asttypes
-open Parsetree
+open! Parsetree
 open Longident
 
 let module_access_name config value =
@@ -921,14 +921,17 @@ let transform_structure_item ~config item =
       let rec get_prop_types types
           ({ptyp_loc; ptyp_desc; ptyp_attributes} as full_type) =
         match ptyp_desc with
-        | Ptyp_arrow {lbl = name; arg; ret = {ptyp_desc = Ptyp_arrow _} as typ2}
-          when is_labelled name || is_optional name ->
-          get_prop_types ((name, ptyp_attributes, ptyp_loc, arg) :: types) typ2
-        | Ptyp_arrow {lbl = Nolabel; ret} -> get_prop_types types ret
-        | Ptyp_arrow {lbl = name; arg; ret = return_value}
-          when is_labelled name || is_optional name ->
+        | Ptyp_arrow {arg; ret = {ptyp_desc = Ptyp_arrow _} as typ2}
+          when is_labelled arg.lbl || is_optional arg.lbl ->
+          get_prop_types
+            ((arg.lbl, ptyp_attributes, ptyp_loc, arg.typ) :: types)
+            typ2
+        | Ptyp_arrow {arg = {lbl = Nolabel}; ret} -> get_prop_types types ret
+        | Ptyp_arrow {arg; ret = return_value}
+          when is_labelled arg.lbl || is_optional arg.lbl ->
           ( return_value,
-            (name, ptyp_attributes, return_value.ptyp_loc, arg) :: types )
+            (arg.lbl, ptyp_attributes, return_value.ptyp_loc, arg.typ) :: types
+          )
         | _ -> (full_type, types)
       in
       let inner_type, prop_types = get_prop_types [] pval_type in
@@ -1022,30 +1025,28 @@ let transform_signature_item ~config item =
       in
       let rec get_prop_types types ({ptyp_loc; ptyp_desc} as full_type) =
         match ptyp_desc with
+        | Ptyp_arrow {arg; ret = {ptyp_desc = Ptyp_arrow _} as rest}
+          when is_optional arg.lbl || is_labelled arg.lbl ->
+          get_prop_types
+            ((arg.lbl, arg.typ.ptyp_attributes, ptyp_loc, arg.typ) :: types)
+            rest
         | Ptyp_arrow
             {
-              lbl;
-              arg = {ptyp_attributes = attrs} as type_;
-              ret = {ptyp_desc = Ptyp_arrow _} as rest;
-            }
-          when is_optional lbl || is_labelled lbl ->
-          get_prop_types ((lbl, attrs, ptyp_loc, type_) :: types) rest
-        | Ptyp_arrow
-            {
-              lbl = Nolabel;
-              arg = {ptyp_desc = Ptyp_constr ({txt = Lident "unit"}, _)};
+              arg =
+                {
+                  lbl = Nolabel;
+                  typ = {ptyp_desc = Ptyp_constr ({txt = Lident "unit"}, _)};
+                };
               ret = rest;
             } ->
           get_prop_types types rest
-        | Ptyp_arrow {lbl = Nolabel; ret = rest} -> get_prop_types types rest
-        | Ptyp_arrow
-            {
-              lbl = name;
-              arg = {ptyp_attributes = attrs} as type_;
-              ret = return_value;
-            }
-          when is_optional name || is_labelled name ->
-          (return_value, (name, attrs, return_value.ptyp_loc, type_) :: types)
+        | Ptyp_arrow {arg = {lbl = Nolabel}; ret = rest} ->
+          get_prop_types types rest
+        | Ptyp_arrow {arg; ret = return_value}
+          when is_optional arg.lbl || is_labelled arg.lbl ->
+          ( return_value,
+            (arg.lbl, arg.typ.ptyp_attributes, return_value.ptyp_loc, arg.typ)
+            :: types )
         | _ -> (full_type, types)
       in
       let inner_type, prop_types = get_prop_types [] pval_type in
diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml
index d362e710c0..a4f3a405f2 100644
--- a/compiler/syntax/src/res_ast_debugger.ml
+++ b/compiler/syntax/src/res_ast_debugger.ml
@@ -875,12 +875,12 @@ module SexpAst = struct
       match typexpr.ptyp_desc with
       | Ptyp_any -> Sexp.atom "Ptyp_any"
       | Ptyp_var var -> Sexp.list [Sexp.atom "Ptyp_var"; string var]
-      | Ptyp_arrow {lbl; arg; ret} ->
+      | Ptyp_arrow {arg; ret} ->
         Sexp.list
           [
             Sexp.atom "Ptyp_arrow";
-            arg_label_loc lbl;
-            core_type arg;
+            arg_label_loc arg.lbl;
+            core_type arg.typ;
             core_type ret;
           ]
       | Ptyp_tuple types ->
diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml
index d62b99400a..9f65e471d5 100644
--- a/compiler/syntax/src/res_comments_table.ml
+++ b/compiler/syntax/src/res_comments_table.ml
@@ -319,27 +319,28 @@ let arrow_type ct =
   let rec process attrs_before acc typ =
     match typ with
     | {
-     ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret};
+     ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel} as arg; ret};
      ptyp_attributes = [];
     } ->
-      let arg = ([], lbl, arg) in
+      let arg = ([], arg.lbl, arg.typ) in
       process attrs_before (arg :: acc) ret
     | {
-     ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret};
+     ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel} as arg; ret};
      ptyp_attributes = [({txt = "bs"}, _)] as attrs;
     } ->
-      let arg = (attrs, lbl, arg) in
+      let arg = (attrs, arg.lbl, arg.typ) in
       process attrs_before (arg :: acc) ret
-    | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}} as return_type ->
+    | {ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel}}} as return_type ->
       let args = List.rev acc in
       (attrs_before, args, return_type)
-    | {ptyp_desc = Ptyp_arrow {lbl; arg; ret}; ptyp_attributes = attrs} ->
-      let arg = (attrs, lbl, arg) in
+    | {ptyp_desc = Ptyp_arrow {arg; ret}; ptyp_attributes = attrs} ->
+      let arg = (attrs, arg.lbl, arg.typ) in
       process attrs_before (arg :: acc) ret
     | typ -> (attrs_before, List.rev acc, typ)
   in
   match ct with
-  | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}; ptyp_attributes = attrs} as typ ->
+  | {ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel}}; ptyp_attributes = attrs} as
+    typ ->
     process attrs [] {typ with ptyp_attributes = []}
   | typ -> process [] [] typ
 
diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml
index 63ca9878c1..1d573460c4 100644
--- a/compiler/syntax/src/res_core.ml
+++ b/compiler/syntax/src/res_core.ml
@@ -4039,7 +4039,8 @@ and parse_poly_type_expr ?current_type_name_path ?inline_types_context p =
         let typ = Ast_helper.Typ.var ~loc:var.loc var.txt in
         let return_type = parse_typ_expr ~alias:false p in
         let loc = mk_loc typ.Parsetree.ptyp_loc.loc_start p.prev_end_pos in
-        Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Nolabel typ return_type
+        Ast_helper.Typ.arrow ~loc ~arity:(Some 1) {lbl = Nolabel; typ}
+          return_type
       | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt)
     | _ -> assert false)
   | _ -> parse_typ_expr ?current_type_name_path ?inline_types_context p
@@ -4388,7 +4389,7 @@ and parse_es6_arrow_type ~attrs p =
     let name, label_loc = parse_lident p in
     Parser.expect ~grammar:Grammar.TypeExpression Colon p;
     let typ = parse_typ_expr ~alias:false ~es6_arrow:false p in
-    let arg =
+    let lbl =
       match p.Parser.token with
       | Equal ->
         Parser.next p;
@@ -4399,7 +4400,7 @@ and parse_es6_arrow_type ~attrs p =
     Parser.expect EqualGreater p;
     let return_type = parse_typ_expr ~alias:false p in
     let loc = mk_loc start_pos p.prev_end_pos in
-    Ast_helper.Typ.arrow ~loc ~attrs ~arity:None arg typ return_type
+    Ast_helper.Typ.arrow ~loc ~attrs ~arity:None {lbl; typ} return_type
   | DocComment _ -> assert false
   | _ ->
     let parameters = parse_type_parameters p in
@@ -4428,7 +4429,7 @@ and parse_es6_arrow_type ~attrs p =
             | _ -> arity
           in
           let t_arg =
-            Ast_helper.Typ.arrow ~loc ~attrs ~arity:None arg_lbl typ t
+            Ast_helper.Typ.arrow ~loc ~attrs ~arity:None {lbl = arg_lbl; typ} t
           in
           if param_num = 1 then
             (param_num - 1, Ast_uncurried.uncurried_type ~arity t_arg, 1)
@@ -4492,7 +4493,7 @@ and parse_arrow_type_rest ~es6_arrow ~start_pos typ p =
     Parser.next p;
     let return_type = parse_typ_expr ~alias:false p in
     let loc = mk_loc start_pos p.prev_end_pos in
-    Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Nolabel typ return_type
+    Ast_helper.Typ.arrow ~loc ~arity:(Some 1) {lbl = Nolabel; typ} return_type
   | _ -> typ
 
 and parse_typ_expr_region p =
@@ -5150,7 +5151,8 @@ and parse_type_equation_or_constr_decl p =
         let return_type = parse_typ_expr ~alias:false p in
         let loc = mk_loc uident_start_pos p.prev_end_pos in
         let arrow_type =
-          Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Nolabel typ return_type
+          Ast_helper.Typ.arrow ~loc ~arity:(Some 1) {lbl = Nolabel; typ}
+            return_type
         in
         let typ = parse_type_alias p arrow_type in
         (Some typ, Asttypes.Public, Parsetree.Ptype_abstract)
diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml
index df617461cf..1deb497adb 100644
--- a/compiler/syntax/src/res_parsetree_viewer.ml
+++ b/compiler/syntax/src/res_parsetree_viewer.ml
@@ -11,24 +11,24 @@ let arrow_type ?(max_arity = max_int) ct =
       when acc <> [] ->
       (attrs_before, List.rev acc, typ)
     | {
-     ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret};
+     ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel} as arg; ret};
      ptyp_attributes = [];
     } ->
-      let arg = ([], lbl, arg) in
+      let arg = ([], arg.lbl, arg.typ) in
       process attrs_before (arg :: acc) ret (arity - 1)
     | {
-     ptyp_desc = Ptyp_arrow {lbl = Nolabel};
+     ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel}};
      ptyp_attributes = [({txt = "bs"}, _)];
     } ->
       (* stop here, the uncurried attribute always indicates the beginning of an arrow function
        * e.g. `(. int) => (. int)` instead of `(. int, . int)` *)
       (attrs_before, List.rev acc, typ)
-    | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}; ptyp_attributes = _attrs} as
-      return_type ->
+    | {ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel}}; ptyp_attributes = _attrs}
+      as return_type ->
       let args = List.rev acc in
       (attrs_before, args, return_type)
     | {
-     ptyp_desc = Ptyp_arrow {lbl = (Labelled _ | Optional _) as lbl; arg; ret};
+     ptyp_desc = Ptyp_arrow {arg = {lbl = Labelled _ | Optional _} as arg; ret};
      ptyp_attributes = attrs;
     } ->
       (* Res_core.parse_es6_arrow_type has a workaround that removed an extra arity for the function if the
@@ -37,18 +37,19 @@ let arrow_type ?(max_arity = max_int) ct =
          When this case is encountered we add that missing arity so the arrow is printed properly.
       *)
       let arity =
-        match arg with
+        match arg.typ with
         | {ptyp_desc = Ptyp_any; ptyp_attributes = attrs1}
           when has_as_attr attrs1 ->
           arity
         | _ -> arity - 1
       in
-      let arg = (attrs, lbl, arg) in
+      let arg = (attrs, arg.lbl, arg.typ) in
       process attrs_before (arg :: acc) ret arity
     | typ -> (attrs_before, List.rev acc, typ)
   in
   match ct with
-  | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}; ptyp_attributes = attrs1} as typ ->
+  | {ptyp_desc = Ptyp_arrow {arg = {lbl = Nolabel}}; ptyp_attributes = attrs1}
+    as typ ->
     process attrs1 [] {typ with ptyp_attributes = []} max_arity
   | typ -> process [] [] typ max_arity
 
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index bf2ed65c64..1722fdda07 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -395,8 +395,8 @@ let valueDetail (typ : Types.type_expr) =
                  collectSignatureTypes t)
         in
         [{path = p; genericParameters = ts}])
-    | Tarrow (_, t1, t2, _, _) ->
-      collectSignatureTypes t1 @ collectSignatureTypes t2
+    | Tarrow (arg, ret, _, _) ->
+      collectSignatureTypes arg.typ @ collectSignatureTypes ret
     | Tvar None -> [{path = "_"; genericParameters = []}]
     | _ -> []
   in