1 files changed, 35 insertions, 24 deletions

diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml
index 136c146..52ce83c 100644
--- a/lib/kernel/SubstantialRelation.ml
+++ b/lib/kernel/SubstantialRelation.ml
@@ -120,30 +120,34 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     kvs
     |> List.map (fun (name, domain) ->
            Concepts.Encoding.Bencode.as_string domain
-           |> Result.map (fun domain -> (name, domain)))
+           |> Result.map (fun domain ->
+                  (name, {Protocols.Schematics.domain; provenance= []}) ) )
     |> Utilities.List.sequence
-    |> Result.map (fun kvs ->
-           List.fold_left
-             (fun acc (name, domain) -> BatMap.String.add name domain acc)
-             BatMap.String.empty kvs)
+    |> Result.map BatMap.String.of_list
 
-  let enumerate storage relation =
+  let generate storage relation binding =
     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
+    let* tx = S.start_read storage in
+    let close () = ignore (S.abort tx) in
+    let* node = tuple_node tx relation |> Result.map_error (fun c -> close (); c) 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.iter tx (fun _ tuple -> yield tuple) node in
-      close ();
-      walked
+      TupleSet.iter tx
+        (fun _ tuple -> if Protocols.Generative.satisfies binding tuple then yield tuple)
+        node
     in
-    Ok (Generator.cursor_of ~on_release:close produce)
+    Ok (Generator.cursor_of ~finally:close produce)
+
+  let enumerate storage relation = generate storage relation Protocols.Generative.nothing
+
+  let modes_of description =
+    Concepts.Mode.of_list
+      [ Concepts.Mode.enumerable Concepts.Cardinality.Finite;
+        {Concepts.Mode.bound= Concepts.Mode.attributes_of_map description; affords= Decides} ]
 
-  class relation storage value =
+  class relation storage value description =
     object (self)
       inherit Lifecycle.null
 
@@ -151,18 +155,16 @@ module Make (S : Abstract.Storage.STORAGE) = struct
 
       val storage : S.connection = storage
       val relation : t = value
+      val declaration = modes_of description
       method predicate = Ok relation.predicate
       method local_constraints = Ok relation.local_constraints
 
       (* 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 tuple)
+        SI.with_read storage (fun tx -> contains_tuple tx relation 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)
+      method describe () = 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
@@ -171,30 +173,39 @@ module Make (S : Abstract.Storage.STORAGE) = struct
          no name resolution, but cancellation should eventually be checked between tuples. *)
       method enumerate = enumerate storage relation
 
+      method modes : (Concepts.Mode.t, Concepts.Condition.condition) result = Ok declaration
+      method generate binding = generate storage relation binding
+
       method protocols : Protocols.Handle.protocol list =
         [ Protocols.Relation.make self
         ; Protocols.Enumerable.make self
+        ; Protocols.Generative.make self
         ; Protocols.Schematics.make self ]
       method hash = hash relation
     end
 
+  (* A relation never changes its schema, so it is read once here and
+     the description and modes are served from it on every request. *)
+  let instantiate tx conn relation =
+    schema_of tx relation
+    |> Result.map (fun description -> new relation conn relation description |> Protocols.Handle.make)
+
   let make conn ~schematics ?predicate ?local_constraints ?indexes () =
     let open Utilities.Result in
     SI.with_transaction conn (fun tx ->
         let* relation = empty tx ~schematics ?predicate ?local_constraints ?indexes () in
         let* _ = store tx relation in
-        Ok (new relation conn relation |> Protocols.Handle.make) )
+        instantiate tx conn relation )
 
   let load_value tx addr =
     let open Utilities.Result in
     let* data = SI.get_req tx (S.Hash addr) in
     Representation.of_blob data
 
-  let wrap conn relation =
-    new relation conn relation |> Protocols.Handle.make |> Result.ok
+  let wrap conn relation = SI.with_read conn (fun tx -> instantiate tx conn relation)
 
   let load tx conn addr =
-    load_value tx addr |> Utilities.Result.fmap (wrap conn)
+    load_value tx addr |> Utilities.Result.fmap (instantiate tx conn)
 
   let assert_tuple tx relation tuple =
     let open Utilities.Result in