hivex/tools/counter.ml

   1 (* Basic counting module.
   2
   3    Copyright (C) 2006 Merjis Ltd.
   4
   5    This library is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU Lesser General Public
   7    License as published by the Free Software Foundation; either
   8    version 2 of the License, or (at your option) any later version.
   9
  10    This library is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13    Lesser General Public License for more details.
  14
  15    You should have received a copy of the GNU Lesser General Public
  16    License along with this library; if not, write to the Free Software
  17    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18 *)
  19
  20 type 'a t = ('a, int ref) Hashtbl.t
  21
  22 let create () =
  23   Hashtbl.create 13
  24
  25 let get_ref counter thing =
  26   try
  27     Hashtbl.find counter thing
  28   with
  29     Not_found ->
  30       let r = ref 0 in
  31       Hashtbl.add counter thing r;
  32       r
  33
  34 let incr counter thing =
  35   let r = get_ref counter thing in
  36   incr r
  37
  38 let decr counter thing =
  39   let r = get_ref counter thing in
  40   decr r
  41
  42 let add counter thing n =
  43   let r = get_ref counter thing in
  44   r := !r + n
  45
  46 let sub counter thing n =
  47   let r = get_ref counter thing in
  48   r := !r - n
  49
  50 let set counter thing n =
  51   let r = get_ref counter thing in
  52   r := n
  53
  54 (* Don't use get_ref, to avoid unnecessarily creating 'ref 0's. *)
  55 let get counter thing =
  56   try
  57     !(Hashtbl.find counter thing)
  58   with
  59     Not_found -> 0
  60
  61 (* This is a common pair of operations, worth optimising. *)
  62 let incr_get counter thing =
  63   let r = get_ref counter thing in
  64   Pervasives.incr r;
  65   !r
  66
  67 let zero = Hashtbl.remove
  68
  69 let read counter =
  70   let counts =
  71     Hashtbl.fold (
  72       fun thing r xs ->
  73         let r = !r in
  74         if r <> 0 then (r, thing) :: xs
  75         else xs
  76     ) counter [] in
  77   List.sort (fun (a, _) (b, _) -> compare (b : int) (a : int)) counts
  78
  79 let length = Hashtbl.length
  80
  81 let total counter =
  82   let total = ref 0 in
  83   Hashtbl.iter (fun _ r -> total := !total + !r) counter;
  84   !total
  85
  86 let clear = Hashtbl.clear