AST cleanup: use inline record for Pexp_fun.

Author: cristianoc

CHANGELOG.md

@@ -40,6 +40,7 @@
 - AST cleanup: store arity in function type. https://github.com/rescript-lang/rescript/pull/7195
 - AST cleanup: remove explicit uses of `function$` in preparation for removing the type entirely. https://github.com/rescript-lang/rescript/pull/7206
 - AST cleanup: remove `function$` entirely. https://github.com/rescript-lang/rescript/pull/7208
+- AST cleanup: use inline record for Pexp_fun. 
 
 # 12.0.0-alpha.5
 

analysis/src/CompletionFrontEnd.ml

@@ -1318,7 +1318,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
             match exprToContextPath lhs with
             | Some contextPath -> setResult (Cpath (CPObj (contextPath, label)))
             | None -> ())
-        | Pexp_fun (lbl, defaultExpOpt, pat, e, _) ->
+        | Pexp_fun
+            {arg_label = lbl; default = defaultExpOpt; lhs = pat; rhs = e} ->
           let oldScope = !scope in
           (match (!processingFun, !currentCtxPath) with
           | None, Some ctxPath -> processingFun := Some (ctxPath, 0)

analysis/src/DumpAst.ml

@@ -213,7 +213,7 @@ and printExprItem expr ~pos ~indentation =
       | None -> ""
       | Some expr -> "," ^ printExprItem expr ~pos ~indentation)
     ^ ")"
-  | Pexp_fun (arg, _maybeDefaultArgExpr, pattern, nextExpr, _) ->
+  | Pexp_fun {arg_label = arg; lhs = pattern; rhs = nextExpr} ->
     "Pexp_fun(\n"
     ^ addIndentation (indentation + 1)
     ^ "arg: "

analysis/src/Hint.ml

@@ -61,7 +61,7 @@ let inlay ~path ~pos ~maxLength ~debug =
            | Pexp_apply _ | Pexp_match _ | Pexp_construct _ | Pexp_ifthenelse _
            | Pexp_array _ | Pexp_ident _ | Pexp_try _ | Pexp_lazy _
            | Pexp_send _ | Pexp_field _ | Pexp_open _
-           | Pexp_fun (_, _, _, _, Some _) );
+           | Pexp_fun {arity = Some _} );
        };
     } ->
       push vb.pvb_pat.ppat_loc Type

analysis/src/Xform.ml

