diff options
| author | Estevan Castilho <tevo@riajuu.net> | 2026-09-24 02:16:27 +0000 |
|---|---|---|
| committer | Estevan Castilho <tevo@riajuu.net> | 2026-09-24 02:16:27 +0000 |
| commit | 2d7c5b7c6696f39028ab07064ff75548d71ee5cf (patch) | |
| tree | 42bc368247a89f528dfc0cf4c96fefe4a620247b /lib/protocols/Handle.ml | |
| parent | 6b4f90c6c0b3a2265140f045512004090e2f28e6 (diff) | |
| download | RNT-2d7c5b7c6696f39028ab07064ff75548d71ee5cf.tar.gz RNT-2d7c5b7c6696f39028ab07064ff75548d71ee5cf.zip | |
Make objects printable
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 cb78cf2..c45afb0 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 @@ -50,9 +52,11 @@ let equal h1 h2 = let hash h = (object_of h)#hash +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 5640b14..daee453 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 @@ -23,5 +24,6 @@ val equal : t -> t -> bool val release : t -> unit val hash : t -> Concepts.Hash.hash +val to_string : t -> string val require : (t -> 'a interface option) -> t -> ('a interface, Concepts.Condition.condition) result |
