drop journal in favor of local branch history

19 files changed, 348 insertions, 370 deletions

diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml
index b0ba06e..e2a9092 100644
--- a/lib/kernel/Branch.ml
+++ b/lib/kernel/Branch.ml
@@ -1,9 +1,9 @@
 module Make (S : Abstract.Storage.STORAGE) = struct
-  (* Branch has a name, a set of multigroups, and a backlink to the previous state
-     multigroup has a name and a set of schemas
-     schema has a name and a set of relations
+  (* A branch state holds its multigroups and a backlink to the state it
+     succeeded, each multigroup its relations:
 
-     \branch\master\multigroup\universe\schema\sky\relation\planet
+     \system\branch\master\multigroup\universe\relation\planet
+     \system\branch\master\previous\multigroup\universe\relation\planet
    *)
 
   module SI = Storage.Make (S)
@@ -70,7 +70,15 @@ module Make (S : Abstract.Storage.STORAGE) = struct
 
   let pointer_of hash = SI.Pointer.make Loader.load (S.Hash hash)
 
-  class branch storage value node =
+  let node_of tx branch =
+    let open Utilities.Result in
+    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 =
     object (self)
       inherit Lifecycle.null
       method to_string = "branch"
@@ -84,12 +92,33 @@ module Make (S : Abstract.Storage.STORAGE) = struct
         let* node' =
           SI.with_transaction storage (fun tx ->
               let* _ = SI.store_blob tx (Representation.to_blob branch'') in
-              MultigroupM.find tx branch'.multigroups
-              |> fmap (Option.to_result ~none:(Error.incomplete_branch branch'.multigroups)) )
+              node_of tx branch' )
         in
-        new branch storage branch'' node' |> Protocols.Handle.make |> Result.ok
+        new branch ?evaluators storage branch'' node' |> Protocols.Handle.make |> Result.ok
+
+      method private previous =
+        match branch.previous with
+        | None -> Ok None
+        | Some pointer ->
+            SI.with_read storage (fun tx ->
+                let open Utilities.Result in
+                let* previous = SI.Pointer.deref tx pointer in
+                let* node = node_of tx previous in
+                Ok (Some (Protocols.Handle.make {<branch = previous; node>})) )
 
       method protocols : Protocols.Handle.protocol list =
+        let bind =
+          Option.map
+            (fun evaluators -> Source.bind evaluators ~within:(Protocols.Handle.make {<>}))
+            evaluators
+        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 ) ] )
+        in
         let open Utilities.Result in
         Protocols.
           [ Addressable.make self;
@@ -100,34 +129,37 @@ module Make (S : Abstract.Storage.STORAGE) = struct
                         Handle.require Addressable.from node'
                         |> Result.map Addressable.address
                         |> fmap (fun addr -> self#deriving {branch with multigroups= addr}) ) ) ] );
-            Prototype.Directory.of_properties
-              [ ( "multigroup",
-                  Prototype.mixture_of node (fun make node ->
-                      [ MMAddressable.make ~node:(MultigroupM.into node);
-                        MMDirectory.make ~storage ~node ~constructor:(M.wrap storage);
-                        MMAssociative.make ~storage ~node:(MultigroupM.into node)
-                          ~constructor:(fun node' -> MultigroupM.from node' |> make |> Result.ok )
-                      ] ) ) ] ]
+            Directory.make
+              object
+                method list =
+                  Ok
+                    (BatFingerTree.of_list
+                       ( "multigroup"
+                       :: Option.fold ~none:[] ~some:(fun _ -> ["previous"]) branch.previous ) )
+
+                method find =
+                  function
+                  | "multigroup" -> Ok (Some multigroups)
+                  | "previous" -> self#previous
+                  | _ -> Ok None
+              end ]
 
       method hash = Representation.to_blob branch |> Concepts.Hash.hash_of_blob
       method address = self#hash
     end
 
-  let load tx conn addr =
+  let load ?evaluators 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 =
-      MultigroupM.find tx branch.multigroups
-      |> fmap (Option.to_result ~none:(Error.incomplete_branch branch.multigroups))
-    in
-    Ok (new branch conn branch node |> Protocols.Handle.make)
+    let* node = node_of tx branch in
+    Ok (new branch ?evaluators conn branch node |> Protocols.Handle.make)
 
-  let make conn =
+  let make ?evaluators 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 conn branch MultigroupM.empty |> Protocols.Handle.make) )
+        Ok (new branch ?evaluators conn branch MultigroupM.empty |> Protocols.Handle.make) )
 end
diff --git a/lib/kernel/Branch.mli b/lib/kernel/Branch.mli
index c08e781..93dd890 100644
--- a/lib/kernel/Branch.mli
+++ b/lib/kernel/Branch.mli
@@ -1,9 +1,16 @@
+(** A branch state: its multigroups, and under [previous] the state it
+    succeeded. Given [evaluators], the stored programs read through it
+    run against it. *)
 module Make (S : Abstract.Storage.STORAGE) : sig
   type t
 