@@ -261,7 +261,7 @@ module AddBracesToFn = struct
         | _ -> false
       in
       (match e.pexp_desc with
-      | Pexp_fun (_, _, _, bodyExpr, _)
+      | Pexp_fun {rhs = bodyExpr}
         when Loc.hasPos ~pos bodyExpr.pexp_loc
              && isBracedExpr bodyExpr = false
              && isFunction bodyExpr = false ->
@@ -303,9 +303,9 @@ module AddTypeAnnotation = struct
     in
     let rec processFunction ~argNum (e : Parsetree.expression) =
       match e.pexp_desc with
-      | Pexp_fun (argLabel, _, pat, e, _) ->
+      | Pexp_fun {arg_label; lhs = pat; rhs = e} ->
         let isUnlabeledOnlyArg =
-          argNum = 1 && argLabel = Nolabel
+          argNum = 1 && arg_label = Nolabel
           &&
           match e.pexp_desc with
           | Pexp_fun _ -> false

compiler/frontend/ast_compatible.ml

@@ -68,7 +68,9 @@ let fun_ ?(loc = default_loc) ?(attrs = []) ~arity pat exp =
   {
     pexp_loc = loc;
     pexp_attributes = attrs;
-    pexp_desc = Pexp_fun (Nolabel, None, pat, exp, arity);
+    pexp_desc =
+      Pexp_fun
+        {arg_label = Nolabel; default = None; lhs = pat; rhs = exp; arity};
   }
 
 let const_exp_string ?(loc = default_loc) ?(attrs = []) ?delimiter (s : string)

compiler/frontend/ast_pat.ml

@@ -35,7 +35,7 @@ let is_unit_cont ~yes ~no (p : t) =
 let arity_of_fun (pat : Parsetree.pattern) (e : Parsetree.expression) =
   let rec aux (e : Parsetree.expression) =
     match e.pexp_desc with
-    | Pexp_fun (_, _, _, e, _) -> 1 + aux e (*FIXME error on optional*)
+    | Pexp_fun {rhs = e} -> 1 + aux e (*FIXME error on optional*)
     (* | Pexp_fun _
        -> Location.raise_errorf
            ~loc:e.pexp_loc "Label is not allowed in JS object" *)
@@ -45,7 +45,7 @@ let arity_of_fun (pat : Parsetree.pattern) (e : Parsetree.expression) =
 
 let rec labels_of_fun (e : Parsetree.expression) =
   match e.pexp_desc with
-  | Pexp_fun (l, _, _, e, _) -> l :: labels_of_fun e
+  | Pexp_fun {arg_label = l; rhs = e} -> l :: labels_of_fun e
   | _ -> []
 
 let rec is_single_variable_pattern_conservative (p : t) =

compiler/frontend/ast_uncurry_gen.ml

@@ -36,7 +36,7 @@ let to_method_callback loc (self : Bs_ast_mapper.mapper) label
     match Ast_attributes.process_attributes_rev body.pexp_attributes with
     | Nothing, attrs -> (
       match body.pexp_desc with
-      | Pexp_fun (arg_label, _, arg, body, _) ->
+      | Pexp_fun {arg_label; lhs = arg; rhs = body} ->
         Bs_syntaxerr.optional_err loc arg_label;
         aux ((arg_label, self.pat self arg, attrs) :: acc) body
       | _ -> (self.expr self body, acc))

compiler/frontend/bs_ast_mapper.ml

@@ -315,7 +315,7 @@ module E = struct
            sub vbs)
         (sub.expr sub e)
     (* #end *)
-    | Pexp_fun (lab, def, p, e, arity) ->
+    | Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity} ->
       fun_ ~loc ~attrs ~arity lab
         (map_opt (sub.expr sub) def)
         (sub.pat sub p) (sub.expr sub e)

compiler/frontend/bs_builtin_ppx.ml

@@ -115,7 +115,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
     let body = Ast_async.add_async_attribute ~async body in
     let res = self.expr self body in
     {e with pexp_desc = Pexp_newtype (s, res)}
-  | Pexp_fun (label, _, pat, body, _arity) -> (
+  | Pexp_fun {arg_label = label; lhs = pat; rhs = body} -> (
     let async = Ast_attributes.has_async_payload e.pexp_attributes <> None in
     match Ast_attributes.process_attributes_rev e.pexp_attributes with
     | Nothing, _ ->
@@ -579,7 +579,7 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
             | Pexp_ifthenelse (_, then_expr, Some else_expr) ->
               aux then_expr @ aux else_expr
             | Pexp_construct (_, Some expr) -> aux expr
-            | Pexp_fun (_, _, _, expr, _) | Pexp_newtype (_, expr) -> aux expr
+            | Pexp_fun {rhs = expr} | Pexp_newtype (_, expr) -> aux expr
             | _ -> acc
           in
           aux pvb_expr @ spelunk_vbs acc tl

compiler/ml/ast_async.ml

@@ -40,14 +40,14 @@ let add_async_attribute ~async (body : Parsetree.expression) =
 
 let rec add_promise_to_result ~loc (e : Parsetree.expression) =
   match e.pexp_desc with
-  | Pexp_fun (label, eo, pat, body, arity) ->
-    let body = add_promise_to_result ~loc body in
-    {e with pexp_desc = Pexp_fun (label, eo, pat, body, arity)}
+  | Pexp_fun f ->
+    let rhs = add_promise_to_result ~loc f.rhs in
+    {e with pexp_desc = Pexp_fun {f with rhs}}
   | _ -> add_promise_type ~loc ~async:true e
 
 let make_function_async ~async (e : Parsetree.expression) =
   if async then
     match e.pexp_desc with
-    | Pexp_fun (_, _, {ppat_loc}, _, _) -> add_promise_to_result ~loc:ppat_loc e
+    | Pexp_fun {lhs = {ppat_loc}} -> add_promise_to_result ~loc:ppat_loc e
     | _ -> assert false
   else e

compiler/ml/ast_helper.ml

@@ -152,7 +152,8 @@ module Exp = struct
   let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
   let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
   let fun_ ?loc ?attrs ~arity a b c d =
-    mk ?loc ?attrs (Pexp_fun (a, b, c, d, arity))
+    mk ?loc ?attrs
+      (Pexp_fun {arg_label = a; default = b; lhs = c; rhs = d; arity})
   let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b))
   let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))
   let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b))

