ocamlutop

Why mark stag functions are not called here?


I am trying to understand the following behaviour of OCaml Format module and semantic tags.

My code:

let prepare_ppf ppf =
  let original_stag_functions = Format.pp_get_formatter_stag_functions ppf () in
  let original_mark_tags_state = Format.pp_get_mark_tags ppf () in
  Format.pp_set_mark_tags ppf true;
  Format.pp_set_print_tags ppf false;
  Format.pp_set_formatter_stag_functions ppf {
    mark_open_stag = (fun stag ->
          print_endline "MARK-OPEN";
          match stag with
          | Format.String_tag s -> Printf.sprintf "<open:%s>" s
          | _ -> "<UNKNOWN>"
        );
    mark_close_stag = (fun stag ->
          print_endline "MARK-CLOSE";
          match stag with
          | Format.String_tag s -> Printf.sprintf "</close:%s>" s
          | _ -> "</UNKNOWN>"
        );
    print_open_stag = (fun _ -> print_endline "PRINT-OPEN"; ());
    print_close_stag = (fun _ -> print_endline "PRINT-CLOSE"; ());
  };
  print_endline "PREPARED";
  if Format.pp_get_mark_tags ppf () then print_endline "MARK:true";
  (fun ppf ->
      print_endline "RESET";
      Format.pp_set_mark_tags ppf original_mark_tags_state;
      Format.pp_set_formatter_stag_functions ppf original_stag_functions;)

let fprintf ppf fmt =
  let reset = prepare_ppf ppf in
  Format.kfprintf reset ppf fmt

let printf fmt = fprintf Format.std_formatter fmt

If I paste that into: utop version 2.8.0 (using OCaml version 4.12.0)

When I run it:

utop # printf "@{<bold>%s@}" "hello";;
PREPARED
MARK:true
RESET
<bold>hello</bold>- : unit = ()

Why are the mark_open_stag and close functions not called?

If I change line 5 to Format.pp_set_print_tags ppf true; then I see the print_open_stag and close function are called.


Solution

  • This is an interaction between buffering and utop handling of the stdout formatter.

    The buffering issue can be seen with

    printf "@{<bold>%s@}" "A very very very very very very very very very very very very very very very very very long hello world";;
    

    which prints the half-correct

    PREPARED
    MARK:true
    MARK-OPEN
    <open:bold>A very very very very very very very very very very very very very very very very very long hello worldRESET
    </bold>
    

    Going on step further, flushing the stdout at the end with

    printf "@{<bold>%s@}@." "hello";;
    

    yields the correct output

    PREPARED
    MARK:true
    MARK-OPEN
    <open:bold>helloMARK-CLOSE
    </close:bold>
    RESET
    

    The issue is thus that

    printf "@{<bold>%s@}" "hello"
    

    buffers completely all its input. And it is utop taking the hand on the stdout formatter which triggers the printing by trying to print

    - : unit = ()
    

    This yields then

    <bold>hello</bold>- : unit = ()
    

    because at the time of the printing utop has reset the formatter configuration to its own default.