diff options
Diffstat (limited to 'lib/protocols')
| -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 |
