photograph with runtime split for object manager

2 files changed, 123 insertions, 26 deletions

diff --git a/lib/backend/managers/Object.ml b/lib/backend/managers/Object.ml
index ae5f5c1..d54c89d 100644
--- a/lib/backend/managers/Object.ml
+++ b/lib/backend/managers/Object.ml
@@ -54,6 +54,17 @@ type registry = {reference_count: int; handle_count: int; pinned: bool; entry: r
 
 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
 
@@ -239,3 +250,94 @@ let unregister (path : Concepts.Path.t) (tree : rnt_object_tree) :
       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
diff --git a/lib/kernel/Runtime.ml b/lib/kernel/Runtime.ml
index 6b4f5a4..aa69791 100644
--- a/lib/kernel/Runtime.ml
+++ b/lib/kernel/Runtime.ml
@@ -1,50 +1,45 @@
-module type REGISTRY_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_conflict () =
-    let msg = "Failed to update the in-memory object registry." in
-    condition "registry-object-update-conflict" msg empty
+    condition "registry-object-update-conflict" "Failed to update the in-memory object registry"
+      empty
 end
 
-module CAS : REGISTRY_STRATEGY = struct
+module CAS : Backend.Managers.Object.RUNTIME_STRATEGY = struct
   type 'a state = 'a Atomic.t
   type 'a token = 'a
+
   let create = Atomic.make
+
   let acquire state =
     let photograph = Atomic.get state in
-    (* Just the same here because of CAS. On MVCC this would be a version number*)
     photograph, photograph
+
   let publish state token next =
-    if Atomic.compare_and_set state token next then Ok ()
-  else Error (Error.registry_conflict ())
+    if Atomic.compare_and_set state token next then Ok () else Error (Error.registry_conflict ())
 end
 
 (* module MVCC : REGISTRY_STRATEGY = struct end *)
 (* module RCU : REGISTRY_STRATEGY = struct end *)
 
-module Make (Strategy : REGISTRY_STRATEGY) (Store: Abstract.Storage.STORAGE) = struct
-  module Init = Initialization.Make(Store)
+module Make (Strategy : Backend.Managers.Object.RUNTIME_STRATEGY) (Store : Abstract.Storage.STORAGE) =
+struct
+  module Init = Initialization.Make (Store)
+  module Objects = Backend.Managers.Object.Make (Strategy)
 
-  type photograph =
-    { branch_index_root: Concepts.Hash.hash
-    ; registry : Backend.Managers.Object.rnt_object_tree }
+  type t = {connection: Store.connection; objects: Objects.t}
 
-  type t =
-    { connection : Store.connection
-    ; state : photograph Strategy.state }
-  
   let initialize configuration : (t, Concepts.Condition.condition) result =
     let open Utilities.Result in
     let* connection = Store.connect configuration in
     let* branch_index_root = Init.initialize connection in
-    
+    (* Registry reconstruction from the branch index is the loader boundary.
+       Until that loader exists, publish only the permanent /system namespace;
+       importantly, the discovered root remains part of the photograph. *)
+    let objects = Objects.create ~branch_index_root ~registry:Backend.Managers.Object.root in
+    Ok {connection; objects}
+
+  let connection runtime = runtime.connection
+  let objects runtime = runtime.objects
 end