@@ -40,6 +40,13 @@ let add_braces doc =
40
40
41
41
let add_async doc = Doc. concat [Doc. text " async " ; doc]
42
42
43
+ let has_inline_type_definitions type_declarations =
44
+ type_declarations
45
+ |> List. find_opt (fun (td : Parsetree.type_declaration ) ->
46
+ Res_parsetree_viewer. has_inline_record_definition_attribute
47
+ td.ptype_attributes)
48
+ |> Option. is_some
49
+
43
50
let get_first_leading_comment tbl loc =
44
51
match Hashtbl. find tbl.CommentTable. leading loc with
45
52
| comment :: _ -> Some comment
@@ -587,29 +594,7 @@ and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl =
587
594
| Asttypes. Recursive -> Doc. text " rec "
588
595
in
589
596
print_value_bindings ~state ~rec_flag value_bindings cmt_tbl
590
- | Pstr_type (Recursive , type_declarations)
591
- when type_declarations
592
- |> List. find_opt (fun (td : Parsetree.type_declaration ) ->
593
- Res_parsetree_viewer. has_inline_record_definition_attribute
594
- td.ptype_attributes)
595
- |> Option. is_some ->
596
- let inline_record_definitions, regular_declarations =
597
- type_declarations
598
- |> List. partition (fun (td : Parsetree.type_declaration ) ->
599
- Res_parsetree_viewer. has_inline_record_definition_attribute
600
- td.ptype_attributes)
601
- in
602
- print_type_declarations ~inline_record_definitions ~state
603
- ~rec_flag:
604
- (if List. length regular_declarations > 1 then Doc. text " rec "
605
- else Doc. nil)
606
- regular_declarations cmt_tbl
607
597
| Pstr_type (rec_flag , type_declarations ) ->
608
- let rec_flag =
609
- match rec_flag with
610
- | Asttypes. Nonrecursive -> Doc. nil
611
- | Asttypes. Recursive -> Doc. text " rec "
612
- in
613
598
print_type_declarations ~state ~rec_flag type_declarations cmt_tbl
614
599
| Pstr_primitive value_description ->
615
600
print_value_description ~state value_description cmt_tbl
@@ -985,11 +970,6 @@ and print_signature_item ~state (si : Parsetree.signature_item) cmt_tbl =
985
970
| Parsetree. Psig_value value_description ->
986
971
print_value_description ~state value_description cmt_tbl
987
972
| Psig_type (rec_flag , type_declarations ) ->
988
- let rec_flag =
989
- match rec_flag with
990
- | Asttypes. Nonrecursive -> Doc. nil
991
- | Asttypes. Recursive -> Doc. text " rec "
992
- in
993
973
print_type_declarations ~state ~rec_flag type_declarations cmt_tbl
994
974
| Psig_typext type_extension ->
995
975
print_type_extension ~state type_extension cmt_tbl
@@ -1191,13 +1171,39 @@ and print_value_description ~state value_description cmt_tbl =
1191
1171
else Doc. nil);
1192
1172
])
1193
1173
1194
- and print_type_declarations ?inline_record_definitions ~state ~rec_flag
1195
- type_declarations cmt_tbl =
1196
- print_listi
1197
- ~get_loc: (fun n -> n.Parsetree. ptype_loc)
1198
- ~nodes: type_declarations
1199
- ~print: (print_type_declaration2 ?inline_record_definitions ~state ~rec_flag )
1200
- cmt_tbl
1174
+ and print_type_declarations ~state ~rec_flag type_declarations cmt_tbl =
1175
+ if has_inline_type_definitions type_declarations then
1176
+ let inline_record_definitions, regular_declarations =
1177
+ type_declarations
1178
+ |> List. partition (fun (td : Parsetree.type_declaration ) ->
1179
+ Res_parsetree_viewer. has_inline_record_definition_attribute
1180
+ td.ptype_attributes)
1181
+ in
1182
+ let adjusted_rec_flag =
1183
+ match rec_flag with
1184
+ | Recursive ->
1185
+ if List. length regular_declarations > 1 then Doc. text " rec "
1186
+ else Doc. nil
1187
+ | Nonrecursive -> Doc. nil
1188
+ in
1189
+ print_listi
1190
+ ~get_loc: (fun n -> n.Parsetree. ptype_loc)
1191
+ ~nodes: regular_declarations
1192
+ ~print:
1193
+ (print_type_declaration2 ~inline_record_definitions ~state
1194
+ ~rec_flag: adjusted_rec_flag)
1195
+ cmt_tbl
1196
+ else
1197
+ print_listi
1198
+ ~get_loc: (fun n -> n.Parsetree. ptype_loc)
1199
+ ~nodes: type_declarations
1200
+ ~print:
1201
+ (print_type_declaration2 ~state
1202
+ ~rec_flag:
1203
+ (match rec_flag with
1204
+ | Nonrecursive -> Doc. nil
1205
+ | Recursive -> Doc. text " rec " ))
1206
+ cmt_tbl
1201
1207
1202
1208
(*
1203
1209
* type_declaration = {
@@ -1458,13 +1464,14 @@ and print_type_param ~state (param : Parsetree.core_type * Asttypes.variance)
1458
1464
in
1459
1465
Doc. concat [printed_variance; print_typ_expr ~state typ cmt_tbl]
1460
1466
1461
- and print_record_declaration ?inline_record_definitions ~ state
1462
- (lds : Parsetree.label_declaration list ) cmt_tbl =
1467
+ and print_record_declaration ?check_break_from_loc ? inline_record_definitions
1468
+ ~ state (lds : Parsetree.label_declaration list ) cmt_tbl =
1463
1469
let force_break =
1464
- match (lds, List. rev lds) with
1465
- | first :: _ , last :: _ ->
1470
+ match (check_break_from_loc, lds, List. rev lds) with
1471
+ | Some loc , _ , _ -> loc.Location. loc_start.pos_lnum < loc.loc_end.pos_lnum
1472
+ | _ , first :: _ , last :: _ ->
1466
1473
first.pld_loc.loc_start.pos_lnum < last.pld_loc.loc_end.pos_lnum
1467
- | _ -> false
1474
+ | _ , _ , _ -> false
1468
1475
in
1469
1476
Doc. breakable_group ~force_break
1470
1477
(Doc. concat
@@ -1799,8 +1806,8 @@ and print_typ_expr ?inline_record_definitions ~(state : State.t)
1799
1806
inline_record_definitions
1800
1807
|> find_inline_record_definition inline_record_name
1801
1808
with
1802
- | Some {ptype_kind = Ptype_record lds } ->
1803
- print_record_declaration
1809
+ | Some {ptype_kind = Ptype_record lds ; ptype_loc } ->
1810
+ print_record_declaration ~check_break_from_loc: ptype_loc
1804
1811
~inline_record_definitions: (inline_record_definitions |> Option. get)
1805
1812
~state lds cmt_tbl
1806
1813
| _ -> assert false )
0 commit comments