Source file Clock.ml

(******************************************************************************)
(*                                                                            *)
(*                                  Monolith                                  *)
(*                                                                            *)
(*                              François Pottier                              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU Lesser General Public License as published by the Free   *)
(*  Software Foundation, either version 3 of the License, or (at your         *)
(*  option) any later version, as described in the file LICENSE.              *)
(*                                                                            *)
(******************************************************************************)

type clock = {
  (* Our granularity. This is the number of ticks that we let go until we
     check what we have to do. A tick that is a multiple of [granularity] is
     said to be round. *)
  granularity: int;
  (* Our start time. *)
  start: float;
  (* An optional timeout. *)
  timeout: float option;
  (* The current time. *)
  mutable now: float;
  (* The number of ticks that have taken place. *)
  mutable ticks: int;
  (* The last time a user function [f] was called via [tick clock f]. *)
  mutable last: float;
  (* A circular array of the times at which the most recent round ticks
     took place. *)
  window: float array;
  (* An index into the circular window. *)
  mutable next: int;
}

let make ?timeout granularity =
  let start = Unix.gettimeofday() in
  let n = 10 (* window size *) in
  let clock = {
    granularity;
    start;
    now = start;
    ticks = 0;
    last = 0.;
    timeout;
    window = Array.make n start;
    next = 0;
  } in
  clock

exception Timeout

let check_timeout clock =
  match clock.timeout with
  | None ->
      ()
  | Some timeout ->
    if clock.now -. clock.start > timeout then
      raise Timeout

let tick_body clock f =
  (* A round tick. Record the current time. *)
  clock.now <- Unix.gettimeofday();
  (* Update the window. *)
  clock.window.(clock.next) <- clock.now;
  let n = Array.length clock.window in
  clock.next <- (clock.next + 1) mod n;
  (* Check if roughly one new second has elapsed. If so, call the user
     function [f]. *)
  if clock.now > clock.last +. 1.0 then begin
    clock.last <- clock.now;
    f()
  end;
  (* Check whether the clock's time limit has been reached. *)
  check_timeout clock

let[@inline] tick clock f =
  (* Count one tick. *)
  clock.ticks <- clock.ticks + 1;
  (* If [granularity] ticks have been counted, perform more expensive work. *)
  if clock.ticks mod clock.granularity = 0 then
    tick_body clock f

let ticks clock =
  clock.ticks

let elapsed_time clock =
  truncate (clock.now -. clock.start)

let overall_ticks_per_second clock =
  truncate (float_of_int clock.ticks /. (clock.now -. clock.start))

let current_ticks_per_second clock =
  let n = Array.length clock.window in
  let oldest = clock.window.(clock.next)
  and newest = clock.now in
  truncate (float_of_int (clock.granularity * n) /. (newest -. oldest))