+476

utils/format_doc.ml

reviewed

··· 1 1 + (**************************************************************************) 2 2 + (* *) 3 3 + (* OCaml *) 4 4 + (* *) 5 5 + (* Florian Angeletti, projet Cambium, Inria Paris *) 6 6 + (* *) 7 7 + (* Copyright 2021 Institut National de Recherche en Informatique et *) 8 8 + (* en Automatique. *) 9 9 + (* *) 10 10 + (* All rights reserved. This file is distributed under the terms of *) 11 11 + (* the GNU Lesser General Public License version 2.1, with the *) 12 12 + (* special exception on linking described in the file LICENSE. *) 13 13 + (* *) 14 14 + (**************************************************************************) 15 15 + 16 16 + 17 17 + type box_type = 18 18 + | H 19 19 + | V 20 20 + | HV 21 21 + | HoV 22 22 + | B 23 23 + 24 24 + type stag = Format.stag 25 25 + 26 26 + type element = 27 27 + | Text of string 28 28 + | With_size of int 29 29 + | Open_box of { kind: box_type ; indent:int } 30 30 + | Close_box 31 31 + | Open_tag of Format.stag 32 32 + | Close_tag 33 33 + | Open_tbox 34 34 + | Tab_break of { width : int; offset : int } 35 35 + | Set_tab 36 36 + | Close_tbox 37 37 + | Simple_break of { spaces : int; indent: int } 38 38 + | Break of { fits : string * int * string as 'a; breaks : 'a } 39 39 + | Flush of { newline:bool } 40 40 + | Newline 41 41 + | If_newline 42 42 + 43 43 + | Deprecated of (Format.formatter -> unit) 44 44 + 45 45 + type doc = { rev:element list } [@@unboxed] 46 46 + 47 47 + type t = doc 48 48 + 49 49 + let empty : doc = { rev = [] } 50 50 + 51 51 + let to_list doc = List.rev doc.rev 52 52 + let add doc x = { rev = x :: doc.rev } 53 53 + let fold f acc doc = List.fold_left f acc (to_list doc) 54 54 + let append left right = { rev = right.rev @ left.rev } 55 55 + 56 56 + let format_open_box_gen ppf kind indent = 57 57 + match kind with 58 58 + | H-> Format.pp_open_hbox ppf () 59 59 + | V -> Format.pp_open_vbox ppf indent 60 60 + | HV -> Format.pp_open_hvbox ppf indent 61 61 + | HoV -> Format.pp_open_hovbox ppf indent 62 62 + | B -> Format.pp_open_box ppf indent 63 63 + 64 64 + let interpret_elt ppf = function 65 65 + | Text x -> Format.pp_print_string ppf x 66 66 + | Open_box { kind; indent } -> format_open_box_gen ppf kind indent 67 67 + | Close_box -> Format.pp_close_box ppf () 68 68 + | Open_tag tag -> Format.pp_open_stag ppf tag 69 69 + | Close_tag -> Format.pp_close_stag ppf () 70 70 + | Open_tbox -> Format.pp_open_tbox ppf () 71 71 + | Tab_break {width;offset} -> Format.pp_print_tbreak ppf width offset 72 72 + | Set_tab -> Format.pp_set_tab ppf () 73 73 + | Close_tbox -> Format.pp_close_tbox ppf () 74 74 + | Simple_break {spaces;indent} -> Format.pp_print_break ppf spaces indent 75 75 + | Break {fits;breaks} -> Format.pp_print_custom_break ppf ~fits ~breaks 76 76 + | Flush {newline=true} -> Format.pp_print_newline ppf () 77 77 + | Flush {newline=false} -> Format.pp_print_flush ppf () 78 78 + | Newline -> Format.pp_force_newline ppf () 79 79 + | If_newline -> Format.pp_print_if_newline ppf () 80 80 + | With_size _ -> () 81 81 + | Deprecated pr -> pr ppf 82 82 + 83 83 + let rec interpret ppf = function 84 84 + | [] -> () 85 85 + | With_size size :: Text text :: l -> 86 86 + Format.pp_print_as ppf size text; 87 87 + interpret ppf l 88 88 + | x :: l -> 89 89 + interpret_elt ppf x; 90 90 + interpret ppf l 91 91 + 92 92 + let format ppf doc = interpret ppf (to_list doc) 93 93 + 94 94 + module Core = struct 95 95 + 96 96 + let open_box kind indent doc = add doc (Open_box {kind;indent}) 97 97 + let close_box doc = add doc Close_box 98 98 + 99 99 + let string s doc = add doc (Text s) 100 100 + let bytes b doc = add doc (Text (Bytes.to_string b)) 101 101 + let with_size size doc = add doc (With_size size) 102 102 + 103 103 + let int n doc = add doc (Text (string_of_int n)) 104 104 + let float f doc = add doc (Text (string_of_float f)) 105 105 + let char c doc = add doc (Text (String.make 1 c)) 106 106 + let bool c doc = add doc (Text (Bool.to_string c)) 107 107 + 108 108 + let break ~spaces ~indent doc = add doc (Simple_break {spaces; indent}) 109 109 + let space doc = break ~spaces:1 ~indent:0 doc 110 110 + let cut = break ~spaces:0 ~indent:0 111 111 + 112 112 + let custom_break ~fits ~breaks doc = add doc (Break {fits;breaks}) 113 113 + 114 114 + let force_newline doc = add doc Newline 115 115 + let if_newline doc = add doc If_newline 116 116 + 117 117 + let flush doc = add doc (Flush {newline=false}) 118 118 + let force_stop doc = add doc (Flush {newline=true}) 119 119 + 120 120 + let open_tbox doc = add doc Open_tbox 121 121 + let set_tab doc = add doc Set_tab 122 122 + let tab_break ~width ~offset doc = add doc (Tab_break {width;offset}) 123 123 + let tab doc = tab_break ~width:0 ~offset:0 doc 124 124 + let close_tbox doc = add doc Close_tbox 125 125 + 126 126 + let open_tag stag doc = add doc (Open_tag stag) 127 127 + let close_tag doc = add doc Close_tag 128 128 + 129 129 + let iter ?(sep=Fun.id) ~iter:iterator elt l doc = 130 130 + let first = ref false in 131 131 + let rdoc = ref doc in 132 132 + let print x = 133 133 + if !first then (first := false; rdoc := elt x !rdoc) 134 134 + else rdoc := !rdoc |> sep |> elt x 135 135 + in 136 136 + iterator print l; 137 137 + !rdoc 138 138 + 139 139 + let rec list ?(sep=Fun.id) elt l doc = match l with 140 140 + | [] -> doc 141 141 + | [a] -> elt a doc 142 142 + | a :: ((_ :: _) as q) -> 143 143 + doc |> elt a |> sep |> list ~sep elt q 144 144 + 145 145 + let array ?sep elt a doc = iter ?sep ~iter:Array.iter elt a doc 146 146 + let seq ?sep elt s doc = iter ?sep ~iter:Seq.iter elt s doc 147 147 + 148 148 + let option ?(none=Fun.id) elt o doc = match o with 149 149 + | None -> none doc 150 150 + | Some x -> elt x doc 151 151 + 152 152 + let either ~left ~right x doc = match x with 153 153 + | Either.Left x -> left x doc 154 154 + | Either.Right x -> right x doc 155 155 + 156 156 + let result ~ok ~error x doc = match x with 157 157 + | Ok x -> ok x doc 158 158 + | Error x -> error x doc 159 159 + 160 160 + (* To format free-flowing text *) 161 161 + let rec subtext len left right s doc = 162 162 + let flush doc = 163 163 + doc |> string (String.sub s left (right - left)) 164 164 + in 165 165 + let after_flush doc = subtext len (right+1) (right+1) s doc in 166 166 + if right = len then 167 167 + if left <> len then flush doc else doc 168 168 + else 169 169 + match s.[right] with 170 170 + | '\n' -> 171 171 + doc |> flush |> force_newline |> after_flush 172 172 + | ' ' -> 173 173 + doc |> flush |> space |> after_flush 174 174 + (* there is no specific support for '\t' 175 175 + as it is unclear what a right semantics would be *) 176 176 + | _ -> subtext len left (right + 1) s doc 177 177 + 178 178 + let text s doc = 179 179 + subtext (String.length s) 0 0 s doc 180 180 + 181 181 + type ('a,'b) fmt = ('a, doc, doc, 'b) format4 182 182 + type printer0 = doc -> doc 183 183 + type 'a printer = 'a -> printer0 184 184 + 185 185 + let output_formatting_lit fmting_lit doc = 186 186 + let open CamlinternalFormatBasics in 187 187 + match fmting_lit with 188 188 + | Close_box -> close_box doc 189 189 + | Close_tag -> close_tag doc 190 190 + | Break (_, width, offset) -> break ~spaces:width ~indent:offset doc 191 191 + | FFlush -> flush doc 192 192 + | Force_newline -> force_newline doc 193 193 + | Flush_newline -> force_stop doc 194 194 + | Magic_size (_, n) -> with_size n doc 195 195 + | Escaped_at -> char '@' doc 196 196 + | Escaped_percent -> char '%' doc 197 197 + | Scan_indic c -> doc |> char '@' |> char c 198 198 + 199 199 + let to_string doc = 200 200 + let b = Buffer.create 20 in 201 201 + let convert = function 202 202 + | Text s -> Buffer.add_string b s 203 203 + | _ -> () 204 204 + in 205 205 + fold (fun () x -> convert x) () doc; 206 206 + Buffer.contents b 207 207 + 208 208 + let box_type = 209 209 + let open CamlinternalFormatBasics in 210 210 + function 211 211 + | Pp_fits -> H 212 212 + | Pp_hbox -> H 213 213 + | Pp_vbox -> V 214 214 + | Pp_hovbox -> HoV 215 215 + | Pp_hvbox -> HV 216 216 + | Pp_box -> B 217 217 + 218 218 + let rec compose_acc acc doc = 219 219 + let open CamlinternalFormat in 220 220 + match acc with 221 221 + | CamlinternalFormat.Acc_formatting_lit (p, f) -> 222 222 + doc |> compose_acc p |> output_formatting_lit f 223 223 + | Acc_formatting_gen (p, Acc_open_tag acc') -> 224 224 + let tag = to_string (compose_acc acc' empty) in 225 225 + let doc = compose_acc p doc in 226 226 + doc |> open_tag (Format.String_tag tag) 227 227 + | Acc_formatting_gen (p, Acc_open_box acc') -> 228 228 + let doc = compose_acc p doc in 229 229 + let box = to_string (compose_acc acc' empty) in 230 230 + let (indent, bty) = CamlinternalFormat.open_box_of_string box in 231 231 + doc |> open_box (box_type bty) indent 232 232 + | Acc_string_literal (p, s) 233 233 + | Acc_data_string (p, s) -> 234 234 + doc |> compose_acc p |> string s 235 235 + | Acc_char_literal (p, c) 236 236 + | Acc_data_char (p, c) -> doc |> compose_acc p |> char c 237 237 + | Acc_delay (p, f) -> doc |> compose_acc p |> f 238 238 + | Acc_flush p -> doc |> compose_acc p |> flush 239 239 + | Acc_invalid_arg (_p, msg) -> invalid_arg msg; 240 240 + | End_of_acc -> doc 241 241 + 242 242 + let kprintf k (CamlinternalFormatBasics.Format (fmt, _)) = 243 243 + CamlinternalFormat.make_printf 244 244 + (fun acc doc -> doc |> compose_acc acc |> k ) 245 245 + End_of_acc fmt 246 246 + 247 247 + let printf doc = kprintf Fun.id doc 248 248 + let kmsg k (CamlinternalFormatBasics.Format (fmt, _)) = 249 249 + CamlinternalFormat.make_printf 250 250 + (fun acc -> k (compose_acc acc empty)) 251 251 + End_of_acc fmt 252 252 + 253 253 + let msg fmt = kmsg Fun.id fmt 254 254 + 255 255 + end 256 256 + 257 257 + (** Compatibility interface *) 258 258 + 259 259 + type formatter = doc ref 260 260 + type 'a printer = formatter -> 'a -> unit 261 261 + 262 262 + let formatter d = d 263 263 + 264 264 + (** {1 Primitive functions }*) 265 265 + 266 266 + let pp_print_string ppf s = ppf := Core.string s !ppf 267 267 + 268 268 + let pp_print_as ppf size s = 269 269 + ppf := !ppf |> Core.with_size size |> Core.string s 270 270 + 271 271 + let pp_print_substring ~pos ~len ppf s = 272 272 + ppf := Core.string (String.sub s pos len) !ppf 273 273 + 274 274 + let pp_print_substring_as ~pos ~len ppf size s = 275 275 + ppf := 276 276 + !ppf 277 277 + |> Core.with_size size 278 278 + |> Core.string (String.sub s pos len) 279 279 + 280 280 + let pp_print_bytes ppf s = ppf := Core.string (Bytes.to_string s) !ppf 281 281 + let pp_print_text ppf s = ppf := Core.text s !ppf 282 282 + let pp_print_char ppf c = ppf := Core.char c !ppf 283 283 + let pp_print_int ppf c = ppf := Core.int c !ppf 284 284 + let pp_print_float ppf f = ppf := Core.float f !ppf 285 285 + let pp_print_bool ppf b = ppf := Core.bool b !ppf 286 286 + let pp_print_nothing _ _ = () 287 287 + 288 288 + let pp_close_box ppf () = ppf := Core.close_box !ppf 289 289 + let pp_close_stag ppf () = ppf := Core.close_tag !ppf 290 290 + 291 291 + let pp_print_break ppf spaces indent = ppf := Core.break ~spaces ~indent !ppf 292 292 + 293 293 + let pp_print_custom_break ppf ~fits ~breaks = 294 294 + ppf := Core.custom_break ~fits ~breaks !ppf 295 295 + 296 296 + let pp_print_space ppf () = pp_print_break ppf 1 0 297 297 + let pp_print_cut ppf () = pp_print_break ppf 0 0 298 298 + 299 299 + let pp_print_flush ppf () = ppf := Core.flush !ppf 300 300 + let pp_force_newline ppf () = ppf := Core.force_newline !ppf 301 301 + let pp_print_newline ppf () = ppf := Core.force_stop !ppf 302 302 + let pp_print_if_newline ppf () =ppf := Core.if_newline !ppf 303 303 + 304 304 + let pp_open_stag ppf stag = ppf := !ppf |> Core.open_tag stag 305 305 + 306 306 + let pp_open_box_gen ppf indent bxty = 307 307 + let box_type = Core.box_type bxty in 308 308 + ppf := !ppf |> Core.open_box box_type indent 309 309 + 310 310 + let pp_open_box ppf indent = pp_open_box_gen ppf indent Pp_box 311 311 + 312 312 + 313 313 + let pp_open_tbox ppf () = ppf := !ppf |> Core.open_tbox 314 314 + 315 315 + let pp_close_tbox ppf () = ppf := !ppf |> Core.close_tbox 316 316 + 317 317 + let pp_set_tab ppf () = ppf := !ppf |> Core.set_tab 318 318 + 319 319 + let pp_print_tab ppf () = ppf := !ppf |> Core.tab 320 320 + 321 321 + let pp_print_tbreak ppf width offset = 322 322 + ppf := !ppf |> Core.tab_break ~width ~offset 323 323 + 324 324 + let pp_doc ppf doc = ppf := append !ppf doc 325 325 + 326 326 + module Driver = struct 327 327 + (* Interpret a formatting entity on a formatter. *) 328 328 + let output_formatting_lit ppf 329 329 + (fmting_lit:CamlinternalFormatBasics.formatting_lit) 330 330 + = match fmting_lit with 331 331 + | Close_box -> pp_close_box ppf () 332 332 + | Close_tag -> pp_close_stag ppf () 333 333 + | Break (_, width, offset) -> pp_print_break ppf width offset 334 334 + | FFlush -> pp_print_flush ppf () 335 335 + | Force_newline -> pp_force_newline ppf () 336 336 + | Flush_newline -> pp_print_newline ppf () 337 337 + | Magic_size (_, _) -> () 338 338 + | Escaped_at -> pp_print_char ppf '@' 339 339 + | Escaped_percent -> pp_print_char ppf '%' 340 340 + | Scan_indic c -> pp_print_char ppf '@'; pp_print_char ppf c 341 341 + 342 342 + 343 343 + 344 344 + let compute_tag output tag_acc = 345 345 + let buf = Buffer.create 16 in 346 346 + let buf_fmt = Format.formatter_of_buffer buf in 347 347 + let ppf = ref empty in 348 348 + output ppf tag_acc; 349 349 + pp_print_flush ppf (); 350 350 + format buf_fmt !ppf; 351 351 + let len = Buffer.length buf in 352 352 + if len < 2 then Buffer.contents buf 353 353 + else Buffer.sub buf 1 (len - 2) 354 354 + 355 355 + (* Recursively output an "accumulator" containing a reversed list of 356 356 + printing entities (string, char, flus, ...) in an output_stream. *) 357 357 + (* Differ from Printf.output_acc by the interpretation of formatting. *) 358 358 + (* Used as a continuation of CamlinternalFormat.make_printf. *) 359 359 + let rec output_acc ppf (acc: _ CamlinternalFormat.acc) = 360 360 + match acc with 361 361 + | Acc_string_literal (Acc_formatting_lit (p, Magic_size (_, size)), s) 362 362 + | Acc_data_string (Acc_formatting_lit (p, Magic_size (_, size)), s) -> 363 363 + output_acc ppf p; 364 364 + pp_print_as ppf size s; 365 365 + | Acc_char_literal (Acc_formatting_lit (p, Magic_size (_, size)), c) 366 366 + | Acc_data_char (Acc_formatting_lit (p, Magic_size (_, size)), c) -> 367 367 + output_acc ppf p; 368 368 + pp_print_as ppf size (String.make 1 c); 369 369 + | Acc_formatting_lit (p, f) -> 370 370 + output_acc ppf p; 371 371 + output_formatting_lit ppf f; 372 372 + | Acc_formatting_gen (p, Acc_open_tag acc') -> 373 373 + output_acc ppf p; 374 374 + pp_open_stag ppf (Format.String_tag (compute_tag output_acc acc')) 375 375 + | Acc_formatting_gen (p, Acc_open_box acc') -> 376 376 + output_acc ppf p; 377 377 + let (indent, bty) = 378 378 + let box_info = compute_tag output_acc acc' in 379 379 + CamlinternalFormat.open_box_of_string box_info 380 380 + in 381 381 + pp_open_box_gen ppf indent bty 382 382 + | Acc_string_literal (p, s) 383 383 + | Acc_data_string (p, s) -> output_acc ppf p; pp_print_string ppf s; 384 384 + | Acc_char_literal (p, c) 385 385 + | Acc_data_char (p, c) -> output_acc ppf p; pp_print_char ppf c; 386 386 + | Acc_delay (p, f) -> output_acc ppf p; f ppf; 387 387 + | Acc_flush p -> output_acc ppf p; pp_print_flush ppf (); 388 388 + | Acc_invalid_arg (p, msg) -> output_acc ppf p; invalid_arg msg; 389 389 + | End_of_acc -> () 390 390 + end 391 391 + 392 392 + let kfprintf k ppf (CamlinternalFormatBasics.Format (fmt, _)) = 393 393 + CamlinternalFormat.make_printf 394 394 + (fun acc -> Driver.output_acc ppf acc; k ppf) 395 395 + End_of_acc fmt 396 396 + let fprintf doc fmt = kfprintf ignore doc fmt 397 397 + 398 398 + 399 399 + let kdprintf k (CamlinternalFormatBasics.Format (fmt, _)) = 400 400 + CamlinternalFormat.make_printf 401 401 + (fun acc -> k (fun ppf -> Driver.output_acc ppf acc)) 402 402 + End_of_acc fmt 403 403 + 404 404 + let dprintf fmt = kdprintf (fun i -> i) fmt 405 405 + 406 406 + let doc_printf fmt = 407 407 + let ppf = ref empty in 408 408 + kfprintf (fun _ -> let doc = !ppf in ppf := empty; doc) ppf fmt 409 409 + 410 410 + let kdoc_printf k fmt = 411 411 + let ppf = ref empty in 412 412 + kfprintf (fun ppf -> 413 413 + let doc = !ppf in 414 414 + ppf := empty; 415 415 + k doc 416 416 + ) 417 417 + ppf fmt 418 418 + 419 419 + let core f x doc = 420 420 + let r = ref doc in 421 421 + f r x; 422 422 + !r 423 423 + 424 424 + let format_printer f ppf x = 425 425 + let doc = core f x empty in 426 426 + format ppf doc 427 427 + let compat = format_printer 428 428 + 429 429 + let kasprintf k fmt = 430 430 + kdoc_printf (fun doc -> k (Format.asprintf "%a" format doc)) fmt 431 431 + let asprintf fmt = kasprintf Fun.id fmt 432 432 + 433 433 + let pp_print_iter ?(pp_sep=pp_print_cut) iter elt ppf c = 434 434 + let sep = core pp_sep () in 435 435 + ppf:= Core.iter ~sep ~iter (core elt) c !ppf 436 436 + 437 437 + let pp_print_list ?(pp_sep=pp_print_cut) elt ppf l = 438 438 + ppf := Core.list ~sep:(core pp_sep ()) (core elt) l !ppf 439 439 + 440 440 + let pp_print_array ?pp_sep elt ppf a = 441 441 + pp_print_iter ?pp_sep Array.iter elt ppf a 442 442 + let pp_print_seq ?pp_sep elt ppf s = pp_print_iter ?pp_sep Seq.iter elt ppf s 443 443 + 444 444 + let pp_print_option ?(none=fun _ () -> ()) elt ppf o = 445 445 + ppf := Core.option ~none:(core none ()) (core elt) o !ppf 446 446 + 447 447 + let pp_print_result ~ok ~error ppf r = 448 448 + ppf := Core.result ~ok:(core ok) ~error:(core error) r !ppf 449 449 + 450 450 + let pp_print_either ~left ~right ppf e = 451 451 + ppf := Core.either ~left:(core left) ~right:(core right) e !ppf 452 452 + 453 453 + let comma ppf () = fprintf ppf ",@ " 454 454 + 455 455 + let pp_two_columns ?(sep = "|") ?max_lines ppf (lines: (string * string) list) = 456 456 + let left_column_size = 457 457 + List.fold_left (fun acc (s, _) -> Int.max acc (String.length s)) 0 lines in 458 458 + let lines_nb = List.length lines in 459 459 + let ellipsed_first, ellipsed_last = 460 460 + match max_lines with 461 461 + | Some max_lines when lines_nb > max_lines -> 462 462 + let printed_lines = max_lines - 1 in (* the ellipsis uses one line *) 463 463 + let lines_before = printed_lines / 2 + printed_lines mod 2 in 464 464 + let lines_after = printed_lines / 2 in 465 465 + (lines_before, lines_nb - lines_after - 1) 466 466 + | _ -> (-1, -1) 467 467 + in 468 468 + fprintf ppf "@[<v>"; 469 469 + List.iteri (fun k (line_l, line_r) -> 470 470 + if k = ellipsed_first then fprintf ppf "...@,"; 471 471 + if ellipsed_first <= k && k <= ellipsed_last then () 472 472 + else fprintf ppf "%*s %s %s@," left_column_size line_l sep line_r 473 473 + ) lines; 474 474 + fprintf ppf "@]" 475 475 + 476 476 + let deprecated_printer pr ppf = ppf := add !ppf (Deprecated pr)

+290

utils/format_doc.mli

reviewed

··· 1 1 + (**************************************************************************) 2 2 + (* *) 3 3 + (* OCaml *) 4 4 + (* *) 5 5 + (* Florian Angeletti, projet Cambium, Inria Paris *) 6 6 + (* *) 7 7 + (* Copyright 2024 Institut National de Recherche en Informatique et *) 8 8 + (* en Automatique. *) 9 9 + (* *) 10 10 + (* All rights reserved. This file is distributed under the terms of *) 11 11 + (* the GNU Lesser General Public License version 2.1, with the *) 12 12 + (* special exception on linking described in the file LICENSE. *) 13 13 + (* *) 14 14 + (**************************************************************************) 15 15 + 16 16 + (** Composable document for the {!Format} formatting engine. *) 17 17 + 18 18 + (** This module introduces a pure and immutable document type which represents a 19 19 + sequence of formatting instructions to be printed by a formatting engine at 20 20 + later point. At the same time, it also provides format string interpreter 21 21 + which produces this document type from format string and their associated 22 22 + printers. 23 23 + 24 24 + The module is designed to be source compatible with code defining format 25 25 + printers: replacing `Format` by `Format_doc` in your code will convert 26 26 + `Format` printers to `Format_doc` printers. 27 27 + *) 28 28 + 29 29 + (** Format box types *) 30 30 + type box_type = 31 31 + | H 32 32 + | V 33 33 + | HV 34 34 + | HoV 35 35 + | B 36 36 + 37 37 + type stag = Format.stag 38 38 + 39 39 + (** Base formatting instruction recognized by {!Format} *) 40 40 + type element = 41 41 + | Text of string 42 42 + | With_size of int 43 43 + | Open_box of { kind: box_type ; indent:int } 44 44 + | Close_box 45 45 + | Open_tag of Format.stag 46 46 + | Close_tag 47 47 + | Open_tbox 48 48 + | Tab_break of { width : int; offset : int } 49 49 + | Set_tab 50 50 + | Close_tbox 51 51 + | Simple_break of { spaces : int; indent : int } 52 52 + | Break of { fits : string * int * string as 'a; breaks : 'a } 53 53 + | Flush of { newline:bool } 54 54 + | Newline 55 55 + | If_newline 56 56 + 57 57 + | Deprecated of (Format.formatter -> unit) 58 58 + (** Escape hatch: a {!Format} printer used to provide backward-compatibility 59 59 + for user-defined printer (from the [#install_printer] toplevel directive 60 60 + for instance). *) 61 61 + 62 62 + (** Immutable document type*) 63 63 + type t 64 64 + type doc = t 65 65 + 66 66 + (** Empty document *) 67 67 + val empty: t 68 68 + 69 69 + (** [format ppf doc] sends the format instruction of [doc] to the Format's 70 70 + formatter [doc]. *) 71 71 + val format: Format.formatter -> doc -> unit 72 72 + 73 73 + (** Fold over a document as a sequence of instructions *) 74 74 + val fold: ('acc -> element -> 'acc) -> 'acc -> doc -> 'acc 75 75 + 76 76 + (** Immutable API for composing {!doc} *) 77 77 + module Core: sig 78 78 + type ('a,'b) fmt = ('a, doc, doc,'b) format4 79 79 + 80 80 + type printer0 = doc -> doc 81 81 + type 'a printer = 'a -> printer0 82 82 + 83 83 + 84 84 + (** {!msg} and {!kmsg} produce a document from a format string and its 85 85 + argument *) 86 86 + val msg: ('a,doc) fmt -> 'a 87 87 + val kmsg: (doc -> 'b) -> ('a,'b) fmt -> 'a 88 88 + 89 89 + (** {!printf} and {!kprintf} produce a printer from a format string and its 90 90 + argument*) 91 91 + val printf: ('a, printer0) fmt -> 'a 92 92 + val kprintf: (doc -> 'b) -> ('a, doc -> 'b) fmt -> 'a 93 93 + 94 94 + (** The functions below mirror {!Format} printers, without the [pp_print_] 95 95 + prefix naming convention *) 96 96 + val open_box: box_type -> int -> printer0 97 97 + val close_box: printer0 98 98 + 99 99 + val text: string printer 100 100 + val string: string printer 101 101 + val bytes: bytes printer 102 102 + val with_size: int printer 103 103 + 104 104 + val int: int printer 105 105 + val float: float printer 106 106 + val char: char printer 107 107 + val bool: bool printer 108 108 + 109 109 + val space: printer0 110 110 + val cut: printer0 111 111 + val break: spaces:int -> indent:int -> printer0 112 112 + 113 113 + val custom_break: 114 114 + fits:(string * int * string as 'a) -> breaks:'a -> printer0 115 115 + val force_newline: printer0 116 116 + val if_newline: printer0 117 117 + 118 118 + val flush: printer0 119 119 + val force_stop: printer0 120 120 + 121 121 + val open_tbox: printer0 122 122 + val set_tab: printer0 123 123 + val tab: printer0 124 124 + val tab_break: width:int -> offset:int -> printer0 125 125 + val close_tbox: printer0 126 126 + 127 127 + val open_tag: stag printer 128 128 + val close_tag: printer0 129 129 + 130 130 + val list: ?sep:printer0 -> 'a printer -> 'a list printer 131 131 + val iter: 132 132 + ?sep:printer0 -> iter:(('a -> unit) -> 'b -> unit) -> 'a printer 133 133 + ->'b printer 134 134 + val array: ?sep:printer0 -> 'a printer -> 'a array printer 135 135 + val seq: ?sep:printer0 -> 'a printer -> 'a Seq.t printer 136 136 + 137 137 + val option: ?none:printer0 -> 'a printer -> 'a option printer 138 138 + val result: ok:'a printer -> error:'e printer -> ('a,'e) result printer 139 139 + val either: left:'a printer -> right:'b printer -> ('a,'b) Either.t printer 140 140 + 141 141 + end 142 142 + 143 143 + (** {1 Compatibility API} *) 144 144 + 145 145 + (** The functions and types below provides source compatibility with format 146 146 + printers and conversion function from {!Format_doc} printers to {!Format} 147 147 + printers. The reverse direction is implemented using an escape hatch in the 148 148 + formatting instruction and should only be used to preserve backward 149 149 + compatibility. *) 150 150 + 151 151 + type formatter 152 152 + type 'a printer = formatter -> 'a -> unit 153 153 + 154 154 + val formatter: doc ref -> formatter 155 155 + (** [formatter rdoc] creates a {!formatter} that updates the [rdoc] reference *) 156 156 + 157 157 + (** Translate a {!Format_doc} printer to a {!Format} one. *) 158 158 + val compat: 'a printer -> Format.formatter -> 'a -> unit 159 159 + 160 160 + (** If necessary, embbed a {!Format} printer inside a formatting instruction 161 161 + stream. This breaks every guarantees provided by {!Format_doc}. *) 162 162 + val deprecated_printer: (Format.formatter -> unit) -> formatter -> unit 163 163 + 164 164 + 165 165 + (** {2 Format string interpreters }*) 166 166 + 167 167 + val fprintf : formatter -> ('a, formatter,unit) format -> 'a 168 168 + val kfprintf: 169 169 + (formatter -> 'a) -> formatter -> 170 170 + ('b, formatter, unit, 'a) format4 -> 'b 171 171 + 172 172 + val asprintf : ('a, formatter, unit, string) format4 -> 'a 173 173 + val kasprintf : (string -> 'a) -> ('b, formatter, unit, 'a) format4 -> 'b 174 174 + 175 175 + 176 176 + val dprintf : ('a, formatter, unit, formatter -> unit) format4 -> 'a 177 177 + val kdprintf: 178 178 + ((formatter -> unit) -> 'a) -> 179 179 + ('b, formatter, unit, 'a) format4 -> 'b 180 180 + 181 181 + (** {!doc_printf} and {!kdoc_printf} creates a document directly *) 182 182 + val doc_printf: ('a, formatter, unit, doc) format4 -> 'a 183 183 + val kdoc_printf: (doc -> 'r) -> ('a, formatter, unit, 'r) format4 -> 'a 184 184 + 185 185 + (** {2 Compatibility with {!Core} }*) 186 186 + 187 187 + val core: 'a printer -> 'a Core.printer 188 188 + val pp_doc: doc printer 189 189 + 190 190 + (** {2 Source compatibility with Format}*) 191 191 + 192 192 + (** {3 String printers } *) 193 193 + 194 194 + val pp_print_string: string printer 195 195 + val pp_print_substring: pos:int -> len:int -> string printer 196 196 + val pp_print_text: string printer 197 197 + val pp_print_bytes: bytes printer 198 198 + 199 199 + val pp_print_as: formatter -> int -> string -> unit 200 200 + val pp_print_substring_as: 201 201 + pos:int -> len:int -> formatter -> int -> string -> unit 202 202 + 203 203 + (** {3 Primitive type printers }*) 204 204 + 205 205 + val pp_print_char: char printer 206 206 + val pp_print_int: int printer 207 207 + val pp_print_float: float printer 208 208 + val pp_print_bool: bool printer 209 209 + val pp_print_nothing: unit printer 210 210 + 211 211 + (** {3 Printer combinators }*) 212 212 + 213 213 + val pp_print_iter: 214 214 + ?pp_sep:unit printer -> (('a -> unit) -> 'b -> unit) -> 215 215 + 'a printer -> 'b printer 216 216 + 217 217 + val pp_print_list: ?pp_sep:unit printer -> 'a printer -> 'a list printer 218 218 + val pp_print_array: ?pp_sep:unit printer -> 'a printer -> 'a array printer 219 219 + val pp_print_seq: ?pp_sep:unit printer -> 'a printer -> 'a Seq.t printer 220 220 + 221 221 + val pp_print_option: ?none:unit printer -> 'a printer -> 'a option printer 222 222 + val pp_print_result: ok:'a printer -> error:'e printer -> ('a,'e) result printer 223 223 + val pp_print_either: 224 224 + left:'a printer -> right:'b printer -> ('a,'b) Either.t printer 225 225 + 226 226 + 227 227 + (** {3 Boxes and tags }*) 228 228 + 229 229 + val pp_open_stag: Format.stag printer 230 230 + val pp_close_stag: unit printer 231 231 + 232 232 + val pp_open_box: int printer 233 233 + val pp_close_box: unit printer 234 234 + 235 235 + (** {3 Break hints} *) 236 236 + 237 237 + val pp_print_space: unit printer 238 238 + val pp_print_cut: unit printer 239 239 + val pp_print_break: formatter -> int -> int -> unit 240 240 + val pp_print_custom_break: 241 241 + formatter -> fits:(string * int * string as 'c) -> breaks:'c -> unit 242 242 + 243 243 + (** {3 Tabulations }*) 244 244 + 245 245 + val pp_open_tbox: unit printer 246 246 + val pp_close_tbox: unit printer 247 247 + val pp_set_tab: unit printer 248 248 + val pp_print_tab: unit printer 249 249 + val pp_print_tbreak: formatter -> int -> int -> unit 250 250 + 251 251 + (** {3 Newlines and flushing }*) 252 252 + 253 253 + val pp_print_if_newline: unit printer 254 254 + val pp_force_newline: unit printer 255 255 + val pp_print_flush: unit printer 256 256 + val pp_print_newline: unit printer 257 257 + 258 258 + (** {1 Compiler specific functions }*) 259 259 + 260 260 + (** {2 Separators }*) 261 261 + 262 262 + val comma: unit printer 263 263 + 264 264 + (** {2 Compiler output} *) 265 265 + 266 266 + val pp_two_columns : 267 267 + ?sep:string -> ?max_lines:int -> 268 268 + formatter -> (string * string) list -> unit 269 269 + (** [pp_two_columns ?sep ?max_lines ppf l] prints the lines in [l] as two 270 270 + columns separated by [sep] ("|" by default). [max_lines] can be used to 271 271 + indicate a maximum number of lines to print -- an ellipsis gets inserted at 272 272 + the middle if the input has too many lines. 273 273 + 274 274 + Example: 275 275 + 276 276 + {v pp_two_columns ~max_lines:3 Format.std_formatter [ 277 277 + "abc", "hello"; 278 278 + "def", "zzz"; 279 279 + "a" , "bllbl"; 280 280 + "bb" , "dddddd"; 281 281 + ] v} 282 282 + 283 283 + prints 284 284 + 285 285 + {v 286 286 + abc | hello 287 287 + ... 288 288 + bb | dddddd 289 289 + v} 290 290 + *)