1 files changed, 48 insertions, 3 deletions

diff --git a/lib/protocols/Generative.ml b/lib/protocols/Generative.ml
index 065ffcb..bd89e21 100644
--- a/lib/protocols/Generative.ml
+++ b/lib/protocols/Generative.ml
@@ -7,6 +7,18 @@ module Error = struct
        declares no modes. A relation that cannot be asked this way can still be reached through \
        another access path."
       empty
+
+  let attributes bound = Concepts.Value.String (String.concat ", " (BatSet.String.elements bound))
+
+  let ungenerable bound =
+    condition "ungenerable-binding"
+      "The relation declares no mode that generates under the attributes bound."
+      ("bound" |=| attributes bound)
+
+  let undecidable bound =
+    condition "undecidable-membership"
+      "The relation declares no mode that decides membership under the attributes of the tuple."
+      ("bound" |=| attributes bound)
 end
 
 type binding = Concepts.Value.value BatMap.String.t
@@ -22,10 +34,17 @@ type t = implementation
 let make impl = Generative (impl :> implementation)
 let from handle = Handle.into handle (function Generative impl -> Some impl | _ -> None)
 let require handle = from handle |> Option.to_result ~none:(Error.not_generative ())
-let modes i = Handle.invoke i (fun o -> o#modes)
-let generate i binding = Handle.invoke i (fun o -> o#generate binding)
 let nothing = BatMap.String.empty
-let bound binding = BatMap.String.keys binding |> BatSet.String.of_enum
+let bound = Concepts.Mode.attributes_of_map
+let modes i = Handle.invoke i (fun o -> o#modes)
+
+let generate i binding =
+  Handle.invoke i (fun o ->
+      let open Utilities.Result in
+      let bound = bound binding in
+      let* declaration = o#modes in
+      if Option.is_some (Concepts.Mode.generation declaration bound) then o#generate binding
+      else Error (Error.ungenerable bound) )
 
 let satisfies binding tuple =
   BatMap.String.for_all
@@ -34,3 +53,29 @@ let satisfies binding tuple =
       | Some found -> Concepts.Value.equal found value
       | None -> false )
     binding
+
+class virtual membership =
+  object (self)
+    val virtual heading : Concepts.Mode.attributes
+    method virtual modes : (Concepts.Mode.t, Concepts.Condition.condition) result
+    method virtual generate : binding -> (Handle.t, Concepts.Condition.condition) result
+
+    method contains (tuple : Concepts.Tuple.t) =
+      let open Utilities.Result in
+      let binding = tuple.Concepts.Tuple.attributes in
+      let bound = bound binding in
+      if not (BatSet.String.equal heading bound) then Ok false
+      else
+        let* declaration = self#modes in
+        let* () =
+          if Concepts.Mode.decision declaration bound then Ok () else Error (Error.undecidable bound)
+        in
+        let* cursor = self#generate binding in
+        let expected = Concepts.Tuple.hash tuple in
+        Fun.protect
+          ~finally:(fun () -> Handle.release cursor)
+          (fun () ->
+            let* scan = Cursor.require cursor in
+            Cursor.exists scan (fun member ->
+                Concepts.Hash.hash_equals (Concepts.Tuple.hash member) expected ) )
+  end