Simple Function Match Macros for OCaml

dune

(library
 (name macros)
 (modules "macros")
 (libraries ppxlib)
 (kind ppx_rewriter)
 (preprocess (pps ppxlib.metaquot)))

(executable
 (public_name macros)
 (modules "main")
 (name main)
 (preprocess (pps macros)))

macros.ml

module AH = Ppxlib_ast.Ast_helper

let unzip ls =
  let rec loop (accl, accr) = function
    | [] -> List.rev accl, List.rev accr
    | (l,r) :: rs -> loop (l :: accl, r :: accr) rs in
  loop ([],[]) ls

let transform_match : Ppxlib.Context_free.Rule.t =
  let open Ppxlib in
  Context_free.Rule.extension @@
    Extension.V3.declare "function"
    Extension.Context.Expression
    Ast_pattern.(
      single_expr_payload @@ pexp_match
        __
        __
    )
    (fun ~ctxt:_ expr cases ->
       let mexpr : expression = AH.with_default_loc expr.pexp_loc @@ fun () ->
         match expr with
         | {pexp_desc = Pexp_unreachable; _} ->
           AH.Exp.function_ cases
         | {pexp_desc = Pexp_tuple args; _ } ->
           let exps, vars =
             let id = ref 0 in
             let get_id () = incr id; Format.sprintf "a%d" !id in
             let make_var loc =
               let id = get_id () in
               AH.Exp.ident ~loc ({txt=Lident id; loc}),
               AH.Pat.var ~loc ({txt=id; loc}) in
             List.map (function
                 | { pexp_desc=Pexp_ident {txt= Lident "??"; _}; pexp_loc; _ } ->
                   make_var pexp_loc
                 | {pexp_loc=loc; _} as e ->
                   Ppxlib.Location.raise_errorf ~loc "all arguments (%a) must be (??)"
                     Ppxlib.Pprintast.expression e
               ) args
             |> unzip in
           List.fold_left
             (fun e v -> AH.Exp.fun_ Nolabel None v e)
             (AH.Exp.match_ (AH.Exp.tuple exps) cases)
             (List.rev vars)
         | {pexp_loc=loc; _} as e ->
           Ppxlib.Location.raise_errorf ~loc "all arguments (%a) must be (??)"
             Ppxlib.Pprintast.expression e
       in
       mexpr
    )

let () =
  Ppxlib.Driver.V2.register_transformation
    ~rules:[transform_match]
    "function"

main.ml

let () = (match%function (??), (??) with
    | true, true -> Format.printf "both true\n"
    | false, false -> Format.printf "both false\n"
    | true, false -> Format.printf "true then false\n"
    | false, true -> Format.printf "true then false\n"
  ) true false