drop journal in favor of local branch history

1 files changed, 45 insertions, 16 deletions

diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml
index 3c8addb..692aa7f 100644
--- a/lib/kernel/Initialization.ml
+++ b/lib/kernel/Initialization.ml
@@ -1,23 +1,52 @@
+module Error = struct
+  open Concepts.Condition
+
+  let taken name =
+    condition "name-taken" "A namespace already binds the name"
+      ("name" |=| Concepts.Value.String name)
+end
+
 module Make (S : Abstract.Storage.STORAGE) = struct
   module BM = BranchManager.Make (S)
 
-  let initialize ?(evaluators = []) conn =
+  let bind namespace (name, handle) =
+    let open Utilities.Result in
+    let* registry = Protocols.Handle.require Protocols.Registry.from namespace in
+    let* bound = Protocols.Registry.update registry name None (Some handle) in
+    if bound then Ok () else Error (Error.taken name)
+
+  let namespace entries =
     let open Utilities.Result in
-    let open Protocols in
-    let root = Namespace.make () in
-    let registry = Registry.from root |> Option.get in
-    let* branch_manager = BM.make conn "rnt-head" in
-    let* _ = Registry.update registry "branch" None (Some branch_manager) in
-    let evaluator_namespace = Namespace.make () in
-    let evaluator_registry = Registry.from evaluator_namespace |> Option.get in
-    let* _ =
+    let n = Namespace.make () in
+    let* () =
       List.fold_left
-        (fun acc (name, handle) ->
-          let* _ = acc in
-          Registry.update evaluator_registry name None (Some handle) )
-        (Ok true) evaluators
+        (fun acc entry ->
+          let* () = acc in
+          bind n entry )
+        (Ok ()) entries
     in
-    let* _ = Registry.update registry "evaluator" None (Some evaluator_namespace) in
-    let* _ = Registry.update registry "session" None (Some (Namespace.make ())) in
-    Ok root
+    Ok n
+
+  (* \system keeps the head label it had before subsystems got roots of
+     their own, so a database made then still opens. *)
+  let initialize ?(evaluators = []) conn =
+    let open Utilities.Result in
+    let* evaluator = namespace evaluators in
+    let* branch = BM.make ~evaluators:evaluator conn "rnt-head" in
+    let* system =
+      namespace
+        [ "branch", branch;
+          "evaluator", evaluator;
+          "session", Namespace.make ();
+          "application", Namespace.make () ]
+    in
+    namespace ["system", system]
+
+  let mount conn root name =
+    let open Utilities.Result in
+    let* evaluators = Path.lookup root Source.evaluators in
+    let* branch = BM.make ~evaluators conn (name ^ "-head") in
+    let* subsystem = namespace ["branch", branch] in
+    let* () = bind root (name, subsystem) in
+    Ok subsystem
 end