-  val make : S.connection -> (Protocols.Handle.t, Concepts.Condition.condition) result
+  val make :
+    ?evaluators:Protocols.Handle.t ->
+    S.connection ->
+    (Protocols.Handle.t, Concepts.Condition.condition) result
 
   val load :
+    ?evaluators:Protocols.Handle.t ->
     S.transaction ->
     S.connection ->
     Concepts.Hash.hash ->
diff --git a/lib/kernel/BranchManager.ml b/lib/kernel/BranchManager.ml
index 3531748..052e38a 100644
--- a/lib/kernel/BranchManager.ml
+++ b/lib/kernel/BranchManager.ml
@@ -28,7 +28,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let data = Concepts.Hash.blob_of_hash addr in
     S.put tx (S.Label label) data
 
-  class manager storage label head =
+  class manager ?evaluators storage label head =
     object (self)
       inherit Lifecycle.null
       inherit Identity.of_id
@@ -51,7 +51,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
             let* head = Atomic.get head |> M.lookup tx key in
             match head with
             | None -> Ok None
-            | Some head -> B.load tx storage head |> Result.map Option.some )
+            | Some head -> B.load ?evaluators tx storage head |> Result.map Option.some )
 
       method update key reference value =
         let open Utilities.Result in
@@ -92,14 +92,14 @@ module Make (S : Abstract.Storage.STORAGE) = struct
             | Error (Some e) -> Error e )
     end
 
-  let make storage label =
+  let make ?evaluators storage label =
     let open Utilities.Result in
     SI.with_transaction storage (fun tx ->
         let* addr = root_for tx label in
         match addr with
-        | None -> Ok (new manager storage label M.empty |> Protocols.Handle.make)
+        | None -> Ok (new manager ?evaluators storage label M.empty |> Protocols.Handle.make)
         | Some addr ->
             let* head = M.find tx addr in
             let* head = Option.to_result ~none:(Error.invalid_root addr) head in
-            Ok (new manager storage label head |> Protocols.Handle.make) )
+            Ok (new manager ?evaluators storage label head |> Protocols.Handle.make) )
 end
diff --git a/lib/kernel/BranchManager.mli b/lib/kernel/BranchManager.mli
index a75875f..9fa10ca 100644
--- a/lib/kernel/BranchManager.mli
+++ b/lib/kernel/BranchManager.mli
@@ -1,3 +1,9 @@
+(** The heads of the branches, persisted under [label]. Branches it hands
+    out run their stored programs through [evaluators]. *)
 module Make (S : Abstract.Storage.STORAGE) : sig
-  val make : S.connection -> string -> (Protocols.Handle.t, Concepts.Condition.condition) result
+  val make :
+    ?evaluators:Protocols.Handle.t ->
+    S.connection ->
+    string ->
+    (Protocols.Handle.t, Concepts.Condition.condition) result
 end
diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml
index 1d9267e..b53256b 100644
--- a/lib/kernel/EphemeralRelation.ml
+++ b/lib/kernel/EphemeralRelation.ml
@@ -105,21 +105,60 @@ class ephemeral_relation ?code description value enumerate inputs =
 let instantiate ?(inputs = []) ?code description value enumerate =
   new ephemeral_relation ?code description value enumerate inputs |> Protocols.Handle.make
 
+let literal description tuples =
+  instantiate description
+    {name= None; schematics= `Temporary description; program= None}
+    (fun () -> Ok (Generator.cursor_of (fun ~yield -> List.iter yield tuples; Ok ())))
+
+type binding =
+  string -> Protocols.Handle.t -> (Protocols.Handle.t, Concepts.Condition.condition) result
+
+(* The relation a program produced has to outlive the cursor over it. *)
+let enumerate_owned relation =
+  let open Utilities.Result in
+  let owner =
+    object
+      method reference = true
+      method release = Protocols.Handle.release relation
+    end
+  in
+  match
+    let* enumerable = Protocols.Enumerable.require relation in
+    Protocols.Enumerable.enumerate enumerable
+  with
+  | Error c -> Protocols.Handle.release relation; Error c
+  | Ok cursor ->
+      Ok
+        (Protocols.Handle.make
+           object
+             inherit Lifecycle.retaining cursor owner
+             method to_string = Protocols.Handle.to_string cursor
+           end )
+
 module Make (S : Abstract.Storage.STORAGE) = struct
   module SI = Storage.Make (S)
   module R = SubstantialRelation.Make (S)
 
-  let restore ~code ({Persisted.name; schematics; program} : Persisted.t) description =
+  (* Unbound, a stored program is only its source. Bound, enumerating
+     it runs the program through its evaluator, afresh each time. *)
+  let restore ?bind ~code ({Persisted.name; schematics; program} : Persisted.t) description =
+    let enumerate () =
+      match bind with
+      | None -> Error (Error.unbound_program name)
+      | Some bind ->
+          let source = Prototype.mixture [Stored {evaluator= program.evaluator; code}] in
+          Result.bind (bind program.evaluator source) enumerate_owned
+    in
     instantiate ~code description
       {name= Some name; schematics= `Persisted schematics; program= Some program}
