Best approach for implementing open recursion over extensible types

Learning
,
5

Funny you should suggest that. I’ve just come up with something somewhat similar;

class type printer = object
  method pp_expr : 'a . Format.formatter -> 'a expr -> unit 
end

Defining printers is quite straightforward:

let printer (p: printer) : printer = object (self)
  method pp_expr : 'a . Format.formatter -> 'a expr -> unit = fun (type a) fmt (expr: a expr) : unit ->
    match expr with
    | Int n -> Format.fprintf fmt "%d" n
    | Add (l,r) -> Format.fprintf fmt "%a + %a" self#pp_expr l self#pp_expr r
    | Sub (l, r) -> Format.fprintf fmt "%a - %a" self#pp_expr l self#pp_expr r
    | _ -> p#pp_expr fmt expr
end

Finally, we need a compose function to tie things together:

let build_printer (printers: (printer -> printer) list) =
  let base_printer = object
    val mutable printer : oprinter option = None
    method set_printer p = printer <- Some p
    method pp_expr : 'a . Format.formatter -> 'a expr -> unit =
      fun fmt expr ->
      match printer with
      | None -> assert false
      | Some p -> p#pp_expr fmt expr
  end in
  let printer =
    List.fold_left (fun printer make_printer ->
      make_printer printer)
      (base_printer :> printer)
      printers in
  base_printer#set_printer printer;
  (base_printer :> printer)

Finally usage:

let () =
  let p = build_printer [Arith.printer; Bool.printer; printer] in
  let x = Int 10 in
  Format.printf "x is %a\n%!" p#pp_expr x;
  let y = Add (x, x) in
  Format.printf "y is %a\n%!" p#pp_expr y;
  let z = Arith.Lt (x, y) in
  Format.printf "z is %a\n%!" p#pp_expr z;
  let a = Bool.And (z, z) in
  Format.printf "a is %a\n%!" p#pp_expr a;
  let b = Bool.Or (a, Arith.UNKNOWN) in
  Format.printf "b is %a\n%!" p#pp_expr b

I don’t think I’m really using anything specific object-properties in the code, so it could probably be replaced with a struct.

The nice thing about this implementation is that the code for the printers can be written in an idiomatic way and don’t need to think about the failure case (no need to wrap things in optional parameters).

The problem with this design is that if no case can handle the constructor, then it loops.