Source file pipe_first.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
(* Based on https://github.com/jaredly/belt/blob/master/belt_ppx/Belt_ppx.ml,
   rewriten in ppxlib register and Context_free.Rule.special_function *)

open Ppxlib

let expander e =
  let rec expander' e =
    let loc = e.pexp_loc in
    match e.pexp_desc with
    | Pexp_apply
        ( {
            pexp_desc = Pexp_ident { txt = Lident "|."; _ };
            pexp_loc_stack;
            pexp_loc = _;
            pexp_attributes = _;
          },
          [ (Nolabel, arg); (Nolabel, fn) ] ) -> (
        let fn = Option.value ~default:fn (expander' fn) in
        let arg = Option.value ~default:arg (expander' arg) in
        match fn with
        | { pexp_desc = Pexp_apply (fn, args); pexp_loc; _ } ->
            let args =
              List.filter_map
                (fun (lab, exp) ->
                  match expander' exp with
                  | Some e -> Some (lab, e)
                  | None -> Some (lab, exp))
                args
            in
            Some
              {
                pexp_desc = Pexp_apply (fn, (Nolabel, arg) :: args);
                pexp_attributes = [];
                pexp_loc;
                pexp_loc_stack;
              }
        | {
         pexp_desc = Pexp_construct (lident, None);
         pexp_loc;
         pexp_loc_stack;
         pexp_attributes = _;
        } ->
            Some
              {
                pexp_desc = Pexp_construct (lident, Some arg);
                pexp_attributes = [];
                pexp_loc;
                pexp_loc_stack;
              }
        | _ -> Some (Ast_builder.Default.pexp_apply ~loc fn [ (Nolabel, arg) ]))
    | _ -> None
  in
  expander' e

let rule = Context_free.Rule.special_function "( |. )" expander