10 files changed, 189 insertions, 330 deletions

diff --git a/lib/backend/storage/LMDB.ml b/lib/backend/storage/LMDB.ml
index fd6cc8e..3b38b93 100644
--- a/lib/backend/storage/LMDB.ml
+++ b/lib/backend/storage/LMDB.ml
@@ -142,8 +142,6 @@ type connection = {env: C.mdb_env_ptr; dbi: C.mdb_dbi}
 type transaction = {tx: C.mdb_txn_ptr; dbi: C.mdb_dbi; mutable active: bool}
 type address = Label of string | Hash of Concepts.Hash.hash
 
-let mapsize = 1 lsl 30
-
 let parse (c : Concepts.Configuration.term) =
   let open Concepts.Configuration in
   let open Utilities.Result in
@@ -171,7 +169,7 @@ let connect (c : Concepts.Configuration.term) =
   let* () = ensure_directory path (directory_mode mode) in
   begin
     let* env = C.mdb_env_create' () in
-    let* () = C.mdb_env_set_mapsize env (Unsigned.Size_t.of_int mapsize) in
+    let* () = C.mdb_env_set_mapsize env (Unsigned.Size_t.of_int (1 lsl 30)) in
     (* NOTLS ties readers to transactions rather than threads, so one
        thread can hold several read transactions (nested cursors). *)
     match C.mdb_env_open env path C.Flags.mdb_notls (PosixTypes.Mode.of_int mode) with
diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
index 9980927..91e00ca 100644
--- a/lib/evaluators/FOL.ml
+++ b/lib/evaluators/FOL.ml
@@ -77,10 +77,6 @@ let decode code = Bencode.of_blob code |> Utilities.Result.fmap term_of_bencode
 (* a program is FOL's if its evaluator's language is, as Source has it *)
 let ours evaluator = snd (Kernel.Source.reference evaluator) = name
 
-let stored relation =
-  Kernel.EphemeralRelation.stored relation
-  |> Option.map (fun (evaluator, code, _) -> evaluator, code)
-
 (* TODO: To strenghten our checks for self references, we need to
    construct a graph and see raise a condition if there are self
    references. We partially do that here with the program calling
@@ -91,9 +87,9 @@ let instantiate resolve =
   let rec bind expanding = function
     | Base reference -> (
         let* relation = resolve reference in
-        match stored relation with
+        match Kernel.EphemeralRelation.stored relation with
         | None -> Ok (Base relation)
-        | Some (evaluator, code) ->
+        | Some (evaluator, code, _) ->
             Protocols.Handle.release relation;
             let identity = Concepts.Hash.hash_of_blob code in
             if not (ours evaluator) then Error (Error.foreign_program evaluator)
@@ -205,12 +201,12 @@ class evaluator =
       let open Utilities.Result in
       match
         ( Protocols.Handle.into program (function Plan plan -> Some plan | _ -> None),
-          stored program )
+          Kernel.EphemeralRelation.stored program )
       with
       | Some plan, _ -> Protocols.Handle.invoke plan execute
-      | None, Some (evaluator, _) when not (ours evaluator) ->
+      | None, Some (evaluator, _, _) when not (ours evaluator) ->
           Error (Error.foreign_program evaluator)
-      | None, Some (_, code) ->
+      | None, Some (_, code, _) ->
           let* term = decode code in
           let* plan = instantiate (Kernel.Path.lookup within) term in
           execute plan
diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml
index b0b3f12..936391c 100644
--- a/lib/kernel/Branch.ml
+++ b/lib/kernel/Branch.ml
@@ -115,8 +115,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
               [ MMAddressable.make ~node:(MultigroupM.into node);
                 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)
-                  () ] )
+                  ~constructor:(fun node' -> MultigroupM.from node' |> make |> Result.ok ) ] )
         in
         let open Utilities.Result in
         Protocols.
