ppx: add let%trace <span var> = "name" in …

this allows the user to access the span within the scope.
This commit is contained in:
Simon Cruanes 2023-12-25 22:23:09 -05:00
parent 1277a64803
commit 9567c1b4a7
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 37 additions and 5 deletions

View file

@ -117,6 +117,21 @@ let f x y z =
raise e
```
Alternatively, a name can be provided for the span, which is useful if you want
to access it and use functions like `Trace.add_data_to_span`:
```ocaml
let%trace f x y z =
do_sth x;
do_sth y;
begin
let%trace _sp = "sub-span" in
do_sth z;
Trace.add_data_to_span _sp ["x", `Int 42]
end
```
### Dune configuration
In your `library` or `executable` stanza, add: `(preprocess (pps ppx_trace))`.

View file

@ -8,19 +8,30 @@ let location_errorf ~loc fmt =
(** {2 let expression} *)
let expand_let ~ctxt (name : string) body =
let expand_let ~ctxt (var : [ `Var of label loc | `Unit ]) (name : string) body
=
let loc = Expansion_context.Extension.extension_point_loc ctxt in
Ast_builder.Default.(
let var_pat =
match var with
| `Var v -> ppat_var ~loc:v.loc v
| `Unit -> ppat_var ~loc { loc; txt = "_trace_span" }
in
let var_exp =
match var with
| `Var v -> pexp_ident ~loc:v.loc { txt = lident v.txt; loc = v.loc }
| `Unit -> [%expr _trace_span]
in
[%expr
let _trace_span =
let [%p var_pat] =
Trace_core.enter_span ~__FILE__ ~__LINE__ [%e estring ~loc name]
in
try
let res = [%e body] in
Trace_core.exit_span _trace_span;
Trace_core.exit_span [%e var_exp];
res
with exn ->
Trace_core.exit_span _trace_span;
Trace_core.exit_span [%e var_exp];
raise exn])
let extension_let =
@ -29,7 +40,13 @@ let extension_let =
single_expr_payload
(pexp_let nonrecursive
(value_binding
~pat:(ppat_construct (lident (string "()")) none)
~pat:
(let pat_var = ppat_var __' |> map ~f:(fun f v -> f (`Var v)) in
let pat_unit =
as__ @@ ppat_construct (lident (string "()")) none
|> map ~f:(fun f _ -> f `Unit)
in
alt pat_var pat_unit)
~expr:(estring __)
^:: nil)
__))