deriving show recursive, polymorphic types

[choeger]

When you try to derive for a type like:

type foo = F of int | B of int bar | C of float bar
type 'a bar = { x : 'a ; r : Foo } 

You will end up with recursive functions:

let rec pp_foo ...
and pp_bar poly_a ...

However, the recursive binding does not allow for multiple instantiations of the polymorphic argument. Hence, you should probably move that out of the recursive group.

[whitequark]

I don't quite understand what you mean. Can you show an example?

[choeger]

Here is a non-working example: type foo = Foo of int | Bar of int baz | Baz of float baz and 'a baz = {a : 'a} [@@deriving show] ;; The reusage of the structure of baz is a useful pattern in real-world applications (since structures tend to occur repeatedly). However, inside the "head" foo there may be a finite amount of instantiations of baz, deriving only allows for one currently. To solve that, one would have to factor out these instantiations and create pretty-printers for each one.

[whitequark]

Ok, the code that is currently generated is:

let rec pp_foo fmt =
    function
    | Foo a0 ->
        (Format.fprintf fmt "(@[<hov2>Foo@ ";
         (Format.fprintf fmt "%d") a0;
         Format.fprintf fmt "@])")
    | Bar a0 ->
        (Format.fprintf fmt "(@[<hov2>Bar@ ";
         (pp_baz (fun fmt  -> Format.fprintf fmt "%d") fmt) a0;
         Format.fprintf fmt "@])")
    | Baz a0 ->
        (Format.fprintf fmt "(@[<hov2>Baz@ ";
         (pp_baz (fun fmt  -> Format.fprintf fmt "%F") fmt) a0;
         Format.fprintf fmt "@])")
  and show_foo x = Format.asprintf "%a" pp_foo x
  and pp_baz poly_a fmt x =
    Format.fprintf fmt "{ @[<hov>";
    (Format.pp_print_string fmt "a = "; (poly_a fmt) x.a);
    Format.fprintf fmt "@] }";;

What code should I generate instead?

[choeger]

I would propose to break the recursion for generated polymoprhic pp functions that appear multiple times on the rhs of other generated pp functions:

 let pp_baz pp_foo poly_a fmt x =
    Format.fprintf fmt "{ @[<hov>";
    (Format.pp_print_string fmt "a = "; (poly_a fmt) x.a);
    Format.fprintf fmt "@] }";;

let rec pp_foo fmt =
    function
    | Foo a0 ->
        (Format.fprintf fmt "(@[<hov2>Foo@ ";
         (Format.fprintf fmt "%d") a0;
         Format.fprintf fmt "@])")
    | Bar a0 ->
        (Format.fprintf fmt "(@[<hov2>Bar@ ";
         (pp_baz pp_foo (fun fmt  -> Format.fprintf fmt "%d") fmt) a0;
         Format.fprintf fmt "@])")
    | Baz a0 ->
        (Format.fprintf fmt "(@[<hov2>Baz@ ";
         (pp_baz pp_foo (fun fmt  -> Format.fprintf fmt "%F") fmt) a0;
         Format.fprintf fmt "@])")
  and show_foo x = Format.asprintf "%a" pp_foo x

The additional parameter to pp_baz is of course not necessary here, but might be in the general case. However it is probably a design decision, where and how to break the recursion. OCaml only requires you to do it somehow ;).

[whitequark]

OK. I will not have time to make this relatively nontrivial change soon, so feel free to submit a PR if you come up with one.

[Twinside]

There is a far simpler solution: adding a strong polymorphic type signature, for the example used in this ticket:

 (* up as before *)
and pp_bar
  : 'a . (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a bar -> unit =
fun poly_a fmt x ->
  (* rest as before *)

The type signature will force the function to be polymorphic, and allowing proper compilation.

I can provide a similar example but for the ord deriver:

    type expr =
      | Bool of bool_expr
      | Plus of expr * expr
      | IfE  of expr if_expr

    and bool_expr =
      | True
      | False
      | And of bool_expr * bool_expr
      | IfB of bool_expr if_expr

    and 'a if_expr = bool_expr * 'a * 'a
      [@@deriving ord]

Compiling it yield the following error message:

File "test.ml", line 39, characters 30-47:
Error: This expression has type bool_expr -> bool_expr -> int
       but an expression was expected of type expr -> expr -> int
       Type bool_expr is not compatible with type expr 

Looking at the generated code (extracting using ppx_tools/rewriter):

let rec compare_expr lhs rhs =
  match (lhs, rhs) with
  (* ... *)
  | (IfE lhs0,IfE rhs0) ->
      (* compare_if_expr with is used and substitute '_a with expr,
         it was not generalized at this point. *)
      (match (compare_if_expr compare_expr) lhs0 rhs0 with
       | (-1)|1 as x -> x
       | _ -> 0)
  (* ... *)
and compare_bool_expr lhs rhs =
  match (lhs, rhs) with
  (* ... *)
  | (IfB lhs0,IfB rhs0) ->
      (* compare_if_expr was monorphized during the previous use,
         and yield a type error here when we try to use it against
         a bool_expr. *)
      (match (compare_if_expr compare_bool_expr) lhs0 rhs0 with
       | (-1)|1 as x -> x
       | _ -> 0)
  (* ... *)
and compare_if_expr poly_a (lhs0,lhs1,lhs2) (rhs0,rhs1,rhs2) =
  (* ... *)

Applying the same technique to fix the compilation:

and compare_if_expr
  : 'a . ('a -> 'a -> int) -> (bool_expr * 'a * 'a) -> (bool_expr * 'a * 'a) -> int =
fun poly_a (lhs0,lhs1,lhs2) (rhs0,rhs1,rhs2) ->