diff --git a/lib/kernel/Multigroup.ml b/lib/kernel/Multigroup.ml
index 4530004..18c59fb 100644
--- a/lib/kernel/Multigroup.ml
+++ b/lib/kernel/Multigroup.ml
@@ -1,12 +1,60 @@
 module Make (S : Abstract.Storage.STORAGE) = struct
   module SI = Storage.Make (S)
-  module Sc = Schema.Make (S)
-  module SchemaM = Merkle.Interface (S) (Merkle.StringKey) (Sc)
-  module SMAddressable = Prototype.Addressable.OfTree (S) (Merkle.StringKey)
-  module SMDirectory = Prototype.Directory.OfTree (S) (Merkle.StringKey) (Sc)
-  module SMAssociative = Prototype.Associative.OfTree (S) (Merkle.StringKey)
+  module R = SubstantialRelation.Make (S)
+  module E = EphemeralRelation.Make (S)
 
-  type t = {schemas: SchemaM.address}
+  (* A relation as a multigroup holds it. *)
+  module Entry = struct
+    module Stored = EphemeralRelation.Persisted.Representation
+
+    type t = Substantial of R.t | Ephemeral of EphemeralRelation.Persisted.t
+
+    let encode = function
+      | Substantial relation -> R.encode relation
+      | Ephemeral relation -> Stored.to_blob relation
+
+    let decode blob =
+      let open Utilities.Result in
+      let open Concepts.Encoding in
+      let* data = Bencode.of_blob blob in
+      match data with
+      | Bencode.Tagged (tag, _) when Char.equal tag Stored.tag ->
+          Stored.of_bencode data |> Result.map (fun relation -> Ephemeral relation)
+      | _ -> R.Representation.of_bencode data |> Result.map (fun relation -> Substantial relation)
+
+    let load ?bind storage = function
+      | Substantial relation -> R.load storage relation
+      | Ephemeral relation -> E.load ?bind storage relation
+
+    (* A program is stored as itself, to run whenever it is read; any
+       other relation is stored as the tuples it holds now. *)
+    let admit name h =
+      let open Utilities.Result in
+      let address entry = Concepts.Hash.hash_of_blob (encode entry) in
+      match EphemeralRelation.stored h with
+      | Some (evaluator, code, _) ->
+          let* description = Protocols.Relation.heading h in
+          Ok
+            (fun tx ->
+              let* record = E.store tx ~name ~evaluator ~code description in
+              Ok (address (Ephemeral record)) )
+      | None ->
+          let* description, tuples = Protocols.Relation.read h in
+          Ok
+            (fun tx ->
+              let* relation = R.store tx description tuples in
+              Ok (address (Substantial relation)) )
+  end
+
+  (* A schema is only a name: \schema\[s] is the tree of its relations,
+     with no record of its own. *)
+  module T = Merkle.Make (S) (Merkle.StringKey)
+  module RelationM = Merkle.Interface (S) (Merkle.StringKey) (Entry)
+  module TAddressable = Prototype.Addressable.OfTree (S) (Merkle.StringKey)
+  module TAssociative = Prototype.Associative.OfTree (S) (Merkle.StringKey)
+  module RMDirectory = Prototype.Directory.OfTree (S) (Merkle.StringKey) (Entry)
+
+  type t = {schemas: T.address}
 
   module Error = struct
     open Concepts.Condition
@@ -17,16 +65,13 @@ module Make (S : Abstract.Storage.STORAGE) = struct
          database corrupted?"
         empty
 
-    let incomplete_multigroup addr =
+    let incomplete addr =
       condition "incomplete-multigroup"
         "A stored multigroup is missing part of its expected structure. Is your storage corrupted?"
         ("address" |=| Concepts.Value.String (Concepts.Hash.to_hum_string addr))
   end
 
