A ppx that instruments OCaml code to produce traces of execution. Traces can be explored to understand the control flow and see where time is spent in a program. Traces can be compared to see how a patch affects control flow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

101 lines
3.5 KiB

open Migrate_parsetree
open Ast_408
open Parsetree
let ocaml_version = Versions.ocaml_408
(* Traversal:
- when crossing a module or let-binding,
remember the name to construct a path
- when crossing a function,
remember that to log the call when we reach the body
*)
let camtrail_prim = Longident.Ldot (Longident.Lident "Camtrail", "enter")
let traverse_fun path mapper =
let rec aux expr =
match expr.pexp_desc with
| Pexp_fun (label, default, pattern, body) ->
let default = match default with
| None -> None
| Some expr -> Some (Ast_mapper.default_mapper.expr mapper expr)
in
let pattern = Ast_mapper.default_mapper.pat mapper pattern in
let body = aux body in
{expr with pexp_desc = Pexp_fun (label, default, pattern, body)}
| Pexp_function cases ->
let cases = List.map (fun { pc_lhs; pc_guard; pc_rhs } ->
let pc_lhs = Ast_mapper.default_mapper.pat mapper pc_lhs in
let pc_guard = match pc_guard with
| None -> None
| Some expr -> Some (Ast_mapper.default_mapper.expr mapper expr)
in
let pc_rhs = aux pc_rhs in
{ pc_lhs; pc_guard; pc_rhs }
) cases
in
{expr with pexp_desc = Pexp_function cases}
| Pexp_newtype (name, body) ->
{expr with pexp_desc = Pexp_newtype (name, aux body)}
| _ ->
let open Ast_helper in
let loc = {expr.pexp_loc with loc_ghost = true} in
let name =
let pos = loc.loc_start in
"\000\000\000\000" ^
String.concat "." (List.rev path) ^ ":" ^
string_of_int pos.pos_lnum ^ "." ^
string_of_int (pos.pos_cnum - pos.pos_bol)
in
Exp.sequence ~loc:expr.pexp_loc
(Exp.apply ~loc
(Exp.ident (Location.mkloc camtrail_prim loc))
[Asttypes.Nolabel, Exp.constant ~loc (Const.string name)])
(Ast_mapper.default_mapper.expr mapper expr)
in
aux
let rec mapper_for_path path = {
Ast_mapper.default_mapper with
expr = (fun self expr ->
match expr.pexp_desc with
| Pexp_fun _ | Pexp_function _ -> traverse_fun path self expr
| Pexp_letmodule (name, mexpr, body) ->
let mexpr =
let path = name.txt :: path in
let mapper = mapper_for_path path in
mapper.Ast_mapper.module_expr mapper mexpr
in
let body = Ast_mapper.default_mapper.expr self body in
{expr with pexp_desc = Pexp_letmodule (name, mexpr, body)}
| _ -> Ast_mapper.default_mapper.expr self expr
);
module_binding = (fun _self mb ->
let mapper = mapper_for_path (mb.pmb_name.txt :: path) in
Ast_mapper.default_mapper.module_binding mapper mb
);
value_binding = (fun self vb ->
let mapper =
match vb.pvb_pat.ppat_desc with
| Ppat_var name -> mapper_for_path (name.txt :: path)
| _ -> self
in
Ast_mapper.default_mapper.value_binding mapper vb
);
}
let () =
Driver.register ~name:"camtrail.ppx" ocaml_version
(fun _ _ -> {Ast_mapper.default_mapper with
structure = fun _ -> function
| [] -> []
| (x :: _) as str ->
let name = x.pstr_loc.loc_start.pos_fname in
let name = Filename.basename name in
let name = Filename.remove_extension name in
let name = String.capitalize_ascii name in
let mapper = mapper_for_path [name] in
mapper.structure mapper str
})