mirror of
https://github.com/ocaml-tracing/ocaml-trace.git
synced 2026-03-08 03:47:57 -04:00
ppx: add let%trace <span var> = "name" in …
this allows the user to access the span within the scope.
This commit is contained in:
parent
1277a64803
commit
9567c1b4a7
2 changed files with 37 additions and 5 deletions
15
README.md
15
README.md
|
|
@ -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))`.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
__))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue