diff options
| author | Estevan Castilho <tevo@riajuu.net> | 2026-09-26 00:48:26 +0000 |
|---|---|---|
| committer | Estevan Castilho <tevo@riajuu.net> | 2026-09-26 00:48:26 +0000 |
| commit | c7b754e96714eeeb9d315ee3de402d73a27d47db (patch) | |
| tree | 274792f6cdb60387e9bd4b5b7508463b4228bc4a /lib/protocols/Handle.ml | |
| parent | b06d16a2eb0846799b3b039dee989cf1cb258b6a (diff) | |
| parent | 0ec1e8a052305f5246d7cd66e11300cd29bc6d64 (diff) | |
| download | RNT-c7b754e96714eeeb9d315ee3de402d73a27d47db.tar.gz RNT-c7b754e96714eeeb9d315ee3de402d73a27d47db.zip | |
Merge branch 'branch-registration'
Diffstat (limited to '')
| -rw-r--r-- | lib/protocols/Handle.ml | 10 | ||||
| -rw-r--r-- | lib/protocols/Handle.mli | 2 |
2 files changed, 9 insertions, 3 deletions
diff --git a/lib/protocols/Handle.ml b/lib/protocols/Handle.ml index 378b8c8..41c88dd 100644 --- a/lib/protocols/Handle.ml +++ b/lib/protocols/Handle.ml @@ -3,14 +3,16 @@ type protocol = .. module Error = struct open Concepts.Condition - let unimplemented_protocol () = condition "unimplemented-protocol" "A required protocol was not implemented by the specified object" - empty + let unimplemented_protocol obj_name = + condition "unimplemented-protocol" "A required protocol was not implemented by the specified object" + ("object" |=| Concepts.Value.String obj_name) end class type obj = object method reference : bool method release : unit method hash : Concepts.Hash.hash + method to_string : string method protocols : protocol list end @@ -51,9 +53,11 @@ let equal h1 h2 = let hash h = (object_of h)#hash let protocols h = (object_of h)#protocols +let to_string h = (object_of h)#to_string + let release ({ valid; _ } as handle) = let o = object_of handle in valid := false; o#release -let require f h = Option.to_result ~none:(Error.unimplemented_protocol ()) (f h) +let require f h = Option.to_result ~none:(Error.unimplemented_protocol (to_string h)) (f h) diff --git a/lib/protocols/Handle.mli b/lib/protocols/Handle.mli index c5c0d6a..40a78ff 100644 --- a/lib/protocols/Handle.mli +++ b/lib/protocols/Handle.mli @@ -8,6 +8,7 @@ class type obj = object method reference : bool method release : unit method hash : Concepts.Hash.hash + method to_string : string method protocols : protocol list end @@ -24,5 +25,6 @@ val release : t -> unit val hash : t -> Concepts.Hash.hash val protocols : t -> protocol list +val to_string : t -> string val require : (t -> 'a interface option) -> t -> ('a interface, Concepts.Condition.condition) result |
