File: quoter.ml

package info (click to toggle)
ppxlib 0.15.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 1,284 kB
  • sloc: ml: 17,184; sh: 149; makefile: 36; python: 36
file content (36 lines) | stat: -rw-r--r-- 814 bytes parent folder | download
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
open Import

type t =
  { mutable next_id : int
  ; mutable bindings : Parsetree.value_binding list
  }

let create () =
  { next_id = 0
  ; bindings = []
  }

let sanitize t e =
  match t.bindings with
  | [] -> e
  | bindings ->
    let (module Ast) = Ast_builder.make e.pexp_loc in
    Ast.pexp_let Recursive bindings e

let quote t (e : expression) =
  let loc = e.pexp_loc in
  let (module Ast) = Ast_builder.make loc in
  let name = "__" ^ Int.to_string t.next_id in
  let binding =
    let pat = Ast.pvar name in
    let expr =
      Ast.pexp_fun Nolabel None
        (let unit = Ast_builder.Default.Located.lident ~loc "()" in
         Ast.ppat_construct unit None)
        e
    in
    Ast.value_binding ~pat ~expr
  in
  t.bindings <- binding :: t.bindings;
  t.next_id <- t.next_id + 1;
  Ast.evar name