make the formating of map li begin fun the same as map li ( fun.

Author: EmileTrotignon

lib/Fmt_ast.ml

@@ -1496,7 +1496,7 @@ and fmt_indexop_access c ctx ~fmt_atrs ~has_attr ~parens x =
     responsible for breaking. *)
 and fmt_function ?(last_arg = false) ?force_closing_paren ~ctx ~ctx0 ?pro
     ~wrap_intro ?box:(should_box = true) ~label ?(parens = false) ?ext ~attrs
-    ~loc c (args, typ, body) =
+    ~loc ?(epi = noop) c (args, typ, body) =
   let should_box =
     should_box
     ||
@@ -1649,10 +1649,10 @@ and fmt_function ?(last_arg = false) ?force_closing_paren ~ctx ~ctx0 ?pro
         $ hvbox_if has_cmts_outer 0
             ( cmts_outer
             $ Params.Exp.box_fun_decl ~ctx0 c.conf
-                ( pro_inner $ fmt_label label label_sep $ cmts_inner
+                ( fmt_label label label_sep $ pro_inner $ cmts_inner
                 $ opn_paren $ head ) ) )
     in
-    body ~pro $ cls_paren
+    body ~pro $ epi $ cls_paren
   in
   let box k = if should_box then box k else k in
   box (disambiguate_parens_wrap body) $ Cmts.fmt_after c loc
@@ -2188,78 +2188,9 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
              ( fmt_str_loc c op $ fmt_if has_cmts cut_break
              $ fmt_expression c ~box (sub_exp ~ctx e)
              $ fmt_atrs ) )
-  | Pexp_apply (e0, e1N1) -> (
-      let wrap =
-        if c.conf.fmt_opts.wrap_fun_args.v then hovbox 2 else hvbox 2
-      in
-      let (lbl, last_arg), args_before =
-        match List.rev e1N1 with
-        | [] -> assert false
-        | hd :: tl -> (hd, List.rev tl)
-      in
-      let intro_epi, expr_epi =
-        (* [intro_epi] should be placed inside the inner most box but before
-           anything. [expr_epi] is placed in the outermost box, outside of
-           parenthesis. *)
-        let dock_fun_arg =
-          (* Do not dock the arguments when there's more than one. *)
-          (not c.conf.fmt_opts.ocp_indent_compat.v)
-          || Location.line_difference e0.pexp_loc last_arg.pexp_loc = 0
-        in
-        if parens || not dock_fun_arg then (noop, pro) else (pro, noop)
-      in
-      match last_arg.pexp_desc with
-      | Pexp_function (largs, ltyp, lbody)
-        when List.for_all args_before ~f:(fun (_, eI) ->
-                 is_simple c.conf (fun _ -> 0) (sub_exp ~ctx eI) ) ->
-          let inner_ctx = Exp last_arg in
-          let inner_parens, outer_parens =
-            (* Don't disambiguate parentheses in some cases, also affect
-               indentation. *)
-            match lbody with
-            | Pfunction_cases _ when not c.conf.fmt_opts.ocp_indent_compat.v
-              ->
-                (parens, false)
-            | _ -> (false, parens)
-          in
-          let args =
-            let wrap_intro x =
-              fmt_if inner_parens (str "(")
-              $ hvbox 0
-                  ( intro_epi
-                  $ wrap
-                      ( fmt_args_grouped e0 args_before
-                      $ break 1 0 $ hvbox 0 x ) )
-              $ break 1 0
-            in
-            let force_closing_paren =
-              if Location.is_single_line pexp_loc c.conf.fmt_opts.margin.v
-              then Fit
-              else Break
-            in
-            fmt_function ~last_arg:true ~force_closing_paren ~ctx:inner_ctx
-              ~ctx0:ctx ~wrap_intro ~label:lbl ~parens:true
-              ~attrs:last_arg.pexp_attributes ~loc:last_arg.pexp_loc c
-              (largs, ltyp, lbody)
-          in
-          hvbox_if has_attr 0
-            ( expr_epi
-            $ Params.parens_if outer_parens c.conf
-                (args $ fmt_atrs $ fmt_if inner_parens (str ")")) )
-      | _ ->
-          let fmt_atrs =
-            fmt_attributes c ~pre:(Break (1, -2)) pexp_attributes
-          in
-          let force =
-            if Location.is_single_line pexp_loc c.conf.fmt_opts.margin.v then
-              Fit
-            else Break
-          in
-          pro
-          $ fmt_if parens (str "(")
-          $ hvbox 2
-              ( fmt_args_grouped ~epi:fmt_atrs e0 e1N1
-              $ fmt_if parens (closing_paren c ~force ~offset:(-3)) ) )
+  | Pexp_apply (e0, e1N1) ->
+      fmt_apply c ~e1N1 ~parens ~pro ~ctx ~e0 ~pexp_loc ~pexp_attributes
+        ~has_attr ~fmt_atrs ~fmt_args_grouped
   | Pexp_array [] ->
       pro
       $ hvbox 0
@@ -2927,6 +2858,102 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
              (sub_exp ~ctx e) )
       $ fmt_atrs
 
