diff options
Diffstat (limited to 'lib/kernel/Namespace.ml')
| -rw-r--r-- | lib/kernel/Namespace.ml | 42 |
1 files changed, 14 insertions, 28 deletions
diff --git a/lib/kernel/Namespace.ml b/lib/kernel/Namespace.ml index 20f83f5..507afa4 100644 --- a/lib/kernel/Namespace.ml +++ b/lib/kernel/Namespace.ml @@ -1,39 +1,25 @@ -module Errors = struct - include Concepts.Condition - - let key_already_exists key = - condition "key-already-exists" "The specified key already exists in the namespace" - ("key" |=| Concepts.Value.String key) - - let no_such_key key = - condition "no-such-key" "The specified key does not exist in the namespace" - ("key" |=| Concepts.Value.String key) -end - class namespace = object (self) inherit Lifecycle.null + inherit Identity.of_id val entries : (string, Protocols.Handle.t) BatMap.t Atomic.t = Atomic.make BatMap.empty method protocols = Protocols.[Directory.make self; Registry.make self] - method register key value = - Utilities.Atomic.mswap entries - (fun e -> - match BatMap.find_opt key e with - | None -> Ok (BatMap.add key value e) - | Some _ -> Error (Errors.key_already_exists key)) - |> Result.map ignore - - method unregister key = - Utilities.Atomic.mswap entries - (fun e -> - try - Ok (BatMap.remove_exn key e) - with Not_found -> - Error (Errors.no_such_key key)) - |> Result.map ignore + method update key reference value = + match + Utilities.Atomic.mswap entries + (fun e -> + if BatMap.find_opt key e = reference then + match value with + | Some v -> Ok (BatMap.add key v e) + | None -> Ok (BatMap.remove key e) + else + Error ()) + with + | Ok _ -> Ok true + | Error _ -> Ok false method list = Atomic.get entries |