-      (fun () -> Error (Error.unbound_program name))
+      enumerate
 
-  let load connection (record : Persisted.t) =
+  let load ?bind connection (record : Persisted.t) =
     SI.with_read connection (fun tx ->
         let open Utilities.Result in
         let* description = R.schema_of tx record.schematics in
         let* code = SI.get_req tx (S.Hash record.program.code) in
-        Ok (restore ~code record description) )
+        Ok (restore ?bind ~code record description) )
 
   let persist connection ~name ~evaluator ~code description =
     SI.with_transaction connection (fun tx ->
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
diff --git a/lib/kernel/Initialization.mli b/lib/kernel/Initialization.mli
index 926bbd8..97a27f3 100644
--- a/lib/kernel/Initialization.mli
+++ b/lib/kernel/Initialization.mli
@@ -1,6 +1,17 @@
 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. *)
   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
diff --git a/lib/kernel/Journal.ml b/lib/kernel/Journal.ml
deleted file mode 100644
index 13782a5..0000000
--- a/lib/kernel/Journal.ml
+++ /dev/null
@@ -1,198 +0,0 @@
-module J = Protocols.Journal
-module Bindings = BatMap.String
-
-module Error = struct
-  open Concepts.Condition
-
-  let empty_commit () = condition "empty-commit" "A commit has to change at least one name" empty
-
-  let repeated_name name =
-    condition "repeated-name" "A commit names the same binding twice"
-      ("name" |=| Concepts.Value.String name)
-end
-
-(* A snapshot is named by its bindings, so two snapshots binding the
-   same objects are the same snapshot. *)
-let identity bindings =
-  Bindings.fold
-    (fun name handle acc ->
-      name :: Concepts.Hash.to_raw_string (Protocols.Handle.hash handle) :: acc )
-    bindings []
-  |> String.concat "\000"
-  |> Bytes.of_string
-  |> Concepts.Hash.hash_of_bytes
-
-class snapshot bindings =
-  object (self)
-    inherit Lifecycle.null
-    method to_string = "snapshot"
-    method hash = identity bindings
-    val mutable handle : Protocols.Handle.t option = None
-    method protocols : Protocols.Handle.protocol list = [Protocols.Directory.make self]
-    method list = Ok (Bindings.keys bindings |> BatFingerTree.of_enum)
-
-    method find name =
-      match Bindings.find_opt name bindings with
-      | None -> Ok None
-      | Some bound -> (
-        match Protocols.Derived.from bound, handle with
-        | Some derived, Some me -> Protocols.Derived.within derived me |> Result.map Option.some
-        | _ -> Ok (Protocols.Handle.copy bound) )
-
-    method attach me = handle <- Some me
-  end
-
-let snapshot_of bindings =
-  let o = new snapshot bindings in
-  let handle = Protocols.Handle.make o in
-  o#attach handle; handle
-
-let snapshot bindings = snapshot_of (Bindings.of_list bindings)
-
-type state = {commit: J.commit; bindings: Protocols.Handle.t Bindings.t}
-
-class journal bindings =
-  object (self)
-    inherit Lifecycle.null
-    inherit Identity.of_id
-    method to_string = "journal"
-    val lock = Mutex.create ()
-
-    (* the latest first *)
-    val mutable states =
-      [ { commit=
-            { J.number= 0;
-              snapshot= snapshot_of bindings;
-              changed= Bindings.keys bindings |> BatList.of_enum };
-          bindings } ]
-
-    val mutable guards : (string * J.guard) list = []
-    val mutable observers : (string * J.observer) list = []
-
-    method protocols : Protocols.Handle.protocol list =
-      Protocols.[Directory.make self; Registry.make self; J.make self]
-
-    method head = (List.hd states).commit
-    method history = List.rev_map (fun {commit; _} -> commit) states
-
-    method guard name g =
-      Mutex.protect lock (fun () ->
-          guards <-
-            List.remove_assoc name guards @ Option.fold ~none:[] ~some:(fun g -> [name, g]) g )
-
-    method observe name f =
-      Mutex.protect lock (fun () ->
-          observers <-
-            List.remove_assoc name observers @ Option.fold ~none:[] ~some:(fun f -> [name, f]) f )
-
-    method list = Ok (Bindings.keys (List.hd states).bindings |> BatFingerTree.of_enum)
-
-    method find name =
-      Ok
-        ( Bindings.find_opt name (List.hd states).bindings
-        |> Utilities.Option.fmap Protocols.Handle.copy )
-
-    method update name expected replacement =
-      self#commit [{J.name; expected; replacement}] |> Result.map Option.is_some
-
-    (* Guards run in the order they were installed, and observers after
-       the commit has landed, both while holding the journal, so they
-       see commits one at a time and in order. *)
-    method commit (changes : J.change list) =
-      let open Utilities.Result in
-      let names = List.map (fun (c : J.change) -> c.name) changes in
-      let repeated =
-        List.find_opt (fun n -> List.length (List.filter (String.equal n) names) > 1) names
-      in
-      match changes, repeated with
-      | [], _ -> Error (Error.empty_commit ())
-      | _, Some name -> Error (Error.repeated_name name)
-      | _ ->
-          Mutex.protect lock (fun () ->
-              let current = List.hd states in
-              let expected (c : J.change) =
-                Bindings.find_opt c.name current.bindings = c.expected
-              in
-              if not (List.for_all expected changes) then Ok None
-              else
-                let bindings =
-                  List.fold_left
-                    (fun bindings (c : J.change) ->
-                      match c.replacement with
-                      | Some h -> Bindings.add c.name h bindings
-                      | None -> Bindings.remove c.name bindings )
-                    current.bindings changes
-                in
-                let commit =
-                  { J.number= current.commit.number + 1;
-                    snapshot= snapshot_of bindings;
-                    changed= names }
-                in
-                let proposal = {J.previous= current.commit; proposed= commit} in
-                let* () =
-                  List.fold_left
-                    (fun acc (_, g) ->
-                      let* () = acc in
-                      g proposal )
-                    (Ok ()) guards
-                in
-                states <- {commit; bindings} :: states;
-                List.iter (fun (_, f) -> f commit) observers;
-                Ok (Some commit) )
-  end
-
-let make ?(bindings = []) () = Protocols.Handle.make (new journal (Bindings.of_list bindings))
-
-let adopt directory =
-  let open Utilities.Result in
-  let* listing = Protocols.Handle.require Protocols.Directory.from directory in
-  let* names = Protocols.Directory.list listing in
-  let* bindings =
-    BatFingerTree.to_list names
-    |> List.map (fun name ->
-        let* found = Protocols.Directory.find listing name in
-        Ok (Option.map (fun h -> name, h) found) )
-    |> Utilities.List.sequence
-  in
-  Ok (make ~bindings:(List.filter_map Fun.id bindings) ())
-
-(* What a name is bound to is read as a copy, which has to stay valid
-   until the swap has compared against it. *)
-let rebind directory bindings =
-  let open Utilities.Result in
-  let* listing = Protocols.Handle.require Protocols.Directory.from directory in
-  let holding names f =
-    let* found =
-      List.map (fun name -> Protocols.Directory.find listing name) names |> Utilities.List.sequence
-    in
-    Fun.protect
-      ~finally:(fun () -> List.iter (Option.iter Protocols.Handle.release) found)
-      (fun () -> f found)
-  in
-  let rec together journal =
-    let* landed =
-      holding (List.map fst bindings) (fun found ->
-          List.map2
-            (fun (name, replacement) expected -> {J.name; expected; replacement})
-            bindings found
-          |> J.commit journal )
-    in
-    match landed with Some _ -> Ok () | None -> together journal
-  in
-  let rec one registry name replacement =
-    let* swapped =
-      holding [name] (fun found ->
-          Protocols.Registry.update registry name (List.hd found) replacement )
-    in
-    if swapped then Ok () else one registry name replacement
-  in
-  match J.from directory, bindings with
-  | _, [] -> Ok ()
-  | Some journal, _ -> together journal
-  | None, _ ->
-      let* registry = Protocols.Handle.require Protocols.Registry.from directory in
-      List.fold_left
-        (fun acc (name, replacement) ->
-          let* () = acc in
-          one registry name replacement )
-        (Ok ()) bindings
diff --git a/lib/kernel/Journal.mli b/lib/kernel/Journal.mli
deleted file mode 100644
index d354e03..0000000
--- a/lib/kernel/Journal.mli
+++ /dev/null
@@ -1,22 +0,0 @@
-(** a namespace that keeps its history: each binding it accepts is a
-    commit of [Protocols.Journal]. It answers [Directory] and [Registry]
-    as a plain namespace does, so a subsystem that only knows those
-    commits without knowing it. *)
-
-(** a journal whose first commit, numbered 0, binds [bindings]. *)
-val make : ?bindings:(string * Protocols.Handle.t) list -> unit -> Protocols.Handle.t
-
-(** a journal whose first commit binds whatever [directory] binds now. *)
-val adopt : Protocols.Handle.t -> (Protocols.Handle.t, Concepts.Condition.condition) result
-
-(** a directory of [bindings] that, asked for a derived relation, hands
-    it out read against itself. *)
-val snapshot : (string * Protocols.Handle.t) list -> Protocols.Handle.t
-
-(** bind each name to its handle, or unbind it, whatever it was bound to
-    before: as one commit when [directory] is a journal, and one name at
-    a time when it is a plain namespace. *)
-val rebind :
-  Protocols.Handle.t ->
-  (string * Protocols.Handle.t option) list ->
-  (unit, Concepts.Condition.condition) result
diff --git a/lib/kernel/Multigroup.ml b/lib/kernel/Multigroup.ml
index 1417a65..ecc871e 100644
--- a/lib/kernel/Multigroup.ml
+++ b/lib/kernel/Multigroup.ml
@@ -21,9 +21,9 @@ module Make (S : Abstract.Storage.STORAGE) = struct
           Stored.of_bencode data |> Result.map (fun relation -> Ephemeral relation)
       | _ -> R.Representation.of_bencode data |> Result.map (fun relation -> Substantial relation)
 
