Clean up Ast_core_type using the arg type.

Author: cristianoc

compiler/frontend/ast_core_type.ml

@@ -131,35 +131,22 @@ let get_curry_arity (ty : t) =
 
 let is_arity_one ty = get_curry_arity ty = 1
 
-type param_type = {
-  label: Asttypes.arg_label;
-  ty: Parsetree.core_type;
-  attr: Parsetree.attributes;
-  loc: loc;
-}
-
-let mk_fn_type (new_arg_types_ty : param_type list) (result : t) : t =
+let mk_fn_type ~loc (new_arg_types_ty : Parsetree.arg list) (result : t) : t =
   let t =
-    Ext_list.fold_right new_arg_types_ty result
-      (fun {label; ty; attr; loc} acc ->
-        Ast_helper.Typ.arrow ~loc ~attrs:attr ~arity:None
-          {attrs = []; lbl = label; typ = ty}
-          acc)
+    Ext_list.fold_right new_arg_types_ty result (fun {lbl; typ; attrs} acc ->
+        Ast_helper.Typ.arrow ~loc ~attrs ~arity:None {attrs = []; lbl; typ} acc)
   in
   match t.ptyp_desc with
   | Ptyp_arrow arr ->
     let arity = List.length new_arg_types_ty in
     {t with ptyp_desc = Ptyp_arrow {arr with arity = Some arity}}
   | _ -> t
 
-let list_of_arrow (ty : t) : t * param_type list =
+let list_of_arrow (ty : t) : t * Parsetree.arg list =
   let rec aux (ty : t) acc =
     match ty.ptyp_desc with
     | Ptyp_arrow {arg; ret; arity} when arity = None || acc = [] ->
-      aux ret
-        (({label = arg.lbl; ty = arg.typ; attr = arg.attrs; loc = ty.ptyp_loc}
-           : param_type)
-        :: acc)
+      aux ret (arg :: acc)
     | Ptyp_poly (_, ty) ->
       (* should not happen? *)
       Bs_syntaxerr.err ty.ptyp_loc Unhandled_poly_type
@@ -169,6 +156,6 @@ let list_of_arrow (ty : t) : t * param_type list =
 
 let add_last_obj (ty : t) (obj : t) =
   let result, params = list_of_arrow ty in
-  mk_fn_type
-    (params @ [{label = Nolabel; ty = obj; attr = []; loc = obj.ptyp_loc}])
+  mk_fn_type ~loc:obj.ptyp_loc
+    (params @ [{lbl = Nolabel; typ = obj; attrs = []}])
     result

compiler/frontend/ast_core_type.mli

@@ -47,16 +47,9 @@ val get_uncurry_arity : t -> int option
    None -- means not a function
 *)
 
-type param_type = {
-  label: Asttypes.arg_label;
-  ty: t;
-  attr: Parsetree.attributes;
-  loc: Location.t;
-}
+val mk_fn_type : loc:Location.t -> Parsetree.arg list -> t -> t
 
-val mk_fn_type : param_type list -> t -> t
-
-val list_of_arrow : t -> t * param_type list
+val list_of_arrow : t -> t * Parsetree.arg list
 (** fails when Ptyp_poly *)
 
 val add_last_obj : t -> t -> t

compiler/frontend/ast_external_process.ml

@@ -408,8 +408,7 @@ type response = {
 }
 
 let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
-    (arg_types_ty : Ast_core_type.param_type list)
-    (result_type : Ast_core_type.t) :
+    (arg_types_ty : Parsetree.arg list) (result_type : Ast_core_type.t) :
     int * Parsetree.core_type * External_ffi_types.t =
   match st with
   | {
@@ -440,11 +439,10 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
       Ext_list.fold_right arg_types_ty ([], [], [])
         (fun
           param_type
-          (arg_labels, (arg_types : Ast_core_type.param_type list), result_types)
+          (arg_labels, (arg_types : Parsetree.arg list), result_types)
         ->
-          let arg_label = param_type.label in
-          let loc = param_type.loc in
-          let ty = param_type.ty in
+          let arg_label = param_type.lbl in
+          let ty = param_type.typ in
           let new_arg_label, new_arg_types, output_tys =
             match arg_label with
             | Nolabel -> (
@@ -459,7 +457,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
             | Labelled {txt = label} -> (
               let field_name =
                 match
-                  Ast_attributes.iter_process_bs_string_as param_type.attr
+                  Ast_attributes.iter_process_bs_string_as param_type.attrs
                 with
                 | Some alias -> alias
                 | None -> label
@@ -518,7 +516,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
             | Optional {txt = label} -> (
               let field_name =
                 match
-                  Ast_attributes.iter_process_bs_string_as param_type.attr
+                  Ast_attributes.iter_process_bs_string_as param_type.attrs
                 with
                 | Some alias -> alias
                 | None -> label
@@ -594,7 +592,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
     in
 
     ( List.length new_arg_types_ty,
-      Ast_core_type.mk_fn_type new_arg_types_ty result,
+      Ast_core_type.mk_fn_type ~loc new_arg_types_ty result,
       External_ffi_types.ffi_obj_create arg_kinds )
   | _ -> Location.raise_errorf ~loc "Attribute found that conflicts with %@obj"
 
@@ -942,11 +940,10 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
     let splice = external_desc.splice in
     let arg_type_specs, new_arg_types_ty, arg_type_specs_length =
       Ext_list.fold_right arg_types_ty
-        (([], [], 0)
-          : External_arg_spec.params * Ast_core_type.param_type list * int)
+        (([], [], 0) : External_arg_spec.params * Parsetree.arg list * int)
         (fun param_type (arg_type_specs, arg_types, i) ->
-          let arg_label = param_type.label in
-          let ty = param_type.ty in
+          let arg_label = param_type.lbl in
+          let ty = param_type.typ in
           (if i = 0 && splice then
              match arg_label with
              | Optional _ ->
@@ -1008,7 +1005,7 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
     let return_wrapper =
       check_return_wrapper loc external_desc.return_wrapper result_type
     in
-    let fn_type = Ast_core_type.mk_fn_type new_arg_types_ty result_type in
+    let fn_type = Ast_core_type.mk_fn_type ~loc new_arg_types_ty result_type in
     ( build_uncurried_type ~arity:(List.length new_arg_types_ty) fn_type,
       External_ffi_types.ffi_bs arg_type_specs return_wrapper ffi,
       unused_attrs,