Add hivex_set_value API call, and ocaml and perl bindings, and tests.
[hivex.git] / lib / 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