compiler/ml/ast_iterator.ml

@@ -282,7 +282,7 @@ module E = struct
     | Pexp_let (_r, vbs, e) ->
       List.iter (sub.value_binding sub) vbs;
       sub.expr sub e
-    | Pexp_fun (_lab, def, p, e, _) ->
+    | Pexp_fun {default = def; lhs = p; rhs = e} ->
       iter_opt (sub.expr sub) def;
       sub.pat sub p;
       sub.expr sub e

compiler/ml/ast_mapper.ml

@@ -278,7 +278,7 @@ module E = struct
     | Pexp_constant x -> constant ~loc ~attrs x
     | Pexp_let (r, vbs, e) ->
       let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
-    | Pexp_fun (lab, def, p, e, arity) ->
+    | Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity} ->
       fun_ ~loc ~attrs ~arity lab
         (map_opt (sub.expr sub) def)
         (sub.pat sub p) (sub.expr sub e)

compiler/ml/ast_mapper_from0.ml

@@ -338,9 +338,9 @@ module E = struct
           | [] -> assert false
         in
         match arg1 with
-        | Some ({pexp_desc = Pexp_fun (l, eo, p, e, _)} as e1) ->
-          let arity = attributes_to_arity attrs in
-          {e1 with pexp_desc = Pexp_fun (l, eo, p, e, Some arity)}
+        | Some ({pexp_desc = Pexp_fun f} as e1) ->
+          let arity = Some (attributes_to_arity attrs) in
+          {e1 with pexp_desc = Pexp_fun {f with arity}}
         | _ -> exp1)
       | _ -> exp1)
     | Pexp_variant (lab, eo) ->

compiler/ml/ast_mapper_to0.ml

@@ -295,7 +295,7 @@ module E = struct
     | Pexp_constant x -> constant ~loc ~attrs (map_constant x)
     | Pexp_let (r, vbs, e) ->
       let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
