Use inline record for Texp_apply.

cristianoc · cristianoc · commit 6d21f0c27f44 · 2025-01-10T14:39:45.000+01:00
diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml
@@ -534,7 +534,7 @@ module FindFunctionsCalled = struct
     let super = Tast_mapper.default in
     let expr (self : Tast_mapper.mapper) (e : Typedtree.expression) =
       (match e.exp_desc with
-      | Texp_apply ({exp_desc = Texp_ident (callee, _, _)}, _args) ->
+      | Texp_apply {funct = {exp_desc = Texp_ident (callee, _, _)}} ->
         let functionName = Path.name callee in
         callees := !callees |> StringSet.add functionName
       | _ -> ());
@@ -577,7 +577,10 @@ module ExtendFunctionTable = struct
         } ->
       Some (path, loc)
     | Some
-        {exp_desc = Texp_apply ({exp_desc = Texp_ident (path, {loc}, _)}, args)}
+        {
+          exp_desc =
+            Texp_apply {funct = {exp_desc = Texp_ident (path, {loc}, _)}; args};
+        }
       when kindOpt <> None ->
       let checkArg ((argLabel : Asttypes.arg_label), _argOpt) =
         match (argLabel, kindOpt) with
@@ -617,7 +620,7 @@ module ExtendFunctionTable = struct
                             calls a progress function"
                            functionName printPos id_pos;
                      })))
-      | Texp_apply ({exp_desc = Texp_ident (callee, _, _)}, args)
+      | Texp_apply {funct = {exp_desc = Texp_ident (callee, _, _)}; args}
         when callee |> FunctionTable.isInFunctionInTable ~functionTable ->
         let functionName = Path.name callee in
         args
@@ -665,7 +668,8 @@ module CheckExpressionWellFormed = struct
       | Texp_ident (path, {loc}, _) ->
         checkIdent ~path ~loc;
         e
-      | Texp_apply ({exp_desc = Texp_ident (functionPath, _, _)}, args) ->
+      | Texp_apply {funct = {exp_desc = Texp_ident (functionPath, _, _)}; args}
+        ->
         let functionName = Path.name functionPath in
         args
         |> List.iter (fun ((argLabel : Asttypes.arg_label), argOpt) ->
@@ -739,8 +743,10 @@ module Compile = struct
     match expr.exp_desc with
     | Texp_ident _ -> Command.nothing
     | Texp_apply
-        (({exp_desc = Texp_ident (calleeToRename, l, vd)} as expr), argsToExtend)
-      -> (
+        {
+          funct = {exp_desc = Texp_ident (calleeToRename, l, vd)} as expr;
+          args = argsToExtend;
+        } -> (
       let callee, args =
         match
           Hashtbl.find_opt ctx.innerRecursiveFunctions
@@ -844,7 +850,8 @@ module Compile = struct
              and create a function call with the appropriate arguments *)
           assert false
         | None -> expr |> expression ~ctx |> evalArgs ~args ~ctx)
-    | Texp_apply (expr, args) -> expr |> expression ~ctx |> evalArgs ~args ~ctx
+    | Texp_apply {funct = expr; args} ->
+      expr |> expression ~ctx |> evalArgs ~args ~ctx
     | Texp_let
         ( Recursive,
           [{vb_pat = {pat_desc = Tpat_var (id, _); pat_loc}; vb_expr}],
diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml
@@ -126,13 +126,16 @@ let rec collectExpr super self (e : Typedtree.expression) =
       ValueReferences.add locTo.loc_start Location.none.loc_start)
     else addValueReference ~addFileReference:true ~locFrom ~locTo
   | Texp_apply
-      ( {
-          exp_desc =
-            Texp_ident
-              (path, _, {Types.val_loc = {loc_ghost = false; _} as locTo});
-          exp_type;
-        },
-        args ) ->
+      {
+        funct =
+          {
+            exp_desc =
+              Texp_ident
+                (path, _, {Types.val_loc = {loc_ghost = false; _} as locTo});
+            exp_type;
+          };
+        args;
+      } ->
     args
     |> processOptionalArgs ~expType:exp_type
          ~locFrom:(locFrom : Location.t)
@@ -163,7 +166,10 @@ let rec collectExpr super self (e : Typedtree.expression) =
                       {
                         exp_desc =
                           Texp_apply
-                            ({exp_desc = Texp_ident (idArg2, _, _)}, args);
+                            {
+                              funct = {exp_desc = Texp_ident (idArg2, _, _)};
+                              args;
+                            };
                       };
                   };
               };
diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml
@@ -294,24 +294,28 @@ let traverseAst () =
         }
         :: !currentEvents
     | Texp_apply
-        ( {exp_desc = Texp_ident (atat, _, _)},
-          [(_lbl1, Some {exp_desc = Texp_ident (callee, _, _)}); arg] )
+        {
+          funct = {exp_desc = Texp_ident (atat, _, _)};
+          args = [(_lbl1, Some {exp_desc = Texp_ident (callee, _, _)}); arg];
+        }
       when (* raise @@ Exn(...) *)
            atat |> Path.name = "Pervasives.@@" && callee |> Path.name |> isRaise
       ->
       let exceptions = [arg] |> raiseArgs in
       currentEvents := {Event.exceptions; loc; kind = Raises} :: !currentEvents;
       arg |> snd |> iterExprOpt self
     | Texp_apply
