(* * Copyright ? 1990-2010 The Regents of the University of California. All rights reserved. * * Permission is hereby granted, without written agreement and without * license or royalty fees, to use, copy, modify, and distribute this * software and its documentation for any purpose, provided that the * above copyright notice and the following two paragraphs appear in * all copies of this software. * * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY * OF SUCH DAMAGE. * * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. *) open FixMisc.Ops type t = { name : string; mutable last : float; mutable events: (int * string option * float) list; } let get_time = fun _ -> (Unix.times ()).Unix.tms_utime let create n = let now = get_time () in { name = n; events = [(0, None, 0.0)]; last = now; } let log_event t so = match t.events with | [] -> assertf "impossible" | (i,_,_)::_ -> let now = get_time () in t.events <- (i+1, so, now -. t.last)::t.events; t.last <- now let to_events = fun t -> List.rev t.events let to_name = fun t -> t.name let print_event ppf = function | (i, Some s, f) -> Format.fprintf ppf "<%6d, %6.3f, %s>@\n" i f s | (i, None , f) -> Format.fprintf ppf "<%6d, %6.3f, *>@\n" i f let print ppf t = Format.fprintf ppf "Timer %s :: @[%a@] \n" t.name (FixMisc.pprint_many false "" print_event) (to_events t)