diff options
Diffstat (limited to 'lib/kernel/Path.ml')
| -rw-r--r-- | lib/kernel/Path.ml | 31 |
1 files changed, 13 insertions, 18 deletions
diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml index 4e36125..0814b1c 100644 --- a/lib/kernel/Path.ml +++ b/lib/kernel/Path.ml @@ -25,37 +25,33 @@ module Error = struct end let walking ?missing f g handle path = + let open Protocols in + let open Utilities.Result in let rec walk handle = function - | [] -> g handle + | [] -> g (Handle.keep handle) | x :: xs -> ( - let open Utilities.Result in - let open Protocols 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 -> ( match missing with Some m -> m () | 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))) + Handle.with_autorelease (fun () -> + 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 = if handle == root then f () else Protocols.Handle.releasing handle f -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 find handle path = walking ~missing:(fun () -> Ok None) - (fun _ parent -> releasing handle parent) + (fun _ _ f -> f ()) (fun h -> Ok (Some h)) handle path @@ -63,9 +59,8 @@ 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 (* The changes at this object, and those beneath each child they reach. *) let split changes = @@ -119,7 +114,7 @@ let assoc_all handle changes = | None when binds beneath -> Ok [x, Some (fresh beneath)] | None -> Ok [] | Some child -> - releasing handle child (fun () -> apply (prefix @ [x]) child beneath) + Handle.releasing child (fun () -> apply (prefix @ [x]) child beneath) |> Result.map (fun child' -> [x, Some child']) ) below |> Utilities.List.sequence |
