Make the autorelease pool opt-in

3 files changed, 7 insertions, 20 deletions

diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml
index 8822d44..a2e270e 100644
--- a/lib/kernel/Path.ml
+++ b/lib/kernel/Path.ml
@@ -21,18 +21,17 @@ end
 
 let walking f g handle path =
   let open Protocols in
+  let open Utilities.Result in
   let rec walk handle = function
     | [] ->
-       Handle.keep handle;
-       g handle
+       g (Handle.keep handle)
     | x :: xs -> (
-        let open Utilities.Result in
         let* dir =
           Handle.require Directory.from handle
           |> Result.map_error
                Concepts.Condition.(complement ("before-segment" |=| Concepts.Value.String x))
         in
-        let* elem = Directory.find dir x in
+        let* elem = Directory.find dir x |> Result.map (Option.map Handle.autorelease) in
         match elem with
         | None -> Error (Error.path_not_found path)
         | Some elem -> f x handle (fun () -> walk elem xs) )
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