Adding optional parameters to ppx extension nodes

Learning
1

Right now I am trying to create a ppx where its input is a module. So it would look something like this

[%%foo
let a = "a"
let b = "b"
...
]

I would like to add some optional argument, similar to how you can add optional arguments to ppx_deriving.

For example, you can use the yojson ppx to derive the following:

type t = string
[@@deriving yojson { strict = true }]

I would like my extension to have the optional parameter strict like with the yojson example:

[%%foo{bar = false}
let a = "a"
let b = "b"
...
]

How can you achieve this with extension nodes?

2

This code is parsed as an extension node foo with a PStr payload containing three structure items:

  • a Pstr_eval item carrying the record { bar = false },
  • two Pstr_value items carrying the let-bindings.

(One of the ways to have a look on how a code foo.ml is parsed is to run ocamlc -dparsetree foo.ml.)

You may use pattern-matching on the payload to extract the optional record. In the following example, the record is extracted in optional_arguments and the remaining structure items are stored in structure.

let structure_item (mapper : Ast_mapper.mapper) (item : Parsetree.structure_item)
    : Parsetree.structure_item =
  match item.pstr_desc with
  | Pstr_extension (({ txt = "foo"; _ }, payload), _attrs) ->
      let structure =
        match payload with
        | PStr structure -> structure
        | _ -> Location.raise_errorf ~loc:item.pstr_loc "Structure expected" in
      let optional_arguments, structure =
        match structure with
        | { pstr_desc = Pstr_eval (
            { pexp_desc = Pexp_record (optional_arguments, None); _ }, []); _ }
          :: structure ->
            Some optional_arguments, structure
        | _ -> None, structure in
      ignore (optional_arguments :
        (Longident.t Location.loc * Parsetree.expression) list option);
      ignore (structure : Parsetree.structure);
      Ast_mapper.default_mapper.structure_item mapper item
  | _ ->
      Ast_mapper.default_mapper.structure_item mapper item

let () =
  Migrate_parsetree.Driver.register ~name:"foo"
    (module Migrate_parsetree.OCaml_current)
    (fun _ _ -> { Ast_mapper.default_mapper with structure_item })

One could argue that there is a grammar conflict between optional arguments and structures that just begin by evaluating a record: I don’t think that this is a real problem since it does not seem particularly useful to evaluate a record just for discarding it immediately after build, but perhaps a more usual syntax would be to use attributes attached to the extension node to carry the optional parameters.

3

How can I read parameters encoded in the optional parameter

4

optional_arguments has type (Longident.t Location.loc * Parsetree.expression) list: it is a list of label/value pairs. You may convert it to a list of string pairs with something like the following code (which requires keys to be simple identifiers and values to be either simple identifiers or quoted strings; you may need adapt this to fit your needs):

let string_pair_of_record_field
    ((label, value) : (Longident.t Location.loc * Parsetree.expression))
    : string * string =
  let key =
    match label.txt with
    | Lident key -> key
    | _ -> Location.raise_errorf ~loc:label.loc "Option name expected" in
  let value =
    match value.pexp_desc with
    | Pexp_ident { txt = Lident s }
    | Pexp_construct ({ txt = Lident s; _ }, None)
    | Pexp_constant (Pconst_string (s, _)) ->
        s
    | _ -> Location.raise_errorf ~loc:value.pexp_loc "Option value expected" in
  (key, value)

let string_pairs_of_record_fields
    (fields : (Longident.t Location.loc * Parsetree.expression) list)
    : (string * string) list =
  List.map string_pair_of_record_field fields