+and fmt_apply c ~e1N1 ~parens ~pro ~ctx ~e0 ~pexp_loc ~pexp_attributes
+    ~has_attr ~fmt_atrs ~fmt_args_grouped =
+  let wrap = if c.conf.fmt_opts.wrap_fun_args.v then hovbox 2 else hvbox 2 in
+  let (lbl, last_arg), args_before =
+    match List.rev e1N1 with
+    | [] -> assert false
+    | hd :: tl -> (hd, List.rev tl)
+  in
+  let intro_epi, expr_epi =
+    (* [intro_epi] should be placed inside the inner most box but before
+       anything. [expr_epi] is placed in the outermost box, outside of
+       parenthesis. *)
+    let dock_fun_arg =
+      (* Do not dock the arguments when there's more than one. *)
+      (not c.conf.fmt_opts.ocp_indent_compat.v)
+      || Location.line_difference e0.pexp_loc last_arg.pexp_loc = 0
+    in
+    if parens || not dock_fun_arg then (noop, pro) else (pro, noop)
+  in
+  match last_arg.pexp_desc with
+  | Pexp_function (largs, ltyp, lbody)
+    when List.for_all args_before ~f:(fun (_, eI) ->
+             is_simple c.conf (fun _ -> 0) (sub_exp ~ctx eI) ) ->
+      fmt_apply_last_arg_function c ~last_arg ~lbody ~parens ~intro_epi
+        ~pexp_loc ~lbl ~ctx ~largs ~has_attr ~expr_epi ~fmt_atrs ~ltyp ~e0
+        ~fmt_args_grouped ~args_before ~wrap ~beginend:None
+  | Pexp_beginend
+      ( { pexp_desc= Pexp_function (largs, ltyp, lbody)
+        ; pexp_attributes= attrs_beginend
+        ; _ } as e_func ) ->
+      fmt_apply_last_arg_function c ~last_arg ~lbody ~parens ~intro_epi
+        ~pexp_loc ~lbl ~ctx ~largs ~has_attr ~expr_epi ~fmt_atrs ~ltyp ~e0
+        ~fmt_args_grouped ~args_before ~wrap
+        ~beginend:(Some (attrs_beginend, Exp e_func))
+  | _ ->
+      let fmt_atrs = fmt_attributes c ~pre:(Break (1, -2)) pexp_attributes in
+      let force =
+        if Location.is_single_line pexp_loc c.conf.fmt_opts.margin.v then Fit
+        else Break
+      in
+      pro
+      $ fmt_if parens (str "(")
+      $ hvbox 2
+          ( fmt_args_grouped ~epi:fmt_atrs e0 e1N1
+          $ fmt_if parens (closing_paren c ~force ~offset:(-3)) )
+
+and fmt_apply_last_arg_function c ~last_arg ~lbody ~parens ~intro_epi
+    ~pexp_loc ~lbl ~ctx ~largs ~has_attr ~expr_epi ~fmt_atrs ~ltyp ~e0
+    ~fmt_args_grouped ~args_before ~wrap ~beginend =
+  let has_beginend = Option.is_some beginend in
+  let inner_ctx = Exp last_arg in
+  let inner_parens, outer_parens =
+    (* Don't disambiguate parentheses in some cases, also affect
+       indentation. *)
+    match lbody with
+    | Pfunction_cases _
+      when (not c.conf.fmt_opts.ocp_indent_compat.v) && not has_beginend ->
+        (parens, false)
+    | _ -> (false, parens)
+  in
+  let args =
+    let wrap_intro x =
+      fmt_if inner_parens (str "(")
+      $ hvbox 0
+          ( intro_epi
+          $ wrap (fmt_args_grouped e0 args_before $ break 1 0 $ hvbox 0 x) )
+      $ break 1 0
+    in
+    let force_closing_paren =
+      if Location.is_single_line pexp_loc c.conf.fmt_opts.margin.v then Fit
+      else Break
+    in
+    let break_end =
+      let indent =
+        match (largs, lbody) with [], Pfunction_cases _ -> 0 | _ -> -2
+      in
+      break 1000 indent
+    in
+    let pro, inner_ctx, end_ =
+      match beginend with
+      | None -> (noop, inner_ctx, noop)
+      | Some (attrs, inner_ctx) ->
+          let fmt_atrs = fmt_attributes c ~pre:Space attrs in
+          (str "begin" $ fmt_atrs $ str " ", inner_ctx, break_end $ str "end")
+    in
+    (* bookmark *)
+    fmt_function ~pro ~last_arg:true ~force_closing_paren ~ctx:inner_ctx
+      ~ctx0:ctx ~wrap_intro ~label:lbl ~parens:(not has_beginend)
+      ~attrs:last_arg.pexp_attributes ~loc:last_arg.pexp_loc c ~epi:end_
+      (largs, ltyp, lbody)
+  in
+  hvbox_if has_attr 0
+    ( expr_epi
+    $ Params.parens_if outer_parens c.conf
+        (args $ fmt_atrs $ fmt_if inner_parens (str ")")) )
+
 and fmt_lazy c ~ctx ?(pro = noop) ~fmt_atrs ~ext ~parens e =
   let lazy_ = str "lazy" $ fmt_extension_suffix c ext in
   let kw_outer, kw_inner =

lib/Params.ml

@@ -39,17 +39,33 @@ let ctx_is_rhs_of_infix ~ctx0 ~ctx =
       true
   | _ -> false
 
+type ctx_is_apply_and_exp_is_arg_ret =
+  {label: arg_label; exp: expression; is_last: bool; is_modulo_beginend: bool}
+
 (** Return [None] if [ctx0] is not an application or [ctx] is not one of its
     argument. *)
 let ctx_is_apply_and_exp_is_arg ~ctx ctx0 =
   match (ctx, ctx0) with
   | Exp exp, Exp {pexp_desc= Pexp_apply (_, args); _} ->
       let last_lbl, last_arg = List.last_exn args in
-      if phys_equal last_arg exp then Some (last_lbl, exp, true)
+      let last_arg, is_modulo_beginend =
+        match last_arg.pexp_desc with
+        | Pexp_beginend last_arg -> (last_arg, true)
+        | _ -> (last_arg, false)
+      in
+      if phys_equal last_arg exp then
+        Some {label= last_lbl; exp; is_last= true; is_modulo_beginend}
       else
         List.find_map
-          ~f:(fun (lbl, x) ->
-            if phys_equal x exp then Some (lbl, exp, false) else None )
+          ~f:(fun (label, arg) ->
+            let arg, is_modulo_beginend =
+              match arg.pexp_desc with
+              | Pexp_beginend arg -> (arg, true)
+              | _ -> (arg, false)
+            in
+            if phys_equal arg exp then
+              Some {label; exp; is_last= false; is_modulo_beginend}
+            else None )
           args
   | _ -> None
 
@@ -70,6 +86,11 @@ let ctx_is_apply_and_exp_is_last_arg_and_other_args_are_simple c ~ctx ctx0 =
         List.for_all args_before ~f:(fun (_, eI) ->
             is_simple c (fun _ -> 0) (sub_exp ~ctx:ctx0 eI) )
       in
+      let last_arg =
+        match last_arg.pexp_desc with
+        | Pexp_beginend last_arg -> last_arg
+        | _ -> last_arg
+      in
       Poly.equal last_arg exp && args_are_simple
   | _ -> false
 
@@ -159,7 +180,7 @@ module Exp = struct
   let break_fun_kw c ~ctx ~ctx0 ~last_arg =
     let is_labelled_arg =
       match ctx_is_apply_and_exp_is_arg ~ctx ctx0 with
-      | Some ((Labelled _ | Optional _), _, _) -> true
+      | Some {label= Labelled _ | Optional _; _} -> true
       | _ -> false
     in
     if Conf.(c.fmt_opts.ocp_indent_compat.v) then
@@ -183,7 +204,7 @@ module Exp = struct
       if ocp c then
         let is_labelled_arg =
           match ctx_is_apply_and_exp_is_arg ~ctx ctx0 with
-          | Some ((Labelled _ | Optional _), _, _) -> true
+          | Some {label= Labelled _ | Optional _; _} -> true
           | _ -> false
         in
         if is_labelled_arg then (Fn.id, true)
@@ -195,12 +216,14 @@ module Exp = struct
           if is_let_func then if kw_in_box then hovbox ~name 4 else Fn.id
           else
             match ctx_is_apply_and_exp_is_arg ~ctx ctx0 with
-            | Some (_, _, true) ->
-                (* Is last arg. *) hvbox ~name (if parens then 0 else 2)
-            | Some (Nolabel, _, false) ->
+            | Some {is_last= true; is_modulo_beginend; _} ->
+                (* Is last arg. *)
+                hvbox ~name (if parens || is_modulo_beginend then 0 else 2)
+            | Some {label= Nolabel; is_last= false; _} ->
                 (* TODO: Inconsistent formatting of fun args. *)
                 hovbox ~name 0
-            | Some ((Labelled _ | Optional _), _, false) -> hvbox ~name 0
+            | Some {label= Labelled _ | Optional _; is_last= false; _} ->
+                hvbox ~name 0
             | None -> Fn.id
         in
         (box, not c.fmt_opts.wrap_fun_args.v)
@@ -225,15 +248,20 @@ module Exp = struct
           Source.begins_line ~ignore_spaces:true source loc
         in
         match ctx_is_apply_and_exp_is_arg ~ctx ctx0 with
-        | Some (Nolabel, fun_exp, is_last_arg) ->
-            if begins_line fun_exp.pexp_loc then if is_last_arg then 5 else 3
+        | Some {label= Nolabel; exp= fun_exp; is_last; is_modulo_beginend= _}
+          ->
+            if begins_line fun_exp.pexp_loc then if is_last then 5 else 3
             else 2
-        | Some ((Labelled x | Optional x), fun_exp, is_last_arg) ->
+        | Some
+            { label= Labelled x | Optional x
+            ; exp= fun_exp
+            ; is_last
+            ; is_modulo_beginend= _ } ->
             if begins_line fun_exp.pexp_loc then
               (* The [fun] had to break after the label, nested boxes must be
                  indented less. The last argument is special as the box
                  structure is different. *)
-              if is_last_arg then 4 else 2
+              if is_last then 4 else 2
             else if begins_line x.loc then 4
             else 2
         | None -> if ctx_is_apply_and_exp_is_func ~ctx ctx0 then 3 else 2
@@ -275,7 +303,7 @@ module Exp = struct
 
   let single_line_function ~ctx ~ctx0 ~args =
     match ctx_is_apply_and_exp_is_arg ~ctx ctx0 with
-    | Some (_, _, true) -> List.is_empty args
+    | Some {is_last= true; _} -> List.is_empty args
     | _ -> false
 
   let indent_function (c : Conf.t) ~ctx ~ctx0 ~parens =
@@ -1001,7 +1029,7 @@ module Indent = struct
     | _ when ctx_is_infix ctx0 -> 0
     | _ when ocp c -> (
       match ctx_is_apply_and_exp_is_arg ~ctx ctx0 with
-      | Some (_, _, true) -> (* Last argument *) 2
+      | Some {is_last= true; _} -> (* Last argument *) 2
       | _ -> if parens then 3 else 2 )
     | _ -> 2
 

test/passing/refs.default/attributes.ml.ref

@@ -393,10 +393,8 @@ include [@foo] M [@boo]
 let () =
   let () =
     S.ntyp Cbor_type.Reserved
-    @@ S.tok
-         begin [@warning "-4"] fun ev ->
-           match ev with Cbor_event.Reserved int -> Some int | _ -> None
-         end
+    @@ S.tok (fun [@warning "-4"] ev ->
+           match ev with Cbor_event.Reserved int -> Some int | _ -> None)
   in
   ()
 

test/passing/refs.default/exp_grouping-parens.ml.err

@@ -0,0 +1 @@
+Warning: exp_grouping-parens.ml:577 exceeds the margin