AST: use inline record for Ptyp_arrow.

Author: cristianoc

CHANGELOG.md

@@ -29,6 +29,7 @@
 - AST cleanup: Remove `structure_item_desc.Pstr_class`, `signature_item_desc.Psig_class`, `structure_item_desc.Pstr_class_type`, `signature_item_desc.Psig_class_type`, `structure_item_desc.Tstr_class`, `structure_item_desc.Tstr_class_type`, `signature_item_desc.Tsig_class`, `signature_item_desc.Tsig_class_type` from AST as it is unused. https://github.com/rescript-lang/rescript/pull/7242
 - AST cleanup: remove "|." and rename "|." to "->" in the internal representation for the pipe operator. https://github.com/rescript-lang/rescript/pull/7244
 - AST cleanup: represent concatenation (`++`) and (dis)equality operators (`==`, `===`, `!=`, `!==`) just like in the syntax. https://github.com/rescript-lang/rescript/pull/7248
+- AST cleanup: use inline record for `Ptyp_arrow`. https://github.com/rescript-lang/rescript/pull/7250
 
 # 12.0.0-alpha.7
 

analysis/src/SignatureHelp.ml

@@ -113,7 +113,8 @@ let extractParameters ~signature ~typeStrForParser ~labelPrefixLen =
       | {
        (* Gotcha: functions with multiple arugments are modelled as a series of single argument functions. *)
        Parsetree.ptyp_desc =
-         Ptyp_arrow (argumentLabel, argumentTypeExpr, nextFunctionExpr, _);
+         Ptyp_arrow
+           {lbl = argumentLabel; arg = argumentTypeExpr; ret = nextFunctionExpr};
        ptyp_loc;
       } ->
         let startOffset =

compiler/frontend/ast_compatible.ml

@@ -122,16 +122,17 @@ let apply_labels ?(loc = default_loc) ?(attrs = []) fn
         };
   }
 
-let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity s a b : core_type =
+let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity s arg ret : core_type
+    =
   {
-    ptyp_desc = Ptyp_arrow (Asttypes.Labelled s, a, b, arity);
+    ptyp_desc = Ptyp_arrow {lbl = Labelled s; arg; ret; arity};
     ptyp_loc = loc;
     ptyp_attributes = attrs;
   }
 
-let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity s a b : core_type =
+let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity s arg ret : core_type =
   {
-    ptyp_desc = Ptyp_arrow (Asttypes.Optional s, a, b, arity);
+    ptyp_desc = Ptyp_arrow {lbl = Asttypes.Optional s; arg; ret; arity};
     ptyp_loc = loc;
     ptyp_attributes = attrs;
   }

compiler/frontend/ast_core_type.ml

@@ -109,7 +109,7 @@ let make_obj ~loc xs = Typ.object_ ~loc xs Closed
 *)
 let rec get_uncurry_arity_aux (ty : t) acc =
   match ty.ptyp_desc with
-  | Ptyp_arrow (_, _, new_ty, _) -> get_uncurry_arity_aux new_ty (succ acc)
+  | Ptyp_arrow {ret = new_ty} -> get_uncurry_arity_aux new_ty (succ acc)
   | Ptyp_poly (_, ty) -> get_uncurry_arity_aux ty acc
   | _ -> acc
 
@@ -120,12 +120,12 @@ let rec get_uncurry_arity_aux (ty : t) acc =
 *)
 let get_uncurry_arity (ty : t) =
   match ty.ptyp_desc with
-  | Ptyp_arrow (_, _, rest, _) -> Some (get_uncurry_arity_aux rest 1)
+  | Ptyp_arrow {ret = rest} -> Some (get_uncurry_arity_aux rest 1)
   | _ -> None
 
 let get_curry_arity (ty : t) =
   match ty.ptyp_desc with
-  | Ptyp_arrow (_, _, _, Some arity) -> arity
+  | Ptyp_arrow {arity = Some arity} -> arity
   | _ -> get_uncurry_arity_aux ty 0
 
 let is_arity_one ty = get_curry_arity ty = 1
@@ -142,23 +142,23 @@ 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 (label, ty, acc, None);
+          ptyp_desc = Ptyp_arrow {lbl = label; arg = ty; ret = acc; arity = None};
           ptyp_loc = loc;
           ptyp_attributes = attr;
         })
   in
   match t.ptyp_desc with
-  | Ptyp_arrow (l, t1, t2, _arity) ->
+  | Ptyp_arrow arr ->
     let arity = List.length new_arg_types_ty in
-    {t with ptyp_desc = Ptyp_arrow (l, t1, t2, Some arity)}
+    {t with ptyp_desc = Ptyp_arrow {arr with arity = Some arity}}
   | _ -> t
 
 let list_of_arrow (ty : t) : t * param_type list =
   let rec aux (ty : t) acc =
     match ty.ptyp_desc with
