diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/protocols/Handle.ml | 15 | ||||
| -rw-r--r-- | lib/protocols/Handle.mli | 5 |
2 files changed, 4 insertions, 16 deletions
diff --git a/lib/protocols/Handle.ml b/lib/protocols/Handle.ml index b8dd691..eea7db2 100644 --- a/lib/protocols/Handle.ml +++ b/lib/protocols/Handle.ml @@ -63,25 +63,14 @@ let with_autorelease f = |> ignore; Effect.Deep.continue k ()) -let without_autorelease f = - try f () - with - | effect (Autorelease _), k -> Effect.Deep.continue k () - | effect (Keep _), k -> Effect.Deep.continue k () +let keep h = Effect.perform (Keep h); h -let keep h = - try Effect.perform (Keep h) - with Effect.Unhandled _ -> () - -let autorelease h = - try Effect.perform (Autorelease h) - with Effect.Unhandled _ -> () +let autorelease h = Effect.perform (Autorelease h); h let interface_of handle interface = {handle; interface} let make o = let h = {valid= Atomic.make true; refers_to= (o :> obj); allocated_at= Printexc.get_callstack 256} in Gc.finalise on_gc h; - if o#is_managed then autorelease h; h let into handle f = List.find_map f (object_of handle)#protocols |> Option.map (interface_of handle) diff --git a/lib/protocols/Handle.mli b/lib/protocols/Handle.mli index 47cee38..1c3b9d4 100644 --- a/lib/protocols/Handle.mli +++ b/lib/protocols/Handle.mli @@ -24,6 +24,5 @@ val protocols : t -> protocol list val to_string : t -> string val require : (t -> 'a interface option) -> t -> ('a interface, Concepts.Condition.condition) result val with_autorelease : (unit -> 'a) -> 'a -val without_autorelease : (unit -> 'a) -> 'a -val autorelease : t -> unit -val keep : t -> unit +val autorelease : t -> t +val keep : t -> t |