From 6201bbc6e7171f037467bbfc2d0a6da084fb516c Mon Sep 17 00:00:00 2001 From: Estevan Castilho Date: Sat, 10 Oct 2026 02:14:55 +0000 Subject: Make the autorelease pool opt-in --- lib/kernel/Path.ml | 7 +++---- lib/protocols/Handle.ml | 15 ++------------- lib/protocols/Handle.mli | 5 ++--- 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 -- cgit v1.2.3