-  module rec Representation : (Concepts.Encoding.Record.S with type t = t) =
-    Concepts.Encoding.Record.Make (Body)
-
-  and Body : Concepts.Encoding.Record.BODY = struct
+  module Representation = Concepts.Encoding.Record.Make (struct
     type nonrec t = t
 
     let tag = '*'
@@ -41,15 +86,86 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       let open Concepts.Encoding in
       let* schemas = Bencode.field "schemas" fields |> fmap Value.hash_of_bencode in
       Ok {schemas}
-  end
+  end)
 
   let encode = Representation.to_blob
   let decode = Representation.of_blob
 
-  let node_of tx multigroup =
+  let node_of tx addr =
+    let open Utilities.Result in
+    T.find tx addr |> fmap (Option.to_result ~none:(Error.incomplete addr))
+
+  (* What [h] holds under [property], each to store once the write has
+     begun, and the tree they make when it has. *)
+  let admissions property admit h =
+    let open Utilities.Result in
+    let* listing = Protocols.Handle.require Protocols.Directory.from h in
+    let* found = Protocols.Directory.find listing property in
+    let* children = Option.fold ~none:(Ok []) ~some:Prototype.Directory.children found in
+    List.map
+      (fun (name, child) ->
+        Prototype.Associative.admission admit name child |> Result.map (fun p -> name, p) )
+      children
+    |> Utilities.List.sequence
+
+  let tree_of tx admissions =
     let open Utilities.Result in
