diff options
| author | Estevan Castilho <tevo@riajuu.net> | 2026-10-10 01:56:59 +0000 |
|---|---|---|
| committer | Estevan Castilho <tevo@riajuu.net> | 2026-10-10 01:57:12 +0000 |
| commit | c19a5169c5fcbfba5546f49d6d4d0b0e29d40e3a (patch) | |
| tree | 008ad4f8e9f3234dd0d5669756516c06558b2d0c /lib/kernel | |
| parent | 2f786a514b54cf4f72eacb6578a11b20a5069aac (diff) | |
| download | RNT-c19a5169c5fcbfba5546f49d6d4d0b0e29d40e3a.tar.gz RNT-c19a5169c5fcbfba5546f49d6d4d0b0e29d40e3a.zip | |
Use an autorelease pool when walking down a path
Diffstat (limited to 'lib/kernel')
| -rw-r--r-- | lib/kernel/Path.ml | 33 |
1 files changed, 14 insertions, 19 deletions
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 |
