diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/backend/managers/Lifecycle.ml | 106 | ||||
| -rw-r--r-- | lib/backend/managers/Lifecycle.mli | 17 |
2 files changed, 123 insertions, 0 deletions
diff --git a/lib/backend/managers/Lifecycle.ml b/lib/backend/managers/Lifecycle.ml new file mode 100644 index 0000000..7aa3836 --- /dev/null +++ b/lib/backend/managers/Lifecycle.ml @@ -0,0 +1,106 @@ +(* The lifecycle manager decides when a registered object may leave memory. + It works purely on the object tree and never touches storage: collection + here means dropping the in-memory registry entry, not deleting anything on + disk. Durable-backed objects (relations, multigroups, branch trees) can be + rebuilt from their encoded form on the next access, so evicting them is + safe and keeps memory bounded. Runtime-only objects (sessions, and later + transactions) have no durable form, so their collection is a real teardown; + the manager surfaces those to the caller as disposals rather than acting on + storage itself. *) + +type tree = Object.rnt_object_tree + +(* A runtime object that was collected and now needs an external teardown the + lifecycle manager cannot perform on its own: closing a session, and later + rolling back a transaction. The caller drains these after a collect. *) +type disposal = {path: Concepts.Path.t; kind: Object.rnt_object_kind} + +let monitor (tree : tree) (path : Concepts.Path.t) : tree = + Object.update path (fun r -> {r with Object.handle_count= r.Object.handle_count + 1}) tree + +(* Pin is an explicit keep-alive that bypasses collection. It does not touch + reference_count: pinning is a decision, reference counting is bookkeeping of + real edges. Keeping them separate is what stops the two from being mistaken + for each other. *) +let pin (tree : tree) (path : Concepts.Path.t) : tree = + Object.update path (fun r -> {r with Object.pinned= true}) tree + +let unpin (tree : tree) (path : Concepts.Path.t) : tree = + Object.update path (fun r -> {r with Object.pinned= false}) tree + +(* An object may be collected only when nothing holds it open, nothing depends + on it, it has not been pinned, and its kind is not exempt (a branch). This + works on the registry record directly so callers that already hold it (the + cascade) need not walk the tree a second time. *) +let registry_eligible (r : Object.registry) : bool = + r.Object.handle_count = 0 + && r.Object.reference_count = 0 + && (not r.Object.pinned) + && not (Object.is_gc_exempt r.Object.entry.Object.kind) + +let is_eligible_for_gc (tree : tree) (path : Concepts.Path.t) : bool = + match Object.find path tree with Some r -> registry_eligible r | None -> false + +(* Contention reports whether a mutation must wait. An exclusive object with an + open handle, such as a branch head being read, cannot be modified until the + handle closes. This gates writers; it is not part of collection. *) +let contention (tree : tree) (path : Concepts.Path.t) : bool = + match Object.find path tree with + | Some r -> r.Object.entry.Object.exclusive && r.Object.handle_count > 0 + | None -> false + +(* Cascade the collection at path, threading the pruned tree and the disposals + gathered so far. Disposals are appended (snoc) as each object is torn down, + so the finger tree hands them back parent-first, left-to-right without any + reversal pass. + + Order of teardown falls out of the counts. Collecting an object drops the + reference_count of every input it depended on (Object.unregister undoes the + edges), which can make those inputs eligible in turn, so we recurse into + them. A populated namespace is kept, not collected and not an error: it is + scaffolding for the objects still living under it. *) +let rec cascade (tree : tree) (disposals : disposal BatFingerTree.t) (path : Concepts.Path.t) : + (tree * disposal BatFingerTree.t, Concepts.Condition.condition) result = + match Object.find path tree with + | None -> Ok (tree, disposals) + | Some r when not (registry_eligible r) -> Ok (tree, disposals) + | Some r -> + let kind = r.Object.entry.Object.kind in + begin match kind with + | Object.Namespace _ when Object.has_children path tree -> Ok (tree, disposals) + | _ -> + let edges = Object.reference_edges kind in + let disposals = + if Object.is_runtime kind then BatFingerTree.snoc disposals {path; kind} else disposals + in + Result.bind (Object.unregister path tree) (fun tree -> + BatFingerTree.fold_left + (fun acc dep -> Result.bind acc (fun (tree, disposals) -> cascade tree disposals dep)) + (Ok (tree, disposals)) + edges ) + end + +let try_collect (tree : tree) (path : Concepts.Path.t) : + (tree * disposal BatFingerTree.t, Concepts.Condition.condition) result = + cascade tree BatFingerTree.empty path + +(* Close a handle, then see whether the object can now go. *) +let unmonitor (tree : tree) (path : Concepts.Path.t) : + (tree * disposal BatFingerTree.t, Concepts.Condition.condition) result = + let tree = + Object.update path + (fun r -> + if r.Object.handle_count = 0 then r + else {r with Object.handle_count= r.Object.handle_count - 1} ) + tree + in + try_collect tree path + +(* Public entry point for an explicit collection request. *) +let collect (tree : tree) (path : Concepts.Path.t) : + (tree * disposal BatFingerTree.t, Concepts.Condition.condition) result = + try_collect tree path + +(* Session reaping is not built here yet. A lost connection is detected by a + per-session inactivity timer whose expiry drives collect on the session. + Design and tasks are tracked in issue #24. *) diff --git a/lib/backend/managers/Lifecycle.mli b/lib/backend/managers/Lifecycle.mli new file mode 100644 index 0000000..f8cec1a --- /dev/null +++ b/lib/backend/managers/Lifecycle.mli @@ -0,0 +1,17 @@ +type tree = Object.rnt_object_tree + +(* A collected runtime object that still needs an external teardown: a session + to close, and later a transaction to roll back. The caller drains these. *) +type disposal = {path: Concepts.Path.t; kind: Object.rnt_object_kind} + +val monitor : tree -> Concepts.Path.t -> tree +val pin : tree -> Concepts.Path.t -> tree +val unpin : tree -> Concepts.Path.t -> tree +val is_eligible_for_gc : tree -> Concepts.Path.t -> bool +val contention : tree -> Concepts.Path.t -> bool + +val unmonitor : + tree -> Concepts.Path.t -> (tree * disposal BatFingerTree.t, Concepts.Condition.condition) result + +val collect : + tree -> Concepts.Path.t -> (tree * disposal BatFingerTree.t, Concepts.Condition.condition) result |