1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*                      Pierre Chambart, OCamlPro                         *)
6(*                                                                        *)
7(*   Copyright 2015 Institut National de Recherche en Informatique et     *)
8(*     en Automatique.                                                    *)
9(*                                                                        *)
10(*   All rights reserved.  This file is distributed under the terms of    *)
11(*   the GNU Lesser General Public License version 2.1, with the          *)
12(*   special exception on linking described in the file LICENSE.          *)
13(*                                                                        *)
14(**************************************************************************)
15
16(** Compiler performance recording *)
17
18type file = string
19
20type source_provenance =
21  | File of file
22  | Pack of string
23  | Startup
24  | Toplevel
25
26type compiler_pass =
27  | All
28  | Parsing of file
29  | Parser of file
30  | Dash_pp of file
31  | Dash_ppx of file
32  | Typing of file
33  | Transl of file
34  | Generate of file
35  | Assemble of source_provenance
36  | Clambda of source_provenance
37  | Cmm of source_provenance
38  | Compile_phrases of source_provenance
39  | Selection of source_provenance
40  | Comballoc of source_provenance
41  | CSE of source_provenance
42  | Liveness of source_provenance
43  | Deadcode of source_provenance
44  | Spill of source_provenance
45  | Split of source_provenance
46  | Regalloc of source_provenance
47  | Linearize of source_provenance
48  | Scheduling of source_provenance
49  | Emit of source_provenance
50  | Flambda_pass of string * source_provenance
51
52val reset : unit -> unit
53(** erase all recorded times *)
54
55val get : compiler_pass -> float option
56(** returns the runtime in seconds of a completed pass *)
57
58val time_call : compiler_pass -> (unit -> 'a) -> 'a
59(** [time_call pass f] calls [f] and records its runtime. *)
60
61val time : compiler_pass -> ('a -> 'b) -> 'a -> 'b
62(** [time pass f arg] records the runtime of [f arg] *)
63
64val accumulate_time : compiler_pass -> ('a -> 'b) -> 'a -> 'b
65(** Like time for passes that can run multiple times *)
66
67val print : Format.formatter -> unit
68(** Prints all recorded timings to the formatter. *)
69