Skip to content

Commit 8b981f6

Browse files
EmileTrotignonEmileTrotignon
authored
begin fun x -> now can be printed on a single line (#2664)
 map x begin fun y -> print x; y end is now map x begin fun y -> print x; y end
1 parent 8056fa5 commit 8b981f6

14 files changed

+392
-53
lines changed

‎CHANGES.md

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,8 +33,8 @@ profile. This started with version 0.26.0.
3333

3434
### Changed
3535

36-
- `begin match` can now be printed on the same line, with one less indentation
37-
level for the body of the match. (#2666, @EmileTrotignon)
36+
- `begin match` and `begin fun` can now be printed on the same line, with one less indentation
37+
level for the body of the inner expression. (#2666, @EmileTrotignon)
3838

3939
## 0.27.0
4040

‎lib/Fmt_ast.ml

Lines changed: 22 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -1494,7 +1494,7 @@ and fmt_indexop_access c ctx ~fmt_atrs ~has_attr ~parens x =
14941494

14951495
(** Format a [Pexp_function]. [wrap_intro] wraps up to after the [->] and is
14961496
responsible for breaking. *)
1497-
and fmt_function ?(last_arg = false) ?force_closing_paren ~ctx ~ctx0
1497+
and fmt_function ?(last_arg = false) ?force_closing_paren ~ctx ~ctx0 ?pro
14981498
~wrap_intro ?box:(should_box = true) ~label ?(parens = false) ?ext ~attrs
14991499
~loc c (args, typ, body) =
15001500
let should_box =
@@ -1637,13 +1637,20 @@ and fmt_function ?(last_arg = false) ?force_closing_paren ~ctx ~ctx0
16371637
wrap (fits_breaks "(" "") (fits_breaks ")" "")
16381638
else Fn.id
16391639
in
1640+
let pro_outer, pro_inner =
1641+
let pro = fmt_opt pro in
1642+
if Params.Exp.function_inner_pro ~has_cmts_outer ~ctx0 then (noop, pro)
1643+
else (pro, noop)
1644+
in
16401645
let body =
16411646
let pro =
16421647
wrap_intro
1643-
(hvbox_if has_cmts_outer 0
1644-
( cmts_outer
1645-
$ Params.Exp.box_fun_decl ~ctx0 c.conf
1646-
(fmt_label label label_sep $ cmts_inner $ opn_paren $ head) ) )
1648+
( pro_outer
1649+
$ hvbox_if has_cmts_outer 0
1650+
( cmts_outer
1651+
$ Params.Exp.box_fun_decl ~ctx0 c.conf
1652+
( pro_inner $ fmt_label label label_sep $ cmts_inner
1653+
$ opn_paren $ head ) ) )
16471654
in
16481655
body ~pro $ cls_paren
16491656
in
@@ -1911,17 +1918,17 @@ and fmt_match c ?pro ?eol ~loc ~parens ?ext ctx xexp cs e0 keyword =
19111918
let cmts_before = Cmts.fmt_before c ?eol loc in
19121919
let ctx0 = xexp.ctx in
19131920
let indent = Params.match_indent c.conf ~parens ~ctx:ctx0 in
1914-
let pro_outside_parens, pro_inside_parens =
1921+
let pro_outer, pro_inner =
19151922
let pro = fmt_opt pro in
1916-
if Params.Exp.box_pro_with_match ~ctx0 ~parens then (noop, pro)
1923+
if Params.Exp.match_inner_pro ~ctx0 ~parens then (noop, pro)
19171924
else (pro, noop)
19181925
in
19191926
hvbox indent
1920-
( cmts_before $ pro_outside_parens
1927+
( cmts_before $ pro_outer
19211928
$ Params.Exp.wrap c.conf ~parens ~disambiguate:true
19221929
@@ Params.Align.match_ c.conf ~xexp
19231930
@@ ( hvbox 0
1924-
( hvbox 0 (pro_inside_parens $ keyword)
1931+
( hvbox 0 (pro_inner $ keyword)
19251932
$ fmt_extension_suffix c ext
19261933
$ fmt_attributes c xexp.ast.pexp_attributes
19271934
$ break 1 2
@@ -2358,11 +2365,10 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
23582365
$ cut_break $ str "." $ fmt_longident_loc c lid $ fmt_atrs ) )
23592366
| Pexp_function (args, typ, body) ->
23602367
let wrap_intro intro =
2361-
hovbox ~name:"fmt_expression | Pexp_function" 2 (pro $ intro)
2362-
$ space_break
2368+
hovbox ~name:"fmt_expression | Pexp_function" 2 intro $ space_break
23632369
in
2364-
fmt_function ~wrap_intro ~box ~ctx ~ctx0 ~label:Nolabel ~parens ?ext
2365-
~attrs:pexp_attributes ~loc:pexp_loc c (args, typ, body)
2370+
fmt_function ~pro ~wrap_intro ~box ~ctx ~ctx0 ~label:Nolabel ~parens
2371+
?ext ~attrs:pexp_attributes ~loc:pexp_loc c (args, typ, body)
23662372
| Pexp_ident {txt; loc} ->
23672373
let outer_parens = has_attr && parens in
23682374
pro
@@ -2565,7 +2571,7 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
25652571
&& c.conf.fmt_opts.break_cases.v <> `Vertical ) ->
25662572
let cmts_before = Cmts.fmt_before c ?eol pexp_loc in
25672573
let pro_outer, pro_inner =
2568-
if Params.Exp.box_pro_with_match ~ctx0 ~parens then (noop, pro)
2574+
if Params.Exp.match_inner_pro ~ctx0 ~parens then (noop, pro)
25692575
else (pro, noop)
25702576
in
25712577
(* side effects of Cmts.fmt_before before [fmt_pattern] is important *)
@@ -2921,11 +2927,11 @@ and fmt_beginend c ?(box = true) ?(pro = noop) ~ctx ~fmt_atrs ~ext
29212927
let begin_ = str "begin" $ fmt_extension_suffix c ext $ fmt_atrs
29222928
and end_ = str "end" in
29232929
match e.pexp_desc with
2924-
| Pexp_match _ | Pexp_try _ ->
2930+
| Pexp_match _ | Pexp_try _ | Pexp_function _ ->
29252931
pro
29262932
$ hvbox 0
29272933
( fmt_expression c
2928-
~pro:(begin_ $ break 1 0)
2934+
~pro:(begin_ $ str " ")
29292935
~box ?eol ~parens:false ~indent_wrap (sub_exp ~ctx e)
29302936
$ break 1 0 $ end_ )
29312937
| Pexp_extension

‎lib/Params.ml

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -308,13 +308,26 @@ module Exp = struct
308308
let box_fun_decl ~ctx0 c k =
309309
match ctx0 with
310310
| _ when ocp c -> hvbox 2 k
311+
(* Avoid large indentation for [let _ = function]. *)
312+
| Lb
313+
{pvb_body= Pfunction_body {pexp_desc= Pexp_function ([], _, _); _}; _}
314+
->
315+
hovbox 2 k
311316
| Str _ | Lb _ | Clf _ | Exp {pexp_desc= Pexp_let _; _} -> hovbox 4 k
312317
| _ -> hvbox 2 k
313318

314-
let box_pro_with_match ~ctx0 ~parens =
319+
let match_inner_pro ~ctx0 ~parens =
315320
if parens then false
316321
else
317322
match ctx0 with Exp {pexp_desc= Pexp_infix _; _} -> false | _ -> true
323+
324+
let function_inner_pro ~has_cmts_outer ~ctx0 =
325+
if has_cmts_outer then false
326+
else
327+
match ctx0 with
328+
| Str _ | Lb _ | Exp {pexp_desc= Pexp_ifthenelse _ | Pexp_let _; _} ->
329+
false
330+
| _ -> true
318331
end
319332

320333
module Mod = struct

‎lib/Params.mli

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -81,8 +81,13 @@ module Exp : sig
8181
val box_fun_decl : ctx0:Ast.t -> Conf.t -> Fmt.t -> Fmt.t
8282
(** Box a function decl from the label to the arrow. *)
8383

84-
val box_pro_with_match : ctx0:Ast.t -> parens:bool -> bool
85-
(** whether the [~pro] argument should be in the same box as the [match] keyword. *)
84+
val match_inner_pro : ctx0:Ast.t -> parens:bool -> bool
85+
(** whether the [pro] argument of [fmt_match] should be displayed as an inner
86+
or outer prologue.*)
87+
88+
val function_inner_pro : has_cmts_outer:bool -> ctx0:Ast.t -> bool
89+
(** whether the [pro] argument of [fmt_function] should be displayed as an
90+
inner or outer prologue. *)
8691
end
8792

8893
module Mod : sig

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

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -394,9 +394,8 @@ let () =
394394
let () =
395395
S.ntyp Cbor_type.Reserved
396396
@@ S.tok
397-
begin [@warning "-4"]
398-
fun ev ->
399-
match ev with Cbor_event.Reserved int -> Some int | _ -> None
397+
begin [@warning "-4"] fun ev ->
398+
match ev with Cbor_event.Reserved int -> Some int | _ -> None
400399
end
401400
in
402401
()

‎test/passing/refs.default/exp_grouping-parens.ml.ref

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -348,3 +348,47 @@ let _ =
348348
begin [@foo]
349349
y
350350
end
351+
352+
let v = map x (fun x y z -> y)
353+
354+
let v =
355+
map x (fun x arggggggggggggggggggggggggggggggggggggggggggggggggggggggggggg ->
356+
y)
357+
358+
let v =
359+
map x
360+
(fun x arggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggg ->
361+
y)
362+
363+
let v =
364+
map x
365+
(fun x yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy z ->
366+
print y;
367+
z)
368+
369+
let v =
370+
map x
371+
(fun
372+
x
373+
argggggggggggggggggggggggggggggggggg
374+
gggggggggggggggggggg
375+
ggggggggggggggg
376+
-> y)
377+
378+
let v =
379+
map x
380+
(fun x yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy z ->
381+
print y;
382+
z)
383+
384+
let v =
385+
map x (fun x y z ->
386+
ya f;
387+
a f b)
388+
389+
let v =
390+
map x
391+
[%ext1
392+
fun%ext2 x y z ->
393+
ya f;
394+
a f b]

‎test/passing/refs.default/exp_grouping.ml.ref

Lines changed: 57 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -16,13 +16,12 @@ let () =
1616

1717
let () =
1818
List.iter
19-
begin
20-
fun v ->
21-
(* do a lot of things *)
22-
let a = "a" in
23-
let b = "b" in
24-
let c = "c" in
25-
()
19+
begin fun v ->
20+
(* do a lot of things *)
21+
let a = "a" in
22+
let b = "b" in
23+
let c = "c" in
24+
()
2625
end
2726
values
2827

@@ -406,3 +405,54 @@ let _ =
406405
begin [@foo]
407406
y
408407
end
408+
409+
let v = map x begin fun x y z -> y end
410+
411+
let v =
412+
map x
413+
begin fun x arggggggggggggggggggggggggggggggggggggggggggggggggggggggggggg ->
414+
y
415+
end
416+
417+
let v =
418+
map x
419+
begin fun x
420+
arggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggg
421+
-> y
422+
end
423+
424+
let v =
425+
map x
426+
(fun x yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy z ->
427+
print y;
428+
z)
429+
430+
let v =
431+
map x
432+
begin fun x
433+
argggggggggggggggggggggggggggggggggg
434+
gggggggggggggggggggg
435+
ggggggggggggggg
436+
-> y
437+
end
438+
439+
let v =
440+
map x
441+
(fun x yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy z ->
442+
print y;
443+
z)
444+
445+
let v =
446+
map x
447+
begin fun x y z ->
448+
ya f;
449+
a f b
450+
end
451+
452+
let v =
453+
map x
454+
begin%ext1
455+
fun%ext2 x y z ->
456+
ya f;
457+
a f b
458+
end

‎test/passing/refs.janestreet/attributes.ml.ref

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -444,11 +444,10 @@ let () =
444444
let () =
445445
S.ntyp Cbor_type.Reserved
446446
@@ S.tok
447-
begin [@warning "-4"]
448-
fun ev ->
449-
match ev with
450-
| Cbor_event.Reserved int -> Some int
451-
| _ -> None
447+
begin [@warning "-4"] fun ev ->
448+
match ev with
449+
| Cbor_event.Reserved int -> Some int
450+
| _ -> None
452451
end
453452
in
454453
()

‎test/passing/refs.janestreet/exp_grouping-parens.ml.ref

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -408,3 +408,43 @@ let _ =
408408
y
409409
end
410410
;;
411+
412+
let v = map x (fun x y z -> y)
413+
let v = map x (fun x arggggggggggggggggggggggggggggggggggggggggggggggggggggggggggg -> y)
414+
415+
let v =
416+
map x (fun x arggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggg -> y)
417+
;;
418+
419+
let v =
420+
map x (fun x yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy z ->
421+
print y;
422+
z)
423+
;;
424+
425+
let v =
426+
map
427+
x
428+
(fun x argggggggggggggggggggggggggggggggggg gggggggggggggggggggg ggggggggggggggg -> y)
429+
;;
430+
431+
let v =
432+
map x (fun x yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy z ->
433+
print y;
434+
z)
435+
;;
436+
437+
let v =
438+
map x (fun x y z ->
439+
ya f;
440+
a f b)
441+
;;
442+
443+
let v =
444+
map
445+
x
446+
[%ext1
447+
fun%ext2 x y z ->
448+
ya f;
449+
a f b]
450+
;;

0 commit comments

Comments
 (0)