Tidy up

1 files changed, 0 insertions, 343 deletions

diff --git a/lib/backend/managers/Object.ml b/lib/backend/managers/Object.ml
deleted file mode 100644
index d54c89d..0000000
--- a/lib/backend/managers/Object.ml
+++ /dev/null
@@ -1,343 +0,0 @@
-(* @uses Path -- snoc, to_string when building registry paths *)
-(* @uses Condition -- builds registry-object/path errors *)
-(* @needs Value *)
-
-type multigroup = {merkle_root: string}
-type relation = {merkle_root: string}
-
-(* An ephemeral relation is a stored plan that reads other relations. Its
-   dependencies are the inputs that plan replays over. They are branch-local
-   symlink paths, not version-pinned paths: as the branch head advances the
-   inputs move with it, and Namespace.resolve turns the symlink into whatever
-   object is current on this branch hash. Keeping them as paths (not hashes)
-   is what lets an ephemeral relation behave like a view. *)
-type ephemeral_relation = {merkle_root: string; dependencies: Concepts.Path.t BatFingerTree.t}
-type transaction = unit
-type session = {connection_context: unit; branch_overrides: string BatMap.String.t}
-type branch = {name: string; target_hash: string}
-type branch_tree = {merkle_root: string}
-
-type rnt_object_kind =
-  | Multigroup of multigroup
-  | Relation of relation
-  | EphemeralRelation of ephemeral_relation
-  | Session of session
-  | Branch of branch
-  | BranchTree of branch_tree
-  | Namespace of namespace
-
-and namespace = {label: string; predicate: rnt_object_kind -> bool}
-
-type rnt_method = OPEN | CLOSE
-
-type rnt_object =
-  {kind: rnt_object_kind; disposable: bool; methods: rnt_method BatSet.t; exclusive: bool}
-
-(* Three independent facts about a registered object, kept apart on purpose:
-
-   - handle_count: how many handles are open on it right now (open/close).
-   - reference_count: how many other objects depend on it staying resident.
-     This is bookkeeping of real edges, nothing more. It goes up because a
-     dependency exists, not because someone asked to keep the object alive.
-   - pinned: an explicit override that bypasses collection regardless of the
-     counts. Used when something must not be evicted even though nothing
-     currently points at it or holds it open. This is deliberately separate
-     from reference_count so the two reasons never get confused. *)
-type registry = {reference_count: int; handle_count: int; pinned: bool; entry: rnt_object}
-
-(*
-  /system/branch/branch1/multigrop/multigroup1/relation/relation1
-  /system/branch1/multigrop/multigroup1/relation/relation2
-  /system/branch1/multigrop/multigroup1/ephemeral_relation/ephemeral_relation1
-  /system/transaction/xyz_txn
- *)
-
-type rnt_object_tree = {data: registry; subsequent: rnt_object_tree BatMap.String.t}
-
-module type RUNTIME_STRATEGY = sig
-  type 'a state
-
-  (* The exact snapshot observed on acquire *)
-  type 'a token
-
-  val create : 'a -> 'a state
-  val acquire : 'a state -> 'a * 'a token
-  val publish : 'a state -> 'a token -> 'a -> (unit, Concepts.Condition.condition) result
-end
-
-module Error = struct
-  open Concepts.Condition
-
-  let registry_object_already_registered path =
-    let msg = "An object is already registered in the path" in
-    condition "registry-object-already-registered" msg
-      ("path" |=| Concepts.Value.String (Concepts.Path.to_string path))
-
-  let registry_path_not_found path =
-    let msg = "The provided path was not found" in
-    condition "registry-path-not-found" msg
-      ("path" |=| Concepts.Value.String (Concepts.Path.to_string path))
-end
-
-let make_object ?(disposable = false) ?(exclusive = false) ?(methods = BatSet.empty)
-    (kind : rnt_object_kind) : rnt_object =
-  {kind; disposable; methods; exclusive}
-
-(* The empty registry. The root node is the system namespace itself, and every
-   other object is registered under it. Path separators are only a string
-   rendering concern, so there is no distinct "/" node above system: system is
-   the root. It is exempt from collection for the same reason a branch is, it
-   is the way in to everything else. *)
-let root : rnt_object_tree =
-  { data=
-      { reference_count= 0;
-        handle_count= 0;
-        pinned= false;
-        entry= make_object (Namespace {label= "system"; predicate= (fun _ -> true)}) };
-    subsequent= BatMap.String.empty }
-
-let find (path : Concepts.Path.t) (tree : rnt_object_tree) : registry option =
-  let rec walk components node =
-    match BatFingerTree.front components with
-    | None -> Some node.data
-    | Some (tail, head) -> Option.bind (BatMap.String.find_opt head node.subsequent) (walk tail)
-  in
-  walk path tree
-
-let update (path : Concepts.Path.t) (f : registry -> registry) (tree : rnt_object_tree) :
-    rnt_object_tree =
-  let rec walk components node =
-    match BatFingerTree.front components with
-    | None -> {node with data= f node.data}
-    | Some (tail, head) ->
-      begin match BatMap.String.find_opt head node.subsequent with
-      | None -> node
-      | Some child ->
-          {node with subsequent= BatMap.String.add head (walk tail child) node.subsequent}
-      end
-  in
-  walk path tree
-
-(* The objects that must stay resident for this object to remain replayable.
-   Registering an object bumps the reference_count of each edge target and
-   unregistering drops it, so reference counts stay in step with the real
-   dependency graph. Only ephemeral relations carry edges today. Which kinds
-   grow edges is a per-kind decision, which is why this lives next to the
-   registry and not in the lifecycle manager: the object knows its own shape. *)
-let reference_edges (kind : rnt_object_kind) : Concepts.Path.t BatFingerTree.t =
-  match kind with
-  | EphemeralRelation {dependencies; _} -> dependencies
-  | Multigroup _ | Relation _ | Session _ | Branch _ | BranchTree _ | Namespace _ ->
-      BatFingerTree.empty
-
-(* Adjust the reference_count of every edge target by delta. A target that is
-   not present is skipped: update leaves the tree untouched when the path is
-   missing. That is fine for a skeleton, but it hides a dangling dependency,
-   so registration will eventually want to fail loudly on a missing input. *)
-let adjust_references (delta : int) (paths : Concepts.Path.t BatFingerTree.t)
-    (tree : rnt_object_tree) : rnt_object_tree =
-  BatFingerTree.fold_left
-    (fun tree path ->
-      update path (fun r -> {r with reference_count= r.reference_count + delta}) tree )
-    tree paths
-
-(* A branch is exempt from collection because everything is reachable through
-   it: collecting a branch would orphan its whole subtree. Every other kind is
-   collectable, including sessions. A session is runtime-only state with no
-   durable encoding, so collecting one is a real teardown rather than an
-   eviction, but it still happens (see Lifecycle for how a dead session is
-   detected). *)
-let is_gc_exempt (kind : rnt_object_kind) : bool = match kind with Branch _ -> true | _ -> false
-
-(* Runtime-only kinds have no durable encoding, so collecting them cannot be
-   undone by rehydrating from disk. The lifecycle manager surfaces these to
-   its caller as disposals to run (a session close, and later a transaction
-   rollback once transactions become objects in their own right). *)
-let is_runtime (kind : rnt_object_kind) : bool = match kind with Session _ -> true | _ -> false
-
-let has_children (path : Concepts.Path.t) (tree : rnt_object_tree) : bool =
-  let rec walk components node =
-    match BatFingerTree.front components with
-    | None -> not (BatMap.String.is_empty node.subsequent)
-    | Some (tail, head) ->
-      begin match BatMap.String.find_opt head node.subsequent with
-      | None -> false
-      | Some child -> walk tail child
-      end
-  in
-  walk path tree
-
-(* TODO: This function is not tail call optimized. We ventured with
-   the idea of using CPS, but that's not going to solve anything here,
-   so the probable best course of action is relying on the growing map
-   to carry on the state. This is not a big deal as the structure is
-   expected to be small enough to live in memory and these operations
-   are relatively uncommon. *)
-let register (path : Concepts.Path.t) (object' : rnt_object) (tree : rnt_object_tree) :
-    (rnt_object_tree, Concepts.Condition.condition) result =
-  let rec insert components node =
-    match BatFingerTree.front components with
-    | None -> Error (Error.registry_object_already_registered path)
-    | Some (tail, head) when BatFingerTree.is_empty tail ->
-        if BatMap.String.mem head node.subsequent then
-          Error (Error.registry_object_already_registered path)
-        else
-          let child =
-            { data= {reference_count= 0; handle_count= 0; pinned= false; entry= object'};
-              subsequent= BatMap.String.empty }
-          in
-          Ok {node with subsequent= BatMap.String.add head child node.subsequent}
-    | Some (tail, head) ->
-      begin match BatMap.String.find_opt head node.subsequent with
-      | None -> Error (Error.registry_path_not_found path)
-      | Some child ->
-          Result.map (fun child' ->
-              {node with subsequent= BatMap.String.add head child' node.subsequent} )
-          @@ insert tail child
-      end
-  in
-  (* On success, record the new object's dependency edges by bumping the
-     reference_count of each input it reads. This is the polymorphic part of
-     registration: the edge set comes from the object's own kind. *)
-  Result.map
-    (fun tree -> adjust_references 1 (reference_edges object'.kind) tree)
-    (insert path tree)
-
-let with_namespace (parent : Concepts.Path.t) (namespace_label : string)
-    (predicate : rnt_object_kind -> bool) (name : string) (object' : rnt_object)
-    (tree : rnt_object_tree) : (rnt_object_tree, Concepts.Condition.condition) result =
-  let namespace_path = Concepts.Path.snoc parent namespace_label in
-  let tree_with_namespace =
-    match find namespace_path tree with
-    | None ->
-        register namespace_path (make_object (Namespace {label= namespace_label; predicate})) tree
-    | Some _ -> Ok tree
-  in
-  Result.bind tree_with_namespace (fun tree ->
-      register (Concepts.Path.snoc namespace_path name) object' tree )
-
-let construct_multigroup parent name (mg : multigroup) tree =
-  with_namespace parent "multigroup"
-    (function Multigroup _ -> true | _ -> false)
-    name (make_object (Multigroup mg)) tree
-
-let construct_relation parent name (rel : relation) tree =
-  with_namespace parent "relation"
-    (function Relation _ -> true | _ -> false)
-    name (make_object (Relation rel)) tree
-
-let unregister (path : Concepts.Path.t) (tree : rnt_object_tree) :
-    (rnt_object_tree, Concepts.Condition.condition) result =
-  (* Read the edges before removing the node so we can undo what register did:
-     dropping an object releases its hold on the inputs it depended on. *)
-  let edges =
-    match find path tree with Some r -> reference_edges r.entry.kind | None -> BatFingerTree.empty
-  in
-  let rec remove components node =
-    match BatFingerTree.front components with
-    | None -> Error (Error.registry_path_not_found path)
-    | Some (tail, head) when BatFingerTree.is_empty tail ->
-        if BatMap.String.mem head node.subsequent then
-          Ok {node with subsequent= BatMap.String.remove head node.subsequent}
-        else Error (Error.registry_path_not_found path)
-    | Some (tail, head) ->
-      begin match BatMap.String.find_opt head node.subsequent with
-      | None -> Error (Error.registry_path_not_found path)
-      | Some child ->
-          Result.map (fun child' ->
-              {node with subsequent= BatMap.String.add head child' node.subsequent} )
-          @@ remove tail child
-      end
-  in
-  Result.map (fun tree -> adjust_references (-1) edges tree) (remove path tree)
-
-module type MANAGER = sig
-  type t
-
-  val create : branch_index_root:Concepts.Hash.hash -> registry:rnt_object_tree -> t
-  val branch_index_root : t -> Concepts.Hash.hash
-  val find : t -> Concepts.Path.t -> registry option
-
-  val update :
-    t -> Concepts.Path.t -> (registry -> registry) -> (unit, Concepts.Condition.condition) result
-
-  val register : t -> Concepts.Path.t -> rnt_object -> (unit, Concepts.Condition.condition) result
-  val unregister : t -> Concepts.Path.t -> (unit, Concepts.Condition.condition) result
-
-  val with_namespace :
-    t ->
-    Concepts.Path.t ->
-    string ->
-    (rnt_object_kind -> bool) ->
-    string ->
-    rnt_object ->
-    (unit, Concepts.Condition.condition) result
-
-  val construct_multigroup :
-    t -> Concepts.Path.t -> string -> multigroup -> (unit, Concepts.Condition.condition) result
-
-  val construct_relation :
-    t -> Concepts.Path.t -> string -> relation -> (unit, Concepts.Condition.condition) result
-end
-
-(* Keep the immutable tree operations above as the implementation core, while
-   this functor owns publication of the current photograph. Runtime bootstraps
-   the first photograph and exposes this opaque manager to its consumers. *)
-module Make (Strategy : RUNTIME_STRATEGY) : MANAGER = struct
-  type photograph = {branch_index_root: Concepts.Hash.hash; registry: rnt_object_tree}
-  type t = {state: photograph Strategy.state}
-
-  let create ~branch_index_root ~registry = {state= Strategy.create {branch_index_root; registry}}
-
-  let branch_index_root manager =
-    let photograph, _ = Strategy.acquire manager.state in
-    photograph.branch_index_root
-
-  let find manager path =
-    let photograph, _ = Strategy.acquire manager.state in
-    find path photograph.registry
-
-  let modify manager transformation =
-    let open Utilities.Result in
-    let photograph, token = Strategy.acquire manager.state in
-    let* next, result = transformation photograph in
-    let* () = Strategy.publish manager.state token next in
-    Ok result
-
-  let update manager path f =
-    modify manager (fun photograph ->
-        let registry = update path f photograph.registry in
-        Ok ({photograph with registry}, ()) )
-
-  let register manager path object_ =
-    modify manager (fun photograph ->
-        let open Utilities.Result in
-        let* registry = register path object_ photograph.registry in
-        Ok ({photograph with registry}, ()) )
-
-  let unregister manager path =
-    modify manager (fun photograph ->
-        let open Utilities.Result in
-        let* registry = unregister path photograph.registry in
-        Ok ({photograph with registry}, ()) )
-
-  let with_namespace manager parent namespace_label predicate name object_ =
-    modify manager (fun photograph ->
-        let open Utilities.Result in
-        let* registry =
-          with_namespace parent namespace_label predicate name object_ photograph.registry
-        in
-        Ok ({photograph with registry}, ()) )
-
-  let construct_multigroup manager parent name multigroup =
-    modify manager (fun photograph ->
-        let open Utilities.Result in
-        let* registry = construct_multigroup parent name multigroup photograph.registry in
-        Ok ({photograph with registry}, ()) )
-
-  let construct_relation manager parent name relation =
-    modify manager (fun photograph ->
-        let open Utilities.Result in
-        let* registry = construct_relation parent name relation photograph.registry in
-        Ok ({photograph with registry}, ()) )
-end