22 files changed, 719 insertions, 32 deletions

diff --git a/lib/concepts/Tuple.ml b/lib/concepts/Tuple.ml
new file mode 100644
index 0000000..296bf26
--- /dev/null
+++ b/lib/concepts/Tuple.ml
@@ -0,0 +1,45 @@
+type t = { type_ : string; attributes : Value.value BatMap.String.t }
+
+let malformed_value () =
+  Condition.condition "malformed-tuple-value"
+    "A tuple field did not conform to what was expected" Condition.empty
+
+let bencode_of_value = function
+  | Value.String s -> Encoding.Bencode.Tagged ('s', Encoding.Bencode.String s)
+  | Value.Integer n -> Encoding.Bencode.Tagged ('i', Encoding.Bencode.Int n)
+
+let value_of_bencode = function
+  | Encoding.Bencode.Tagged ('s', Encoding.Bencode.String s) -> Ok (Value.String s)
+  | Encoding.Bencode.Tagged ('i', Encoding.Bencode.Int n) -> Ok (Value.Integer n)
+  | _ -> Error (malformed_value ())
+
+module rec Representation : (Encoding.Record.S with type t = t) =
+  Encoding.Record.Make (Body)
+
+and Body : Encoding.Record.BODY = struct
+  type nonrec t = t
+
+  let tag = 'T'
+  let malformed = malformed_value
+
+  let fields { type_; attributes } =
+    [ "type", Encoding.Bencode.String type_;
+      "attributes",
+      Encoding.Bencode.Dict
+        (BatMap.String.enum attributes
+         |> BatEnum.fold
+              (fun acc (name, value) -> (name, bencode_of_value value) :: acc)
+              []) ]
+
+  let of_fields data =
+    let open Utilities.Result in
+    let* type_ = Encoding.Bencode.field "type" data |> fmap Encoding.Bencode.as_string in
+    let* kvs = Encoding.Bencode.field "attributes" data |> fmap Encoding.Bencode.as_dict in
+    kvs
+    |> List.map (fun (name, v) -> value_of_bencode v |> Result.map (fun v -> (name, v)))
+    |> Utilities.List.sequence
+    |> Result.map (fun kvs ->
+           { type_; attributes = BatMap.String.of_list kvs })
+end
+
+let hash tuple = Representation.to_blob tuple |> Hash.hash_of_blob
diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
new file mode 100644
index 0000000..70cf9de
--- /dev/null
+++ b/lib/evaluators/FOL.ml
@@ -0,0 +1,40 @@
+module Error = struct
+  open Concepts.Condition
+
+  let unknown_relation name =
+    condition "unknown-relation" "A plan named a relation that does not exist under this snapshot"
+      ("name" |=| Concepts.Value.String name)
+
+  let cancelled () =
+    condition "evaluation-cancelled" "An evaluation was stopped before it produced its result" empty
+end
+
+type plan = Base of string
+
+module Program = Protocols.Program.Make (struct
+  type t = plan
+end)
+
+let execute context = function
+  | Base name ->
+     let open Utilities.Result in
+     match context.Protocols.Context.status () with
+     | `Cancelled | `Exhausted -> Error (Error.cancelled ())
+     | `Live ->
+        let* found = Runtime.Context.resolve context name in
+        let* handle = Option.to_result ~none:(Error.unknown_relation name) found in
+        Fun.protect
+          ~finally:(fun () -> Protocols.Handle.release handle)
+          (fun () ->
+            let* enumerable = Protocols.Enumerable.require handle in
+            Protocols.Enumerable.enumerate enumerable context)
+
+class evaluator = object (self)
+  inherit Kernel.Lifecycle.null
+  inherit Kernel.Identity.of_id
+
+  method invoke ~program context = execute context program
+  method protocols : Protocols.Handle.protocol list = [Program.make self]
+end
+
+let make () = new evaluator |> Protocols.Handle.make
diff --git a/lib/evaluators/Lambda.ml b/lib/evaluators/Lambda.ml
new file mode 100644
index 0000000..7cb0248
--- /dev/null
+++ b/lib/evaluators/Lambda.ml
@@ -0,0 +1,90 @@
+module Error = struct
+  open Concepts.Condition
+
+  let unknown_name name =
+    condition "unknown-name"
+      "A term named neither a bound variable nor a relation existing under this snapshot"
+      ("name" |=| Concepts.Value.String name)
+  let not_applicable () =
+    condition "not-applicable"
+      "A term was applied to an argument, but it denotes a relation rather than an abstraction"
+      empty
+  let unapplied_abstraction () =
+    condition "unapplied-abstraction"
+      "A program reduced to an abstraction, which names no relation to enumerate" empty
+  let cancelled () =
+    condition "evaluation-cancelled" "An evaluation was stopped before it produced its result" empty
+end
+
+(* A dummy untyped lambda calculus where constants are relations. We
+   look for a name in the environment first and resolved through the
+   context otherwise, so the relations reachable under the snapshot
+   are the outer environment every program is evaluated on *)
+type term =
+  | Name of string
+  | Abstract of string * term
+  | Apply of term * term
+
+module Program = Protocols.Program.Make (struct
+  type t = term
+end)
+
+type value =
+  | Relation of Protocols.Handle.t
+  | Closure of string * term * environment
+and environment = value BatMap.String.t
+
+let reduce context ~acquire term =
+  let open Utilities.Result in
+  let rec eval environment term =
+    match context.Protocols.Context.status () with
+    | `Cancelled | `Exhausted -> Error (Error.cancelled ())
+    | `Live ->
+       match term with
+       | Name name ->
+          begin match BatMap.String.find_opt name environment with
+           | Some value -> Ok value
+           | None ->
+              let* found = Runtime.Context.resolve context name in
+              let* handle = Option.to_result ~none:(Error.unknown_name name) found in
+              Ok (Relation (acquire handle))
+          end
+       | Abstract (binder, body) -> Ok (Closure (binder, body, environment))
+       | Apply (operator, operand) ->
+          let* operator = eval environment operator in
+          match operator with
+          | Relation _ -> Error (Error.not_applicable ())
+          | Closure (binder, body, closed) ->
+             let* argument = eval environment operand in
+             eval (BatMap.String.add binder argument closed) body
+  in
+  eval BatMap.String.empty term
+
+(* Every handle resolved during reduction is released once the result
+   has been enumerated and we keep a closure free to carry a relation
+   it did not resolve itself *)
+let execute context term =
+  let open Utilities.Result in
+  let acquired = ref [] in
+  let acquire handle =
+    acquired := handle :: !acquired;
+    handle
+  in
+  Fun.protect
+    ~finally:(fun () -> List.iter Protocols.Handle.release !acquired)
+    (fun () ->
+      let* value = reduce context ~acquire term in
+      match value with
+      | Closure _ -> Error (Error.unapplied_abstraction ())
+      | Relation handle ->
+         let* enumerable = Protocols.Enumerable.require handle in
+         Protocols.Enumerable.enumerate enumerable context)
+
+class evaluator = object (self)
+  inherit Kernel.Lifecycle.null
+  inherit Kernel.Identity.of_id
+  method invoke ~program context = execute context program
+  method protocols : Protocols.Handle.protocol list = [Program.make self]
+end
+
+let make () = new evaluator |> Protocols.Handle.make
diff --git a/lib/kernel/Generator.ml b/lib/kernel/Generator.ml
new file mode 100644
index 0000000..e4a15f8
--- /dev/null
+++ b/lib/kernel/Generator.ml
@@ -0,0 +1,56 @@
+type _ Effect.t += Yield : Concepts.Tuple.t -> unit Effect.t
+
+type step =
+  | Element of Concepts.Tuple.t * (unit, step) Effect.Deep.continuation
+  | Finished of (unit, Concepts.Condition.condition) result
+
+let start produce =
+  try Finished (produce ~yield:(fun tuple -> Effect.perform (Yield tuple))) with
+  | effect (Yield tuple), k -> Element (tuple, k)
+
+let resume k = Effect.Deep.continue k ()
+
+class producer_cursor produce on_release =
+  object (self)
+    inherit Lifecycle.null
+    inherit Identity.of_id
+
+    val mutable state : [`Fresh | `Live of (unit, step) Effect.Deep.continuation | `Done] = `Fresh
+    method protocols : Protocols.Handle.protocol list = Protocols.[Cursor.make self]
+    method private step : (Concepts.Tuple.t option, Concepts.Condition.condition) result =
+      let settle = function
+        | Element (tuple, k) ->
+            state <- `Live k;
+            Ok (Some tuple)
+        | Finished r ->
+            state <- `Done;
+            Result.map (fun () -> None) r
+      in
+      match state with
+      | `Done -> Ok None
+      | `Fresh -> settle (start produce)
+      | `Live k -> settle (resume k)
+
+    method fetch limit =
+      let open Utilities.Result in
+      let rec fill taken tuples =
+        if taken >= limit then Ok Protocols.Cursor.{tuples; exhausted= false}
+        else
+          let* stepped = self#step in
+          match stepped with
+          | None -> Ok Protocols.Cursor.{tuples; exhausted= true}
+          | Some tuple -> fill (taken + 1) (BatFingerTree.snoc tuples tuple)
+      in
+      if limit <= 0 then
+        Ok Protocols.Cursor.{tuples= BatFingerTree.empty; exhausted= (state = `Done)}
+      else fill 0 BatFingerTree.empty
+
+    method! release =
+      (match state with
+       | `Live _ -> Option.iter (fun f -> f ()) on_release
+       | `Fresh | `Done -> ());
+      state <- `Done
+  end
+
+let cursor_of ?on_release produce =
+  new producer_cursor produce on_release |> Protocols.Handle.make
diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml
index d213b66..ae041fc 100644
--- a/lib/kernel/Initialization.ml
+++ b/lib/kernel/Initialization.ml
@@ -1,12 +1,22 @@
 module Make (S : Abstract.Storage.STORAGE) = struct
   module BM = BranchManager.Make (S)
 
-  let initialize conn =
+  let initialize ?(evaluators = []) conn =
     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* _ =
+      List.fold_left
+        (fun acc (name, handle) ->
+          let* _ = acc in
+          Registry.update evaluator_registry name None (Some handle))
+        (Ok true) evaluators
+    in
+    let* _ = Registry.update registry "evaluator" None (Some evaluator_namespace) in
     Ok root
 end
diff --git a/lib/kernel/Initialization.mli b/lib/kernel/Initialization.mli
index 104d523..926bbd8 100644
--- a/lib/kernel/Initialization.mli
+++ b/lib/kernel/Initialization.mli
@@ -1,3 +1,6 @@
 module Make (S : Abstract.Storage.STORAGE) : sig
-  val initialize : S.connection -> (Protocols.Handle.t, Concepts.Condition.condition) result
+  val initialize :
+    ?evaluators:(string * Protocols.Handle.t) list ->
+    S.connection ->
+    (Protocols.Handle.t, Concepts.Condition.condition) result
 end
diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml
index eebae3e..6592acb 100644
--- a/lib/kernel/SubstantialRelation.ml
+++ b/lib/kernel/SubstantialRelation.ml
@@ -37,7 +37,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
   module TupleSet = Merkle.Make (S) (TupleKey)
 
   type t =
-    { heading: Concepts.Hash.hash;
+    { schematics: Concepts.Hash.hash;
       predicate: Concepts.Hash.hash option;
       local_constraints: Concepts.Hash.hash option;
       tuples: TupleSet.address;
@@ -52,9 +52,9 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let tag = 'R'
     let malformed = Error.malformed_relation
 
-    let fields {heading; predicate; local_constraints; tuples; indexes} =
+    let fields {schematics; predicate; local_constraints; tuples; indexes} =
       let open Concepts.Encoding in
-      [ "heading", Value.bencode_of_hash heading;
+      [ "schema", Value.bencode_of_hash schematics;
         "predicate", Value.bencode_of_option Value.bencode_of_hash predicate;
         "local-constraints", Value.bencode_of_option Value.bencode_of_hash local_constraints;
         "tuples", Value.bencode_of_hash tuples;
@@ -63,7 +63,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let of_fields fields =
       let open Utilities.Result in
       let open Concepts.Encoding in
-      let* heading = Bencode.field "heading" fields |> fmap Value.hash_of_bencode in
+      let* schematics = Bencode.field "schema" fields |> fmap Value.hash_of_bencode in
       let* predicate =
         Bencode.field "predicate" fields |> fmap (Value.option_of_bencode Value.hash_of_bencode)
       in
@@ -75,13 +75,13 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       let* indexes =
         Bencode.field "indexes" fields |> fmap (Value.option_of_bencode Value.hash_of_bencode)
       in
-      Ok {heading; predicate; local_constraints; tuples; indexes}
+      Ok {schematics; predicate; local_constraints; tuples; indexes}
   end
 
   let encode = Representation.to_blob
   let decode = Representation.of_blob
 
-  let heading {heading; _} = heading
+  let schematics {schematics; _} = schematics
   let predicate {predicate; _} = predicate
   let local_constraints {local_constraints; _} = local_constraints
   let tuples {tuples; _} = tuples
@@ -93,10 +93,10 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let* tuples = TupleSet.find tx relation.tuples in
     Option.to_result ~none:(Error.invalid_tuple_root relation.tuples) tuples
 
-  let empty tx ~heading ?predicate ?local_constraints ?indexes () =
+  let empty tx ~schematics ?predicate ?local_constraints ?indexes () =
     let open Utilities.Result in
     let* tuples = TupleSet.empty_under tx in
-    Ok {heading; predicate; local_constraints; tuples; indexes}
+    Ok {schematics; predicate; local_constraints; tuples; indexes}
 
   let store tx relation = SI.store_blob tx (Representation.to_blob relation)
 
@@ -107,27 +107,84 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let* present = TupleSet.lookup tx tuple node in
     Ok (Option.is_some present)
 
+  let schema_of tx relation =
+    let open Utilities.Result in
+    let* data = SI.get_req tx (S.Hash relation.schematics) in
+    let* fields = Concepts.Encoding.Bencode.of_blob data in
+    let* kvs = Concepts.Encoding.Bencode.as_dict fields in
+    kvs
+    |> List.map (fun (name, domain) ->
+           Concepts.Encoding.Bencode.as_string domain
+           |> Result.map (fun domain -> (name, domain)))
+    |> Utilities.List.sequence
+    |> Result.map (fun kvs ->
+           List.fold_left
+             (fun acc (name, domain) -> BatMap.String.add name domain acc)
+             BatMap.String.empty kvs)
+
+  let enumerate storage relation =
+    let open Utilities.Result in
+    let* tx = S.start storage in
+    let* node = tuple_node tx relation in
+    let closed = ref false in
+    let close () = if not !closed then begin closed := true; ignore (S.abort tx) end in
+    (* The fold is suspended by [yield], so the tree is walked one node
+       and one tuple at a time rather than materialized before the
+       first tuple is produced. *)
+    let produce ~yield =
+      let* walked =
+        TupleSet.fold_left tx
+          (fun acc _ addr ->
+            let* () = acc in
+            let* tuple =
+              SI.get_req tx (S.Hash addr) |> fmap Concepts.Tuple.Representation.of_blob
+            in
+            yield tuple;
+            Ok ())
+          (Ok ()) node
+      in
+      close ();
+      walked
+    in
+    Ok (Generator.cursor_of ~on_release:close produce)
+
   class relation storage value =
     object (self)
       inherit Lifecycle.null
       val storage : S.connection = storage
       val relation : t = value
-      method heading = Ok relation.heading
       method predicate = Ok relation.predicate
       method local_constraints = Ok relation.local_constraints
-      method tuples = Ok relation.tuples
-
-      method contains tuple =
-        SI.with_transaction storage (fun tx -> contains_tuple tx relation tuple)
 
-      method protocols : Protocols.Handle.protocol list = Protocols.[Relation.make self]
+      (* The protocol takes a tuple, not bytes: encoding is this object's business, and a caller
+         that had to produce the exact stored bytes would have to know this encoding to do it. *)
+      method contains (tuple : Concepts.Tuple.t) =
+        SI.with_transaction storage (fun tx ->
+            contains_tuple tx relation (Concepts.Tuple.Representation.to_blob tuple) )
+
+      method describe () =
+        let open Utilities.Result in
+        let* description = SI.with_transaction storage (fun tx -> schema_of tx relation) in
+        Ok (Protocols.Schematics.Relation description)
+
+      (* A substantial relation is finitely enumerable, so it carries [Enumerable] as well as
+         [Relation]. A procedural relation would carry only the latter, which is how an evaluator
+         discovers it cannot iterate one -- see [Protocols.Enumerable]. The context is accepted and
+         unused here: this enumeration reads through its own cursor-lifetime transaction and needs
+         no name resolution, but cancellation should eventually be checked between tuples. *)
+      method enumerate (_ : Protocols.Context.t) = enumerate storage relation
+
+      method protocols : Protocols.Handle.protocol list =
+        [ Protocols.Relation.make self
+        ; Protocols.Enumerable.make self
+        ; Protocols.Schematics.make self ]
       method hash = hash relation
     end
 
-  let make conn ~heading ?predicate ?local_constraints ?indexes () =
+  let make conn ~schematics ?predicate ?local_constraints ?indexes () =
     let open Utilities.Result in
     SI.with_transaction conn (fun tx ->
-        let* relation = empty tx ~heading ?predicate ?local_constraints ?indexes () in
+        let* relation = empty tx ~schematics ?predicate ?local_constraints ?indexes () in
         let* _ = store tx relation in
         Ok (new relation conn relation |> Protocols.Handle.make) )
 
diff --git a/lib/kernel/SubstantialRelation.mli b/lib/kernel/SubstantialRelation.mli
index 9e61411..be2ad28 100644
--- a/lib/kernel/SubstantialRelation.mli
+++ b/lib/kernel/SubstantialRelation.mli
@@ -6,7 +6,7 @@ module Make (S : Abstract.Storage.STORAGE) : sig
 
   val empty :
     S.transaction ->
-    heading:Concepts.Hash.hash ->
+    schematics:Concepts.Hash.hash ->
     ?predicate:Concepts.Hash.hash ->
     ?local_constraints:Concepts.Hash.hash ->
     ?indexes:Concepts.Hash.hash ->
@@ -17,7 +17,7 @@ module Make (S : Abstract.Storage.STORAGE) : sig
 
   val make :
     S.connection ->
-    heading:Concepts.Hash.hash ->
+    schematics:Concepts.Hash.hash ->
     ?predicate:Concepts.Hash.hash ->
     ?local_constraints:Concepts.Hash.hash ->
     ?indexes:Concepts.Hash.hash ->
@@ -34,7 +34,7 @@ module Make (S : Abstract.Storage.STORAGE) : sig
     Concepts.Hash.hash ->
     (Protocols.Handle.t, Concepts.Condition.condition) result
 
-  val heading : t -> Concepts.Hash.hash
+  val schematics : t -> Concepts.Hash.hash
   val predicate : t -> Concepts.Hash.hash option
   val local_constraints : t -> Concepts.Hash.hash option
   val tuples : t -> Concepts.Hash.hash
@@ -46,4 +46,19 @@ module Make (S : Abstract.Storage.STORAGE) : sig
 
   val contains_tuple :
     S.transaction -> t -> Concepts.Blob.t -> (bool, Concepts.Condition.condition) result
+
+  (** decodes the schematics at [schematics relation] -- the body of
+      [Protocols.Schematics.describe] for this kind of relation. *)
+  val schema_of :
+    S.transaction ->
+    t ->
+    (Protocols.Schematics.relation_description, Concepts.Condition.condition) result
+
+  (** a handle carrying [Protocols.Cursor] over every tuple currently
+      asserted, decoded via [Concepts.Tuple.Representation.of_blob] --
+      the body of [Protocols.Relation.enumerate] for this kind of
+      relation. Opens its own storage transaction, held for the
+      cursor's whole lifetime rather than just this call -- see
+      [Kernel.Generator] and docs/design/evaluator.md, "Shape". *)
+  val enumerate : S.connection -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result
 end
diff --git a/lib/kernel/Tuple.ml b/lib/kernel/Tuple.ml
new file mode 100644
index 0000000..ef591ae
--- /dev/null
+++ b/lib/kernel/Tuple.ml
@@ -0,0 +1,144 @@
+module Make (S : Abstract.Storage.STORAGE) = struct
+  module SI = Storage.Make (S)
+
+  module Error = struct
+    open Concepts.Condition
+
+    let unknown_attribute name =
+      condition "unknown-attribute" "No such attribute on this tuple"
+        ("attribute" |=| Concepts.Value.String name)
+    let malformed_value () =
+      condition "malformed-tuple-value"
+        "A tuple field did not conform to what was expected" empty
+    let incomplete_tuple addr =
+      condition "incomplete-tuple"
+        "A stored tuple is missing part of its expected structure. Is your storage corrupted?"
+        ("address" |=| Concepts.Value.String (Concepts.Hash.to_hum_string addr))
+  end
+
+  module Attribute = struct
+    type t = Concepts.Value.value
+
+    let malformed_value = Error.malformed_value
+
+    let encode value =
+      let open Concepts.Encoding in
+      Bencode.to_blob
+        (match value with
+         | Concepts.Value.String s -> Bencode.Tagged ('s', Bencode.String s)
+         | Concepts.Value.Integer n -> Bencode.Tagged ('i', Bencode.Int n))
+
+    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 ('s', Bencode.String s) -> Ok (Concepts.Value.String s)
+      | Bencode.Tagged ('i', Bencode.Int n) -> Ok (Concepts.Value.Integer n)
+      | _ -> Error (malformed_value ())
+
+    let domain = function
+      | Concepts.Value.String _ -> "string"
+      | Concepts.Value.Integer _ -> "integer"
+  end
+
+  module AttributeM = Merkle.Interface (S) (Merkle.StringKey) (Attribute)
+
+  (* TODO: ephemeral tuples are served by instantiating this functor
+     over an in-memory storage. Consider later splitting [t] into
+     resident (an address) and ephemeral (an in-memory attribute map)
+     forms instead. *)
+  type t = { type_ : string; attributes : AttributeM.address }
+
+  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 = 'T'
+    let malformed = Error.malformed_value
+
+    let fields { type_; attributes } =
+      let open Concepts.Encoding in
+      [ "type", Bencode.String type_;
+        "attributes", Value.bencode_of_hash attributes ]
+
+    let of_fields data =
+      let open Utilities.Result in
+      let open Concepts.Encoding in
+      let* type_ = Bencode.field "type" data |> fmap Bencode.as_string in
+      let* attributes = Bencode.field "attributes" data |> fmap Value.hash_of_bencode in
+      Ok { type_; attributes }
+  end
+
+  let encode = Representation.to_blob
+  let decode = Representation.of_blob
+  let hash tuple = Representation.to_blob tuple |> Concepts.Hash.hash_of_blob
+
+  let type_of { type_; _ } = type_
+
+  let node tx { attributes; _ } =
+    let open Utilities.Result in
+    AttributeM.find tx attributes
+    |> fmap (Option.to_result ~none:(Error.incomplete_tuple attributes))
+
+  let empty tx ~type_ () =
+    let open Utilities.Result in
+    let* attributes = AttributeM.empty_under tx in
+    Ok { type_; attributes }
+
+  let make tx ~type_ attributes =
+    let open Utilities.Result in
+    let* node =
+      AttributeM.with_batch tx (fun () ->
+          BatMap.String.enum attributes
+          |> BatEnum.fold
+               (fun node (name, value) ->
+                 let* node = node in
+                 AttributeM.insert tx name value node)
+               (Ok AttributeM.empty))
+    in
+    Ok { type_; attributes = AttributeM.hash_of node }
+
+  let attribute tx tuple name =
+    let open Utilities.Result in
+    let* node = node tx tuple in
+    let* value = AttributeM.lookup tx name node in
+    Option.to_result ~none:(Error.unknown_attribute name) value
+
+  let attributes tx tuple =
+    let open Utilities.Result in
+    let* node = node tx tuple in
+    AttributeM.fold_left tx
+      (fun acc name value -> BatMap.String.add name value acc)
+      BatMap.String.empty node
+
+  class tuple ~relation conn value node = object (self)
+    inherit Lifecycle.null
+
+    val tuple = value
+    val storage = conn
+    val node = node
+
+    method describe () =
+      let open Utilities.Result in
+      let* attributes =
+        SI.with_transaction storage (fun tx ->
+            AttributeM.fold_left tx
+              (fun acc name value -> BatMap.String.add name (Attribute.domain value) acc)
+              BatMap.String.empty node)
+      in
+      Ok (Protocols.Schematics.Tuple { Protocols.Schematics.relation; attributes })
+
+    method protocols : Protocols.Handle.protocol list =
+      [Protocols.Schematics.make self]
+
+    method hash = hash tuple
+  end
+
+  let wrap ~relation conn value =
+    let open Utilities.Result in
+    let* node = SI.with_transaction conn (fun tx -> node tx value) in
+    new tuple ~relation conn value node |> Protocols.Handle.make |> Result.ok
+end
diff --git a/lib/protocols/Context.ml b/lib/protocols/Context.ml
new file mode 100644
index 0000000..b7c8a37
--- /dev/null
+++ b/lib/protocols/Context.ml
@@ -0,0 +1,4 @@
+type t =
+  { snapshot : Concepts.Hash.hash
+  ; root : Handle.t
+  ; status : unit -> [`Live | `Cancelled | `Exhausted] }
diff --git a/lib/protocols/Cursor.ml b/lib/protocols/Cursor.ml
new file mode 100644
index 0000000..36db97d
--- /dev/null
+++ b/lib/protocols/Cursor.ml
@@ -0,0 +1,36 @@
+module Error = struct
+  open Concepts.Condition
+
+  let not_a_cursor () =
+    condition "not-a-cursor" "A handle was expected to carry the cursor protocol and did not" empty
+end
+
+type batch = {tuples: Concepts.Tuple.t BatFingerTree.t; exhausted: bool}
+
+class type implementation = object
+  method fetch : int -> (batch, Concepts.Condition.condition) result
+end
+
+type Handle.protocol += Cursor of implementation
+type t = implementation
+
+let make impl = Cursor (impl :> implementation)
+let from handle = Handle.into handle (function Cursor impl -> Some impl | _ -> None)
+let require handle = from handle |> Option.to_result ~none:(Error.not_a_cursor ())
+let fetch i limit = Handle.invoke i (fun o -> o#fetch limit)
+
+let rec next i =
+  let open Utilities.Result in
+  let* batch = fetch i 1 in
+  match BatFingerTree.front batch.tuples with
+  | Some (_, tuple) -> Ok (Some tuple)
+  | None -> if batch.exhausted then Ok None else next i
+
+let drain i ?(limit = 256) () =
+  let open Utilities.Result in
+  let rec loop tuples =
+    let* batch = fetch i limit in
+    let tuples = BatFingerTree.append tuples batch.tuples in
+    if batch.exhausted then Ok tuples else loop tuples
+  in
+  loop BatFingerTree.empty
diff --git a/lib/protocols/Cursor.mli b/lib/protocols/Cursor.mli
new file mode 100644
index 0000000..08c7628
--- /dev/null
+++ b/lib/protocols/Cursor.mli
@@ -0,0 +1,21 @@
+type batch =
+  {tuples: Concepts.Tuple.t BatFingerTree.t; exhausted: bool}
+
+type t
+
+class type implementation = object
+  method fetch : int -> (batch, Concepts.Condition.condition) result
+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 fetch : t Handle.interface -> int -> (batch, Concepts.Condition.condition) result
+
+val next : t Handle.interface -> (Concepts.Tuple.t option, Concepts.Condition.condition) result
+
+val drain :
+  t Handle.interface ->
+  ?limit:int ->
+  unit ->
+  (Concepts.Tuple.t BatFingerTree.t, Concepts.Condition.condition) result
diff --git a/lib/protocols/Enumerable.ml b/lib/protocols/Enumerable.ml
new file mode 100644
index 0000000..e78f265
--- /dev/null
+++ b/lib/protocols/Enumerable.ml
@@ -0,0 +1,21 @@
+module Error = struct
+  open Concepts.Condition
+
+  let not_enumerable () =
+    condition "not-enumerable"
+      "A relation was used where the expression must iterate its members, but it does not support \
+       enumeration. A procedural relation may decide membership without being able to produce it."
+      empty
+end
+
+class type implementation = object
+  method enumerate : Context.t -> (Handle.t, Concepts.Condition.condition) result
+end
+
+type Handle.protocol += Enumerable of implementation
+type t = implementation
+
+let make impl = Enumerable (impl :> implementation)
+let from handle = Handle.into handle (function Enumerable impl -> Some impl | _ -> None)
+let require handle = from handle |> Option.to_result ~none:(Error.not_enumerable ())
+let enumerate i context = Handle.invoke i (fun o -> o#enumerate context)
diff --git a/lib/protocols/Enumerable.mli b/lib/protocols/Enumerable.mli
new file mode 100644
index 0000000..4a903f6
--- /dev/null
+++ b/lib/protocols/Enumerable.mli
@@ -0,0 +1,13 @@
+type t
+
+class type implementation = object
+  method enumerate : Context.t -> (Handle.t, Concepts.Condition.condition) result
+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 enumerate :
+  t Handle.interface -> Context.t -> (Handle.t, Concepts.Condition.condition) result
diff --git a/lib/protocols/Program.ml b/lib/protocols/Program.ml
new file mode 100644
index 0000000..49e6e2d
--- /dev/null
+++ b/lib/protocols/Program.ml
@@ -0,0 +1,20 @@
+module type PROGRAM = sig
+  type t
+end
+
+module Make (P : PROGRAM) = struct
+  class type implementation = object
+    method invoke :
+      program:P.t ->
+      Context.t ->
+      (Handle.t, Concepts.Condition.condition) result
+  end
+
+  type Handle.protocol += Program of implementation
+
+  type t = implementation
+
+  let make impl = Program (impl :> implementation)
+  let from handle = Handle.into handle (function Program impl -> Some impl | _ -> None)
+  let invoke i ~program ctx = Handle.invoke i (fun o -> o#invoke ~program ctx)
+end
diff --git a/lib/protocols/Program.mli b/lib/protocols/Program.mli
new file mode 100644
index 0000000..1d6c3ae
--- /dev/null
+++ b/lib/protocols/Program.mli
@@ -0,0 +1,23 @@
+module type PROGRAM = sig
+  type t
+end
+
+module Make (P : PROGRAM) : sig
+  type t
+
+  class type implementation = object
+    method invoke :
+      program:P.t ->
+      Context.t ->
+      (Handle.t, Concepts.Condition.condition) result
+  end
+
+  val make : #implementation -> Handle.protocol
+  val from : Handle.t -> t Handle.interface option
+
+  val invoke :
+    t Handle.interface ->
+    program:P.t ->
+    Context.t ->
+    (Handle.t, Concepts.Condition.condition) result
+end
diff --git a/lib/protocols/Relation.ml b/lib/protocols/Relation.ml
index ece9b8e..c05337f 100644
--- a/lib/protocols/Relation.ml
+++ b/lib/protocols/Relation.ml
@@ -1,9 +1,15 @@
+module Error = struct
+  open Concepts.Condition
+
+  let not_a_relation () =
+    condition "not-a-relation" "A handle was expected to carry the relation protocol and did not"
+      empty
+end
+
 class type implementation = object
-  method heading : (Concepts.Hash.hash, Concepts.Condition.condition) result
   method predicate : (Concepts.Hash.hash option, Concepts.Condition.condition) result
   method local_constraints : (Concepts.Hash.hash option, Concepts.Condition.condition) result
-  method tuples : (Concepts.Hash.hash, Concepts.Condition.condition) result
-  method contains : Concepts.Blob.t -> (bool, Concepts.Condition.condition) result
+  method contains : Concepts.Tuple.t -> (bool, Concepts.Condition.condition) result
 end
 
 type Handle.protocol += Relation of implementation
@@ -11,8 +17,7 @@ type t = implementation
 
 let make impl = Relation (impl :> implementation)
 let from handle = Handle.into handle (function Relation impl -> Some impl | _ -> None)
-let heading i = Handle.invoke i (fun o -> o#heading)
+let require handle = from handle |> Option.to_result ~none:(Error.not_a_relation ())
 let predicate i = Handle.invoke i (fun o -> o#predicate)
 let local_constraints i = Handle.invoke i (fun o -> o#local_constraints)
-let tuples i = Handle.invoke i (fun o -> o#tuples)
 let contains i tuple = Handle.invoke i (fun o -> o#contains tuple)
diff --git a/lib/protocols/Relation.mli b/lib/protocols/Relation.mli
index 4aeb562..384877e 100644
--- a/lib/protocols/Relation.mli
+++ b/lib/protocols/Relation.mli
@@ -1,16 +1,14 @@
 type t
 
 class type implementation = object
-  method heading : (Concepts.Hash.hash, Concepts.Condition.condition) result
   method predicate : (Concepts.Hash.hash option, Concepts.Condition.condition) result
   method local_constraints : (Concepts.Hash.hash option, Concepts.Condition.condition) result
-  method tuples : (Concepts.Hash.hash, Concepts.Condition.condition) result
-  method contains : Concepts.Blob.t -> (bool, Concepts.Condition.condition) result
+  method contains : Concepts.Tuple.t -> (bool, Concepts.Condition.condition) result
 end
 
 val make : #implementation -> Handle.protocol
 val from : Handle.t -> t Handle.interface option
-val heading : t Handle.interface -> (Concepts.Hash.hash, Concepts.Condition.condition) result
+val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result
 
 val predicate :
   t Handle.interface -> (Concepts.Hash.hash option, Concepts.Condition.condition) result
@@ -18,5 +16,5 @@ val predicate :
 val local_constraints :
   t Handle.interface -> (Concepts.Hash.hash option, Concepts.Condition.condition) result
 
-val tuples : t Handle.interface -> (Concepts.Hash.hash, Concepts.Condition.condition) result
-val contains : t Handle.interface -> Concepts.Blob.t -> (bool, Concepts.Condition.condition) result
+val contains :
+  t Handle.interface -> Concepts.Tuple.t -> (bool, Concepts.Condition.condition) result
diff --git a/lib/protocols/Schematics.ml b/lib/protocols/Schematics.ml
new file mode 100644
index 0000000..d2e50ad
--- /dev/null
+++ b/lib/protocols/Schematics.ml
@@ -0,0 +1,24 @@
+type multigroup_description = string BatMap.String.t
+type relation_description = string BatMap.String.t
+type tuple_description = {relation: relation_description; attributes: string BatMap.String.t}
+
+(* TODO: For now the description is completely detached from actual
+   types and domains. Later figure out a way to represent the links
+   without strings. *)
+type description =
+  | Multigroup of multigroup_description
+  | Relation of relation_description
+  | Tuple of tuple_description
+
+class type implementation = object
+  method describe : unit -> (description, Concepts.Condition.condition) result
+end
+
+type Handle.protocol += Schematics of implementation
+
+type t = implementation
+
+let make impl = Schematics (impl :> implementation)
+let from handle =
+  Handle.into handle (function Schematics impl -> Some impl | _ -> None)
+let describe impl = Handle.invoke impl (fun o -> o#describe ())
diff --git a/lib/protocols/Schematics.mli b/lib/protocols/Schematics.mli
new file mode 100644
index 0000000..dc8f320
--- /dev/null
+++ b/lib/protocols/Schematics.mli
@@ -0,0 +1,21 @@
+type t
+
+(* TODO: For now the description is completely detached from actual
+   types and domains. Later figure out a way to represent the links
+   without strings. *)
+type multigroup_description = string BatMap.String.t
+type relation_description = string BatMap.String.t
+type tuple_description = {relation: relation_description; attributes: string BatMap.String.t}
+
+type description =
+  | Multigroup of multigroup_description
+  | Relation of relation_description
+  | Tuple of tuple_description
+
+class type implementation = object
+  method describe : unit -> (description, Concepts.Condition.condition) result
+end
+
+val make : #implementation -> Handle.protocol
+val from : Handle.t -> t Handle.interface option
+val describe : t Handle.interface -> (description, Concepts.Condition.condition) result
diff --git a/lib/runtime/Context.ml b/lib/runtime/Context.ml
new file mode 100644
index 0000000..000f5d6
--- /dev/null
+++ b/lib/runtime/Context.ml
@@ -0,0 +1,30 @@
+module Error = struct
+  open Concepts.Condition
+
+  let not_a_directory segment =
+    condition "not-a-directory" "A path segment named an object with no Directory protocol"
+      ("segment" |=| Concepts.Value.String segment)
+end
+
+let resolve { Protocols.Context.root; _ } name =
+  let open Utilities.Result in
+  let rec walk handle = function
+    | [] -> Ok (Protocols.Handle.copy handle)
+    | segment :: rest ->
+       let* directory =
+         Protocols.Directory.from handle
+         |> Option.to_result ~none:(Error.not_a_directory segment)
+       in
+       let* found = Protocols.Directory.find directory segment in
+       match found with
+       | None -> Ok None
+       | Some child ->
+          Fun.protect ~finally:(fun () -> Protocols.Handle.release child)
+            (fun () -> walk child rest)
+  in
+  String.split_on_char '/' name |> List.filter (fun segment -> segment <> "") |> walk root
+
+let over ~snapshot ~root ?(cancelled = fun () -> false) () =
+  { Protocols.Context.snapshot
+  ; root
+  ; status = (fun () -> if cancelled () then `Cancelled else `Live) }
diff --git a/lib/runtime/Context.mli b/lib/runtime/Context.mli
new file mode 100644
index 0000000..6e7ab2f
--- /dev/null
+++ b/lib/runtime/Context.mli
@@ -0,0 +1,11 @@
+val resolve :
+  Protocols.Context.t ->
+  string ->
+  (Protocols.Handle.t option, Concepts.Condition.condition) result
+
+val over :
+  snapshot:Concepts.Hash.hash ->
+  root:Protocols.Handle.t ->
+  ?cancelled:(unit -> bool) ->
+  unit ->
+  Protocols.Context.t