1 files changed, 115 insertions, 43 deletions

diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml
index 1d9267e..c0ec241 100644
--- a/lib/kernel/EphemeralRelation.ml
+++ b/lib/kernel/EphemeralRelation.ml
@@ -7,8 +7,6 @@ type t =
       | `Temporary of Protocols.Schematics.attribute_description BatMap.String.t ];
     program: program option }
 
-type Protocols.Handle.protocol += Stored of {evaluator: string; code: Concepts.Blob.t}
-
 module Error = struct
   open Concepts.Condition
 
@@ -20,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
@@ -61,7 +63,7 @@ let persisted = function
       Some {Persisted.name; schematics; program}
   | _ -> None
 
-class ephemeral_relation ?code description value enumerate inputs =
+class ephemeral_relation ?program ?decide description value modes enumerate inputs =
   object (self)
     inherit Lifecycle.counted
     inherit Identity.of_id
@@ -69,64 +71,134 @@ class ephemeral_relation ?code 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
-      Fun.protect
-        ~finally:(fun () -> Protocols.Handle.release 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 = Protocols.[Relation.make self; Enumerable.make self; Schematics.make self] in
+      let protocols =
+        Protocols.[Relation.make self; Enumerable.make self; Schematics.make self]
+        @ Option.fold ~none:[] ~some:Protocols.Handle.protocols program
+      in
       match persisted relation with
       | None -> protocols
       | Some record ->
-          let stored =
-            Option.fold ~none:protocols
-              ~some:(fun code -> Stored {evaluator= record.program.evaluator; code} :: protocols)
-              code
-          in
           Protocols.Addressable.make
             object
               method address = Persisted.Representation.to_blob record |> Concepts.Hash.hash_of_blob
             end
-          :: stored
+          :: protocols
   end
 
-let instantiate ?(inputs = []) ?code description value enumerate =
-  new ephemeral_relation ?code 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 ())))
+
+type binding = {root: Protocols.Handle.t; within: Protocols.Handle.t}
+
+(* The relation a program produced has to outlive the cursor over it. *)
+let enumerate_owned relation =
+  let open Utilities.Result in
+  let owner =
+    object
+      method reference = true
+      method release = Protocols.Handle.release relation
+      method is_managed = true
+    end
+  in
+  match
+    let* enumerable = Protocols.Enumerable.require relation in
+    Protocols.Enumerable.enumerate enumerable
+  with
+  | Error c -> Protocols.Handle.release relation; Error c
+  | Ok cursor ->
+      Ok
+        (Protocols.Handle.make
+           object
+             inherit Lifecycle.retaining cursor owner
+             method to_string = Protocols.Handle.to_string cursor
+           end )
+
+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}
 
 module Make (S : Abstract.Storage.STORAGE) = struct
   module SI = Storage.Make (S)
   module R = SubstantialRelation.Make (S)
 
-  let restore ~code ({Persisted.name; schematics; program} : Persisted.t) description =
-    instantiate ~code description
-      {name= Some name; schematics= `Persisted schematics; program= Some program}
-      (fun () -> Error (Error.unbound_program name))
-
-  let load connection (record : Persisted.t) =
-    SI.with_read connection (fun tx ->
-        let open Utilities.Result in
-        let* description = R.schema_of tx record.schematics in
-        let* code = SI.get_req tx (S.Hash record.program.code) in
-        Ok (restore ~code record description) )
-
-  let persist connection ~name ~evaluator ~code description =
+  let restore ?program ?within ({Persisted.name; schematics; program= pointer} : Persisted.t)
+      description =
+    generated ?program ?within name description
+      {name= Some name; schematics= `Persisted schematics; program= Some pointer}
+
+  let load ?bind connection (record : Persisted.t) =
+    let open Utilities.Result in
+    let* description, source =
+      SI.with_read connection (fun tx ->
+          let* description = R.schema_of tx record.schematics in
+          let* code = SI.get_req tx (S.Hash record.program.code) in
+          Ok (description, Bytes.to_string (Concepts.Blob.bytes_of_blob code)) )
+    in
+    match bind with
+    | None -> Ok (restore record description)
+    | Some {root; within} ->
+        let* program = Program.load root ~evaluator:record.program.evaluator ~source in
+        Ok (restore ~program ~within record description)
+
+  let store tx ~name ~evaluator ~source description =
+    let open Utilities.Result in
+    let* schematics = R.store_schema tx description in
+    let* address = SI.store_blob tx (Concepts.Blob.blob_of_bytes (Bytes.of_string source)) in
+    let record = {Persisted.name; schematics; program= {evaluator; code= address}} in
+    let* _ = SI.store_blob tx (Persisted.Representation.to_blob record) in
+    Ok record
+
+  let persist connection ~name program description =
+    let open Utilities.Result in
+    let* {Program.evaluator; source; _} = Program.require program in
     SI.with_transaction connection (fun tx ->
-        let open Utilities.Result in
-        let* schematics = R.store_schema tx description in
-        let* address = SI.store_blob tx code in
-        let record = {Persisted.name; schematics; program= {evaluator; code= address}} in
-        let* _ = SI.store_blob tx (Persisted.Representation.to_blob record) in
-        Ok (restore ~code record description) )
+        let* record = store tx ~name ~evaluator ~source description in
+        Ok (restore ~program record description) )
 end