-    | Pexp_fun (lab, def, p, e, arity) -> (
+    | Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity} -> (
       let e =
         fun_ ~loc ~attrs lab
           (map_opt (sub.expr sub) def)

compiler/ml/ast_uncurried.ml

@@ -9,18 +9,18 @@ let uncurried_type ~arity (t_arg : Parsetree.core_type) =
 let uncurried_fun ~arity fun_expr =
   let fun_expr =
     match fun_expr.Parsetree.pexp_desc with
-    | Pexp_fun (l, eo, p, e, _) ->
-      {fun_expr with pexp_desc = Pexp_fun (l, eo, p, e, Some arity)}
+    | Pexp_fun f ->
+      {fun_expr with pexp_desc = Pexp_fun {f with arity = Some arity}}
     | _ -> assert false
   in
   fun_expr
 
 let expr_is_uncurried_fun (expr : Parsetree.expression) =
   match expr.pexp_desc with
-  | Pexp_fun (_, _, _, _, Some _) -> true
+  | Pexp_fun {arity = Some _} -> true
   | _ -> false
 
 let expr_extract_uncurried_fun (expr : Parsetree.expression) =
   match expr.pexp_desc with
-  | Pexp_fun (_, _, _, _, Some _) -> expr
+  | Pexp_fun {arity = Some _} -> expr
   | _ -> assert false

compiler/ml/depend.ml

@@ -218,7 +218,7 @@ let rec add_expr bv exp =
   | Pexp_let (rf, pel, e) ->
     let bv = add_bindings rf bv pel in
     add_expr bv e
-  | Pexp_fun (_, opte, p, e, _) ->
+  | Pexp_fun {default = opte; lhs = p; rhs = e} ->
     add_opt add_expr bv opte;
     add_expr (add_pattern bv p) e
   | Pexp_apply (e, el) ->

compiler/ml/parsetree.ml

@@ -224,7 +224,13 @@ and expression_desc =
     (* let P1 = E1 and ... and Pn = EN in E       (flag = Nonrecursive)
        let rec P1 = E1 and ... and Pn = EN in E   (flag = Recursive)
     *)
-  | Pexp_fun of arg_label * expression option * pattern * expression * arity
+  | Pexp_fun of {
+      arg_label: arg_label;
+      default: expression option;
+      lhs: pattern;
+      rhs: expression;
+      arity: arity;
+    }
     (* fun P -> E1                          (Simple, None)
        fun ~l:P -> E1                       (Labelled l, None)
        fun ?l:P -> E1                       (Optional l, None)

compiler/ml/pprintast.ml

@@ -543,7 +543,7 @@ and expression ctxt f x =
     | Pexp_let _ | Pexp_letmodule _ | Pexp_open _ | Pexp_letexception _
         when ctxt.semi ->
         paren true (expression reset_ctxt) f x
-    | Pexp_fun (l, e0, p, e, arity) ->
+    | Pexp_fun {arg_label=l; default= e0; lhs= p; rhs= e; arity} ->
         let arity_str = match arity with
           | None -> ""
           | Some arity -> "[arity:" ^ string_of_int arity ^ "]"
@@ -951,7 +951,7 @@ and binding ctxt f {pvb_pat=p; pvb_expr=x; _} =
   let rec pp_print_pexp_function f x =
     if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
     else match x.pexp_desc with
-      | Pexp_fun (label, eo, p, e, arity) ->
+      | Pexp_fun {arg_label=label; default= eo; lhs= p; rhs= e; arity} ->
           let arity_str = match arity with
             | None -> ""
             | Some arity -> "[arity:" ^ string_of_int arity ^ "]"

compiler/ml/printast.ml

@@ -238,7 +238,7 @@ and expression i ppf x =
     line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
     list i value_binding ppf l;
     expression i ppf e
-  | Pexp_fun (l, eo, p, e, arity) ->
+  | Pexp_fun {arg_label = l; default = eo; lhs = p; rhs = e; arity} ->
     line i ppf "Pexp_fun\n";
     let () =
       match arity with

compiler/ml/typecore.ml

@@ -136,7 +136,7 @@ let iter_expression f e =
     | Pexp_extension _ (* we don't iterate under extension point *)
     | Pexp_ident _ | Pexp_new _ | Pexp_constant _ ->
       ()
-    | Pexp_fun (_, eo, _, e, _) ->
+    | Pexp_fun {default = eo; rhs = e} ->
       may expr eo;
       expr e
     | Pexp_apply (e, lel) ->
@@ -1905,7 +1905,7 @@ let rec approx_type env sty =
 let rec type_approx env sexp =
   match sexp.pexp_desc with
   | Pexp_let (_, _, e) -> type_approx env e
-  | Pexp_fun (p, _, _, e, arity) ->
+  | Pexp_fun {arg_label = p; rhs = e; arity} ->
     let ty = if is_optional p then type_option (newvar ()) else newvar () in
     newty (Tarrow (p, ty, type_approx env e, Cok, arity))
   | Pexp_match (_, {pc_rhs = e} :: _) -> type_approx env e
@@ -2363,7 +2363,8 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp
         exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
-  | Pexp_fun (l, Some default, spat, sbody, arity) ->
+  | Pexp_fun
+      {arg_label = l; default = Some default; lhs = spat; rhs = sbody; arity} ->
     assert (is_optional l);
     (* default allowed only with optional argument *)
     let open Ast_helper in
@@ -2403,7 +2404,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp
     in
     type_function ?in_function ~arity loc sexp.pexp_attributes env ty_expected l
       [Exp.case pat body]
-  | Pexp_fun (l, None, spat, sbody, arity) ->
+  | Pexp_fun {arg_label = l; default = None; lhs = spat; rhs = sbody; arity} ->
     type_function ?in_function ~arity loc sexp.pexp_attributes env ty_expected l
       [Ast_helper.Exp.case spat sbody]
   | Pexp_apply (sfunct, sargs) ->