-        ( {exp_desc = Texp_ident (atat, _, _)},
-          [arg; (_lbl1, Some {exp_desc = Texp_ident (callee, _, _)})] )
+        {
+          funct = {exp_desc = Texp_ident (atat, _, _)};
+          args = [arg; (_lbl1, Some {exp_desc = Texp_ident (callee, _, _)})];
+        }
       when (*  Exn(...) |> raise *)
            atat |> Path.name = "Pervasives.|>" && callee |> Path.name |> isRaise
       ->
       let exceptions = [arg] |> raiseArgs in
       currentEvents := {Event.exceptions; loc; kind = Raises} :: !currentEvents;
       arg |> snd |> iterExprOpt self
-    | Texp_apply (({exp_desc = Texp_ident (callee, _, _)} as e), args) ->
+    | Texp_apply {funct = {exp_desc = Texp_ident (callee, _, _)} as e; args} ->
       let calleeName = Path.name callee in
       if calleeName |> isRaise then
         let exceptions = args |> raiseArgs in
diff --git a/analysis/reanalyze/src/SideEffects.ml b/analysis/reanalyze/src/SideEffects.ml
@@ -26,7 +26,7 @@ let rec exprNoSideEffects (expr : Typedtree.expression) =
   | Texp_ident _ | Texp_constant _ -> true
   | Texp_construct (_, _, el) -> el |> List.for_all exprNoSideEffects
   | Texp_function _ -> true
-  | Texp_apply ({exp_desc = Texp_ident (path, _, _)}, args)
+  | Texp_apply {funct = {exp_desc = Texp_ident (path, _, _)}; args}
     when path |> pathIsWhitelistedForSideEffects ->
     args |> List.for_all (fun (_, eo) -> eo |> exprOptNoSideEffects)
   | Texp_apply _ -> false
diff --git a/compiler/gentype/TranslateStructure.ml b/compiler/gentype/TranslateStructure.ml
@@ -18,8 +18,10 @@ let rec addAnnotationsToTypes_ ~config ~(expr : Typedtree.expression)
       else a_name
     in
     {a_name; a_type} :: next_types1
-  | Texp_apply ({exp_desc = Texp_ident (path, _, _)}, [(_, Some expr1)]), _, _
-    -> (
+  | ( Texp_apply
+        {funct = {exp_desc = Texp_ident (path, _, _)}; args = [(_, Some expr1)]},
+      _,
+      _ ) -> (
     match path |> TranslateTypeExprFromTypes.path_to_list |> List.rev with
     | ["Js"; "Internal"; fn_mk]
       when (* Uncurried function definition uses Js.Internal.fn_mkX(...) *)
diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml
@@ -295,7 +295,7 @@ and expression i ppf x =
     line i ppf "%a" Ident.print param;
     arg_label i ppf p;
     case i ppf case_
-  | Texp_apply (e, l) ->
+  | Texp_apply {funct = e; args = l} ->
     line i ppf "Texp_apply\n";
     expression i ppf e;
     list i label_x_expression ppf l
diff --git a/compiler/ml/rec_check.ml b/compiler/ml/rec_check.ml
@@ -201,7 +201,8 @@ let rec classify_expression : Typedtree.expression -> sd =
   | Texp_pack _ | Texp_function _ | Texp_lazy _ | Texp_extension_constructor _
     ->
     Static
-  | Texp_apply ({exp_desc = Texp_ident (_, _, vd)}, _) when is_ref vd -> Static
+  | Texp_apply {funct = {exp_desc = Texp_ident (_, _, vd)}} when is_ref vd ->
+    Static
   | Texp_apply _ | Texp_match _ | Texp_ifthenelse _ | Texp_send _ | Texp_field _
   | Texp_assert _ | Texp_try _ | Texp_override _ ->
     Dynamic
@@ -235,10 +236,11 @@ let rec expression : Env.env -> Typedtree.expression -> Use.t =
   | Texp_constant _ -> Use.empty
   | Texp_new _ -> assert false
   | Texp_instvar _ -> Use.empty
-  | Texp_apply ({exp_desc = Texp_ident (_, _, vd)}, [(_, Some arg)])
+  | Texp_apply
+      {funct = {exp_desc = Texp_ident (_, _, vd)}; args = [(_, Some arg)]}
     when is_ref vd ->
     Use.guard (expression env arg)
-  | Texp_apply (e, args) ->
+  | Texp_apply {funct = e; args} ->
     let arg env (_, eo) = option expression env eo in
     Use.(join (inspect (expression env e)) (inspect (list arg env args)))
   | Texp_tuple exprs -> Use.guard (list expression env exprs)
diff --git a/compiler/ml/tast_iterator.ml b/compiler/ml/tast_iterator.ml
@@ -156,7 +156,7 @@ let expr sub {exp_extra; exp_desc; exp_env; _} =
     sub.value_bindings sub (rec_flag, list);
     sub.expr sub exp
   | Texp_function {case; _} -> sub.case sub case
-  | Texp_apply (exp, list) ->
+  | Texp_apply {funct = exp; args = list} ->
     sub.expr sub exp;
     List.iter (fun (_, o) -> Option.iter (sub.expr sub) o) list
   | Texp_match (exp, list1, list2, _) ->
diff --git a/compiler/ml/tast_mapper.ml b/compiler/ml/tast_mapper.ml
@@ -202,9 +202,12 @@ let expr sub x =
     | Texp_function {arg_label; arity; param; case; partial; async} ->
       Texp_function
         {arg_label; arity; param; case = sub.case sub case; partial; async}
-    | Texp_apply (exp, list) ->
+    | Texp_apply {funct = exp; args = list} ->
       Texp_apply
-        (sub.expr sub exp, List.map (tuple2 id (opt (sub.expr sub))) list)
+        {
+          funct = sub.expr sub exp;
+          args = List.map (tuple2 id (opt (sub.expr sub))) list;
+        }
     | Texp_match (exp, cases, exn_cases, p) ->
       Texp_match
         (sub.expr sub exp, sub.cases sub cases, sub.cases sub exn_cases, p)
diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml
@@ -711,11 +711,14 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
           loc )
     | None -> lambda)
   | Texp_apply