-    let load storage = function
+    let load ?bind storage = function
       | Substantial relation -> R.load storage relation
-      | Ephemeral relation -> E.load storage relation
+      | Ephemeral relation -> E.load ?bind storage relation
   end
 
   module RelationM = Merkle.Interface (S) (Merkle.StringKey) (Entry)
@@ -71,7 +71,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
   let encode = Representation.to_blob
   let decode = Representation.of_blob
 
-  class multigroup conn value node =
+  class multigroup ?bind conn value node =
     object (self)
       inherit Lifecycle.null
       method to_string = "multigroup"
@@ -91,7 +91,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
               RelationM.find tx multigroup'.relations
               |> fmap (Option.to_result ~none:(Error.incomplete_multigroup multigroup'.relations)) )
         in
-        new multigroup storage multigroup' node' |> Protocols.Handle.make |> Result.ok
+        new multigroup ?bind storage multigroup' node' |> Protocols.Handle.make |> Result.ok
 
       method protocols : Protocols.Handle.protocol list =
         let open Utilities.Result in
@@ -108,7 +108,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
               [ ( "relation",
                   Prototype.mixture_of node (fun make node ->
                       [ RMAddressable.make ~node:(RelationM.into node);
-                        RMDirectory.make ~storage ~node ~constructor:(Entry.load storage);
+                        RMDirectory.make ~storage ~node ~constructor:(Entry.load ?bind storage);
                         RMAssociative.make ~storage ~node:(RelationM.into node)
                           ~constructor:(fun node' -> RelationM.from node' |> make |> Result.ok ) ] )
                 ) ] ]
@@ -117,13 +117,13 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       method address = self#hash
     end
 
-  let wrap conn value =
+  let wrap ?bind conn value =
     let open Utilities.Result in
     let* node =
       SI.with_transaction conn (fun tx -> RelationM.find tx value.relations)
       |> fmap (Option.to_result ~none:(Error.incomplete_multigroup value.relations))
     in
-    new multigroup conn value node |> Protocols.Handle.make |> Result.ok
+    new multigroup ?bind conn value node |> Protocols.Handle.make |> Result.ok
 
   let make conn =
     let open Utilities.Result in
diff --git a/lib/kernel/Multigroup.mli b/lib/kernel/Multigroup.mli
index 2df41e6..f8e2555 100644
--- a/lib/kernel/Multigroup.mli
+++ b/lib/kernel/Multigroup.mli
@@ -3,6 +3,14 @@ module Make (S : Abstract.Storage.STORAGE) : sig
 
   val encode : t -> Concepts.Blob.t
   val decode : Concepts.Blob.t -> (t, Concepts.Condition.condition) result
-  val wrap : S.connection -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result
+
+  (** [bind] runs the stored programs read through the multigroup; see
+      [EphemeralRelation.binding]. *)
+  val wrap :
+    ?bind:EphemeralRelation.binding ->
+    S.connection ->
+    t ->
+    (Protocols.Handle.t, Concepts.Condition.condition) result
+
   val make : S.connection -> (Protocols.Handle.t, Concepts.Condition.condition) result
 end
diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml
index eeef396..d6a65c9 100644
--- a/lib/kernel/Path.ml
+++ b/lib/kernel/Path.ml
@@ -17,6 +17,11 @@ module Error = struct
   let path_not_found path =
     condition "path-not-found" "A given path was not found under the specified object"
       ("path" |=| Concepts.Value.String (to_string path))
+
+  let overlapping_change path =
+    condition "overlapping-change"
+      "A batch of changes both replaced an object and changed inside it"
+      ("path" |=| Concepts.Value.String (to_string path))
 end
 
 let walking f g handle path =
@@ -56,17 +61,100 @@ let update handle path key reference value =
       let* registry = Handle.require Registry.from target in
       Registry.update registry key reference value )
 
