Commit b8ac12f3 authored by Raphaël Proust's avatar Raphaël Proust

Shell, Stdlib: inline and remove Registry

Registry only has a single use throughout the code. It is simple to
inline.
parent eb3ff8f2
......@@ -1027,9 +1027,7 @@ module Make (Filter : Prevalidator_filters.FILTER) (Arg : ARG) : T = struct
Lwt.return (State.Block.fitness pv.predecessor)
end
module ChainProto_registry = Registry.Make (struct
type v = t
module ChainProto_registry = Map.Make (struct
type t = Chain_id.t * Protocol_hash.t
let compare (c1, p1) (c2, p2) =
......@@ -1037,10 +1035,17 @@ module ChainProto_registry = Registry.Make (struct
if pc = 0 then Chain_id.compare c1 c2 else pc
end)
let chain_proto_registry : t ChainProto_registry.t ref =
ref ChainProto_registry.empty
let create limits (module Filter : Prevalidator_filters.FILTER) chain_db =
let chain_state = Distributed_db.chain_state chain_db in
let chain_id = State.Chain.id chain_state in
match ChainProto_registry.query (chain_id, Filter.Proto.hash) with
match
ChainProto_registry.find_opt
(chain_id, Filter.Proto.hash)
!chain_proto_registry
with
| None ->
let module Prevalidator =
Make
......@@ -1057,7 +1062,11 @@ let create limits (module Filter : Prevalidator_filters.FILTER) chain_db =
* `worker` value to caller. *)
Prevalidator.initialization_errors
>>=? fun () ->
ChainProto_registry.register Prevalidator.name (module Prevalidator : T) ;
chain_proto_registry :=
ChainProto_registry.add
Prevalidator.name
(module Prevalidator : T)
!chain_proto_registry ;
return (module Prevalidator : T)
| Some p ->
return p
......@@ -1065,7 +1074,8 @@ let create limits (module Filter : Prevalidator_filters.FILTER) chain_db =
let shutdown (t : t) =
let module Prevalidator : T = (val t) in
let w = Lazy.force Prevalidator.worker in
ChainProto_registry.remove Prevalidator.name ;
chain_proto_registry :=
ChainProto_registry.remove Prevalidator.name !chain_proto_registry ;
Prevalidator.Worker.shutdown w
let flush (t : t) head =
......@@ -1113,7 +1123,10 @@ let status (t : t) =
Prevalidator.Worker.status w
let running_workers () =
ChainProto_registry.fold (fun (id, proto) t acc -> (id, proto, t) :: acc) []
ChainProto_registry.fold
(fun (id, proto) t acc -> (id, proto, t) :: acc)
!chain_proto_registry
[]
let pending_requests (t : t) =
let module Prevalidator : T = (val t) in
......
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <[email protected]> *)
(* *)
(* 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 type S = sig
type k
type v
val register : k -> v -> unit
val remove : k -> unit
val query : k -> v option
val fold : (k -> v -> 'a -> 'a) -> 'a -> 'a
end
module Make (M : sig
type v
include Map.OrderedType
end) : S with type k = M.t and type v = M.v = struct
module Reg = Map.Make (M)
type v = M.v
type k = Reg.key
let registry : v Reg.t ref = ref Reg.empty
let register k v = registry := Reg.add k v !registry
let remove k = registry := Reg.remove k !registry
let query k = Reg.find_opt k !registry
let fold f a = Reg.fold f !registry a
end
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <[email protected]> *)
(* *)
(* 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. *)
(* *)
(*****************************************************************************)
(** A simple imperative map *)
module type S = sig
type k
type v
val register : k -> v -> unit
val remove : k -> unit
val query : k -> v option
val fold : (k -> v -> 'a -> 'a) -> 'a -> 'a
end
module Make (M : sig
type v
include Map.OrderedType
end) : S with type k = M.t and type v = M.v
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment