2 files changed, 48 insertions, 41 deletions

diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml
index 692aa7f..518fe4f 100644
--- a/lib/kernel/Initialization.ml
+++ b/lib/kernel/Initialization.ml
@@ -6,33 +6,50 @@ module Error = struct
       ("name" |=| Concepts.Value.String name)
 end
 
-module Make (S : Abstract.Storage.STORAGE) = struct
-  module BM = BranchManager.Make (S)
+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 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 into = Namespace.make () in
+  let open Utilities.Result in
+  let* () =
+    List.fold_left
+      (fun acc entry ->
+        let* () = acc in
+        bind into entry )
+      (Ok ()) entries
+  in
+  Ok into
 
-  let namespace entries =
-    let open Utilities.Result in
-    let n = Namespace.make () in
-    let* () =
-      List.fold_left
-        (fun acc entry ->
-          let* () = acc in
-          bind n entry )
-        (Ok ()) entries
-    in
-    Ok n
+(* A subsystem's root holds what is its own and not data: its
+   evaluators, and whatever else it registers beside them. *)
+let mount root name =
+  match Path.lookup root Path.(name @/ this) with
+  | Ok mounted -> Ok mounted
+  | Error _ ->
+      let open Utilities.Result in
+      let* mounted = namespace ["evaluator", Namespace.make ()] in
+      let* () = bind root (name, mounted) in
+      Ok mounted
 
-  (* \system keeps the head label it had before subsystems got roots of
-     their own, so a database made then still opens. *)
+module Make (S : Abstract.Storage.STORAGE) = struct
+  module BM = BranchManager.Make (S)
+  module B = Branch.Make (S)
+
+  (* The heads of \system's branches, of which there is always a master,
+     are kept under the label rnt-head. *)
   let initialize ?(evaluators = []) conn =
     let open Utilities.Result in
+    let root = Namespace.make () in
     let* evaluator = namespace evaluators in
-    let* branch = BM.make ~evaluators:evaluator conn "rnt-head" in
+    let* branch = BM.make ~root conn "rnt-head" in
+    let* () =
+      if Path.lookup branch Path.("master" @/ this) |> Result.is_ok then Ok ()
+      else Result.bind (B.make conn) (fun empty -> bind branch ("master", empty))
+    in
     let* system =
       namespace
         [ "branch", branch;
@@ -40,13 +57,6 @@ module Make (S : Abstract.Storage.STORAGE) = struct
           "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
+    let* () = bind root ("system", system) in
+    Ok root
 end
diff --git a/lib/kernel/Initialization.mli b/lib/kernel/Initialization.mli
index 97a27f3..a6e6ae0 100644
--- a/lib/kernel/Initialization.mli
+++ b/lib/kernel/Initialization.mli
@@ -1,17 +1,14 @@
+(** a subsystem's root, \[name], holding \[name]\evaluator for the
+    evaluators it registers. Mounting it again gives the one there. *)
+val mount :
+  Protocols.Handle.t -> string -> (Protocols.Handle.t, Concepts.Condition.condition) result
+
 module Make (S : Abstract.Storage.STORAGE) : sig
-  (** the root of the object tree, holding only \system: its branches,
-      the [evaluators] by language, the sessions and the applications. *)
+  (** the root of the object tree, holding \system: its branches, of
+      which there is always a master, the system's [evaluators] by
+      language, the sessions and the applications. *)
   val initialize :
     ?evaluators:(string * Protocols.Handle.t) list ->
     S.connection ->
     (Protocols.Handle.t, Concepts.Condition.condition) result
-
-  (** give a subsystem a root of its own, \[name], with branches of its
-      own whose heads are kept apart from every other root's. Its stored
-      programs run through \system\evaluator. *)
-  val mount :
-    S.connection ->
-    Protocols.Handle.t ->
-    string ->
-    (Protocols.Handle.t, Concepts.Condition.condition) result
 end