merge lifecycle-ergonomics and rework modes and contain checks

1 files changed, 48 insertions, 26 deletions

diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml
index 8cae91f..c0ec241 100644
--- a/lib/kernel/EphemeralRelation.ml
+++ b/lib/kernel/EphemeralRelation.ml
@@ -18,8 +18,12 @@ module Error = struct
 
   let unbound_program name =
     condition "unbound-program"
-      "A stored relation has to be instantiated by its evaluator before it can be enumerated"
+      "A relation generated by a program has to be given a state to run within before it is read"
       ("relation" |=| Concepts.Value.String name)
+
+  let undecidable_membership () =
+    condition "undecidable-membership"
+      "A relation with no membership test and no end was asked whether it holds a tuple" empty
 end
 
 module Persisted = struct
@@ -59,7 +63,7 @@ let persisted = function
       Some {Persisted.name; schematics; program}
   | _ -> None
 
-class ephemeral_relation ?program description value enumerate inputs =
+class ephemeral_relation ?program ?decide description value modes enumerate inputs =
   object (self)
     inherit Lifecycle.counted
     inherit Identity.of_id
@@ -67,19 +71,24 @@ class ephemeral_relation ?program description value enumerate inputs =
     val relation : t = value
     method destroy = List.iter Protocols.Handle.release inputs
     method enumerate : (Protocols.Handle.t, Concepts.Condition.condition) result = enumerate ()
+    method modes : (Concepts.Mode.t, Concepts.Condition.condition) result = modes ()
     method describe () = Ok (Protocols.Schematics.Relation description)
 
-    (* TODO: We do not need to scan, but simply apply a membership
-       criteria (set of constraints. For now this works, but it's
-       inneficient and hurts data independence, as there is an
-       assymetry between ephemeral and substantial relations. *)
     method contains (tuple : Concepts.Tuple.t) =
       let open Utilities.Result in
-      let* cursor = self#enumerate in
-      Protocols.Handle.releasing cursor (fun () ->
-          let* scan = Protocols.Cursor.require cursor in
-          Protocols.Cursor.exists scan (fun member ->
-              Concepts.Hash.hash_equals (Concepts.Tuple.hash member) (Concepts.Tuple.hash tuple) ) )
+      match decide with
+      | Some decide -> decide tuple
+      | None ->
+          let* modes = self#modes in
+          if not (Concepts.Mode.exhaustible modes BatSet.String.empty) then
+            Error (Error.undecidable_membership ())
+          else
+            let* cursor = self#enumerate in
+            Protocols.Handle.releasing cursor (fun () ->
+                let* scan = Protocols.Cursor.require cursor in
+                Protocols.Cursor.exists scan (fun member ->
+                    Concepts.Hash.hash_equals (Concepts.Tuple.hash member)
+                      (Concepts.Tuple.hash tuple) ) )
 
     method protocols : Protocols.Handle.protocol list =
       let protocols =
@@ -96,11 +105,13 @@ class ephemeral_relation ?program description value enumerate inputs =
           :: protocols
   end
 
-let instantiate ?(inputs = []) ?program description value enumerate =
-  new ephemeral_relation ?program description value enumerate inputs |> Protocols.Handle.make
+let instantiate ?(inputs = []) ?program ?decide ~modes description value enumerate =
+  new ephemeral_relation ?program ?decide description value modes enumerate inputs
+  |> Protocols.Handle.make
 
 let literal description tuples =
   instantiate description
+    ~modes:(fun () -> Ok [Concepts.(Mode.mode [] (Cardinality.bounded (List.length tuples)))])
     {name= None; schematics= `Temporary description; program= None}
     (fun () -> Ok (Generator.cursor_of (fun ~yield -> List.iter yield tuples; Ok ())))
 
@@ -113,6 +124,7 @@ let enumerate_owned relation =
     object
       method reference = true
       method release = Protocols.Handle.release relation
+      method is_managed = true
     end
   in
   match
@@ -128,18 +140,29 @@ let enumerate_owned relation =
              method to_string = Protocols.Handle.to_string cursor
            end )
 
-let run name program within () =
-  let open Utilities.Result in
-  match program, within with
-  | Some program, Some within ->
-      let* executable = Protocols.Executable.require program in
-      Result.bind (Protocols.Executable.invoke executable [] ~within) enumerate_owned
-  | _ -> Error (Error.unbound_program name)
-
-let view ?within description program =
-  instantiate ~program description
+let asking f relation =
+  Protocols.Handle.releasing relation (fun () -> Result.bind (Protocols.Relation.require relation) f)
+
+(* What a program generates is known only from the relation it
+   returns, so reading it, asking its modes and asking for a tuple
+   all invoke it. *)
+let generated ?program ?within name description value =
+  let invoking f () =
+    let open Utilities.Result in
+    match program, within with
+    | Some program, Some within ->
+        let* executable = Protocols.Executable.require program in
+        Result.bind (Protocols.Executable.invoke executable [] ~within) f
+    | _ -> Error (Error.unbound_program name)
+  in
+  instantiate ?program
+    ~decide:(fun tuple -> invoking (asking (fun r -> Protocols.Relation.contains r tuple)) ())
+    ~modes:(invoking (asking Protocols.Relation.modes))
+    description value (invoking enumerate_owned)
+
+let of_program ?within description program =
+  generated ~program ?within (Protocols.Handle.to_string program) description
     {name= None; schematics= `Temporary description; program= None}
-    (run (Protocols.Handle.to_string program) (Some program) within)
 
 module Make (S : Abstract.Storage.STORAGE) = struct
   module SI = Storage.Make (S)
@@ -147,9 +170,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
 
   let restore ?program ?within ({Persisted.name; schematics; program= pointer} : Persisted.t)
       description =
-    instantiate ?program description
+    generated ?program ?within name description
       {name= Some name; schematics= `Persisted schematics; program= Some pointer}
-      (run name program within)
 
   let load ?bind connection (record : Persisted.t) =
     let open Utilities.Result in