Fmt 0.9.0 破坏了我的代码，我怎样才能使它兼容？ Format.pp_set_formatter_stag_functions

Question

我有一些类似的代码：

(* Format.stag is an extensible variant type, we only want to handle Format.String_tag *)
exception UnhandledExtension of Format.stag

...

      let conditionally_raise e stack = match raise_errors with
        | true -> reset ppf; raise e
        | false -> Stack.clear stack
      in
      let color_tag_funs : Format.formatter_stag_functions =
        {
          mark_open_stag = (fun stag ->
              let _ = match stag with
                | Format.String_tag s -> begin
                    match Lexer.tag_to_code @@ String.lowercase_ascii s with
                    | Ok s -> Stack.push s stack
                    | Error e -> conditionally_raise e stack
                  end
                | other -> conditionally_raise (UnhandledExtension other) stack (* case not expected *)
              in
              collapse stack
            );
          mark_close_stag = (fun _ ->
              match Stack.is_empty stack with
              | true -> ""
              | false -> ignore @@ Stack.pop stack; collapse stack
            );
          print_open_stag = (fun _ -> ());
          print_close_stag = (fun _ -> ());
        }
      in

当我在本地运行它时，它运行良好，直到我今天重建了我的交换机。

完美，我的意思是这条线从未到达过：

    stag -> conditionally_raise (UnhandledExtension stag) stack (* case not expected *)

当我将更改推送到 github 时，我发现我的操作导致测试失败：

  [OK]          Fatal error: exception Spectrum.Printer.UnhandledExtension(_)
Raised at Spectrum__Printer.make_printer.M.prepare_ppf.conditionally_raise in file "lib/printer.ml", line 38, characters 18-25
Called from Fmt.store_op in file "src/fmt.ml" (inlined), line 626, characters 2-24
Called from Fmt.get in file "src/fmt.ml", line 628, characters 40-73
Called from Fmt.style_renderer in file "src/fmt.ml" (inlined), line 650, characters 25-52
Called from Fmt.styled in file "src/fmt.ml", line 745, characters 36-54
Called from Stdlib__format.output_acc in file "format.ml", line 1298, characters 32-48
Called from Stdlib__format.output_acc in file "format.ml", line 1298, characters 32-48
Called from Stdlib__format.kfprintf.(fun) in file "format.ml", line 1349, characters 16-34
Called from Stdlib__format.output_acc in file "format.ml", line 1298, characters 32-48
Called from Stdlib__format.kfprintf.(fun) in file "format.ml", line 1349, characters 16-34
Called from Alcotest_engine__Pp.Make.info in file "src/alcotest-engine/pp.ml", line 94, characters 8-41
Called from Alcotest_engine__Pp.Make.pp_result_full in file "src/alcotest-engine/pp.ml", line 136, characters 4-65
Called from Stdlib__format.output_acc in file "format.ml", line 1288, characters 4-20
Called from Stdlib__format.kfprintf.(fun) in file "format.ml", line 1349, characters 16-34
Called from Alcotest_engine__Core.Make.pp_event in file "src/alcotest-engine/core.ml", line 128, characters 6-168
Called from Alcotest_engine__Core.Make.perform_test in file "src/alcotest-engine/core.ml", line 237, characters 4-45
Called from Alcotest_engine__Monad.Extend.Syntax.(>|=).(fun) in file "src/alcotest-engine/monad.ml", line 32, characters 46-51
Called from Alcotest_engine__Monad.Extend.List.fold_map_s.inner in file "src/alcotest-engine/monad.ml", line 44, characters 26-34
Called from Alcotest_engine__Core.Make.perform_tests in file "src/alcotest-engine/core.ml", line 252, characters 6-276
Called from Alcotest_engine__Core.Make.result in file "src/alcotest-engine/core.ml", line 302, characters 19-44
Called from Alcotest_engine__Core.Make.run_tests in file "src/alcotest-engine/core.ml", line 356, characters 8-27
Called from Alcotest_engine__Core.Make.run_with_args' in file "src/alcotest-engine/core.ml", line 390, characters 6-304
Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 25, characters 19-24
Called from Cmdliner.Term.run in file "cmdliner.ml", line 117, characters 32-39
Called from Cmdliner.Term.term_eval in file "cmdliner.ml", line 147, characters 18-36
Called from Cmdliner.Term.eval_choice in file "cmdliner.ml", line 265, characters 22-48
Called from Alcotest_engine__Cli.Make.run_with_args' in file "src/alcotest-engine/cli.ml", line 108, characters 6-164
Called from Junit_alcotest.run_and_report in file "alcotest/junit_alcotest.ml", line 65, characters 6-26
Called from Dune__exe__Printer in file "tests/printer.ml", line 111, characters 26-73

