aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel/Branch.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/kernel/Branch.ml')
-rw-r--r--lib/kernel/Branch.ml29
1 files changed, 14 insertions, 15 deletions
diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml
index e2a9092..b0b3f12 100644
--- a/lib/kernel/Branch.ml
+++ b/lib/kernel/Branch.ml
@@ -75,10 +75,10 @@ module Make (S : Abstract.Storage.STORAGE) = struct
MultigroupM.find tx branch.multigroups
|> fmap (Option.to_result ~none:(Error.incomplete_branch branch.multigroups))
- (* [evaluators] is the directory the stored programs of this state run
- through; they read against this very state, so an earlier state
- reads as it was. *)
- class branch ?evaluators storage value node =
+ (* Given [root], the stored programs of this state run through the
+ evaluators registered under it, against this very state, so an
+ earlier state reads as it was. *)
+ class branch ?root storage value node =
object (self)
inherit Lifecycle.null
method to_string = "branch"
@@ -94,7 +94,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
let* _ = SI.store_blob tx (Representation.to_blob branch'') in
node_of tx branch' )
in
- new branch ?evaluators storage branch'' node' |> Protocols.Handle.make |> Result.ok
+ new branch ?root storage branch'' node' |> Protocols.Handle.make |> Result.ok
method private previous =
match branch.previous with
@@ -108,16 +108,15 @@ module Make (S : Abstract.Storage.STORAGE) = struct
method protocols : Protocols.Handle.protocol list =
let bind =
- Option.map
- (fun evaluators -> Source.bind evaluators ~within:(Protocols.Handle.make {<>}))
- evaluators
+ Option.map (fun root -> Source.bind root ~within:(Protocols.Handle.make {<>})) root
in
let multigroups =
Prototype.mixture_of node (fun make node ->
[ MMAddressable.make ~node:(MultigroupM.into node);
- MMDirectory.make ~storage ~node ~constructor:(M.wrap ?bind storage);
- MMAssociative.make ~storage ~node:(MultigroupM.into node) ~constructor:(fun node' ->
- MultigroupM.from node' |> make |> Result.ok ) ] )
+ MMDirectory.make ~storage ~node ~constructor:(M.load ?bind storage);
+ MMAssociative.make ~admit:M.admit ~storage ~node:(MultigroupM.into node)
+ ~constructor:(fun node' -> MultigroupM.from node' |> make |> Result.ok)
+ () ] )
in
let open Utilities.Result in
Protocols.
@@ -148,18 +147,18 @@ module Make (S : Abstract.Storage.STORAGE) = struct
method address = self#hash
end
- let load ?evaluators tx conn addr =
+ let load ?root tx conn addr =
let open Utilities.Result in
let* data = SI.get_req tx (S.Hash addr) in
let* branch = Representation.of_blob data in
let* node = node_of tx branch in
- Ok (new branch ?evaluators conn branch node |> Protocols.Handle.make)
+ Ok (new branch ?root conn branch node |> Protocols.Handle.make)
- let make ?evaluators conn =
+ let make conn =
let open Utilities.Result in
SI.with_transaction conn (fun tx ->
let* empty = MultigroupM.empty_under tx in
let branch = {multigroups= empty; previous= None} in
let* _ = SI.store_blob tx (Representation.to_blob branch) in
- Ok (new branch ?evaluators conn branch MultigroupM.empty |> Protocols.Handle.make) )
+ Ok (new branch conn branch MultigroupM.empty |> Protocols.Handle.make) )
end