1 files changed, 51 insertions, 0 deletions
diff --git a/driver/Clflags.ml b/driver/Clflags.ml
index b1f2bd8..610d807 100644
--- a/driver/Clflags.ml
+++ b/driver/Clflags.ml
@@ -52,3 +52,54 @@ let option_small_data =
        && Configuration.system = "diab"
        then 8 else 0)
 let option_small_const = ref (!option_small_data)
+let option_timings = ref false
+
+(** Timing facility *)
+
+let timers : (string * float) list ref = ref []
+
+let add_to_timer name time =
+  let rec add = function
+  | [] -> [name, time]
+  | (name1, time1 as nt1) :: rem ->
+      if name1 = name then (name1, time1 +. time) :: rem else nt1 :: add rem
+  in timers := add !timers
+
+let time name fn arg =
+  if not !option_timings then
+    fn arg
+  else begin
+    let start = Sys.time() in
+    try
+      let res = fn arg in
+      add_to_timer name (Sys.time() -. start);
+      res
+    with x ->
+      add_to_timer name (Sys.time() -. start);
+      raise x
+  end
+
+let time2 name fn arg1 arg2 = time name (fun () -> fn arg1 arg2) ()
+let time3 name fn arg1 arg2 arg3 = time name (fun () -> fn arg1 arg2 arg3) ()
+
+let time_coq name fn arg =
+  if not !option_timings then
+    fn arg
+  else begin
+    let start = Sys.time() in
+    try
+      let res = fn arg in
+      add_to_timer (Camlcoq.camlstring_of_coqstring name) (Sys.time() -. start);
+      res
+    with x ->
+      add_to_timer (Camlcoq.camlstring_of_coqstring name) (Sys.time() -. start);
+      raise x
+  end
+
+let print_timers () =
+  if !option_timings then
+    List.iter
+      (fun (name, time) -> Printf.printf "%7.2fs  %s\n" time name)
+      !timers
+
+let _ = at_exit print_timers