-let assoc handle path key value =
+(* Changes under the same name are applied to the child together, so
+   every object on the way is derived once however many changes reach
+   it: a batch of changes to a branch is one successor state. *)
+let assoc_all handle changes =
   let open Utilities.Result in
-  let open Utilities.Fun in
   let open Protocols in
-  let assoc_on handle key value =
-    let* a = Handle.require Associative.from handle in
+  let assoc_on node (key, value) =
+    let* a = Handle.require Associative.from node in
     let* a' = Associative.update a key value in
     Ok (Handle.from a')
   in
-  walking
-    (fun key dir f ->
-      releasing handle dir (fun () -> f () |> fmap (assoc_on dir key |.| Option.some)) )
-    (fun h -> releasing handle h (fun () -> assoc_on h key value))
-    handle path
+  let rec apply prefix node changes =
+    let here, below = List.partition (fun (path, _, _) -> path = []) changes in
+    let segments =
+      List.fold_left
+        (fun segments (path, _, _) ->
+          let x = List.hd path in
+          if List.mem x segments then segments else segments @ [x] )
+        [] below
+    in
+    let beneath x =
+      List.filter_map
+        (fun (path, key, value) ->
+          match path with y :: rest when y = x -> Some (rest, key, value) | _ -> None )
+        below
+    in
+    match List.find_opt (fun (_, key, _) -> List.mem key segments) here with
+    | Some (_, key, _) -> Error (Error.overlapping_change (prefix @ [key]))
+    | None ->
+        let* children =
+          List.map
+            (fun x ->
+              let* dir = Handle.require Directory.from node in
+              let* found = Directory.find dir x in
+              match found with
+              | None -> Error (Error.path_not_found (prefix @ [x]))
+              | Some child ->
+                  releasing handle child (fun () -> apply (prefix @ [x]) child (beneath x))
+                  |> Result.map (fun child' -> x, Some child') )
+            segments
+          |> Utilities.List.sequence
+        in
+        (* each step derives from the last; only the steps in between are
+           ours to release *)
+        List.fold_left
+          (fun current change ->
+            let* current = current in
+            let* next = assoc_on current change in
+            if current != node then Handle.release current;
+            Ok next )
+          (Ok node)
+          (children @ List.map (fun (_, key, value) -> key, value) here)
+  in
+  apply [] handle changes
+
+let assoc handle path key value = assoc_all handle [path, key, value]
+
+let diff a b =
+  let open Utilities.Result in
+  let open Protocols in
+  let address h = Option.map Addressable.address (Addressable.from h) in
+  let same x y =
+    match address x, address y with
+    | Some p, Some q -> Concepts.Hash.hash_equals p q
+    | _ -> Handle.equal x y
+  in
+  let names h =
+    let* dir = Handle.require Directory.from h in
+    let* names = Directory.list dir in
+    Ok (BatFingerTree.to_list names)
+  in
+  let find h name =
+    let* dir = Handle.require Directory.from h in
+    Directory.find dir name
+  in
+  let rec walk prefix a b =
+    let* left = names a in
+    let* right = names b in
+    List.sort_uniq String.compare (left @ right)
+    |> List.map (fun name ->
+        let path = prefix @ [name] in
+        let* x = find a name in
+        let* y = find b name in
+        Fun.protect
+          ~finally:(fun () -> List.iter Handle.release (Option.to_list x @ Option.to_list y))
+          (fun () ->
+            match x, y with
+            | None, None -> Ok []
+            | Some x, Some y when same x y -> Ok []
+            | Some x, Some y when Directory.from x <> None && Directory.from y <> None ->
+                let* below = walk path x y in
+                Ok (if below = [] then [path] else below)
+            | _ -> Ok [path] ) )
+    |> Utilities.List.sequence
+    |> Result.map List.concat
+  in
+  walk [] a b
diff --git a/lib/kernel/Path.mli b/lib/kernel/Path.mli
index 571e59c..e331b3a 100644
--- a/lib/kernel/Path.mli
+++ b/lib/kernel/Path.mli
@@ -4,6 +4,7 @@ val this : t
 val ( @/ ) : string -> t -> t
 val of_list : string list -> t
 val to_list : t -> string list
+val to_string : t -> string
 val lookup : Protocols.Handle.t -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result
 
 val update :
@@ -14,9 +15,24 @@ val update :
   Protocols.Handle.t option ->
   (bool, Concepts.Condition.condition) result
 
+(** [assoc handle path key value] derives [handle] with [key] under
+    [path] bound to [value], or unbound when [None]. *)
 val assoc :
   Protocols.Handle.t ->
   t ->
   string ->
   Protocols.Handle.t option ->
   (Protocols.Handle.t, Concepts.Condition.condition) result
+
+(** every change of [assoc] at once: each object on the way is derived
+    once, so the changes to a branch land as one successor state. *)
+val assoc_all :
+  Protocols.Handle.t ->
+  (t * string * Protocols.Handle.t option) list ->
+  (Protocols.Handle.t, Concepts.Condition.condition) result
+
+(** the paths, relative to [a] and [b], that differ between them. Equal
+    addresses are not descended, so this costs what changed. Every child
+    is compared, so diff a branch's \multigroup rather than the branch,
+    whose \previous differs whenever anything does. *)
+val diff : Protocols.Handle.t -> Protocols.Handle.t -> (t list, Concepts.Condition.condition) result
diff --git a/lib/kernel/Session.ml b/lib/kernel/Session.ml
index 1abd278..4bce1ac 100644
--- a/lib/kernel/Session.ml
+++ b/lib/kernel/Session.ml
@@ -2,7 +2,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
   module SI = Storage.Make (S)
   module B = Branch.Make (S)
 
-  class session storage state =
+  class session ?evaluators storage state =
     object (self)
       inherit Lifecycle.exclusive
       inherit Identity.of_id
@@ -18,10 +18,11 @@ module Make (S : Abstract.Storage.STORAGE) = struct
         function
         | "branch" ->
             SI.with_read storage (fun tx ->
-                B.load tx storage (Atomic.get state).Protocols.Session.snapshot )
+                B.load ?evaluators tx storage (Atomic.get state).Protocols.Session.snapshot )
             |> Result.map Option.some
         | _ -> Ok None
     end
 
