The OCaml Format module contains many features that are easy to miss at first glance. This blog post proposes a small tour of some of the less known features of Format.fprintf.

Conversion specifications within boxes

First, let’s have a look at a Format combinator that takes a printer and encapsulate inside a box:

let box pp ppf x = Format.fprintf ppf "@[<b>%a@]" f x
let vbox pp ppf x = Format.fprintf ppf "@[<v>%a@]" f x

If we have a custom printer, for instance, for a list of int

let comma ppf () = Format.fprintf ppf ",@ "
let int_list = Format.pp_print_list ~pp_sep:comma Format.pp_print_int

Then the box and vbox combinators make it easy to choose the interpretation of the break hints inside the list

box int_list Format.std_formatter [1;2;3];;
  [1, 2, 3]

One issue with those functions is that we need one function for each box kind and for each choice of indentation. Is it possible to generalize this function and pass the kind and the indentation of the box as an argument? Surprisingly, a possible solution is to add conversion specifications inside the box definition:

let with_box box indent ppf pp x =
  Format.fprintf ppf "@[<%s %d>%a@]" box indent pp x

Going further, it is possible to avoid the string-typed box by defining

type box = H | V of int | HV of int | HoV of int | B of int
let print_box ppf = function
| H -> Format.fprintf ppf "h"
| V n -> Format.fprintf ppf "v %d" n
| HV n -> Format.fprintf ppf "hv %d" n
| HoV n -> Format.fprintf ppf "hov %d" n
| B 0 -> ()
| B n -> Format.fprintf ppf "%d" n

let with_box box pp ppf x =
  Format.fprintf ppf "@[<%a>%a@]" print_box box pp x

Then, we can switch to a vertical display for our int list with

with_box (V 0) int_list Format.std_formatter [1;2;3];;
  1,
  2,
  3

This trick also works with tags rather than boxes

type box = Red | Blue | Magenta
let print_color ppf = function
| Red -> Format.fprintf ppf "red"
| Blue -> Format.fprintf ppf "blue" n
| Magenta -> Format.fprintf ppf "magenta" n

let with_color c pp ppf x =
  Format.fprintf ppf "@{<%a>%a@}" print_color c pp x

Subformat substitution

Another rarely used feature of Format.fprintf is subformat substitution. Consider for instance an integer vector type:

type vec3d = { x:int; y: int; z: int }

A printer for this type may be written as

let pp_vec ppf v = Format.fprintf ppf "(%d, %d, %d)" v.x v.y v.z

However, a problem with this printer is that the integer format is fixed. It is no longer possible to choose a padding size with "%3d", or an hexadecimal base with "%x". Subformat substitution can resolve this issue.

let pp_vec subfmt ppf v =
  Format.fprintf ppf "(%(%d%), %(%d%), %(%d%))" subfmt v.x subfmt v.y subfmt v.z
let pp_vec_hex = pp_vec "%x"
let pp_vec_three = pp_vec "%03d"

Here, the conversion specification %(%d) takes as an argument a format string which itself takes an integer as argument, and then substitutes this format string inside the parent format string.

Another curiosity is to use a substitution conversion specification without a specifier

let strange ppf =
  Format.fprintf ppf "@[<v> First item.@ %(%)Last item@ @]"
    "Second item.@ Third item.@ "

Here, %(%) accepts as an argument any format string without any conversion specification. In other words, %(%) is a version of %s that allows formatting hints.

It is also possible to use this format substitution in a more complex settings,

let pair subformat pp1 pp2 ppf x y =
  Format.fprintf ppf "%(%a%a%)" subformat pp1 x pp2 y
let comma_pair x = pair "(%a,@ %a)" x
let list_pair x = pair "[%a;@ %a]" x
let eq_pair x = pair "%a=%a" x

but this does not feel very practical.

Padding and precision

Another interesting way to customize the printing of basic type are the padding and precision argument modals. Numeric specifiers can be adjoined a padding size:

Format.printf "%05d@." 5

00005

This padding size determines the minimum size of the output. Moreover, here, the leading 0 indicates that the output should be padded by 0. Similarly, for floats, the precision modal determines the number of fractional digits

Format.printf "%.2d@." 0.51542

0.52

Those explicit padding and precision modals can also be provided as an argument of fprintf by replacing the numerical value by *

let pp_int ~padding ~precision ppf = Format.fprintf "%*.*f" padding precision

Format type specifier printer

An even more anecdotal features of Format.fprintf is the printing of the canonical type specification of a format string, also known as %{...%}

Format.printf "%{%a%}@."  "A format with %a"

%a

The specifier %{fmt%} prints the type specification of the format given as an argument and of which the type is compatible with the format argument fmt. In other words, in many cases, %{fmt%} is a very involved way to print fmt. However, the two strings can differ slightly when non-canonical conversion specification are used:

Format.printf "%{%+*.*g%}@." "%*.*f"

%i%i%f

Note that %{...%} is more useful on the Scanf side.