beam subsystem hack for karuta execution under internal nodeHEADmaster

3 files changed, 16 insertions, 9 deletions

diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml
index 54bb76d..86c6882 100644
--- a/lib/kernel/Initialization.ml
+++ b/lib/kernel/Initialization.ml
@@ -20,12 +20,11 @@ let namespace entries =
    evaluators, and whatever else it registers beside them. *)
 let mount root name =
   match Path.lookup root Path.(name @/ this) with
-  | Ok mounted -> Ok mounted
+  | Ok mounted -> Ok (Protocols.Handle.release mounted)
   | Error _ ->
       let open Utilities.Result in
       let* mounted = namespace ["evaluator", Namespace.make ()] in
-      let* () = bind root (name, mounted) in
-      Ok mounted
+      bind root (name, mounted)
 
 module Make (S : Abstract.Storage.STORAGE) = struct
   module BM = BranchManager.Make (S)
diff --git a/lib/kernel/Initialization.mli b/lib/kernel/Initialization.mli
index a6e6ae0..02db00f 100644
--- a/lib/kernel/Initialization.mli
+++ b/lib/kernel/Initialization.mli
@@ -1,7 +1,6 @@
 (** 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
+    evaluators it registers. Mounting it again keeps the one there. *)
+val mount : Protocols.Handle.t -> string -> (unit, Concepts.Condition.condition) result
 
 module Make (S : Abstract.Storage.STORAGE) : sig
   (** the root of the object tree, holding \system: its branches, of
diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml
index 512cfb0..2a9b053 100644
--- a/lib/kernel/Path.ml
+++ b/lib/kernel/Path.ml
@@ -22,6 +22,10 @@ module Error = struct
     condition "overlapping-change"
       "A batch of changes both replaced an object and changed inside it"
       ("path" |=| Concepts.Value.String (to_string path))
+
+  let unheld path =
+    condition "path-unheld" "The object at the path could not be held"
+      ("path" |=| Concepts.Value.String (to_string path))
 end
 
 let walking ?missing f g handle path =
@@ -42,7 +46,11 @@ let walking ?missing f g handle path =
         | Some elem -> f x handle (fun () -> walk elem xs) )
   in
   Handle.with_autorelease (fun () ->
-      walk handle path
+      begin match path with
+      | [] -> (
+        match Handle.copy handle with Some copy -> g copy | None -> Error (Error.unheld path) )
+      | _ -> walk handle path
+      end
       |> Result.map_error
            Concepts.Condition.(complement ("path" |=| Concepts.Value.String (to_string path))) )
 
@@ -55,8 +63,9 @@ let update handle path key reference value =
   let open Utilities.Result in
   let open Protocols in
   let* target = lookup handle path in
-  let* registry = Handle.require Registry.from target in
-  Registry.update registry key reference value
+  Handle.releasing target (fun () ->
+      let* registry = Handle.require Registry.from target in
+      Registry.update registry key reference value )
 
 (* The changes at this object, and those beneath each child they reach. *)
 let split changes =