150 lines
4.6 KiB
OCaml
150 lines
4.6 KiB
OCaml
(*****************************************************************************)
|
|
(* *)
|
|
(* Open Source License *)
|
|
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* Permission is hereby granted, free of charge, to any person obtaining a *)
|
|
(* copy of this software and associated documentation files (the "Software"),*)
|
|
(* to deal in the Software without restriction, including without limitation *)
|
|
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
|
|
(* and/or sell copies of the Software, and to permit persons to whom the *)
|
|
(* Software is furnished to do so, subject to the following conditions: *)
|
|
(* *)
|
|
(* The above copyright notice and this permission notice shall be included *)
|
|
(* in all copies or substantial portions of the Software. *)
|
|
(* *)
|
|
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
|
|
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
|
|
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
|
|
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
|
|
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
|
|
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
|
|
(* DEALINGS IN THE SOFTWARE. *)
|
|
(* *)
|
|
(*****************************************************************************)
|
|
|
|
module Ring = struct
|
|
type 'a raw =
|
|
| Empty of int
|
|
| Inited of {
|
|
data : 'a array ;
|
|
mutable pos : int ;
|
|
}
|
|
|
|
type 'a t = 'a raw ref
|
|
|
|
let create size = ref (Empty size)
|
|
|
|
let add r v =
|
|
match !r with
|
|
| Empty size ->
|
|
r := Inited { data = Array.make size v ; pos = 0 }
|
|
| Inited s ->
|
|
s.pos <-
|
|
if s.pos = 2 * Array.length s.data - 1 then
|
|
Array.length s.data
|
|
else
|
|
s.pos + 1 ;
|
|
s.data.(s.pos mod Array.length s.data) <- v
|
|
|
|
let add_and_return_erased r v =
|
|
let replaced = match !r with
|
|
| Empty _ -> None
|
|
| Inited s ->
|
|
if s.pos >= Array.length s.data - 1 then
|
|
Some (s.data.(s.pos mod Array.length s.data))
|
|
else
|
|
None in
|
|
add r v ; replaced
|
|
|
|
let clear r =
|
|
match !r with
|
|
| Empty _ -> ()
|
|
| Inited { data ; _ } ->
|
|
r := Empty (Array.length data)
|
|
|
|
|
|
let add_list r l = List.iter (add r) l
|
|
|
|
let last r =
|
|
match !r with
|
|
| Empty _ -> None
|
|
| Inited { data ; pos } -> Some data.(pos mod Array.length data)
|
|
|
|
let fold r ~init ~f =
|
|
match !r with
|
|
| Empty _ -> init
|
|
| Inited { data ; pos } ->
|
|
let size = Array.length data in
|
|
let acc = ref init in
|
|
for i = 0 to min pos (size - 1) do
|
|
acc := f !acc data.((pos - i) mod size)
|
|
done ;
|
|
!acc
|
|
|
|
let elements t =
|
|
fold t ~init:[] ~f:(fun acc elt -> elt :: acc)
|
|
|
|
exception Empty
|
|
|
|
let last_exn r =
|
|
match last r with
|
|
| None -> raise Empty
|
|
| Some d -> d
|
|
end
|
|
|
|
include Ring
|
|
|
|
(** Ring Buffer Table *)
|
|
module type TABLE = sig
|
|
type t
|
|
type v
|
|
val create : int -> t
|
|
val add : t -> v -> unit
|
|
val mem : t -> v -> bool
|
|
val remove : t -> v -> unit
|
|
val clear : t -> unit
|
|
val elements : t -> v list
|
|
end
|
|
|
|
|
|
(* fixed size set of Peers id. If the set exceed the maximal allowed capacity, the
|
|
element that was added first is removed when a new one is added *)
|
|
module MakeTable (V: Hashtbl.HashedType) = struct
|
|
module Table = Hashtbl.Make(V)
|
|
|
|
type raw = {
|
|
size : int ;
|
|
ring : V.t Ring.t ;
|
|
table : unit Table.t ;
|
|
}
|
|
type t = raw ref
|
|
type v = V.t
|
|
|
|
let create size = ref {
|
|
size;
|
|
ring = Ring.create size;
|
|
table = Table.create size }
|
|
|
|
let add {contents = t } v =
|
|
Option.iter
|
|
(Ring.add_and_return_erased t.ring v)
|
|
~f:(Table.remove t.table);
|
|
Table.add t.table v ()
|
|
|
|
let mem {contents = t} v = Table.mem t.table v
|
|
|
|
let remove {contents = t} v =
|
|
Table.remove t.table v
|
|
|
|
let clear ({contents = t} as tt) =
|
|
tt := { t with
|
|
ring = Ring.create t.size;
|
|
table = Table.create t.size
|
|
}
|
|
|
|
let elements {contents = t} =
|
|
Table.fold (fun k _ acc -> k::acc) t.table []
|
|
|
|
end
|