simon/ocaml-trace
1
0
Fork 0
mirror of https://github.com/ocaml-tracing/ocaml-trace.git synced 2026-03-08 20:07:55 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

deal with Pexp_function

Browse source
This commit is contained in:
Simon Cruanes 2025-11-04 12:48:41 -05:00
parent 9b4a3855fb
commit b3da5bc41e
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
1 changed files with 15 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
src/ppx/ppx_trace.ml
View file

@ -39,7 +39,7 @@ let extension_let =
(let open! Ast_pattern in (let open! Ast_pattern in
single_expr_payload single_expr_payload
(pexp_let nonrecursive (pexp_let nonrecursive
(value_binding (value_binding ~constraint_:none
~pat: ~pat:
(let pat_var = ppat_var __' |> map ~f:(fun f v -> f (`Var v)) in (let pat_var = ppat_var __' |> map ~f:(fun f v -> f (`Var v)) in
let pat_unit = let pat_unit =
@ -62,8 +62,20 @@ let expand_top_let ~ctxt rec_flag (vbs : _ list) =
(* go in functions, and add tracing around the body *) (* go in functions, and add tracing around the body *)
let rec push_into_fun (e : expression) : expression = let rec push_into_fun (e : expression) : expression =
match e.pexp_desc with match e.pexp_desc with
| Pexp_fun (lbl, lbl_expr, pat, body) -> | Pexp_function (args, ty, Pfunction_body body) ->
pexp_fun ~loc:e.pexp_loc lbl lbl_expr pat @@ push_into_fun body pexp_function ~loc args ty @@ Pfunction_body (push_into_fun body)
| Pexp_function (_args, _ty, Pfunction_cases _) ->
(* explicitly fail on [let%trace foo = function …], for now *)
Ast_helper.Exp.extension
( { txt = "ocaml.error"; loc },
PStr
[
pstr_eval ~loc
(pexp_constant ~loc
(Pconst_string
("ppxtrace: cannot trace `function`", loc, None)))
[];
] )
| _ -> | _ ->
[%expr [%expr
let _trace_span = let _trace_span =