journal for the websitejournal

13 files changed, 657 insertions, 0 deletions

diff --git a/docs/journal.org b/docs/journal.org
new file mode 100644
index 0000000..f26f068
--- /dev/null
+++ b/docs/journal.org
@@ -0,0 +1,52 @@
+#+TITLE: Journals and derived relations
+
+Two protocols and two kernel modules let subsystems share state over time
+without linking each other. They stand in for what the branch manager will
+do once it records the bindings of a namespace.
+
+* Journal
+A journal (=Kernel.Journal=) is a namespace that keeps its history. It
+answers =Directory= and =Registry= as =Kernel.Namespace= does, so code that
+only knows those keeps working, and every binding it accepts is a commit:
+
+#+begin_src ocaml
+type commit = {number: int; snapshot: Handle.t; changed: string list}
+#+end_src
+
+=snapshot= is a directory of every binding as it stood after the commit.
+The =Journal= protocol adds:
+
+- =commit=: bind several names together, each provided it is still bound
+  to what was expected. Either all land or none does.
+- =guard=: a function shown each commit before it lands, with the commit it
+  would follow. Returning an error refuses it.
+- =observe=: a function told of each commit after it lands.
+
+Guards and observers run while the journal is held, so they see commits one
+at a time and in order. Neither may commit to the journal itself.
+
+=Kernel.Journal.adopt= makes a journal holding whatever a directory binds
+now. =Kernel.Journal.rebind= binds names in one commit when given a journal,
+and one at a time, retrying each swap, when given a plain namespace.
+
+* Derived
+A relation computed from other relations carries =Derived=:
+
+#+begin_src ocaml
+method within : Handle.t -> (Handle.t, condition) result
+#+end_src
+
+=within d= is the same relation read against the directory =d=. A snapshot
+applies it to whatever derived relation it hands out, with itself as =d=.
+So reading through a snapshot gives a derived relation as it was at that
+commit, or, for a commit a guard is still weighing, as it would be.
+
+=Kernel.View.computed= makes such a relation from a function of a directory,
+and =Kernel.View.fixed= one that never changes. =Kernel.View.read= reads a
+relation's heading and tuples whole.
+
+* Limits
+- History lives in memory and grows without bound.
+- A snapshot is named by its bindings, so two commits that bind the same
+  objects are the same snapshot.
+- A derived relation is computed again on every read.
diff --git a/lib/kernel/Journal.ml b/lib/kernel/Journal.ml
new file mode 100644
index 0000000..13782a5
--- /dev/null
+++ b/lib/kernel/Journal.ml
@@ -0,0 +1,198 @@
+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
new file mode 100644
index 0000000..d354e03
--- /dev/null
+++ b/lib/kernel/Journal.mli
@@ -0,0 +1,22 @@
+(** 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/Source.ml b/lib/kernel/Source.ml
new file mode 100644
index 0000000..b3b7389
--- /dev/null
+++ b/lib/kernel/Source.ml
@@ -0,0 +1,58 @@
+let program ~language text =
+  Prototype.mixture
+    [ EphemeralRelation.Stored
+        {evaluator= language; code= Concepts.Blob.blob_of_bytes (Bytes.of_string text)} ]
+
+let text handle =
+  Protocols.Handle.into handle (function
+    | EphemeralRelation.Stored {evaluator; code} ->
+        Some (evaluator, Bytes.to_string (Concepts.Blob.bytes_of_blob code))
+    | _ -> None )
+  |> Option.map (fun i -> Protocols.Handle.invoke i Fun.id)
+
+module Error = struct
+  open Concepts.Condition
+
+  let not_a_program language =
+    condition "not-a-program" "An evaluator was given something that carries no source"
+      ("language" |=| Concepts.Value.String language)
+
+  let foreign language given =
+    condition "foreign-program" "An evaluator was given source in another language"
+      ("language" |=| Concepts.Value.String language & "given" |=| Concepts.Value.String given)
+
+  let no_evaluator language =
+    condition "no-evaluator" "No evaluator is registered for the language"
+      ("language" |=| Concepts.Value.String language)
+end
+
+let evaluator ~language run =
+  Protocols.Handle.make
+    object (self)
+      inherit Lifecycle.null
+      inherit Identity.of_id
+      method to_string = language ^ "-evaluator"
+      method protocols : Protocols.Handle.protocol list = [Protocols.Evaluator.make self]
+
+      method invoke program =
+        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
+    end
+
+let run root ~language source =
+  let open Utilities.Result in
+  let* evaluator =
+    Path.lookup root Path.("evaluator" @/ 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)
+
+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* _ = Protocols.Registry.update registry language None (Some evaluator) in
+  Ok ()
diff --git a/lib/kernel/Source.mli b/lib/kernel/Source.mli
new file mode 100644
index 0000000..1a51da2
--- /dev/null
+++ b/lib/kernel/Source.mli
@@ -0,0 +1,32 @@
+(** programs as source. A program in any language travels the tree as a
+    handle carrying [EphemeralRelation.Stored], with its text as the code,
+    so whoever holds one can run it through the evaluator of its language
+    without linking that language. *)
+
+(** a program in [language]. *)
+val program : language:string -> string -> Protocols.Handle.t
+
+(** the language and text a handle carries, if it is a program. *)
+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. *)
+val evaluator :
+  language:string ->
+  (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. *)
+val run :
+  Protocols.Handle.t ->
+  language:string ->
+  string ->
+  (Protocols.Handle.t, Concepts.Condition.condition) result
+
+(** register [evaluator] as \evaluator\[language] under [root]. *)
+val register :
+  Protocols.Handle.t ->
+  language:string ->
+  Protocols.Handle.t ->
+  (unit, Concepts.Condition.condition) result
diff --git a/lib/kernel/View.ml b/lib/kernel/View.ml
new file mode 100644
index 0000000..b90afef
--- /dev/null
+++ b/lib/kernel/View.ml
@@ -0,0 +1,44 @@
+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
new file mode 100644
index 0000000..04e75ff
--- /dev/null
+++ b/lib/kernel/View.mli
@@ -0,0 +1,21 @@
+(** 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
diff --git a/lib/protocols/Derived.ml b/lib/protocols/Derived.ml
new file mode 100644
index 0000000..1968ffc
--- /dev/null
+++ b/lib/protocols/Derived.ml
@@ -0,0 +1,10 @@
+class type implementation = object
+  method within : Handle.t -> (Handle.t, Concepts.Condition.condition) result
+end
+
+type Handle.protocol += Derived of implementation
+type t = implementation
+
+let make impl = Derived (impl :> implementation)
+let from handle = Handle.into handle (function Derived impl -> Some impl | _ -> None)
+let within i directory = Handle.invoke i (fun o -> o#within directory)
diff --git a/lib/protocols/Derived.mli b/lib/protocols/Derived.mli
new file mode 100644
index 0000000..b3dce96
--- /dev/null
+++ b/lib/protocols/Derived.mli
@@ -0,0 +1,13 @@
+(** a relation computed from other relations. [within] gives the same
+    relation read against another directory of relations, so a snapshot
+    of the tree can hand out its derived relations as they were, or as
+    they would be, at that moment. *)
+type t
+
+class type implementation = object
+  method within : Handle.t -> (Handle.t, Concepts.Condition.condition) result
+end
+
+val make : #implementation -> Handle.protocol
+val from : Handle.t -> t Handle.interface option
+val within : t Handle.interface -> Handle.t -> (Handle.t, Concepts.Condition.condition) result
diff --git a/lib/protocols/Journal.ml b/lib/protocols/Journal.ml
new file mode 100644
index 0000000..392eb5a
--- /dev/null
+++ b/lib/protocols/Journal.ml
@@ -0,0 +1,25 @@
+type change = {name: string; expected: Handle.t option; replacement: Handle.t option}
+type commit = {number: int; snapshot: Handle.t; changed: string list}
+type proposal = {previous: commit; proposed: commit}
+type guard = proposal -> (unit, Concepts.Condition.condition) result
+type observer = commit -> unit
+
+class type implementation = object
+  method commit : change list -> (commit option, Concepts.Condition.condition) result
+  method head : commit
+  method history : commit list
+  method guard : string -> guard option -> unit
+  method observe : string -> observer option -> unit
+end
+
+type Handle.protocol += Journal of implementation
+type t = implementation
+
+let make impl = Journal (impl :> implementation)
+let from handle = Handle.into handle (function Journal impl -> Some impl | _ -> None)
+let require = Handle.require from
+let commit i changes = Handle.invoke i (fun o -> o#commit changes)
+let head i = Handle.invoke i (fun o -> o#head)
+let history i = Handle.invoke i (fun o -> o#history)
+let guard i name g = Handle.invoke i (fun o -> o#guard name g)
+let observe i name f = Handle.invoke i (fun o -> o#observe name f)
diff --git a/lib/protocols/Journal.mli b/lib/protocols/Journal.mli
new file mode 100644
index 0000000..5f2e760
--- /dev/null
+++ b/lib/protocols/Journal.mli
@@ -0,0 +1,48 @@
+(** a directory that keeps its history. Every change to its bindings is
+    a commit: one or more names bound again together, numbered, with a
+    snapshot of every binding as it stood afterwards. Guards are shown a
+    commit before it lands and may refuse it; observers are told of it
+    after. *)
+type t
+
+(** bind [name] to [replacement], or unbind it when [None], provided it
+    is still bound to [expected]. *)
+type change = {name: string; expected: Handle.t option; replacement: Handle.t option}
+
+(** [snapshot] is a directory of the bindings as of the commit. *)
+type commit = {number: int; snapshot: Handle.t; changed: string list}
+
+(** what a guard is shown: the commit the proposal would follow and the
+    commit it would be. *)
+type proposal = {previous: commit; proposed: commit}
+
+type guard = proposal -> (unit, Concepts.Condition.condition) result
+type observer = commit -> unit
+
+class type implementation = object
+  (** [Ok None] when a name was no longer bound to what was expected;
+      [Error] when a guard refused. Either way nothing changes. *)
+  method commit : change list -> (commit option, Concepts.Condition.condition) result
+
+  method head : commit
+
+  (** every commit, the oldest first. *)
+  method history : commit list
+
+  (** install, replace or remove the guard or observer of that name. *)
+  method guard : string -> guard option -> unit
+
+  method observe : string -> observer option -> unit
+end
+
+val make : #implementation -> Handle.protocol
+val from : Handle.t -> t Handle.interface option
+val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result
+
+val commit :
+  t Handle.interface -> change list -> (commit option, Concepts.Condition.condition) result
+
+val head : t Handle.interface -> commit
+val history : t Handle.interface -> commit list
+val guard : t Handle.interface -> string -> guard option -> unit
+val observe : t Handle.interface -> string -> observer option -> unit
diff --git a/test/test_rnt.ml b/test/test_rnt.ml
index da8c008..fdf7ef7 100644
--- a/test/test_rnt.ml
+++ b/test/test_rnt.ml
@@ -5,6 +5,7 @@ let all_suites =
   @ Unit.Kernel.Merkle.suites ()
   @ Unit.Kernel.SubstantialRelation.suites ()
   @ Unit.Kernel.Session.suites ()
+  @ Unit.Kernel.Journal.suites ()
   @ Unit.Evaluators.FOL.suites ()
   @ Integration.Registration.suites ()
 
diff --git a/test/unit/kernel/Journal.ml b/test/unit/kernel/Journal.ml
new file mode 100644
index 0000000..d0ab9f6
--- /dev/null
+++ b/test/unit/kernel/Journal.ml
@@ -0,0 +1,133 @@
+open Rnt
+open Alcotest
+module J = Protocols.Journal
+
+let ok = Helpers.condition_as_failure
+let thing () = Rnt.Kernel.Prototype.mixture []
+
+let journal () =
+  let handle = Rnt.Kernel.Journal.make ~bindings:["A", thing ()] () in
+  handle, ok (J.require handle)
+
+let bound directory name =
+  let listing = ok (Protocols.Handle.require Protocols.Directory.from directory) in
+  ok (Protocols.Directory.find listing name) |> Option.is_some
+
+let a_registry_update_is_a_commit () =
+  let handle, journal = journal () in
+  let registry = Protocols.Registry.from handle |> Option.get in
+  check bool "bound" true (ok (Protocols.Registry.update registry "B" None (Some (thing ()))));
+  let history = J.history journal in
+  check (list int) "numbered" [0; 1] (List.map (fun (c : J.commit) -> c.number) history);
+  check bool "the first snapshot keeps its past" false (bound (List.hd history).snapshot "B");
+  check bool "the head sees it" true (bound (J.head journal).snapshot "B")
+
+let a_commit_binds_together_or_not_at_all () =
+  let _, journal = journal () in
+  let changes stale =
+    J.
+      [ {name= "B"; expected= None; replacement= Some (thing ())};
+        { name= "C";
+          expected= (if stale then Some (thing ()) else None);
+          replacement= Some (thing ()) } ]
+  in
+  check bool "a stale expectation" true (ok (J.commit journal (changes true)) = None);
+  check int "nothing landed" 0 (J.head journal).number;
+  let commit = ok (J.commit journal (changes false)) |> Option.get in
+  check (list string) "both" ["B"; "C"] commit.changed;
+  check bool "B" true (bound commit.snapshot "B");
+  check bool "C" true (bound commit.snapshot "C")
+
+let a_guard_refuses_and_an_observer_hears () =
+  let _, journal = journal () in
+  let heard = ref [] in
+  J.observe journal "ear" (Some (fun c -> heard := c.number :: !heard));
+  J.guard journal "no-B"
+    (Some
+       (fun {proposed; _} ->
+         if List.mem "B" proposed.changed then
+           Error Concepts.Condition.(condition "no-B" "B stays unbound" empty)
+         else Ok () ) );
+  let change name = [J.{name; expected= None; replacement= Some (thing ())}] in
+  check bool "refused" true (Result.is_error (J.commit journal (change "B")));
+  check bool "allowed" true (Result.is_ok (J.commit journal (change "C")));
+  check (list int) "heard only what landed" [1] !heard
+
+let a_snapshot_hands_out_derived_relations_against_itself () =
+  let derived =
+    Rnt.Kernel.Prototype.mixture
+      [ Protocols.Derived.make
+          object
+            method within directory =
+              Ok
+                (Rnt.Kernel.Prototype.mixture
+                   [Rnt.Kernel.Prototype.Directory.of_properties ["seen", directory]] )
+          end ]
+  in
+  let snapshot = Rnt.Kernel.Journal.snapshot ["D", derived] in
+  let read = ok (Rnt.Kernel.Path.lookup snapshot Rnt.Kernel.Path.("D" @/ "seen" @/ this)) in
+  check bool "read against the snapshot" true (Protocols.Handle.equal read snapshot)
+
+let suites () =
+  [ ( "kernel/journal",
+      [ test_case "a registry update is a commit" `Quick a_registry_update_is_a_commit;
+        test_case "a commit binds together or not at all" `Quick
+          a_commit_binds_together_or_not_at_all;
+        test_case "a guard refuses and an observer hears" `Quick
+          a_guard_refuses_and_an_observer_hears;
+        test_case "a snapshot hands out derived relations against itself" `Quick
+          a_snapshot_hands_out_derived_relations_against_itself ] ) ]
+
+let schema = BatMap.String.singleton "N" {Protocols.Schematics.domain= "integer"; provenance= []}
+
+let row n =
+  {Concepts.Tuple.type_= "R"; attributes= BatMap.String.singleton "N" (Concepts.Value.Integer n)}
+
+let count relation =
+  let _, tuples = ok (Rnt.Kernel.View.read relation) in
+  List.length tuples
+
+let rebinding_lands_as_one_commit_or_one_name_at_a_time () =
+  let handle, journal = journal () in
+  let fixed n = Rnt.Kernel.View.fixed schema (List.init n row) in
+  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 1); "B", Some (fixed 2)]);
+  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 3)]);
+  check (list int) "two commits after the first" [0; 1; 2]
+    (List.map (fun (c : J.commit) -> c.number) (J.history journal));
+  let plain = Rnt.Kernel.Namespace.make () in
+  ok (Rnt.Kernel.Journal.rebind plain ["A", Some (fixed 1)]);
+  ok (Rnt.Kernel.Journal.rebind plain ["A", Some (fixed 4)]);
+  check int "a plain namespace too" 4
+    (count (ok (Rnt.Kernel.Path.lookup plain Rnt.Kernel.Path.("A" @/ this))))
+
+(* A computed relation counts the tuples of A in whatever it is read
+   against, so the first snapshot still sees one and the head three. *)
+let a_computed_relation_reads_as_of_its_snapshot () =
+  let ( let* ) = Result.bind in
+  let handle, journal = journal () in
+  let fixed n = Rnt.Kernel.View.fixed schema (List.init n row) in
+  let counting =
+    Rnt.Kernel.View.computed schema
+      ~current:(fun () -> Ok handle)
+      (fun directory ->
+        let* a = Rnt.Kernel.Path.lookup directory Rnt.Kernel.Path.("A" @/ this) in
+        Ok [row (count a)] )
+  in
+  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 1); "C", Some counting]);
+  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 3)]);
+  let read snapshot =
+    let c = ok (Rnt.Kernel.Path.lookup snapshot Rnt.Kernel.Path.("C" @/ this)) in
+    let _, tuples = ok (Rnt.Kernel.View.read c) in
+    BatMap.String.find "N" (List.hd tuples).Concepts.Tuple.attributes
+  in
+  let history = J.history journal in
+  check Helpers.value "as it was" (Concepts.Value.Integer 1) (read (List.nth history 1).snapshot);
+  check Helpers.value "as it is" (Concepts.Value.Integer 3) (read (J.head journal).snapshot)
+
+let suites () =
+  suites ()
+  @ [ ( "kernel/view",
+        [ test_case "rebinding lands as one commit, or one name at a time" `Quick
+            rebinding_lands_as_one_commit_or_one_name_at_a_time;
+          test_case "a computed relation reads as of its snapshot" `Quick
+            a_computed_relation_reads_as_of_its_snapshot ] ) ]