aboutsummaryrefslogtreecommitdiff
path: root/lib/system.ml
diff options
context:
space:
mode:
authorHugo Herbelin2014-07-03 12:43:28 +0200
committerHugo Herbelin2014-07-13 18:02:57 +0200
commitd29b487f7c50fd8332cb1cfc144f70bc7db595d9 (patch)
treea80671a48c3db293d46f5d8d2a929486a4d02e13 /lib/system.ml
parentd90205f6284b998a8fc50b295d2d790d2580ea26 (diff)
Adding a "time" tactical for benchmarking purposes. In case the tactic
backtracks, print time spent in each of successive calls.
Diffstat (limited to 'lib/system.ml')
-rw-r--r--lib/system.ml16
1 files changed, 16 insertions, 0 deletions
diff --git a/lib/system.ml b/lib/system.ml
index 6c357ee364..4188eb2b4a 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -279,3 +279,19 @@ let fmt_time_difference (startreal,ustart,sstart) (stopreal,ustop,sstop) =
str "," ++
real (round (sstop -. sstart)) ++ str "s" ++
str ")"
+
+let with_time time f x =
+ let tstart = get_time() in
+ let msg = if time then "" else "Finished transaction in " in
+ try
+ let y = f x in
+ let tend = get_time() in
+ let msg2 = if time then "" else " (successful)" in
+ msg_info (str msg ++ fmt_time_difference tstart tend ++ str msg2);
+ y
+ with e ->
+ let tend = get_time() in
+ let msg = if time then "" else "Finished failing transaction in " in
+ let msg2 = if time then "" else " (failure)" in
+ msg_info (str msg ++ fmt_time_difference tstart tend ++ str msg2);
+ raise e