Skip to content

Commit 8056fa5

Browse files
EmileTrotignonEmileTrotignon
authored
Overhaul begin match formatting (#2666)
Introduce `fmt_beginend` and use pro to display `begin`. Also includes a fix for `begin try`.
1 parent 9a050fb commit 8056fa5

14 files changed

+658
-63
lines changed

‎CHANGES.md‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,11 @@ profile. This started with version 0.26.0.
3131
- ocamlformat is now more robust when used as a library to print modified ASTs
3232
(#2659, @v-gb)
3333

34+
### Changed
35+
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)
38+
3439
## 0.27.0
3540

3641
### Highlight

‎lib/Fmt_ast.ml‎

Lines changed: 60 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1907,15 +1907,21 @@ and fmt_pat_cons c ~parens args =
19071907
Params.Exp.Infix_op_arg.wrap c.conf ~parens ~parens_nested:false
19081908
(list_fl groups fmt_op_arg_group)
19091909

1910-
and fmt_match c ?pro ~parens ?ext ctx xexp cs e0 keyword =
1910+
and fmt_match c ?pro ?eol ~loc ~parens ?ext ctx xexp cs e0 keyword =
1911+
let cmts_before = Cmts.fmt_before c ?eol loc in
19111912
let ctx0 = xexp.ctx in
19121913
let indent = Params.match_indent c.conf ~parens ~ctx:ctx0 in
1914+
let pro_outside_parens, pro_inside_parens =
1915+
let pro = fmt_opt pro in
1916+
if Params.Exp.box_pro_with_match ~ctx0 ~parens then (noop, pro)
1917+
else (pro, noop)
1918+
in
19131919
hvbox indent
1914-
( fmt_opt pro
1920+
( cmts_before $ pro_outside_parens
19151921
$ Params.Exp.wrap c.conf ~parens ~disambiguate:true
19161922
@@ Params.Align.match_ c.conf ~xexp
19171923
@@ ( hvbox 0
1918-
( str keyword
1924+
( hvbox 0 (pro_inside_parens $ keyword)
19191925
$ fmt_extension_suffix c ext
19201926
$ fmt_attributes c xexp.ast.pexp_attributes
19211927
$ break 1 2
@@ -1935,7 +1941,7 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
19351941
(* Some expressions format the 'pro' and comments differently. *)
19361942
let cmts_in_pro =
19371943
match exp.pexp_desc with
1938-
| Pexp_function _ -> noop
1944+
| Pexp_function _ | Pexp_match _ | Pexp_try _ -> noop
19391945
| _ -> Cmts.fmt_before c ?eol pexp_loc
19401946
in
19411947
cmts_in_pro $ pro
@@ -2557,18 +2563,23 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
25572563
c.conf.fmt_opts.single_case.v = `Compact
25582564
&& c.conf.fmt_opts.break_cases.v <> `All
25592565
&& c.conf.fmt_opts.break_cases.v <> `Vertical ) ->
2566+
let cmts_before = Cmts.fmt_before c ?eol pexp_loc in
2567+
let pro_outer, pro_inner =
2568+
if Params.Exp.box_pro_with_match ~ctx0 ~parens then (noop, pro)
2569+
else (pro, noop)
2570+
in
25602571
(* side effects of Cmts.fmt_before before [fmt_pattern] is important *)
25612572
let xpc_rhs = sub_exp ~ctx pc_rhs in
25622573
let leading_cmt = Cmts.fmt_before c pc_lhs.ppat_loc in
25632574
let parens_here, parens_for_exp =
25642575
if c.conf.fmt_opts.leading_nested_match_parens.v then (false, None)
25652576
else (parenze_exp xpc_rhs, Some false)
25662577
in
2567-
pro
2578+
cmts_before $ pro_outer
25682579
$ Params.Exp.wrap c.conf ~parens ~disambiguate:true
25692580
(hvbox 2
25702581
( hvbox 0
2571-
( str "try"
2582+
( hvbox 0 (pro_inner $ str "try")
25722583
$ fmt_extension_suffix c ext
25732584
$ fmt_attributes c pexp_attributes
25742585
$ break 1 2
@@ -2595,8 +2606,11 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
25952606
| `Closing_on_separate_line -> break 1000 (-2) $ str ")" )
25962607
) )
25972608
| Pexp_match (e0, cs) ->
2598-
fmt_match c ~pro ~parens ?ext ctx xexp cs e0 "match"
2599-
| Pexp_try (e0, cs) -> fmt_match c ~pro ~parens ?ext ctx xexp cs e0 "try"
2609+
fmt_match c ?eol ~loc:pexp_loc ~pro ~parens ?ext ctx xexp cs e0
2610+
(str "match")
2611+
| Pexp_try (e0, cs) ->
2612+
fmt_match c ?eol ~loc:pexp_loc ~pro ~parens ?ext ctx xexp cs e0
2613+
(str "try")
26002614
| Pexp_pack (me, pt) ->
26012615
let outer_pro = pro in
26022616
let outer_parens = parens && has_attr in
@@ -2894,23 +2908,49 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
28942908
pro $ fmt_indexop_access c ctx ~fmt_atrs ~has_attr ~parens x
28952909
| Pexp_hole -> pro $ hvbox 0 (fmt_hole () $ fmt_atrs)
28962910
| Pexp_beginend e ->
2897-
let wrap_beginend k =
2898-
let opn =
2899-
hvbox 0 (str "begin" $ fmt_extension_suffix c ext $ fmt_atrs)
2900-
and cls = str "end" in
2901-
hvbox 0 (wrap opn cls (wrap (break 1 2) force_break k))
2902-
in
2903-
pro
2904-
$ wrap_beginend
2905-
(fmt_expression c ~box ?eol ~parens:false ~indent_wrap ?ext
2906-
(sub_exp ~ctx e) )
2911+
fmt_beginend c ~box ~pro ~ctx ~fmt_atrs ~ext ~indent_wrap ?eol e
29072912
| Pexp_parens e ->
29082913
pro
29092914
$ hvbox 0
29102915
(fmt_expression c ~box ?eol ~parens:true ~indent_wrap ?ext
29112916
(sub_exp ~ctx e) )
29122917
$ fmt_atrs
29132918

2919+
and fmt_beginend c ?(box = true) ?(pro = noop) ~ctx ~fmt_atrs ~ext
2920+
~indent_wrap ?eol e =
2921+
let begin_ = str "begin" $ fmt_extension_suffix c ext $ fmt_atrs
2922+
and end_ = str "end" in
2923+
match e.pexp_desc with
2924+
| Pexp_match _ | Pexp_try _ ->
2925+
pro
2926+
$ hvbox 0
2927+
( fmt_expression c
2928+
~pro:(begin_ $ break 1 0)
2929+
~box ?eol ~parens:false ~indent_wrap (sub_exp ~ctx e)
2930+
$ break 1 0 $ end_ )
2931+
| Pexp_extension
2932+
( ext_inner
2933+
, PStr
2934+
[ ( { pstr_desc=
2935+
Pstr_eval
2936+
(({pexp_desc= Pexp_match _ | Pexp_try _; _} as e1), _)
2937+
; _ } as stru ) ] )
2938+
when Source.extension_using_sugar ~name:ext_inner ~payload:e1.pexp_loc ->
2939+
let ctx = Str stru in
2940+
pro
2941+
$ hvbox 0
2942+
( fmt_expression c ~ext:ext_inner
2943+
~pro:(begin_ $ str " ")
2944+
~box ?eol ~parens:false ~indent_wrap (sub_exp ~ctx e1)
2945+
$ break 1 0 $ end_ )
2946+
| _ ->
2947+
pro
2948+
$ hvbox 0
2949+
( hvbox 0 begin_ $ break 1 2
2950+
$ fmt_expression c ~box ?eol ~parens:false ~indent_wrap
2951+
(sub_exp ~ctx e)
2952+
$ force_break $ end_ )
2953+
29142954
and fmt_let_bindings c ~ctx0 ~parens ~has_attr ~fmt_atrs ~fmt_expr ~loc_in
29152955
rec_flag bindings body =
29162956
let indent_after_in =
@@ -2977,7 +3017,8 @@ and fmt_class_signature c ~ctx ~pro ~epi ?ext self_ fields =
29773017
in
29783018
let ast x = Ctf x in
29793019
let cmts_within =
2980-
if List.is_empty fields then (* Side effect order is important. *)
3020+
if List.is_empty fields then
3021+
(* Side effect order is important. *)
29813022
Cmts.fmt_within ~pro:noop c (Ast.location ctx)
29823023
else noop
29833024
in

‎lib/Params.ml‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -310,6 +310,11 @@ module Exp = struct
310310
| _ when ocp c -> hvbox 2 k
311311
| Str _ | Lb _ | Clf _ | Exp {pexp_desc= Pexp_let _; _} -> hovbox 4 k
312312
| _ -> hvbox 2 k
313+
314+
let box_pro_with_match ~ctx0 ~parens =
315+
if parens then false
316+
else
317+
match ctx0 with Exp {pexp_desc= Pexp_infix _; _} -> false | _ -> true
313318
end
314319

315320
module Mod = struct

‎lib/Params.mli‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -80,6 +80,9 @@ module Exp : sig
8080

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. *)
83+
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. *)
8386
end
8487

8588
module Mod : sig

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

Lines changed: 114 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -91,3 +91,117 @@ let _ =
9191
| D -> fooooooooooooo
9292
end
9393
[@@ocamlformat "break-cases=all"]
94+
95+
let a =
96+
begin match f x i with
97+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
98+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
99+
end
100+
101+
let a =
102+
begin match%lwt f x i with
103+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
104+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
105+
end
106+
107+
let a =
108+
begin%e match%lwt f x i with
109+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
110+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
111+
end
112+
113+
let a =
114+
begin%e match f x i with
115+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
116+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
117+
end
118+
119+
let a = begin match f x i with A -> a | B -> b end
120+
121+
let a =
122+
begin [@a] match[@b]
123+
f xxxx xxxxx xxxxx xxxxxxxxxxxxxxxxx
124+
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx i iiiiiiiiiiiiiiiiiii
125+
with
126+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
127+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
128+
end
129+
130+
let a =
131+
[%e
132+
begin [@a] match%lwt[@b]
133+
f xxxx xxxxx xxxxx xxxxxxxxxxxxxxxxx
134+
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx i iiiiiiiiiiiiiiiiiii
135+
with
136+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
137+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
138+
end]
139+
140+
let a =
141+
begin match
142+
f xxxx xxxxx xxxxx xxxxxxxxxxxxxxxxx
143+
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx i iiiiiiiiiiiiiiiiiii
144+
with
145+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
146+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
147+
end
148+
149+
let a =
150+
begin%e try f x i with
151+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
152+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
153+
end
154+
155+
let a =
156+
begin try f x i with
157+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
158+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
159+
end
160+
161+
let a =
162+
begin try%lwt f x i with
163+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
164+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
165+
end
166+
167+
let a =
168+
begin%e try%lwt f x i with
169+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
170+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
171+
end
172+
173+
let a =
174+
begin%e try f x i with
175+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
176+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
177+
end
178+
179+
let a = begin try f x i with A -> a | B -> b end
180+
181+
let a =
182+
begin [@a] try[@b]
183+
f xxxx xxxxx xxxxx xxxxxxxxxxxxxxxxx
184+
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx i iiiiiiiiiiiiiiiiiii
185+
with
186+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
187+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
188+
end
189+
190+
let a =
191+
[%e
192+
begin [@a] try%lwt[@b]
193+
f xxxx xxxxx xxxxx xxxxxxxxxxxxxxxxx
194+
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx i iiiiiiiiiiiiiiiiiii
195+
with
196+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
197+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
198+
end]
199+
200+
let a =
201+
begin try
202+
f xxxx xxxxx xxxxx xxxxxxxxxxxxxxxxx
203+
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx i iiiiiiiiiiiiiiiiiii
204+
with
205+
| A -> f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
206+
| B -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
207+
end

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

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -319,13 +319,12 @@ let x =
319319
match Tbl.find dist_tbl (pv1, pv2) with
320320
| None ->
321321
(* FIXME: temporary hack to avoid Jane Street's annoying warnings. *)
322-
begin [@warning "-3"]
323-
try
324-
let path', dist = Dijkstra.shortest_path pgraph pv1 pv2 in
325-
let path = unwrap_path path' in
326-
Tbl.set dist_tbl ~key:(pv1, pv2) ~data:(path, dist);
327-
Some (path, dist)
328-
with Not_found | Not_found_s _ -> None
322+
begin [@warning "-3"] try
323+
let path', dist = Dijkstra.shortest_path pgraph pv1 pv2 in
324+
let path = unwrap_path path' in
325+
Tbl.set dist_tbl ~key:(pv1, pv2) ~data:(path, dist);
326+
Some (path, dist)
327+
with Not_found | Not_found_s _ -> None
329328
end
330329
| pd -> pd
331330
in

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

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -375,13 +375,12 @@ let x =
375375
match Tbl.find dist_tbl (pv1, pv2) with
376376
| None ->
377377
(* FIXME: temporary hack to avoid Jane Street's annoying warnings. *)
378-
begin [@warning "-3"]
379-
try
380-
let path', dist = Dijkstra.shortest_path pgraph pv1 pv2 in
381-
let path = unwrap_path path' in
382-
Tbl.set dist_tbl ~key:(pv1, pv2) ~data:(path, dist);
383-
Some (path, dist)
384-
with Not_found | Not_found_s _ -> None
378+
begin [@warning "-3"] try
379+
let path', dist = Dijkstra.shortest_path pgraph pv1 pv2 in
380+
let path = unwrap_path path' in
381+
Tbl.set dist_tbl ~key:(pv1, pv2) ~data:(path, dist);
382+
Some (path, dist)
383+
with Not_found | Not_found_s _ -> None
385384
end
386385
| pd -> pd
387386
in

0 commit comments

Comments
 (0)