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 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
|
open Base
open Stdio
open Ppxlib
open Ast_builder.Default
open Monad.Ident.Let_syntax
let () =
Driver.register_transformation
"code_path"
~rules:
[ Context_free.Rule.extension
(Extension.V3.declare
"code_path"
Expression
Ast_pattern.(pstr nil)
(fun ~ctxt ->
estring
~loc:(Expansion_context.Extension.extension_point_loc ctxt)
(Code_path.enclosing_value (Expansion_context.Extension.code_path ctxt)
|> Option.value ~default:"_")))
]
;;
let () =
let without_bind = [%code_path] in
let%bind with_bind = [%code_path] in
let%bind with_bind_and_left = [%code_path]
and with_bind_and_right = [%code_path] in
print_endline without_bind;
print_endline with_bind;
print_endline with_bind_and_left;
print_endline with_bind_and_right
;;
[%%expect
{|
without_bind
with_bind
with_bind_and_left
with_bind_and_right
|}]
let () =
let without_bind_fst, without_bind_snd = [%code_path], [%code_path] in
let%bind with_bind_fst, with_bind_snd = [%code_path], [%code_path] in
print_endline without_bind_fst;
print_endline without_bind_snd;
print_endline with_bind_fst;
print_endline with_bind_snd
;;
[%%expect
{|
_
_
_
_
|}]
let () =
let a, b = [%code_path], [%code_path]
and c = [%code_path] in
let%bind x, y = [%code_path], [%code_path]
and z = [%code_path] in
print_endline a;
print_endline b;
print_endline c;
print_endline x;
print_endline y;
print_endline z
;;
[%%expect
{|
_
_
c
_
_
z
|}]
let () =
let without_bind_outer =
let without_bind_inner = [%code_path] in
print_endline without_bind_inner;
[%code_path]
in
print_endline without_bind_outer;
let%bind with_bind_outer =
let%bind with_bind_inner = [%code_path] in
print_endline with_bind_inner;
[%code_path]
in
print_endline with_bind_outer
;;
[%%expect
{|
without_bind_inner
without_bind_outer
with_bind_inner
with_bind_outer
|}]
|