Incomplete expression in ppx extension

[mattiasdrp]

Duplicated from https://stackoverflow.com/questions/71466896/incomplete-expression-in-ppx-extension

I want to try to write my own ppx to allow named arguments in formatting strings:

From Format.printf [%fmt "!(abc) !(qsd)"] to Format.printf "%s %s" abc qsd

When dumping with ppx_tools I want to go from:

{pexp_desc =
  Pexp_apply
   ({pexp_desc = Pexp_ident {txt = Ldot (Lident "Format", "printf")};
     pexp_loc_stack = []},
   [(Nolabel,
     {pexp_desc =
       Pexp_extension
        ({txt = "fmt"},
         PStr
          [{pstr_desc =
             Pstr_eval
              ({pexp_desc =
                 Pexp_constant (Pconst_string ("!(abc) !(qsd)", ...));
                pexp_loc_stack = []},
              ...)}]);
      pexp_loc_stack = []})]);
 pexp_loc_stack = []}

To

{pexp_desc =
  Pexp_apply
   ({pexp_desc = Pexp_ident {txt = Ldot (Lident "Format", "printf")};
     pexp_loc_stack = []},
   [(Nolabel,
     {pexp_desc = Pexp_constant (Pconst_string ("%s %s", ...));
      pexp_loc_stack = []});
    (Nolabel,
     {pexp_desc = Pexp_ident {txt = Lident "abc"}; pexp_loc_stack = []});
    (Nolabel,
     {pexp_desc = Pexp_ident {txt = Lident "qsd"}; pexp_loc_stack = []})]);
 pexp_loc_stack = []}

The ppx extension starts inside a function application so I would just want to specify that what I'm about to create are applications arguments but so far I've not been able to do so:

I get the formatting string (in my example it would be "%s %s") and the arguments to it (e.g. abc and qsd) and try to produce "%s %s" abc qsd but if I use Ast_build.Default.elist fmt args I get ["%s %s"; abc; qsd] and with eapply I get ("%s %s" abc qsd) (almost there but the parenthesis make it wrong).

let expand ~ctxt fmt =
  let loc = Expansion_context.Extension.extension_point_loc ctxt in
  let fmt, args = parse loc fmt in
  Ast_builder.Default.eapply ~loc (* <- Here is where I don't know what to do *)
    (Ast_builder.Default.estring ~loc fmt)
    (List.map (Ast_builder.Default.evar ~loc) args)

Since it's heavily recommended to use ppxlib to do this kind of things, is there an easy way to achieve what I want? I tried looking for some documentation for it but it's still a work in progress and the few examples I could find transform an expression in another expression while I'm transforming an expression (a string) in an incomplete one.

---

FULL CODE:

open Ppxlib

(* A format string is a normal string with the special construct !(...) *)

let parse loc string =
  let length = String.length string in
  let buffer = Buffer.create length in
  let rec parse args index =
    if index = length then (Buffer.contents buffer, args)
    else
      match String.unsafe_get string index with
      | '!' as c ->
          if index = length - 1 || String.unsafe_get string (index + 1) <> '('
          then (
            (* Simple ! not starting a named argument *)
            Buffer.add_char buffer c;
            parse args (index + 1))
          else
            (* We saw !( and need to parse the rest as a named argument *)
            let index, var = parse_named_arg (index + 2) in
            Buffer.add_string buffer "%s";
            parse (var :: args) index
      | c ->
          Buffer.add_char buffer c;
          parse args (index + 1)
  and parse_named_arg index =
    let var = Buffer.create 8 in
    let rec parse_var index =
      if index = length then
        Location.raise_errorf ~loc
          "Reached end of formatting string with !(...) construct not ended"
      else
        match String.unsafe_get string index with
        | ')' -> (index + 1, Buffer.contents var)
        | c ->
            Buffer.add_char var c;
            parse_var (index + 1)
    in
    parse_var index
  in
  parse [] 0

let expand ~ctxt fmt =
  let loc = Expansion_context.Extension.extension_point_loc ctxt in
  let fmt, args = parse loc fmt in
  Ast_builder.Default.eapply ~loc
    (Ast_builder.Default.estring ~loc fmt)
    (List.map (Ast_builder.Default.evar ~loc) args)

let my_extension =
  Extension.V3.declare "fmt" Extension.Context.expression
    Ast_pattern.(single_expr_payload (estring __))
    expand

let rule = Ppxlib.Context_free.Rule.extension my_extension
let () = Driver.register_transformation ~rules:[ rule ] "ppx_fmt_string"

[panglesd]

Ppxlib's extenders can rewrite extension nodes only in a "context-free" way, that is the rewriting cannot depend on the context.

In particular, let _ = [%fmt "!(abc) !(qsd)"] would need to be able to be rewritten, but it does not make sense without a prepended function, as [%fmt "!(abc) !(qsd)"] only add arguments.

One way to go around this would be to include the function in the payload:
[%fmt f "!(abc) !(qsd)"] would be rewritten to f "%s %s" abc qsd.
(f = Printf.printf to get your example.)

Another way is to write your own "context-sensitive" rewriter: a function which takes an AST, looks for fmt extension nodes, verify that they are given as an argument to a function, rewrite the application, and return the new AST. (see impl and intf labelled arguments in the register_transformation doc)

Usually, context-dependent rewriters should be avoided, as their composition semantic is unclear (the order on which they are applied matter). Instead, I would go for the first option, including the function in the payload.