（不仅仅是测试失败，测试运行本身基本崩溃）

我重建了本地交换机，错误也在本地重现。我将其缩小到 Fmt 库中的更改...重建我的交换机给了我几周前发布的 0.9.0 版本。 （降级到 Fmt 0.8.10 让它再次消失）。

由于https://github.com/dbuenzli/fmt/blob/master/src/fmt.ml#L608https://github.com/dbuenzli/fmt/blob/master/src/fmt.ml#L608 的更改，我很确定我的代码正在中断

所以 Fmt 库现在扩展了 Format.stag 变体。

不幸的是，我不明白发生了什么，除此之外，我猜现在有两个语义标签格式化程序以某种方式相互冲突。

它只会在测试中崩溃，而不是在说 utop 中使用我的代码时。 这是有道理的，因为在这种情况下Fmt 是不活动的（它作为 Alcotest 的依赖项出现）。

我知道| other -> conditionally_raise (UnhandledExtension other) stack 是个坏主意，但如果我用| _ -> () 替换它，我会遇到不同的崩溃：

  [OK]          Fatal error: exception File "src/fmt.ml", line 647, characters 60-66: Assertion failed
Raised at Fmt.style_renderer_attr.dec in file "src/fmt.ml", line 647, characters 60-72
Called from Fmt.get in file "src/fmt.ml", line 629, characters 25-32
Called from Fmt.style_renderer in file "src/fmt.ml" (inlined), line 650, characters 25-52
Called from Fmt.styled in file "src/fmt.ml", line 745, characters 36-54
Called from Stdlib__format.output_acc in file "format.ml", line 1298, characters 32-48
...

所以它在这里触发了assert false 案例：https://github.com/dbuenzli/fmt/blob/master/src/fmt.ml#L647

Answer 1

您的问题确实源于您既要发出 Fmt 标签，又要安装拒绝这些标签的标签打印机。

我不确定您要对标签处理做什么，所以让我介绍使用新标签扩展格式化程序的通用方法。 这个想法基本上是用处理新标签的版本更新格式化程序中存在的当前标签打印功能，并将未知标签的处理委托给预先存在的功能。

(** normally, when defining new tags, it is better to extend the `Format.stag` type rather than relying on parsing tags *)
type Format.stag += My_tag of Lexer.t


let extend_tags_with_my_tag ppf =
  (* first, we get the existing tag-handling functions *)
  let parent = Format.pp_get_formatter_stag_functions ppf () in
  let print_open_stag stag = begin match stag with
    | Format.String_tag s ->
        (* backward-compatibility path *)
        begin match Lexer.tag_to_code @@ String.lowercase_ascii s with
        | Ok s -> Stack.push s stack
        | Error e ->
          (* we don't know this string tag,
             we delegate to the original function *)
          parent.print_open_stag stag
      end
    | My_tag lex -> 
      (* with a stag, there is no need for parsing *)
      Stack.push lex stack
    | stag -> 
      (* we let the parent handler takes care of the unknown tags *)
      parent.print_open_stag stag
  end;
    collapse stack
  in
  let print_close_stag stag = match stag with
    | My_tag lex -> ignore (Stack.pop stack)
    | Format.String_tag s as stag ->
      begin
        match Lexer.tag_to_code @@ String.lowercase_ascii s with
        | Ok s -> ignore (Stack.pop stack)
        | Error e -> parent.print_close_stag stag
      end
    | _ -> parent.print_close_stag stag
  in
  (* updating the original record is probably better
     for future-compatibility *)
  { parent with print_open_stag; print_close_stag }

请注意，我使用的是print_open_stag 和print_close_stag，因为它们通常比标记版本更有用。

编辑：关于标记功能，它们大多适合调试目的。通常，

Format.set_mark_tags true; Format.printf "@{<tag>content@}"

打印

<tag>contents</tag>

<tag> 和 </tag> 在格式方面都被忽略。 然而，标签的细化往往需要打印中断提示、框、一些格式化的内容甚至其他标签。这不符合标记 API。在这种情况下，最好选择print 变体。