-    | Ptyp_arrow (label, t1, t2, arity) when arity = None || acc = [] ->
-      aux t2
-        (({label; ty = t1; attr = ty.ptyp_attributes; loc = ty.ptyp_loc}
+    | Ptyp_arrow {lbl = label; arg; ret; arity} when arity = None || acc = [] ->
+      aux ret
+        (({label; ty = arg; attr = ty.ptyp_attributes; loc = ty.ptyp_loc}
            : param_type)
         :: acc)
     | Ptyp_poly (_, ty) ->

compiler/frontend/ast_core_type_class_type.ml

@@ -67,7 +67,7 @@ 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 (label, args, body, _)
+  | Ptyp_arrow {lbl = label; arg = args; ret = body}
   (* let it go without regard label names,
      it will report error later when the label is not empty
   *) -> (

compiler/frontend/ast_external_process.ml

@@ -22,9 +22,6 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-[@@@warning "+9"]
-(* record pattern match complete checker*)
-
 let rec variant_can_unwrap_aux (row_fields : Parsetree.row_field list) : bool =
   match row_fields with
   | [] -> true
@@ -68,7 +65,7 @@ let spec_of_ptyp (nolabel : bool) (ptyp : Parsetree.core_type) :
     | _ -> Bs_syntaxerr.err ptyp.ptyp_loc Invalid_bs_unwrap_type)
   | `Nothing -> (
     match ptyp_desc with
-    | Ptyp_constr ({txt = Lident "unit"; _}, []) ->
+    | Ptyp_constr ({txt = Lident "unit"}, []) ->
       if nolabel then Extern_unit else Nothing
     | _ -> Nothing)
 
@@ -257,7 +254,7 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
                   {
                     pstr_desc =
                       Pstr_eval
-                        ({pexp_loc; pexp_desc = Pexp_record (fields, _); _}, _);
+                        ({pexp_loc; pexp_desc = Pexp_record (fields, _)}, _);
                     _;
                   };
                 ] -> (
@@ -270,10 +267,10 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
                        Longident.t Location.loc * Parsetree.expression * bool)
                    ->
                      match (l, exp.pexp_desc) with
-                     | ( {txt = Lident "from"; _},
+                     | ( {txt = Lident "from"},
                          Pexp_constant (Pconst_string (s, _)) ) ->
                        from_name := Some s
-                     | {txt = Lident "with"; _}, Pexp_record (fields, _) ->
+                     | {txt = Lident "with"}, Pexp_record (fields, _) ->
                        with_ := Some fields
                      | _ -> ());
               match (!from_name, !with_) with
@@ -395,7 +392,7 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
           | "return" -> (
             let actions = Ast_payload.ident_or_record_as_config loc payload in
             match actions with
-            | [({txt; _}, None)] ->
+            | [({txt}, None)] ->
               {st with return_wrapper = return_wrapper loc txt}
             | _ -> Bs_syntaxerr.err loc Not_supported_directive_in_bs_return)
           | _ -> raise_notrace Not_handled_external_attribute
@@ -467,7 +464,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
             match arg_label with
             | Nolabel -> (
               match ty.ptyp_desc with
-              | Ptyp_constr ({txt = Lident "unit"; _}, []) ->
+              | Ptyp_constr ({txt = Lident "unit"}, []) ->
                 ( External_arg_spec.empty_kind Extern_unit,
                   param_type :: arg_types,
                   result_types )
@@ -550,7 +547,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
               | Nothing ->
                 let for_sure_not_nested =
                   match ty.ptyp_desc with
-                  | Ptyp_constr ({txt = Lident txt; _}, []) ->
+                  | Ptyp_constr ({txt = Lident txt}, []) ->
                     Ast_core_type.is_builtin_rank0_type txt
                   | _ -> false
                 in
@@ -643,7 +640,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
     else
       Location.raise_errorf ~loc
         "Ill defined attribute %@set_index (arity of 3)"
-  | {set_index = true; _} ->
+  | {set_index = true} ->
     Bs_syntaxerr.err loc
       (Conflict_ffi_attribute "Attribute found that conflicts with %@set_index")
   | {
@@ -669,7 +666,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
       Location.raise_errorf ~loc
         "Ill defined attribute %@get_index (arity expected 2 : while %d)"
         arg_type_specs_length
-  | {get_index = true; _} ->
+  | {get_index = true} ->
     Bs_syntaxerr.err loc
       (Conflict_ffi_attribute "Attribute found that conflicts with %@get_index")
   | {
@@ -702,7 +699,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
       Location.raise_errorf ~loc
         "Incorrect FFI attribute found: (%@new should not carry a payload here)"
     )
-  | {module_as_val = Some _; get_index; val_send; _} ->
+  | {module_as_val = Some _; get_index; val_send} ->
     let reason =
       match (get_index, val_send) with
       | true, _ ->
@@ -770,7 +767,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
       Js_var {name; external_module_name; scopes}
       (*FIXME: splice is not supported here *)
     else Js_call {splice; name; external_module_name; scopes; tagged_template}
-  | {call_name = Some _; _} ->
+  | {call_name = Some _} ->
     Bs_syntaxerr.err loc
       (Conflict_ffi_attribute "Attribute found that conflicts with %@val")
   | {
@@ -797,7 +794,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
                ]}
       *)
     Js_var {name; external_module_name; scopes}
-  | {val_name = Some _; _} ->
+  | {val_name = Some _} ->
     Bs_syntaxerr.err loc
       (Conflict_ffi_attribute "Attribute found that conflicts with %@val")
   | {
@@ -855,7 +852,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
       Location.raise_errorf ~loc
         "Ill defined attribute %@send(first argument can't be const)"
     | _ :: _ -> Js_send {splice; name; js_send_scopes = scopes})
-  | {val_send = Some _; _} ->
+  | {val_send = Some _} ->
     Location.raise_errorf ~loc
       "You used a FFI attribute that can't be used with %@send"
   | {
@@ -876,7 +873,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    tagged_template = _;
   } ->
     Js_new {name; external_module_name; splice; scopes}
-  | {new_name = Some _; _} ->
+  | {new_name = Some _} ->
     Bs_syntaxerr.err loc
       (Conflict_ffi_attribute "Attribute found that conflicts with %@new")
   | {
@@ -901,7 +898,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
     else
       Location.raise_errorf ~loc
         "Ill defined attribute %@set (two args required)"
-  | {set_name = Some _; _} ->
+  | {set_name = Some _} ->
     Location.raise_errorf ~loc "conflict attributes found with %@set"
   | {
    get_name = Some {name; source = _};
@@ -925,7 +922,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
     else
       Location.raise_errorf ~loc
         "Ill defined attribute %@get (only one argument)"
-  | {get_name = Some _; _} ->
+  | {get_name = Some _} ->
     Location.raise_errorf ~loc "Attribute found that conflicts with %@get"
 
 (** Note that the passed [type_annotation] is already processed by visitor pattern before*)
@@ -935,8 +932,8 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
   let prim_name_with_source = {name = prim_name; source = External} in
   let type_annotation, build_uncurried_type =
     match type_annotation with
-    | {ptyp_desc = Ptyp_arrow (_, _, _, Some _); _} as t ->
-      ( t,
+    | {ptyp_desc = Ptyp_arrow {arity = Some _}} ->
+      ( type_annotation,
         fun ~arity (x : Parsetree.core_type) ->
           Ast_uncurried.uncurried_type ~arity x )
     | _ -> (type_annotation, fun ~arity:_ x -> x)
@@ -978,7 +975,7 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
                  Location.raise_errorf ~loc
                    "%@variadic expect the last type to be an array";
                match ty.ptyp_desc with
-               | Ptyp_constr ({txt = Lident "array"; _}, [_]) -> ()
+               | Ptyp_constr ({txt = Lident "array"}, [_]) -> ()
                | _ ->
                  Location.raise_errorf ~loc
                    "%@variadic expect the last type to be an array"));

compiler/frontend/ast_typ_uncurry.ml

@@ -61,8 +61,7 @@ let to_uncurry_type loc (mapper : Bs_ast_mapper.mapper)
   let arity = Ast_core_type.get_uncurry_arity fn_type in
   let fn_type =
     match fn_type.ptyp_desc with
-    | Ptyp_arrow (l, t1, t2, _) ->
-      {fn_type with ptyp_desc = Ptyp_arrow (l, t1, t2, arity)}
+    | Ptyp_arrow arr -> {fn_type with ptyp_desc = Ptyp_arrow {arr with arity}}
     | _ -> assert false
   in
   match arity with

compiler/frontend/bs_ast_mapper.ml

@@ -101,8 +101,8 @@ module T = struct
     match desc with
     | Ptyp_any -> any ~loc ~attrs ()
     | Ptyp_var s -> var ~loc ~attrs s
-    | Ptyp_arrow (lab, t1, t2, arity) ->
-      arrow ~loc ~attrs ~arity lab (sub.typ sub t1) (sub.typ sub t2)
+    | Ptyp_arrow {lbl; arg; ret; arity} ->
+      arrow ~loc ~attrs ~arity lbl (sub.typ sub arg) (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)

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 a b c =
-    mk ?loc ?attrs (Ptyp_arrow (a, b, c, arity))
+  let arrow ?loc ?attrs ~arity lbl arg ret =
+    mk ?loc ?attrs (Ptyp_arrow {lbl; 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))
@@ -82,8 +82,8 @@ module Typ = struct
         | Ptyp_var x ->
           check_variable var_names t.ptyp_loc x;
           Ptyp_var x
-        | Ptyp_arrow (label, core_type, core_type', a) ->
-          Ptyp_arrow (label, loop core_type, loop core_type', a)
+        | Ptyp_arrow {lbl = label; arg; ret; arity = a} ->
+          Ptyp_arrow {lbl = label; arg = loop arg; ret = loop ret; arity = a}
         | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
         | Ptyp_constr ({txt = Longident.Lident s}, []) when List.mem s var_names
           ->

compiler/ml/ast_iterator.ml

@@ -96,9 +96,9 @@ module T = struct
     sub.attributes sub attrs;
     match desc with
     | Ptyp_any | Ptyp_var _ -> ()
-    | Ptyp_arrow (_lab, t1, t2, _) ->
-      sub.typ sub t1;
-      sub.typ sub t2
+    | Ptyp_arrow {arg; ret} ->
+      sub.typ sub arg;
+      sub.typ sub ret
     | Ptyp_tuple tyl -> List.iter (sub.typ sub) tyl
     | Ptyp_constr (lid, tl) ->
       iter_loc sub lid;

compiler/ml/ast_mapper.ml

@@ -93,8 +93,8 @@ module T = struct
     match desc with
     | Ptyp_any -> any ~loc ~attrs ()
     | Ptyp_var s -> var ~loc ~attrs s
-    | Ptyp_arrow (lab, t1, t2, arity) ->
-      arrow ~loc ~attrs ~arity lab (sub.typ sub t1) (sub.typ sub t2)
+    | Ptyp_arrow {lbl; arg; ret; arity} ->
+      arrow ~loc ~attrs ~arity lbl (sub.typ sub arg) (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)

compiler/ml/ast_mapper_from0.ml

@@ -106,8 +106,7 @@ module T = struct
         constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
       in
       match typ0.ptyp_desc with
-      | Ptyp_constr
-          (lid, [({ptyp_desc = Ptyp_arrow (lbl, t1, t2, _)} as fun_t); t_arity])
+      | Ptyp_constr (lid, [({ptyp_desc = Ptyp_arrow arr} as fun_t); t_arity])
         when lid.txt = Lident "function$" ->
         let decode_arity_string arity_s =
           int_of_string
@@ -120,7 +119,7 @@ module T = struct
           | _ -> assert false
         in
         let arity = arity_from_type t_arity in
-        {fun_t with ptyp_desc = Ptyp_arrow (lbl, t1, t2, Some arity)}
+        {fun_t with ptyp_desc = Ptyp_arrow {arr with arity = Some arity}}
       | _ -> typ0)
     | Ptyp_object (l, o) ->
       object_ ~loc ~attrs (List.map (object_field sub) l) o

compiler/ml/ast_mapper_to0.ml

@@ -98,8 +98,8 @@ module T = struct
     match desc with
     | Ptyp_any -> any ~loc ~attrs ()
     | Ptyp_var s -> var ~loc ~attrs s
-    | Ptyp_arrow (lab, t1, t2, arity) -> (
-      let typ0 = arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) in
+    | Ptyp_arrow {lbl; arg; ret; arity} -> (
+      let typ0 = arrow ~loc ~attrs lbl (sub.typ sub arg) (sub.typ sub ret) in
       match arity with
       | None -> typ0
       | Some arity ->

compiler/ml/ast_uncurried.ml

@@ -2,8 +2,8 @@
 
 let uncurried_type ~arity (t_arg : Parsetree.core_type) =
   match t_arg.ptyp_desc with
-  | Ptyp_arrow (l, t1, t2, _) ->
-    {t_arg with ptyp_desc = Ptyp_arrow (l, t1, t2, Some arity)}
+  | Ptyp_arrow arr ->
+    {t_arg with ptyp_desc = Ptyp_arrow {arr with arity = Some arity}}
   | _ -> assert false
 
 let uncurried_fun ?(async = false) ~arity fun_expr =

compiler/ml/depend.ml

@@ -105,9 +105,9 @@ let rec add_type bv ty =
   match ty.ptyp_desc with
   | Ptyp_any -> ()
   | Ptyp_var _ -> ()
-  | Ptyp_arrow (_, t1, t2, _) ->
-    add_type bv t1;
-    add_type bv t2
+  | Ptyp_arrow {arg; ret} ->
+    add_type bv arg;
+    add_type bv ret
   | Ptyp_tuple tl -> List.iter (add_type bv) tl
   | Ptyp_constr (c, tl) ->
     add bv c;