From c19a5169c5fcbfba5546f49d6d4d0b0e29d40e3a Mon Sep 17 00:00:00 2001
From: Estevan Castilho <tevo@riajuu.net>
Date: Sat, 10 Oct 2026 01:56:59 +0000
Subject: Use an autorelease pool when walking down a path

---
 lib/kernel/Path.ml | 33 ++++++++++++++-------------------
 1 file changed, 14 insertions(+), 19 deletions(-)

(limited to 'lib/kernel')

diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml
index eeef396..8822d44 100644
--- a/lib/kernel/Path.ml
+++ b/lib/kernel/Path.ml
@@ -20,11 +20,13 @@ module Error = struct
 end
 
 let walking f g handle path =
+  let open Protocols in
   let rec walk handle = function
-    | [] -> g handle
+    | [] ->
+       Handle.keep handle;
+       g handle
     | x :: xs -> (
         let open Utilities.Result in
-        let open Protocols in
         let* dir =
           Handle.require Directory.from handle
           |> Result.map_error
@@ -35,26 +37,20 @@ let walking f g handle path =
         | None -> Error (Error.path_not_found path)
         | Some elem -> f x handle (fun () -> walk elem xs) )
   in
-  walk handle path
-  |> Result.map_error
-       Concepts.Condition.(complement ("path" |=| Concepts.Value.String (to_string path)))
-
-(* Handles we find in the middle of a walk get released once we're
-   done with them, but never the caller's root.  If you leak one and
-   its refcount never drops, nothing under that path gets collected,
-   and an exclusive object, like a session, stays locked forever. *)
-let releasing root handle f =
-  Fun.protect ~finally:(fun () -> if handle != root then Protocols.Handle.release handle) f
+  Handle.with_autorelease
+    (fun () ->
+      walk handle path
+      |> Result.map_error
+           Concepts.Condition.(complement ("path" |=| Concepts.Value.String (to_string path))))
 
-let lookup handle path = walking (fun _ parent -> releasing handle parent) Result.ok handle path
+let lookup handle path = walking (fun _ _ f -> f ()) Result.ok handle path
 
 let update handle path key reference value =
   let open Utilities.Result in
   let open Protocols in
   let* target = lookup handle path in
-  releasing handle target (fun () ->
-      let* registry = Handle.require Registry.from target in
-      Registry.update registry key reference value )
+  let* registry = Handle.require Registry.from target in
+  Registry.update registry key reference value
 
 let assoc handle path key value =
   let open Utilities.Result in
@@ -66,7 +62,6 @@ let assoc handle path key value =
     Ok (Handle.from a')
   in
   walking
-    (fun key dir f ->
-      releasing handle dir (fun () -> f () |> fmap (assoc_on dir key |.| Option.some)) )
-    (fun h -> releasing handle h (fun () -> assoc_on h key value))
+    (fun key dir f -> f () |> fmap (assoc_on dir key |.| Option.some))
+    (fun h -> assoc_on h key value)
     handle path
-- 
cgit v1.2.3