runtime with cas skeleton

3 files changed, 50 insertions, 3 deletions

diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml
index 767dcca..375070f 100644
--- a/lib/kernel/Initialization.ml
+++ b/lib/kernel/Initialization.ml
@@ -100,8 +100,6 @@ module Make (Store : Abstract.Storage.STORAGE) = struct
     let* () = store_fixed_root tx root in
     Ok root
 
-  let read connection = with_transaction connection read_in_transaction
-
   let initialize connection =
     with_transaction connection (fun tx ->
         let open Utilities.Result in
diff --git a/lib/kernel/Initialization.mli b/lib/kernel/Initialization.mli
index 4f98215..5c348bd 100644
--- a/lib/kernel/Initialization.mli
+++ b/lib/kernel/Initialization.mli
@@ -5,6 +5,5 @@ val fixed_label : string
 val fixed_label_address : address
 
 module Make (Store : Abstract.Storage.STORAGE) : sig
-  val read : Store.connection -> (branch_index_root option, Concepts.Condition.condition) result
   val initialize : Store.connection -> (branch_index_root, Concepts.Condition.condition) result
 end
diff --git a/lib/kernel/Runtime.ml b/lib/kernel/Runtime.ml
new file mode 100644
index 0000000..6b4f5a4
--- /dev/null
+++ b/lib/kernel/Runtime.ml
@@ -0,0 +1,50 @@
+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
+end
+
+module CAS : REGISTRY_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 ())
+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)
+
+  type photograph =
+    { branch_index_root: Concepts.Hash.hash
+    ; registry : Backend.Managers.Object.rnt_object_tree }
+
+  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
+    
+end