11
11
12
12
(* * Formatting combinators *)
13
13
14
- module Format = Format_
15
-
16
14
(* * Define the core type and minimal combinators.
17
15
18
16
Other higher level functions like [fmt_if] or [list_pn] are implemented
@@ -24,7 +22,7 @@ module T : sig
24
22
val ( $ ) : t -> t -> t
25
23
(* * Sequence *)
26
24
27
- val with_pp : (Format .formatter -> unit ) -> t
25
+ val with_pp : (Format_ .formatter -> unit ) -> t
28
26
(* * Use an arbitrary pretty-printing function *)
29
27
30
28
val protect : t -> on_error :(exn -> unit ) -> t
@@ -39,10 +37,10 @@ module T : sig
39
37
40
38
See [tests_lazy] in [Test_fmt]. *)
41
39
42
- val eval : Format .formatter -> t -> unit
40
+ val eval : Format_ .formatter -> t -> unit
43
41
(* * Main function to evaluate a term using an actual formatter. *)
44
42
end = struct
45
- type t = (Format .formatter -> unit ) Staged .t
43
+ type t = (Format_ .formatter -> unit ) Staged .t
46
44
47
45
let ( $ ) f g =
48
46
let f = Staged. unstage f in
@@ -60,7 +58,7 @@ end = struct
60
58
Staged. stage (fun fs ->
61
59
try t fs
62
60
with exn ->
63
- Format . pp_print_flush fs () ;
61
+ Format_ . pp_print_flush fs () ;
64
62
on_error exn )
65
63
66
64
let lazy_ f =
71
69
72
70
include T
73
71
74
- type s = (unit , Format .formatter , unit ) format
72
+ type s = (unit , Format_ .formatter , unit ) format
75
73
76
74
type sp = Blank | Cut | Space | Break of int * int
77
75
78
76
let ( >$ ) f g x = f $ g x
79
77
80
78
let set_margin n =
81
- with_pp (fun fs -> Format. pp_set_geometry fs ~max_indent: n ~margin: (n + 1 ))
79
+ with_pp (fun fs ->
80
+ Format_. pp_set_geometry fs ~max_indent: n ~margin: (n + 1 ) )
82
81
83
82
let max_indent = ref None
84
83
@@ -87,15 +86,15 @@ let set_max_indent x = with_pp (fun _ -> max_indent := x)
87
86
(* * Debug of formatting -------------------------------------------------*)
88
87
89
88
let pp_color_k color_code k fs =
90
- let c = Format . sprintf " \x1B [%dm" in
91
- Format . fprintf fs " @<0>%s%t@<0>%s" (c color_code) k (c 0 )
89
+ let c = Format_ . sprintf " \x1B [%dm" in
90
+ Format_ . fprintf fs " @<0>%s%t@<0>%s" (c color_code) k (c 0 )
92
91
93
92
(* * Break hints and format strings --------------------------------------*)
94
93
95
- let break n o = with_pp (fun fs -> Format . pp_print_break fs n o)
94
+ let break n o = with_pp (fun fs -> Format_ . pp_print_break fs n o)
96
95
97
96
let cbreak ~fits ~breaks =
98
- with_pp (fun fs -> Format . pp_print_custom_break fs ~fits ~breaks )
97
+ with_pp (fun fs -> Format_ . pp_print_custom_break fs ~fits ~breaks )
99
98
100
99
let noop = with_pp (fun _ -> () )
101
100
@@ -112,16 +111,16 @@ let sequence l =
112
111
in
113
112
go l (List. length l)
114
113
115
- let fmt f = with_pp (fun fs -> Format . fprintf fs f)
114
+ let fmt f = with_pp (fun fs -> Format_ . fprintf fs f)
116
115
117
116
(* * Primitive types -----------------------------------------------------*)
118
117
119
- let char c = with_pp (fun fs -> Format . pp_print_char fs c)
118
+ let char c = with_pp (fun fs -> Format_ . pp_print_char fs c)
120
119
121
120
let utf8_length s =
122
121
Uuseg_string. fold_utf_8 `Grapheme_cluster (fun n _ -> n + 1 ) 0 s
123
122
124
- let str_as n s = with_pp (fun fs -> Format . pp_print_as fs n s)
123
+ let str_as n s = with_pp (fun fs -> Format_ . pp_print_as fs n s)
125
124
126
125
let str s = if String. is_empty s then noop else str_as (utf8_length s) s
127
126
@@ -176,18 +175,19 @@ let fmt_opt o = Option.value o ~default:noop
176
175
177
176
(* * Conditional on immediately following a line break -------------------*)
178
177
179
- let if_newline s = with_pp (fun fs -> Format. pp_print_string_if_newline fs s)
178
+ let if_newline s =
179
+ with_pp (fun fs -> Format_. pp_print_string_if_newline fs s)
180
180
181
181
let break_unless_newline n o =
182
- with_pp (fun fs -> Format . pp_print_or_newline fs n o " " " " )
182
+ with_pp (fun fs -> Format_ . pp_print_or_newline fs n o " " " " )
183
183
184
184
(* * Conditional on breaking of enclosing box ----------------------------*)
185
185
186
186
type behavior = Fit | Break
187
187
188
188
let fits_or_breaks ~level fits nspaces offset breaks =
189
189
with_pp (fun fs ->
190
- Format . pp_print_fits_or_breaks fs ~level fits nspaces offset breaks )
190
+ Format_ . pp_print_fits_or_breaks fs ~level fits nspaces offset breaks )
191
191
192
192
let fits_breaks ?force ?(hint = (0 , Int. min_value)) ?(level = 0 ) fits breaks
193
193
=
@@ -251,24 +251,24 @@ let debug_box_open ?name box_kind n fs =
251
251
if ! box_debug_enabled then (
252
252
let name =
253
253
match name with
254
- | Some s -> Format . sprintf " %s:%s" box_kind s
254
+ | Some s -> Format_ . sprintf " %s:%s" box_kind s
255
255
| None -> box_kind
256
256
in
257
- let openning = if n = 0 then name else Format . sprintf " %s<%d" name n in
257
+ let openning = if n = 0 then name else Format_ . sprintf " %s<%d" name n in
258
258
pp_color_k (box_depth_color () )
259
- (fun fs -> Format . fprintf fs " @<0>[@<0>%s@<0>>" openning)
259
+ (fun fs -> Format_ . fprintf fs " @<0>[@<0>%s@<0>>" openning)
260
260
fs ;
261
261
Int. incr box_depth )
262
262
263
263
let debug_box_close fs =
264
264
if ! box_debug_enabled then
265
265
if ! box_depth = 0 then
266
266
(* mismatched close, red background *)
267
- pp_color_k 41 (fun fs -> Format . fprintf fs " @<0>]" ) fs
267
+ pp_color_k 41 (fun fs -> Format_ . fprintf fs " @<0>]" ) fs
268
268
else (
269
269
Int. decr box_depth ;
270
270
pp_color_k (box_depth_color () )
271
- (fun fs -> Format . fprintf fs " @<0>]" )
271
+ (fun fs -> Format_ . fprintf fs " @<0>]" )
272
272
fs )
273
273
274
274
let apply_max_indent n = Option. value_map ! max_indent ~f: (min n) ~default: n
@@ -277,28 +277,30 @@ let open_box ?name n =
277
277
with_pp (fun fs ->
278
278
let n = apply_max_indent n in
279
279
debug_box_open ?name " b" n fs ;
280
- Format . pp_open_box fs n )
280
+ Format_ . pp_open_box fs n )
281
281
282
282
and open_vbox ?name n =
283
283
with_pp (fun fs ->
284
284
let n = apply_max_indent n in
285
285
debug_box_open ?name " v" n fs ;
286
- Format . pp_open_vbox fs n )
286
+ Format_ . pp_open_vbox fs n )
287
287
288
288
and open_hvbox ?name n =
289
289
with_pp (fun fs ->
290
290
let n = apply_max_indent n in
291
291
debug_box_open ?name " hv" n fs ;
292
- Format . pp_open_hvbox fs n )
292
+ Format_ . pp_open_hvbox fs n )
293
293
294
294
and open_hovbox ?name n =
295
295
with_pp (fun fs ->
296
296
let n = apply_max_indent n in
297
297
debug_box_open ?name " hov" n fs ;
298
- Format . pp_open_hovbox fs n )
298
+ Format_ . pp_open_hovbox fs n )
299
299
300
300
and close_box =
301
- with_pp (fun fs -> debug_box_close fs ; Format. pp_close_box fs () )
301
+ with_pp (fun fs ->
302
+ debug_box_close fs ;
303
+ Format_. pp_close_box fs () )
302
304
303
305
(* * Wrapping boxes ------------------------------------------------------*)
304
306
0 commit comments