-  let make storage state = new session storage state |> Protocols.Handle.make
+  let make ?evaluators storage state =
+    new session ?evaluators storage state |> Protocols.Handle.make
 end
diff --git a/lib/kernel/Session.mli b/lib/kernel/Session.mli
index be4451b..77c7d5d 100644
--- a/lib/kernel/Session.mli
+++ b/lib/kernel/Session.mli
@@ -1,3 +1,4 @@
 module Make (S : Abstract.Storage.STORAGE) : sig
-  val make : S.connection -> Protocols.Session.state -> Protocols.Handle.t
+  val make :
+    ?evaluators:Protocols.Handle.t -> S.connection -> Protocols.Session.state -> Protocols.Handle.t
 end
diff --git a/lib/kernel/Source.ml b/lib/kernel/Source.ml
index b3b7389..e5de6e8 100644
--- a/lib/kernel/Source.ml
+++ b/lib/kernel/Source.ml
@@ -34,25 +34,35 @@ let evaluator ~language run =
       method to_string = language ^ "-evaluator"
       method protocols : Protocols.Handle.protocol list = [Protocols.Evaluator.make self]
 
-      method invoke program =
+      method invoke program ~within =
         match text program with
         | None -> Error (Error.not_a_program language)
         | Some (given, _) when given <> language -> Error (Error.foreign language given)