-      ( ({
-           exp_desc = Texp_ident (_, _, {val_kind = Val_prim p});
-           exp_type = prim_type;
-         } as funct),
-        oargs )
+      {
+        funct =
+          {
+            exp_desc = Texp_ident (_, _, {val_kind = Val_prim p});
+            exp_type = prim_type;
+          } as funct;
+        args = oargs;
+      }
     when List.length oargs >= p.prim_arity
          && List.for_all (fun (_, arg) -> arg <> None) oargs -> (
     let args, args' = cut p.prim_arity oargs in
@@ -757,7 +760,7 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
       | Plazyforce, [a] -> wrap (Matching.inline_lazy_force a e.exp_loc)
       | Plazyforce, _ -> assert false
       | _ -> wrap (Lprim (prim, argl, e.exp_loc))))
-  | Texp_apply (funct, oargs) ->
+  | Texp_apply {funct; args = oargs} ->
     let inlined, funct =
       Translattribute.get_and_remove_inlined_attribute funct
     in
diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml
@@ -1799,7 +1799,7 @@ let rec is_nonexpansive exp =
     List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list
     && is_nonexpansive body
   | Texp_function _ -> true
-  | Texp_apply (e, (_, None) :: el) ->
+  | Texp_apply {funct = e; args = (_, None) :: el} ->
     is_nonexpansive e && List.for_all is_nonexpansive_opt (List.map snd el)
   | Texp_match (e, cases, [], _) ->
     is_nonexpansive e
@@ -1834,12 +1834,15 @@ let rec is_nonexpansive exp =
      or the relaxed value restriction. See GPR#1142 *)
   | Texp_assert exp -> is_nonexpansive exp
   | Texp_apply
-      ( {
-          exp_desc =
-            Texp_ident
-              (_, _, {val_kind = Val_prim {Primitive.prim_name = "%raise"}});
-        },
-        [(Nolabel, Some e)] ) ->
+      {
+        funct =
+          {
+            exp_desc =
+              Texp_ident
+                (_, _, {val_kind = Val_prim {Primitive.prim_name = "%raise"}});
+          };
+        args = [(Nolabel, Some e)];
+      } ->
     is_nonexpansive e
   | _ -> false
 
@@ -2443,7 +2446,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp
     let mk_apply funct args =
       rue
         {
-          exp_desc = Texp_apply (funct, args);
+          exp_desc = Texp_apply {funct; args};
           exp_loc = loc;
           exp_extra = [];
           exp_type = ty_res;
diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml
@@ -84,7 +84,10 @@ and expression_desc =
       partial: partial;
       async: bool;
     }
-  | Texp_apply of expression * (arg_label * expression option) list
+  | Texp_apply of {
+      funct: expression;
+      args: (arg_label * expression option) list;
+    }
   | Texp_match of expression * case list * case list * partial
   | Texp_try of expression * case list
   | Texp_tuple of expression list
diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli
@@ -148,7 +148,10 @@ and expression_desc =
               [Partial] if the pattern match is partial
               [Total] otherwise.
          *)
-  | Texp_apply of expression * (arg_label * expression option) list
+  | Texp_apply of {
+      funct: expression;
+      args: (arg_label * expression option) list;
+    }
       (** E0 ~l1:E1 ... ~ln:En
 
             The expression can be None if the expression is abstracted over
diff --git a/compiler/ml/typedtreeIter.ml b/compiler/ml/typedtreeIter.ml
@@ -231,7 +231,7 @@ end = struct
       iter_bindings rec_flag list;
       iter_expression exp
     | Texp_function {case; _} -> iter_case case
-    | Texp_apply (exp, list) ->
+    | Texp_apply {funct = exp; args = list} ->
       iter_expression exp;
       List.iter
         (fun (_label, expo) ->
