PPX for generating a recursive traversal of a non-polymorphic datatype?

Learning
1

I’m looking for a PPX to do a recursive traversal of a non-polymorphic datatype. Here is the kind of code I want to generate:

type exp =
  | Int of int
  | Add of exp * exp
  | Sub of exp * exp

(* I want to generate this: *)
let conv (f : exp -> exp) (e : exp) : exp =
  match e with
    | Int _ -> e
    | Add (e1, e2) -> Add (f e1, f e2)
    | Sub (e1, e2) -> Sub (f e1, f e2)

I’m aware of the “deriving map” from ppx_deriving, but that requires a polymorphic datatype, which is not what I have here. (Essentially, this is like a degenerate form of map.) I want to use this in conjunction with ppx_stable to allow me to convert a value from a type to a superset the type without having to do the manual boilerplate for uninteresting recursive points. I’ve looked, but so far I haven’t found anything exactly like this. Does anyone know of a PPX that can do this?

2

I think visitors POTTIER Francois / visitors · GitLab should provide what you need. Check out the (excellent) documentation: http://gallium.inria.fr/~fpottier/visitors/manual.pdf.

Cheers,
Nicolas

3 Likes
3

OK, checked out. Very cool approach, but also pretty heavyweight. It would make sense if I needed a way to change a single constructor, for instance, but to apply a function to every subexpression I would have to override a visitor method for each constructor with subexpressions. This isn’t going to be any easier than just writing the transformation by hand.

4

Isn’t it enough to override the visit_expr method of the map visitor?

image

Cheers,
Nicolas

2 Likes
5

Ah yes, you can do this:

let mapper =
  object
    inherit [_] map as super
    method visit_exp f e = super#visit_exp f (f e)
  end

which works fine. Thanks!

6

[nevermind, deriving map doesn’t generate what you want.]

7

For reasons unrelated to your problem, what I’m going to suggest might not be useful to you, but it might be interesting to look at anyway. pa_ppx_migrate (part of the Camlp5 suite of PPX rewriters) does this pretty much on-the-nose.

[Why not useful? B/c it’s based on Camlp5, which is not compatible with the standard PPX rewriter infrastructure (it implements its own, work-alike for many rewriters, but not internally compatible)]

The problem it solves:

  1. suppose you have two types A,B (actually two families of mutually-recursive types) that are pretty similar, but with some differences (for example, two different versions of the OCaml AST types).

  2. you want to implement functions that go from the type A_i to the types B_i, and maybe back also.

  3. You don’t want to write all the boilerplate code for the cases where various case-branches and type-expressions are the same between A, B.

  4. And maybe you want to step in with code for a case-branch that is different, or a field that needs to be supplied, or a field that no longer exists. Or, custom code for a case branch that you want to deviate from straight copying.

pa_ppx_migrate automates the generation of the boilerplate, while providing the spots for those custommizations. Here’s a few examples based on your type:

First, your type (in foo.ml):

type exp =
  | Int of int
  | Add of exp * exp
  | Sub of exp * exp

then just copying a value of your type

type exp = [%import: Foo.exp
  [@with int := t2]
]
and t2 = int
[@@deriving migrate
    { dispatch_type = dispatch_table_t
    ; dispatch_table_constructor = make_dt
    ; default_open_recursion = true
    ; default_dispatchers = [
        {
          srcmod = Foo
        ; dstmod = Foo
        ; types = [
            exp
          ]
        }
      ]
    ; dispatchers = {
        migrate_t2 = {
          srctype = [%typ: t2]
        ; dsttype = [%typ: int]
        ; code = (fun __dt__ x -> x)
        }
      }
    }
]

now add one to the Int values


type exp = [%import: Foo.exp
  [@with int := t2]
]
and t2 = int
[@@deriving migrate
    { dispatch_type = dispatch_table_t
    ; dispatch_table_constructor = make_dt
    ; default_open_recursion = true
    ; default_dispatchers = [
        {
          srcmod = Foo
        ; dstmod = Foo
        ; types = [
            exp
          ]
        }
      ]
    ; dispatchers = {
        migrate_t2 = {
          srctype = [%typ: t2]
        ; dsttype = [%typ: int]
        ; code = (fun __dt__ x -> x)
        }
      }
    }
]

and now swap the subtrees of Add constructors

type exp = [%import: Foo.exp
  [@with int := t2]
]
and t2 = int
[@@deriving migrate
    { dispatch_type = dispatch_table_t
    ; dispatch_table_constructor = make_dt
    ; default_open_recursion = true
    ; dispatchers = {
        migrate_exp = {
          srctype = [%typ: exp]
        ; dsttype = [%typ: exp]
        ; custom_branches_code = function
              Add(a,b) ->  Add (__dt__.migrate_exp __dt__ b, __dt__.migrate_exp __dt__ a)
        }
      ; migrate_t2 = {
          srctype = [%typ: t2]
        ; dsttype = [%typ: int]
        ; code = (fun __dt__ x -> x)
        }
      }
    }
]

And here it is in use in a toplevel:

#use "topfind.camlp5";;
#load "foo.cmo";;
#load "foo_migrate.cmo";;
open Foo ;;
open Foo_migrate ;;
let x = Add(Int 1,  Int 2) ;;
let dt0 = Copy.make_dt () ;;
dt0.migrate_exp dt0 x ;;

let dt1 = AddOne.make_dt () ;;
dt1.migrate_exp dt1 x ;;

let dt2 = SwapAdd.make_dt () ;;
dt2.migrate_exp dt2 x ;;
val x : Foo.exp = Add (Int 1, Int 2)
val dt0 : unit Foo_migrate.Copy.dispatch_table_t =
  {Foo_migrate.Copy.aux = (); migrate_exp = <fun>; migrate_t2 = <fun>}
- : Foo.exp = Add (Int 1, Int 2)
val dt1 : unit Foo_migrate.AddOne.dispatch_table_t =
  {Foo_migrate.AddOne.aux = (); migrate_exp = <fun>; migrate_t2 = <fun>}
- : Foo.exp = Add (Int 2, Int 3)
val dt2 : unit Foo_migrate.SwapAdd.dispatch_table_t =
  {Foo_migrate.SwapAdd.aux = (); migrate_exp = <fun>; migrate_t2 = <fun>}
- : Foo.exp = Add (Int 2, Int 1)

The project GitHub - camlp5/pa_ppx_migrate: PPX Rewriter to help write AST migrations for Ocaml (using Camlp5 and pa_ppx) has a ton of examples (but sadly, not so much documentation) and I use it to generate migrations between the various versions of the OCaml AST, so it’s pretty full-featured.

ETA: and you can override the functions in the “dispatch table” after it’s been created, so starting with one that copies blindly, you can override a case-branch to swap the subtrees of an Add:

let dt2' =
  let dt = Copy.make_dt() in
  let old_migrate_exp = dt.migrate_exp in
  { dt with migrate_exp = fun __dt__ e ->
    match e with
      Add(a,b) -> Add(__dt__.migrate_exp __dt__ b, __dt__.migrate_exp __dt__ a)
    | _ ->  old_migrate_exp __dt__ e }
                                     
;;
dt2'.migrate_exp dt2' x ;;
val dt2' : unit Foo_migrate.Copy.dispatch_table_t =
  {Foo_migrate.Copy.aux = (); migrate_exp = <fun>; migrate_t2 = <fun>}
# dt2'.migrate_exp dt2' x ;;
- : Foo.exp = Add (Int 2, Int 1)
#
2 Likes
8

Thanks for the link and explanation!