-        | Some (_, source) -> run source
+        | Some (_, source) -> run ~within source
     end
 
-let run root ~language source =
+let evaluators = Path.("system" @/ "evaluator" @/ this)
+
+let bind directory ~within language program =
   let open Utilities.Result in
   let* evaluator =
-    Path.lookup root Path.("evaluator" @/ language @/ this)
+    Path.lookup directory Path.(language @/ this)
     |> Result.map_error (fun _ -> Error.no_evaluator language)
   in
-  let* evaluator = Protocols.Evaluator.require evaluator in
-  Protocols.Evaluator.invoke evaluator (program ~language source)
+  Fun.protect
+    ~finally:(fun () -> Protocols.Handle.release evaluator)
+    (fun () ->
+      let* evaluator = Protocols.Evaluator.require evaluator in
+      Protocols.Evaluator.invoke evaluator program ~within )
+
+let run root ~language ~within source =
+  let open Utilities.Result in
+  let* directory = Path.lookup root evaluators in
+  bind directory ~within language (program ~language source)
 
 let register root ~language evaluator =
   let open Utilities.Result in
-  let* evaluators = Path.lookup root Path.("evaluator" @/ this) in
-  let* registry = Protocols.Handle.require Protocols.Registry.from evaluators in
+  let* directory = Path.lookup root evaluators in
+  let* registry = Protocols.Handle.require Protocols.Registry.from directory in
   let* _ = Protocols.Registry.update registry language None (Some evaluator) in
   Ok ()
diff --git a/lib/kernel/Source.mli b/lib/kernel/Source.mli
index 1a51da2..0961dcc 100644
--- a/lib/kernel/Source.mli
+++ b/lib/kernel/Source.mli
@@ -10,21 +10,36 @@ val program : language:string -> string -> Protocols.Handle.t
 val text : Protocols.Handle.t -> (string * string) option
 
 (** an evaluator for [language]: it runs the text of a program in that
-    language, and refuses anything else. *)
+    language against the directory it is given, and refuses anything
+    else. *)
 val evaluator :
   language:string ->
