From a8b5ab741245bbbadd1afbfb68e3936bc1bca0f9 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 22 Jul 2024 14:16:35 +0200
Subject: [PATCH] Safer box_fun_expr

---
 lib/Params.ml | 45 +++++++++++++++++++++++++++------------------
 1 file changed, 27 insertions(+), 18 deletions(-)

diff --git a/lib/Params.ml b/lib/Params.ml
index 9e14043678..03a399b6d3 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -26,14 +26,28 @@ let is_labelled_arg args exp =
       | Labelled _, x | Optional _, x -> phys_equal x exp )
     args
 
+(** Whether [exp] occurs in [args] as a labelled argument. *)
+let is_unlabelled_arg args exp =
+  List.exists
+    ~f:(function
+      | Nolabel, x -> phys_equal x exp
+      | Labelled _, _ | Optional _, _ -> false )
+    args
+
 let ctx_is_infix = function
-| Exp { pexp_desc= Pexp_infix ({txt= ":="; _}, _, _); _ } -> false
-    | Exp { pexp_desc= Pexp_infix _; _ } -> true
-    | _ -> false
+  | Exp {pexp_desc= Pexp_infix ({txt= ":="; _}, _, _); _} -> false
+  | Exp {pexp_desc= Pexp_infix _; _} -> true
+  | _ -> false
 
 let ctx_is_apply = function
-    | Exp { pexp_desc= Pexp_apply _; _ } -> true
-    | _ -> false
+  | Exp {pexp_desc= Pexp_apply _; _} -> true
+  | _ -> false
+
+let ctx_is_apply_and_exp_is_arg ~ctx ctx0 =
+  match (ctx, ctx0) with
+  | Exp exp, Exp {pexp_desc= Pexp_apply (_, args); _} ->
+      is_unlabelled_arg args exp
+  | _ -> false
 
 (** [ctx_is_let ~ctx ctx0] checks whether [ctx0] is a let binding containing
     [ctx]. *)
@@ -119,26 +133,21 @@ module Exp = struct
     in
     box_decl (kw $ hvbox_if should_box_args 0 args $ fmt_opt annot)
 
-  let box_fun_expr (c: Conf.t) ~ctx0 ~ctx ~parens:_ ~has_label =
+  let box_fun_expr (c : Conf.t) ~ctx0 ~ctx ~parens:_ ~has_label =
     let indent =
-      if ctx_is_infix ctx0 then (
-        if ocp c && has_label then 2
-        else 0 )
+      if ctx_is_infix ctx0 then if ocp c && has_label then 2 else 0
       else
         match c.fmt_opts.function_indent_nested.v with
         | `Always -> c.fmt_opts.function_indent.v
         | _ ->
             if ctx_is_let ~ctx ctx0 then
-              if c.fmt_opts.let_binding_deindent_fun.v then 1
-              else 0
-            else if ocp c && ctx_is_apply ctx0 && not has_label then 4
-            else if ocp c then 2
-            else
-              4 in
+              if c.fmt_opts.let_binding_deindent_fun.v then 1 else 0
+            else if ocp c then
+              if ctx_is_apply_and_exp_is_arg ~ctx ctx0 then 4 else 2
+            else 4
+    in
     let name = "Params.box_fun_expr" in
-    ( match ctx0 with
-      | Str _ -> hvbox ~name indent
-      | _ -> hovbox ~name indent)
+    match ctx0 with Str _ -> hvbox ~name indent | _ -> hovbox ~name indent
 
   (* if the function is the last argument of an apply and no other arguments
      are "complex" (approximation). *)