pax_global_header00006660000000000000000000000064150161701700014510gustar00rootroot0000000000000052 comment=22116aabee7218be54e2bfdf0f2202d303e8ee2b ppx_bench-0.17.1/000077500000000000000000000000001501617017000135445ustar00rootroot00000000000000ppx_bench-0.17.1/.gitignore000066400000000000000000000000411501617017000155270ustar00rootroot00000000000000_build *.install *.merlin _opam ppx_bench-0.17.1/.ocamlformat000066400000000000000000000000231501617017000160440ustar00rootroot00000000000000profile=janestreet ppx_bench-0.17.1/CHANGES.md000066400000000000000000000011701501617017000151350ustar00rootroot00000000000000## v0.11 Depend on ppxlib instead of (now deprecated) ppx\_core ## 113.43.00 - use the new context-free API ## 113.33.00 - Add an attribute `@name_suffix` to `let%bench_module`. This is an arbitrary expression that gets concatenated to the name of the bench module. It's useful to have this when using `ppx_bench` inside a functor, to distinguish each functor application in the output. ## 113.24.00 - Update to follow `Ppx_core` evolution. - Mark attributes as handled inside explicitly dropped pieces of code. So that a `@@deriving` inside a let%test dropped by ppx\_inline\_test\_drop doesn't cause a failure. ppx_bench-0.17.1/CONTRIBUTING.md000066400000000000000000000044101501617017000157740ustar00rootroot00000000000000This repository contains open source software that is developed and maintained by [Jane Street][js]. Contributions to this project are welcome and should be submitted via GitHub pull requests. Signing contributions --------------------- We require that you sign your contributions. Your signature certifies that you wrote the patch or otherwise have the right to pass it on as an open-source patch. The rules are pretty simple: if you can certify the below (from [developercertificate.org][dco]): ``` Developer Certificate of Origin Version 1.1 Copyright (C) 2004, 2006 The Linux Foundation and its contributors. 1 Letterman Drive Suite D4700 San Francisco, CA, 94129 Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Developer's Certificate of Origin 1.1 By making a contribution to this project, I certify that: (a) The contribution was created in whole or in part by me and I have the right to submit it under the open source license indicated in the file; or (b) The contribution is based upon previous work that, to the best of my knowledge, is covered under an appropriate open source license and I have the right under that license to submit that work with modifications, whether created in whole or in part by me, under the same open source license (unless I am permitted to submit under a different license), as indicated in the file; or (c) The contribution was provided directly to me by some other person who certified (a), (b) or (c) and I have not modified it. (d) I understand and agree that this project and the contribution are public and that a record of the contribution (including all personal information I submit with it, including my sign-off) is maintained indefinitely and may be redistributed consistent with this project or the open source license(s) involved. ``` Then you just add a line to every git commit message: ``` Signed-off-by: Joe Smith ``` Use your real name (sorry, no pseudonyms or anonymous contributions.) If you set your `user.name` and `user.email` git configs, you can sign your commit automatically with git commit -s. [dco]: http://developercertificate.org/ [js]: https://opensource.janestreet.com/ ppx_bench-0.17.1/LICENSE.md000066400000000000000000000021461501617017000151530ustar00rootroot00000000000000The MIT License Copyright (c) 2015--2024 Jane Street Group, LLC Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ppx_bench-0.17.1/Makefile000066400000000000000000000004031501617017000152010ustar00rootroot00000000000000INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) default: dune build install: dune install $(INSTALL_ARGS) uninstall: dune uninstall $(INSTALL_ARGS) reinstall: uninstall install clean: dune clean .PHONY: default install uninstall reinstall clean ppx_bench-0.17.1/README.md000066400000000000000000000005331501617017000150240ustar00rootroot00000000000000ppx_bench ========= Syntax extension for writing in-line benchmarks in OCaml code. For documentation and examples, see: example/ppx_bench_sample.ml These benchmarks are intended to be run with the runner provided by the `core_bench` library, `Inline_benchmarks_public.Runner.main`. See the documentation of `core_bench` for more details. ppx_bench-0.17.1/dune000066400000000000000000000000001501617017000144100ustar00rootroot00000000000000ppx_bench-0.17.1/dune-project000066400000000000000000000000211501617017000160570ustar00rootroot00000000000000(lang dune 3.11) ppx_bench-0.17.1/example/000077500000000000000000000000001501617017000151775ustar00rootroot00000000000000ppx_bench-0.17.1/example/dune000066400000000000000000000002211501617017000160500ustar00rootroot00000000000000(library (name ppx_bench_sample_lib) (libraries core) (preprocess (pps ppx_bench))) (alias (name DEFAULT) (deps ppx_bench_sample.ml.pp)) ppx_bench-0.17.1/example/ppx_bench_sample.ml000066400000000000000000000076421501617017000210510ustar00rootroot00000000000000open Core (* This shows some sample uses of BENCH. Build and look at ppx_bench_sample.ml.pp in this directory to see how the preprocessor works. *) (* One can specify a benchmark using the following syntax: {[ let%bench "name" = expr ]} In the above, the value of [expr] is ignored. This creates a benchmark for [expr], that is run using the [inline_benchmarks_runner] script from the command-line. This workflow is similar to that of inline unit tests. *) let%bench "add mutable" = let i = ref 0 in for j = 1 to 10_000 do i := !i + j done; !i ;; let%bench "add functional" = let rec f acc j = if j > 10_000 then acc else f (acc + j) (j + 1) in f 0 1 ;; (* One can specify benchmarks that require some initialization using [bench_fun]. For example: {[ let%bench_fun "name" = let t = create () in (fun () -> test_something t) ]} The function returned on the RHS of [bench_fun] should have type [unit -> unit]. The reason that the RHS of [bench] can be any non-arrow type, while [bench_fun] and [bench_indexed] have constrained types is that [bench] is a special case for writing terse macros, while in the other cases the macros cannot be as terse and consequently it is less useful to insert an ignore there. *) let%bench_fun "fold list" = let l = List.init 10_000 ~f:(fun i -> i) in fun () -> (List.fold l ~init:0 ~f:( + ) : int) |> ignore ;; (* One can specify benchmarks that have a variable parameter using an optional [@indexed = ] argument to [bench_fun]. Here has to be of type [int list]. In the example below, the parameter [len] is bound in the RHS of [bench_indexed]. Indexed tests can be useful in highlighting non-linearities in the execution time of functions. *) let%bench_fun ("fold list indexed" [@indexed len = [ 1; 10; 100; 1000 ]]) = let l = List.init len ~f:(fun i -> i) in fun () -> (List.fold l ~init:0 ~f:( + ) : int) |> ignore ;; (* Arbitrary arguments can be provided with [@params = ], where is an assoc list of test case names with values. *) let%bench_fun ("fold list by function" [@params f = [ "add", ( + ); "sub", ( - ); "mul", ( * ) ]]) = let l = List.init 20 ~f:(fun i -> i) in fun () -> (List.fold l ~init:1 ~f : int) |> ignore ;; (* We can group benchmarks together into modules and the output of [inline_benchmarks_runner] will reflect this grouping. {[ let%bench_module "Blit tests" = (module struct ..some benchmarks.. end) ]} For examples of all of the above see [bench_gc.ml] and [bench_array.ml] in [lib/core_kernel/bench]. Only the generated [inline_benchmarks_runner.exe] depends on [Core_bench] and other libraries. The library that includes the benchmarks itself does not have a dependency on [Core_bench]. Doing this is important so that we can add benchmarks to [Core] and still avoid cyclic dependencies. Finally, it is important to note that adding inline benchmarks should have little effect on the execution or module initialization time. *) let%bench_module "trivial module" = (module struct let%bench "trivial" = 3 end) ;; (* You can also use bench inside a functor. Since bench cannot figure out the module name (since this is not a well-defined concept), you can use the [@name_suffix] attribute to append an arbitrary expression (of type string) to the benchmark name. The following modules' benchmark names will look like: [pa_bench_sample.ml:Make:MakeQ_1] blah [pa_bench_sample.ml:Make:MakeQ_1000] blah *) module type Q = sig val j : int end module Make (Q : Q) = struct let j = Q.j let%bench_module ("MakeQ" [@name_suffix sprintf "_%i" j]) = (module struct let%bench "blah" = for _ = 0 to j do () done ;; end) ;; end module _ = Make (struct let j = 1 end) module _ = Make (struct let j = 1_000 end) ppx_bench-0.17.1/example/ppx_bench_sample.mli000066400000000000000000000000551501617017000212110ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_bench-0.17.1/ppx_bench.opam000066400000000000000000000014121501617017000163660ustar00rootroot00000000000000opam-version: "2.0" version: "v0.17.1" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/ppx_bench" bug-reports: "https://github.com/janestreet/ppx_bench/issues" dev-repo: "git+https://github.com/janestreet/ppx_bench.git" doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_bench/index.html" license: "MIT" build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ "ocaml" {>= "5.1.0"} "ppx_inline_test" {>= "v0.17" & < "v0.18"} "dune" {>= "3.11.0"} "ppxlib" {>= "0.36.0"} ] available: arch != "arm32" & arch != "x86_32" synopsis: "Syntax extension for writing in-line benchmarks in ocaml code" description: " Part of the Jane Street's PPX rewriters collection. " ppx_bench-0.17.1/runtime-lib/000077500000000000000000000000001501617017000157735ustar00rootroot00000000000000ppx_bench-0.17.1/runtime-lib/benchmark_accumulator.ml000066400000000000000000000077461501617017000226740ustar00rootroot00000000000000let unique_id = let r = ref 0 in fun () -> incr r; !r ;; (* Used to track the current libname in such a way that for functor applications, it is the calling libraries name that gets registered. *) module Current_libname = struct let null = "" let libname_ref = ref null let set str = libname_ref := str let unset () = libname_ref := null let get () = !libname_ref end module Current_bench_module_stack = struct let t = ref [] let push s = t := s :: !t let pop_exn () = t := List.tl !t let to_name () = match !t with | [] -> None | ms -> Some (String.concat "." (List.rev ms)) ;; end (* This is the main data structure of this module. An [Entry.t] represents a benchmark along with some metadata about is position, arguments etc. *) module Entry = struct type ('param, 'a) parameterised_spec = { arg_name : string ; params : (string * 'param) list ; thunk : 'param -> unit -> 'a } type test_spec = | Regular_thunk : ([ `init ] -> unit -> 'a) -> test_spec | Parameterised_thunk : ('param, 'a) parameterised_spec -> test_spec type t = { unique_id : int ; code : string ; type_conv_path : string ; name : string ; filename : string ; line : int ; startpos : int ; endpos : int ; test_spec : test_spec ; bench_module_name : string option } let compare t1 t2 = compare t1.unique_id t2.unique_id (* Extracts module name from ["filename.ml.Module"], which is the format of [ext_name] as set by [typeconv]. *) let get_module_name_opt t = let str = t.type_conv_path in let len = String.length str in let rec loop i = if i + 4 <= len then if String.sub str i 4 = ".ml." then Some (String.sub str (i + 4) (len - i - 4)) else loop (i + 1) else None in loop 0 ;; let with_test_spec t test_spec = { t with test_spec } end (* Inspect system environment variables to decide if benchmarks are being run. This is called by the code generated by the [pa_bench] syntax to decide if the global hashtable should be populated. *) let add_environment_var = let v = try Sys.getenv "BENCHMARKS_RUNNER" with | Not_found -> "" in v = "TRUE" ;; (* This hashtable contains all the benchmarks from all the of libraries that have been loaded. At the time the benchmarks are registering themselves with [ppx_bench_lib] we don't yet know which libraries will need to be run. *) let libs_to_entries : (string, Entry.t list) Hashtbl.t = Hashtbl.create 10 let lookup_rev_lib ~libname = try Hashtbl.find libs_to_entries libname with | Not_found -> [] ;; let lookup_lib ~libname = List.rev (lookup_rev_lib ~libname) let force_drop = (* Useful for js_of_ocaml to perform deadcode elimination. see ppx/ppx_inline_test/runtime-lib/runtime.ml [Action.get] for more details *) try ignore (Sys.getenv "FORCE_DROP_BENCH" : string); true with | Not_found -> false ;; let get_mode () = if force_drop then `Ignore else `Collect let[@inline never] add_bench ~name ~code ~filename ~type_conv_path ~line ~startpos ~endpos test_spec = match get_mode () with | `Ignore -> () | `Collect -> let libname = Current_libname.get () in let entry = { Entry.code ; unique_id = unique_id () ; type_conv_path ; bench_module_name = Current_bench_module_stack.to_name () ; name ; filename ; line ; startpos ; endpos ; test_spec } in Hashtbl.add libs_to_entries libname (entry :: lookup_rev_lib ~libname) ;; let[@inline never] add_bench_module ~name ~code:_ ~type_conv_path:_ ~filename:_ ~line:_ ~startpos:_ ~endpos:_ f = match get_mode () with | `Ignore -> () | `Collect -> (* Running f registers the benchmarks using BENCH *) Current_bench_module_stack.push name; (try f (); Current_bench_module_stack.pop_exn () with | ex -> Current_bench_module_stack.pop_exn (); raise ex) ;; ppx_bench-0.17.1/runtime-lib/benchmark_accumulator.mli000066400000000000000000000046221501617017000230330ustar00rootroot00000000000000(** The point of [Benchmark_accumulator] is to provide a global place where inline benchmarking macros can register themselves. Once registered here, the benchmarks are retrieved and analyzed using [Core_bench]. This module holds the registered benchmarks in a global hashtable indexed by library name. We care about the registered benchmarks if and only if the library is being used in a [inline_benchmarks_runner.exe]. To avoid building this hashtable in cases where we will not use it, this module peeks into the commandline args of the running program to decide if the benchmarks should be registered or not. *) module Current_libname : sig val set : string -> unit val unset : unit -> unit end module Entry : sig type ('param, 'a) parameterised_spec = { arg_name : string ; params : (string * 'param) list (** The first coordinate is some string representation of the second coordinate. *) ; thunk : 'param -> unit -> 'a } type test_spec = | Regular_thunk : ([ `init ] -> unit -> 'a) -> test_spec | Parameterised_thunk : ('param, 'a) parameterised_spec -> test_spec type t = private { unique_id : int ; code : string ; type_conv_path : string ; name : string ; filename : string ; line : int ; startpos : int ; endpos : int ; test_spec : test_spec ; bench_module_name : string option } val with_test_spec : t -> test_spec -> t val compare : t -> t -> int val get_module_name_opt : t -> string option end (** [add_environment_var] returns true if the benchmarks should be added to the hashtable *) val add_environment_var : bool (** [lookup_lib] returns all the benchmarks from the specified library *) val lookup_lib : libname:string -> Entry.t list (** [add_bench] registers benchmarks with the global hashtable maintained in [ppx_bench_lib]. This is meant to be called by the code generated for the BENCH and BENCH_INDEXED macros *) val add_bench : name:string -> code:string -> filename:string -> type_conv_path:string -> line:int -> startpos:int -> endpos:int -> Entry.test_spec -> unit (** [add_bench_module] adds a bench module name to the benchmarks. This is called by BENCH_MODULE macro *) val add_bench_module : name:string -> code:string -> type_conv_path:string -> filename:string -> line:int -> startpos:int -> endpos:int -> (unit -> unit) -> unit ppx_bench-0.17.1/runtime-lib/dune000066400000000000000000000001441501617017000166500ustar00rootroot00000000000000(library (name ppx_bench_lib) (public_name ppx_bench.runtime-lib) (preprocess no_preprocessing)) ppx_bench-0.17.1/runtime-lib/export.ml000066400000000000000000000000501501617017000176410ustar00rootroot00000000000000external ignore : _ -> unit = "%ignore" ppx_bench-0.17.1/runtime-lib/export.mli000066400000000000000000000004041501617017000200150ustar00rootroot00000000000000(* This module re-exports the stdlib functions we need in the generated code, as [Pervasives] might be shadowed by [Base] for instance. *) (* It has to be defined as an external so that we get warning 5 properly. *) external ignore : _ -> unit = "%ignore" ppx_bench-0.17.1/src/000077500000000000000000000000001501617017000143335ustar00rootroot00000000000000ppx_bench-0.17.1/src/dune000066400000000000000000000003131501617017000152060ustar00rootroot00000000000000(library (name ppx_bench) (public_name ppx_bench) (kind ppx_rewriter) (ppx_runtime_libraries ppx_bench.runtime-lib) (libraries ppxlib ppx_inline_test.libname) (preprocess (pps ppxlib.metaquot))) ppx_bench-0.17.1/src/ppx_bench.ml000066400000000000000000000204521501617017000166360ustar00rootroot00000000000000open Ppxlib open Ast_builder.Default type maybe_drop = | Keep | Deadcode | Remove let drop_benches = ref Keep let () = Driver.add_arg "-bench-drop" (Unit (fun () -> drop_benches := Remove)) ~doc:" Drop inline benchmarks"; Driver.add_arg "-bench-drop-with-deadcode" (Unit (fun () -> drop_benches := Deadcode)) ~doc: " Drop inline benchmarks by wrapping them inside deadcode to prevent unused \ variable warnings." ;; let () = Driver.Cookies.add_simple_handler "inline-bench" Ast_pattern.(pexp_ident (lident __')) ~f:(function | None -> () | Some id -> (match id.txt with | "drop" -> drop_benches := Remove | "drop_with_deadcode" -> drop_benches := Deadcode | s -> Location.raise_errorf ~loc:id.loc "invalid 'inline-bench' cookie (%s), expected one of: drop, \ drop_with_deadcode" s)) ;; let maybe_drop loc code = match !drop_benches with | Keep -> [%str let () = [%e code]] | Deadcode -> [%str let () = if false then [%e code] else ()] | Remove -> Attribute.explicitly_drop#expression code; [%str] ;; let descr (loc : Location.t) ?(inner_loc = loc) () = let filename = loc.loc_start.pos_fname in let line = loc.loc_start.pos_lnum in let start_pos = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in let end_pos = inner_loc.Location.loc_end.pos_cnum - loc.loc_start.pos_bol in estring ~loc filename, eint ~loc line, eint ~loc start_pos, eint ~loc end_pos ;; let apply_to_descr_bench type_conv_path lid loc ?inner_loc e_opt ?name_suffix name more_arg = let filename, line, start_pos, end_pos = descr loc ?inner_loc () in let s = match e_opt with | None -> "" | Some e -> Pprintast.string_of_expression e in let descr = estring ~loc s in let name = let base_name = estring ~loc name in match name_suffix with | None -> base_name | Some name_suffix -> [%expr [%e base_name] ^ [%e name_suffix]] in let type_conv_path = estring ~loc type_conv_path in maybe_drop loc [%expr if Ppx_bench_lib.Benchmark_accumulator.add_environment_var then [%e evar ~loc ("Ppx_bench_lib.Benchmark_accumulator." ^ lid)] ~name:[%e name] ~code:[%e descr] ~type_conv_path:[%e type_conv_path] ~filename:[%e filename] ~line:[%e line] ~startpos:[%e start_pos] ~endpos:[%e end_pos] [%e more_arg]] ;; type bench_kind = | Bench | Bench_fun type arg_kind = | Indexed of (string * expression) | Parameterised of (string * expression) let thunk_bench kind e = match kind with | Bench_fun -> e | Bench -> let loc = { e.pexp_loc with loc_ghost = true } in [%expr fun () -> [%e e]] ;; let enabled () = match Ppx_inline_test_libname.get () with | None -> false | Some _ -> true ;; let assert_enabled loc = if not (enabled ()) then Location.raise_errorf ~loc "ppx_bench: extension is disabled as no -inline-test-lib was given" ;; let expand_bench_exp ~loc ~path kind index name e = let loc = { loc with loc_ghost = true } in assert_enabled loc; match index with | None -> (* Here and in the other cases below, because functions given to pa_bench can return any 'a, we add a dead call to ignore so we can get a warning if the user code mistakenly gives a partial application. *) apply_to_descr_bench path "add_bench" loc (Some e) name [%expr let f `init = [%e thunk_bench kind e] in if false then Ppx_bench_lib.Export.ignore (f `init ()) else (); Ppx_bench_lib.Benchmark_accumulator.Entry.Regular_thunk f] | Some (Indexed (var_name, args)) -> apply_to_descr_bench path "add_bench" loc (Some e) name [%expr let arg_values = [%e args] and f [%p pvar ~loc var_name] = [%e thunk_bench kind e] in if false then Ppx_bench_lib.Export.ignore (f 0 ()) else (); Ppx_bench_lib.Benchmark_accumulator.Entry.Parameterised_thunk { Ppx_bench_lib.Benchmark_accumulator.Entry.arg_name = [%e estring ~loc var_name] ; Ppx_bench_lib.Benchmark_accumulator.Entry.params = (* We use Stdlib.* because this might run without any opens. *) Stdlib.List.map (fun i -> Stdlib.string_of_int i, i) arg_values [@warning "-3"] ; Ppx_bench_lib.Benchmark_accumulator.Entry.thunk = f }] | Some (Parameterised (var_name, args)) -> apply_to_descr_bench path "add_bench" loc (Some e) name [%expr let params = [%e args] and f [%p pvar ~loc var_name] = [%e thunk_bench kind e] in if false then Ppx_bench_lib.Export.ignore (f (List.hd_exn params |> snd) ()) else (); Ppx_bench_lib.Benchmark_accumulator.Entry.Parameterised_thunk { Ppx_bench_lib.Benchmark_accumulator.Entry.arg_name = [%e estring ~loc var_name] ; Ppx_bench_lib.Benchmark_accumulator.Entry.params ; Ppx_bench_lib.Benchmark_accumulator.Entry.thunk = f }] ;; let expand_bench_module ~loc ~path name_suffix name m = let loc = { loc with loc_ghost = true } in assert_enabled loc; apply_to_descr_bench path "add_bench_module" loc ~inner_loc:m.pmod_loc None ?name_suffix name (pexp_fun ~loc Nolabel None (punit ~loc) (pexp_letmodule ~loc (Located.mk ~loc (Some "M")) m (eunit ~loc))) ;; module E = struct let indexed = Attribute.declare "bench.indexed" Attribute.Context.pattern Ast_pattern.( single_expr_payload (pexp_apply (pexp_ident (lident (string "="))) (no_label (pexp_ident (lident __)) ^:: no_label __ ^:: nil))) (fun var values -> Indexed (var, values)) ;; let parameterised = Attribute.declare "bench.params" Attribute.Context.pattern Ast_pattern.( single_expr_payload (pexp_apply (pexp_ident (lident (string "="))) (no_label (pexp_ident (lident __)) ^:: no_label __ ^:: nil))) (fun var values -> Parameterised (var, values)) ;; let name_suffix = Attribute.declare "bench.name_suffix" Attribute.Context.pattern Ast_pattern.(single_expr_payload __) (fun a -> a) ;; let simple = let open Ast_pattern in pstr (pstr_value nonrecursive (value_binding ~pat: (alt (Attribute.pattern indexed (pstring __)) (Attribute.pattern parameterised (pstring __))) ~expr:__ ~constraint_:none ^:: nil) ^:: nil) ;; let bench = Extension.declare_inline "bench" Extension.Context.structure_item simple (expand_bench_exp Bench) ;; let bench_fun = Extension.declare_inline "bench_fun" Extension.Context.structure_item simple (expand_bench_exp Bench_fun) ;; let bench_module = Extension.declare_inline "bench_module" Extension.Context.structure_item Ast_pattern.( pstr (pstr_value nonrecursive (value_binding ~constraint_:drop ~pat:(Attribute.pattern name_suffix (pstring __)) ~expr:(pexp_pack __) ^:: nil) ^:: nil)) expand_bench_module ;; let all = [ bench; bench_fun; bench_module ] end let () = Driver.register_transformation "bench" ~extensions:E.all ~enclose_impl:(fun loc -> match loc, Ppx_inline_test_libname.get () with | None, _ | _, None -> [], [] | Some loc, Some (libname, _) -> let loc = { loc with loc_ghost = true } in (* See comment in benchmark_accumulator.ml *) let header = let loc = { loc with loc_end = loc.loc_start } in maybe_drop loc [%expr Ppx_bench_lib.Benchmark_accumulator.Current_libname.set [%e estring ~loc libname]] and footer = let loc = { loc with loc_start = loc.loc_end } in maybe_drop loc [%expr Ppx_bench_lib.Benchmark_accumulator.Current_libname.unset ()] in header, footer) ;; ppx_bench-0.17.1/src/ppx_bench.mli000066400000000000000000000000001501617017000167720ustar00rootroot00000000000000