-  (string -> (Protocols.Handle.t, Concepts.Condition.condition) result) ->
+  (within:Protocols.Handle.t -> string -> (Protocols.Handle.t, Concepts.Condition.condition) result) ->
   Protocols.Handle.t
 
-(** look up the evaluator of [language] under [root]'s \evaluator and run
-    [text] with it. *)
+(** where the evaluators are registered, from the root: \system\evaluator. *)
+val evaluators : Path.t
+
+(** run [program] through the evaluator of [language] found in
+    [directory], against [within]. Usable as an
+    [EphemeralRelation.binding] once [directory] and [within] are given. *)
+val bind :
+  Protocols.Handle.t ->
+  within:Protocols.Handle.t ->
+  string ->
+  Protocols.Handle.t ->
+  (Protocols.Handle.t, Concepts.Condition.condition) result
+
+(** run [text] in [language] against [within], with the evaluator
+    registered under [root]. *)
 val run :
   Protocols.Handle.t ->
   language:string ->
+  within:Protocols.Handle.t ->
   string ->
   (Protocols.Handle.t, Concepts.Condition.condition) result
 
-(** register [evaluator] as \evaluator\[language] under [root]. *)
+(** register [evaluator] for [language] under [root]. *)
 val register :
   Protocols.Handle.t ->
   language:string ->
diff --git a/lib/kernel/View.ml b/lib/kernel/View.ml
deleted file mode 100644
index b90afef..0000000
--- a/lib/kernel/View.ml
+++ /dev/null
@@ -1,44 +0,0 @@
-type heading = Protocols.Schematics.attribute_description BatMap.String.t
-type rows = (Concepts.Tuple.t list, Concepts.Condition.condition) result
-
-let ephemeral heading enumerate =
-  EphemeralRelation.instantiate heading
-    {EphemeralRelation.name= None; schematics= `Temporary heading; program= None}
-    (fun () ->
-      Result.map
-        (fun tuples -> Generator.cursor_of (fun ~yield -> List.iter yield tuples; Ok ()))
-        (enumerate ()) )
-
-let fixed heading tuples = ephemeral heading (fun () -> Ok tuples)
-
-let computed heading ~current compute =
-  let open Utilities.Result in
-  let now = ephemeral heading (fun () -> current () |> fmap compute) in
-  Prototype.mixture
-    ( Protocols.Derived.make
-        object
-          method within directory = Ok (ephemeral heading (fun () -> compute directory))
-        end
-    :: Protocols.Handle.protocols now )
-
-let read relation =
-  let open Utilities.Result in
-  let* schematics = Protocols.Handle.require Protocols.Schematics.from relation in
-  let* description = Protocols.Schematics.describe schematics in
-  let* heading =
-    match description with
-    | Protocols.Schematics.Relation heading -> Ok heading
-    | _ ->
-        Error
-          Concepts.Condition.(
-            condition "not-a-relation" "The object does not describe itself as a relation"
-              ("object" |=| Concepts.Value.String (Protocols.Handle.to_string relation)) )
-  in
-  let* enumerable = Protocols.Enumerable.require relation in
-  let* cursor = Protocols.Enumerable.enumerate enumerable in
-  Fun.protect
-    ~finally:(fun () -> Protocols.Handle.release cursor)
-    (fun () ->
-      let* scan = Protocols.Cursor.require cursor in
-      let* tuples = Protocols.Cursor.drain scan () in
-      Ok (heading, BatFingerTree.to_list tuples) )
diff --git a/lib/kernel/View.mli b/lib/kernel/View.mli
deleted file mode 100644
index 04e75ff..0000000
--- a/lib/kernel/View.mli
+++ /dev/null
@@ -1,21 +0,0 @@
-(** relations as values a subsystem hands to the tree. *)
-
-type heading = Protocols.Schematics.attribute_description BatMap.String.t
-type rows = (Concepts.Tuple.t list, Concepts.Condition.condition) result
-
-(** a relation holding [tuples], which never changes. *)
-val fixed : heading -> Concepts.Tuple.t list -> Protocols.Handle.t
-
-(** a relation computed from a directory of relations. Read as it is, it
-    is computed against [current ()] each time; read through a snapshot,
-    it is computed against the snapshot instead (see [Protocols.Derived]),
-    so it is what it was, or would be, at that moment. *)
-val computed :
-  heading ->
-  current:(unit -> (Protocols.Handle.t, Concepts.Condition.condition) result) ->
-  (Protocols.Handle.t -> rows) ->
-  Protocols.Handle.t
-
-(** the heading and tuples of a relation, read whole. *)
-val read :
-  Protocols.Handle.t -> (heading * Concepts.Tuple.t list, Concepts.Condition.condition) result