-    SchemaM.find tx multigroup.schemas
-    |> fmap (Option.to_result ~none:(Error.incomplete_multigroup multigroup.schemas))
+    let* _ = T.empty_under tx in
+    T.with_batch tx (fun () ->
+        List.fold_left
+          (fun node (name, store) ->
+            let* node = node in
+            let* addr = store tx in
+            T.insert tx name addr node )
+          (Ok T.empty) admissions )
+
+  let admit_schema _ h =
+    let open Utilities.Result in
+    let* relations = admissions "relation" Entry.admit h in
+    Ok (fun tx -> Result.map T.hash_of (tree_of tx relations))
+
+  let relations ?bind storage node =
+    Prototype.mixture_of node (fun make node ->
+        [ TAddressable.make ~node;
+          RMDirectory.make ~storage ~node:(RelationM.from node)
+            ~constructor:(Entry.load ?bind storage);
+          TAssociative.make ~admit:Entry.admit ~storage ~node ~constructor:(fun node' ->
+              Ok (make node') ) ] )
+
+  let rec schema ?bind storage node =
+    let open Utilities.Result in
+    Prototype.mixture
+      [ TAddressable.make ~node;
+        Prototype.Directory.of_properties ["relation", relations ?bind storage node];
+        Prototype.Associative.(
+          of_properties
+            [ ( "relation",
+                update_only (fun relations' ->
+                    let* a = Protocols.Handle.require Protocols.Addressable.from relations' in
+                    let* node' =
+                      SI.with_read storage (fun tx -> node_of tx (Protocols.Addressable.address a))
+                    in
+                    Ok (schema ?bind storage node') ) ) ] ) ]
+
+  let schemas ?bind storage node =
+    Prototype.mixture_of node (fun make node ->
+        [ TAddressable.make ~node;
+          Protocols.Directory.make
+            object
+              method list = SI.with_read storage (Fun.flip T.keys node)
+
+              method find name =
+                let open Utilities.Result in
+                SI.with_read storage (fun tx ->
+                    let* found = T.lookup tx name node in
+                    match found with
+                    | None -> Ok None
+                    | Some addr ->
+                        let* relations = node_of tx addr in
+                        Ok (Some (schema ?bind storage relations)) )
+            end;
+          TAssociative.make ~admit:admit_schema ~storage ~node ~constructor:(fun node' ->
+              Ok (make node') ) ] )
 
   class multigroup ?bind conn value node =
     object (self)
@@ -67,8 +183,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
         let open Utilities.Result in
         let* node' =
           SI.with_transaction storage (fun tx ->
-              let* _ = SI.store_blob tx (Representation.to_blob multigroup') in
-              node_of tx multigroup' )
+              let* _ = SI.store_blob tx (encode multigroup') in
+              node_of tx multigroup'.schemas )
         in
         new multigroup ?bind storage multigroup' node' |> Protocols.Handle.make |> Result.ok
 
@@ -83,68 +199,32 @@ module Make (S : Abstract.Storage.STORAGE) = struct
                         Handle.require Addressable.from node'
                         |> Result.map Addressable.address
                         |> fmap (fun addr -> self#deriving {schemas= addr}) ) ) ] );
-            Prototype.Directory.of_properties
-              [ ( "schema",
-                  Prototype.mixture_of node (fun make node ->
-                      [ SMAddressable.make ~node:(SchemaM.into node);
-                        SMDirectory.make ~storage ~node ~constructor:(Sc.load ?bind storage);
-                        SMAssociative.make ~admit:Sc.admit ~storage ~node:(SchemaM.into node)
-                          ~constructor:(fun node' -> SchemaM.from node' |> make |> Result.ok)
-                          () ] ) ) ] ]
-
-      method hash = Representation.to_blob multigroup |> Concepts.Hash.hash_of_blob
+            Prototype.Directory.of_properties ["schema", schemas ?bind storage node] ]
+
+      method hash = encode multigroup |> Concepts.Hash.hash_of_blob
       method address = self#hash
     end
 
   let load ?bind conn value =
     let open Utilities.Result in
-    let* node = SI.with_read conn (fun tx -> node_of tx value) in
+    let* node = SI.with_read conn (fun tx -> node_of tx value.schemas) in
     new multigroup ?bind conn value node |> Protocols.Handle.make |> Result.ok
 
   let make conn =
     let open Utilities.Result in
     SI.with_transaction conn (fun tx ->
-        let* empty = SchemaM.empty_under tx in
+        let* empty = T.empty_under tx in
         let multigroup = {schemas= empty} in
-        let* _ = SI.store_blob tx (Representation.to_blob multigroup) in
-        new multigroup conn multigroup SchemaM.empty |> Protocols.Handle.make |> Result.ok )
+        let* _ = SI.store_blob tx (encode multigroup) in
+        new multigroup conn multigroup T.empty |> Protocols.Handle.make |> Result.ok )
 
   (* Handed over as the tree shows one, a directory holding its schemas
      under \schema, a multigroup not stored yet is stored with them. *)
   let admit _ h =
     let open Utilities.Result in
-    let* listing = Protocols.Handle.require Protocols.Directory.from h in
-    let* schemas = Protocols.Directory.find listing "schema" in
-    let* schemas =
-      match schemas with
-      | None -> Ok []
-      | Some schemas ->
-          let* listing = Protocols.Handle.require Protocols.Directory.from schemas in
-          let* names = Protocols.Directory.list listing in
-          BatFingerTree.to_list names
-          |> List.filter_map (fun name ->
-              match Protocols.Directory.find listing name with
-              | Ok None -> None
-              | Error c -> Some (Error c)
-              | Ok (Some schema) -> (
-                match Protocols.Addressable.from schema with
-                | Some a ->
-                    let addr = Protocols.Addressable.address a in
-                    Some (Ok (name, fun _ -> Ok addr))
-                | None -> Some (Sc.admit name schema |> Result.map (fun p -> name, p)) ) )
-          |> Utilities.List.sequence
-    in
+    let* schemas = admissions "schema" admit_schema h in
     Ok
       (fun tx ->
-        let* _ = SchemaM.empty_under tx in
-        let* node =
-          SchemaM.with_batch tx (fun () ->
-              List.fold_left
-                (fun node (name, store) ->
-                  let* node = node in
-                  let* addr = store tx in
-                  SchemaM.Tree.insert tx name addr (SchemaM.into node) |> Result.map SchemaM.from )
-                (Ok SchemaM.empty) schemas )
-        in
-        SI.store_blob tx (Representation.to_blob {schemas= SchemaM.hash_of node}) )
+        let* node = tree_of tx schemas in
+        SI.store_blob tx (encode {schemas= T.hash_of node}) )
 end
diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml
index db3d17d..8e7eab0 100644
--- a/lib/kernel/Path.ml
+++ b/lib/kernel/Path.ml
@@ -73,11 +73,7 @@ let update handle path key reference value =
 let split 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
+    List.sort_uniq String.compare (List.map (fun (path, _, _) -> List.hd path) below)
   in
   let beneath x =
     List.filter_map
diff --git a/lib/kernel/Prototype.ml b/lib/kernel/Prototype.ml
index 3fd208e..ea1083b 100644
--- a/lib/kernel/Prototype.ml
+++ b/lib/kernel/Prototype.ml
@@ -49,29 +49,29 @@ module Associative = struct
 
   type 'tx admission = 'tx -> (Concepts.Hash.hash, Concepts.Condition.condition) result
 
+  (* A value with no address yet is [admit]ted: it is read here, before
+     the write begins, since reading it may itself need storage, and
+     stored by the write. *)
+  let admission admit key h =
+    match Protocols.Addressable.from h with
+    | Some a ->
+        let addr = Protocols.Addressable.address a in
+        Ok (fun _ -> Ok addr)
+    | None -> admit key h
+
   module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) = struct
     module Tree = Merkle.Make (S) (K)
     module SI = Storage.Make (S)
 
-    (* A value with no address yet is [admit]ted: it is read here, before
-       the write begins, since reading it may itself need storage, and
-       stored by the write. *)
-    let make ?admit ~storage ~constructor ~node () =
+    let make ~admit ~storage ~constructor ~node =
       Protocols.Associative.make
       @@ object
            method update key value =
              let open Utilities.Result in
-             let open Protocols in
              let* store =
                match value with
                | None -> Ok None
-               | Some h -> (
-                 match Addressable.from h, admit with
-                 | None, Some admit -> admit key h |> Result.map Option.some
-                 | _ ->
-                     let* addressable = Handle.require Addressable.from h in
-                     let addr = Addressable.address addressable in
-                     Ok (Some (fun _ -> Ok addr)) )
+               | Some h -> admission admit key h |> Result.map Option.some
              in
              SI.with_transaction storage (fun tx ->
                  let* node' =
@@ -95,6 +95,17 @@ module Directory = struct
          method find k = Ok (BatMap.find_opt k props)
        end
 
+  let children directory =
+    let open Utilities.Result in
+    let* listing = Protocols.Handle.require Protocols.Directory.from directory in
+    let* names = Protocols.Directory.list listing in
+    BatFingerTree.to_list names
+    |> List.map (fun name ->
+        let* found = Protocols.Directory.find listing name in
+        Ok (Option.map (fun child -> name, child) found) )
+    |> Utilities.List.sequence
+    |> Result.map (List.filter_map Fun.id)
+
   module OfTree
       (S : Abstract.Storage.STORAGE)
       (K : Merkle.KEY with type t = string)
diff --git a/lib/kernel/Prototype.mli b/lib/kernel/Prototype.mli
index 5f0e29e..9c446fc 100644
--- a/lib/kernel/Prototype.mli
+++ b/lib/kernel/Prototype.mli
@@ -6,6 +6,10 @@ val mixture : Protocols.Handle.protocol list -> Protocols.Handle.t
 module Directory : sig
   val of_properties : (string * Protocols.Handle.t) list -> Protocols.Handle.protocol
 
+  (** the names a directory lists, and what each reaches. *)
+  val children :
+    Protocols.Handle.t -> ((string * Protocols.Handle.t) list, Concepts.Condition.condition) result
+
   module OfTree
       (S : Abstract.Storage.STORAGE)
       (K : Merkle.KEY with type t = string)
@@ -35,20 +39,26 @@ module Associative : sig
   (** how a value is stored once a write has begun, giving its address. *)
   type 'tx admission = 'tx -> (Concepts.Hash.hash, Concepts.Condition.condition) result
 
+  (** a value with an address is stored as that address; [admit] reads
+      one with none, before the write begins, into an admission. *)
+  val admission :
+    (string -> Protocols.Handle.t -> ('tx admission, Concepts.Condition.condition) result) ->
+    string ->
+    Protocols.Handle.t ->
+    ('tx admission, Concepts.Condition.condition) result
+
   module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) : sig
     module Tree : module type of Merkle.Make (S) (K)
 
-    (** a value bound under a key must have an address, unless [admit]
-        can read it, before the write begins, into an admission. *)
+    (** a value bound under a key is stored as its [admission]. *)
     val make :
-      ?admit:
+      admit:
         (string ->
         Protocols.Handle.t ->
         (S.transaction admission, Concepts.Condition.condition) result ) ->
       storage:S.connection ->
       constructor:(Tree.node -> (Protocols.Handle.t, Concepts.Condition.condition) result) ->
       node:Tree.node ->
-      unit ->
       Protocols.Handle.protocol
   end
 end
diff --git a/lib/kernel/Schema.ml b/lib/kernel/Schema.ml
deleted file mode 100644
index e121e7a..0000000
--- a/lib/kernel/Schema.ml
+++ /dev/null
@@ -1,196 +0,0 @@
-module Make (S : Abstract.Storage.STORAGE) = struct
-  module SI = Storage.Make (S)
-  module R = SubstantialRelation.Make (S)
-  module E = EphemeralRelation.Make (S)
-
-  (* A relation as a schema holds it. *)
-  module Entry = struct
-    module Stored = EphemeralRelation.Persisted.Representation
-
-    type t = Substantial of R.t | Ephemeral of EphemeralRelation.Persisted.t
-
-    let encode = function
-      | Substantial relation -> R.encode relation
-      | Ephemeral relation -> Stored.to_blob relation
-
-    let decode blob =
-      let open Utilities.Result in
-      let open Concepts.Encoding in
-      let* data = Bencode.of_blob blob in
-      match data with
-      | Bencode.Tagged (tag, _) when Char.equal tag Stored.tag ->
-          Stored.of_bencode data |> Result.map (fun relation -> Ephemeral relation)
-      | _ -> R.Representation.of_bencode data |> Result.map (fun relation -> Substantial relation)
-
-    let load ?bind storage = function
-      | Substantial relation -> R.load storage relation
-      | Ephemeral relation -> E.load ?bind storage relation
-
-    (* A program is stored as itself, to run whenever it is read; any
-       other relation is stored as the tuples it holds now. *)
-    let admit name h =
-      let open Utilities.Result in
-      let address entry = Concepts.Hash.hash_of_blob (encode entry) in
-      match EphemeralRelation.stored h with
-      | Some (evaluator, code, _) ->
-          let* description = Protocols.Relation.heading h in
-          Ok
-            (fun tx ->
-              let* record = E.store tx ~name ~evaluator ~code description in
-              Ok (address (Ephemeral record)) )
-      | None ->
-          let* description, tuples = Protocols.Relation.read h in
-          Ok
-            (fun tx ->
-              let* relation = R.store tx description tuples in
-              Ok (address (Substantial relation)) )
-  end
-
-  module RelationM = Merkle.Interface (S) (Merkle.StringKey) (Entry)
-  module RMAddressable = Prototype.Addressable.OfTree (S) (Merkle.StringKey)
-  module RMDirectory = Prototype.Directory.OfTree (S) (Merkle.StringKey) (Entry)
-  module RMAssociative = Prototype.Associative.OfTree (S) (Merkle.StringKey)
-
-  type t = {relations: RelationM.address}
-
-  module Error = struct
-    open Concepts.Condition
-
-    let malformed_schema () =
-      condition "malformed-schema"
-        "The on-disk representation of a schema did not conform to what was expected. Is your \
-         database corrupted?"
-        empty
-
-    let incomplete_schema addr =
-      condition "incomplete-schema"
-        "A stored schema is missing part of its expected structure. Is your storage corrupted?"
-        ("address" |=| Concepts.Value.String (Concepts.Hash.to_hum_string addr))
-  end
-
-  module rec Representation : (Concepts.Encoding.Record.S with type t = t) =
-    Concepts.Encoding.Record.Make (Body)
-
-  and Body : Concepts.Encoding.Record.BODY = struct
-    type nonrec t = t
-
-    let tag = 'S'
-    let malformed = Error.malformed_schema
-
-    let fields {relations} =
-      let open Concepts.Encoding in
-      ["relations", Value.bencode_of_hash relations]
-
-    let of_fields fields =
-      let open Utilities.Result in
-      let open Concepts.Encoding in
-      let* relations = Bencode.field "relations" fields |> fmap Value.hash_of_bencode in
-      Ok {relations}
-  end
-
-  let encode = Representation.to_blob
-  let decode = Representation.of_blob
-
-  let node_of tx schema =
-    let open Utilities.Result in
-    RelationM.find tx schema.relations
-    |> fmap (Option.to_result ~none:(Error.incomplete_schema schema.relations))
-
-  class schema ?bind conn value node =
-    object (self)
-      inherit Lifecycle.null
-      method to_string = "schema"
-      val schema = value
-      val storage = conn
-      val node = node (* FIXME: see the comment on Branch.ml *)
-
-      (* TODO: Add later to the lifecycle management, accounting for
-         derived instances. Callers must release the previous handle
-         when done with it so its instance can be cleaned up after the
-         last reference is released. *)
-      method deriving schema' =
-        let open Utilities.Result in
-        let* node' =
-          SI.with_transaction storage (fun tx ->
-              let* _ = SI.store_blob tx (Representation.to_blob schema') in
-              node_of tx schema' )
-        in
-        new schema ?bind storage schema' node' |> Protocols.Handle.make |> Result.ok
-
-      method protocols : Protocols.Handle.protocol list =
-        let open Utilities.Result in
-        Protocols.
-          [ Addressable.make self;
-            Prototype.Associative.(
-              of_properties
-                [ ( "relation",
-                    update_only (fun node' ->
-                        Handle.require Addressable.from node'
-                        |> Result.map Addressable.address
-                        |> fmap (fun addr -> self#deriving {relations= addr}) ) ) ] );
-            Prototype.Directory.of_properties
-              [ ( "relation",
-                  Prototype.mixture_of node (fun make node ->
-                      [ RMAddressable.make ~node:(RelationM.into node);
-                        RMDirectory.make ~storage ~node ~constructor:(Entry.load ?bind storage);
-                        RMAssociative.make ~admit:Entry.admit ~storage ~node:(RelationM.into node)
-                          ~constructor:(fun node' -> RelationM.from node' |> make |> Result.ok)
-                          () ] ) ) ] ]
-
-      method hash = Representation.to_blob schema |> Concepts.Hash.hash_of_blob
-      method address = self#hash
-    end
-
-  let load ?bind conn value =
-    let open Utilities.Result in
-    let* node = SI.with_read conn (fun tx -> node_of tx value) in
-    new schema ?bind conn value node |> Protocols.Handle.make |> Result.ok
-
-  let make conn =
-    let open Utilities.Result in
-    SI.with_transaction conn (fun tx ->
-        let* empty = RelationM.empty_under tx in
-        let schema = {relations= empty} in
-        let* _ = SI.store_blob tx (Representation.to_blob schema) in
-        new schema conn schema RelationM.empty |> Protocols.Handle.make |> Result.ok )
-
-  (* Handed over as the tree shows one, a directory holding its relations
-     under \relation, a schema not stored yet is stored with them. *)
-  let admit _ h =
-    let open Utilities.Result in
-    let* listing = Protocols.Handle.require Protocols.Directory.from h in
-    let* relations = Protocols.Directory.find listing "relation" in
-    let* relations =
-      match relations with
-      | None -> Ok []
-      | Some relations ->
-          let* listing = Protocols.Handle.require Protocols.Directory.from relations in
-          let* names = Protocols.Directory.list listing in
-          BatFingerTree.to_list names
-          |> List.filter_map (fun name ->
-              match Protocols.Directory.find listing name with
-              | Ok None -> None
-              | Error c -> Some (Error c)
-              | Ok (Some relation) -> (
-                match Protocols.Addressable.from relation with
-                | Some a ->
-                    let addr = Protocols.Addressable.address a in
-                    Some (Ok (name, fun _ -> Ok addr))
-                | None -> Some (Entry.admit name relation |> Result.map (fun p -> name, p)) ) )
-          |> Utilities.List.sequence
-    in
-    Ok
-      (fun tx ->
-        let* _ = RelationM.empty_under tx in
-        let* node =
-          RelationM.with_batch tx (fun () ->
-              List.fold_left
-                (fun node (name, store) ->
-                  let* node = node in
-                  let* addr = store tx in
-                  RelationM.Tree.insert tx name addr (RelationM.into node)
-                  |> Result.map RelationM.from )
-                (Ok RelationM.empty) relations )
-        in
-        SI.store_blob tx (Representation.to_blob {relations= RelationM.hash_of node}) )
-end
diff --git a/lib/kernel/Schema.mli b/lib/kernel/Schema.mli
deleted file mode 100644
index 7970ee2..0000000
--- a/lib/kernel/Schema.mli
+++ /dev/null
@@ -1,23 +0,0 @@
-(** A schema: its relations, \schema\[s]\relation\[r]. For now only a
-    namespace for them. *)
-module Make (S : Abstract.Storage.STORAGE) : sig
-  include Merkle.VALUE
-
-  val load :
-    ?bind:EphemeralRelation.binding ->
-    S.connection ->
-    t ->
-    (Protocols.Handle.t, Concepts.Condition.condition) result
-
-  (** a schema handed over with no address, as a directory holding its
-      relations under \relation, to store once the write has begun. A
-      relation with no address is stored as a program if it is one, and
-      as the tuples it holds if not. *)
-  val admit :
-    string ->
-    Protocols.Handle.t ->
-    (S.transaction Prototype.Associative.admission, Concepts.Condition.condition) result
-
-  (** an empty one, stored. *)
-  val make : S.connection -> (Protocols.Handle.t, Concepts.Condition.condition) result
-end
diff --git a/lib/kernel/Scope.ml b/lib/kernel/Scope.ml
index cfba6b3..95896b4 100644
--- a/lib/kernel/Scope.ml
+++ b/lib/kernel/Scope.ml
@@ -40,18 +40,6 @@ let attribute home relation text =
       Some a
   | _ -> None
 
-(* the names a directory lists, and what each reaches *)
-let children directory =
-  let open Utilities.Result in
-  let* listing = Protocols.Handle.require Protocols.Directory.from directory in
-  let* names = Protocols.Directory.list listing in
-  BatFingerTree.to_list names
-  |> List.map (fun name ->
-      let* found = Protocols.Directory.find listing name in
-      Ok (Option.map (fun child -> name, child) found) )
-  |> Utilities.List.sequence
-  |> Result.map (List.filter_map Fun.id)
-
 (* every relation of a branch state, as multigroup:schema:relation *)
 let catalog_of branch =
   let open Utilities.Result in
@@ -65,7 +53,7 @@ let catalog_of branch =
         let* names = Protocols.Directory.list listing in
         Ok (List.map (name prefix) (BatFingerTree.to_list names))
     | Some level, rest ->
-        let* named = children level in
+        let* named = Prototype.Directory.children level in
         List.map (fun (n, child) -> down (n :: prefix) child rest) named
         |> Utilities.List.sequence
         |> Result.map List.concat