ephemeral relations as outputs of FOL and program overhaul

1 files changed, 105 insertions, 13 deletions

diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
index 4299524..016e3a0 100644
--- a/lib/evaluators/FOL.ml
+++ b/lib/evaluators/FOL.ml
@@ -7,32 +7,124 @@ module Error = struct
 
   let cancelled () =
     condition "evaluation-cancelled" "An evaluation was stopped before it produced its result" empty
+
+  let not_a_plan name =
+    condition "not-a-fol-program" "The evaluator was given an object that carries no FOL plan"
+      ("object" |=| Concepts.Value.String name)
+
+  let not_a_relation name =
+    condition "not-a-relation" "A plan named an object that does not describe itself as a relation"
+      ("object" |=| Concepts.Value.String name)
+
+  let unknown_attribute name =
+    condition "unknown-attribute" "A plan projected an attribute its relation does not have"
+      ("attribute" |=| Concepts.Value.String name)
+
+  let released_relation name =
+    condition "released-relation" "A plan named a relation that was already released"
+      ("object" |=| Concepts.Value.String name)
 end
 
 type plan = Base of Protocols.Handle.t | Project of plan * string BatFingerTree.t
+type Protocols.Handle.protocol += Plan of plan
+
+class program plan =
+  object
+    inherit Kernel.Lifecycle.null
+    inherit Kernel.Identity.of_id
+    method to_string = "fol-program"
+    method protocols : Protocols.Handle.protocol list = [Plan plan]
+  end
 
-module Program = Protocols.Program.Make (struct
-  type t = plan
-end)
+let program plan = new program plan |> Protocols.Handle.make
+
+let restrict attributes description =
+  let open Utilities.Result in
+  BatFingerTree.fold_left
+    (fun restricted name ->
+      let* restricted = restricted in
+      let* attribute =
+        BatMap.String.find_opt name description
+        |> Option.to_result ~none:(Error.unknown_attribute name)
+      in
+      Ok (BatMap.String.add name attribute restricted) )
+    (Ok BatMap.String.empty) attributes
 
-let execute =
+let rec describe =
   let open Utilities.Result in
   function
-  | Base relation_handle ->
-      Fun.protect
-        ~finally:(fun () -> Protocols.Handle.release relation_handle)
-        (fun () ->
-          let* enumerable = Protocols.Enumerable.require relation_handle in
-          Protocols.Enumerable.enumerate enumerable )
-  | Project (_plan, _attributes) -> failwith "TODO"
+  | Base relation -> (
+      let* schematics = Protocols.Handle.require Protocols.Schematics.from relation in
+      let* description = Protocols.Schematics.describe schematics in
+      match description with
+      | Protocols.Schematics.Relation description -> Ok description
+      | _ -> Error (Error.not_a_relation (Protocols.Handle.to_string relation)) )
+  | Project (plan, attributes) -> describe plan |> fmap (restrict attributes)
+
+let enumerate relation =
+  let open Utilities.Result in
+  let* enumerable = Protocols.Enumerable.require relation in
+  Protocols.Enumerable.enumerate enumerable
+
+let project description relation =
+  let open Utilities.Result in
+  let* cursor = enumerate relation in
+  let produce ~yield =
+    let* scan = Protocols.Cursor.require cursor in
+    let rec distinct seen =
+      let* next = Protocols.Cursor.next scan in
+      match next with
+      | None -> Ok ()
+      | Some tuple ->
+          let tuple =
+            { tuple with
+              attributes=
+                BatMap.String.filter
+                  (fun name _ -> BatMap.String.mem name description)
+                  tuple.Concepts.Tuple.attributes }
+          in
+          let key = Concepts.Tuple.hash tuple |> Concepts.Hash.to_raw_string in
+          if BatSet.String.mem key seen then distinct seen
+          else begin
+            yield tuple;
+            distinct (BatSet.String.add key seen)
+          end
+    in
+    distinct BatSet.String.empty
+  in
+  Ok (Kernel.Generator.cursor_of ~finally:(fun () -> Protocols.Handle.release cursor) produce)
+
+let derive relation description enumerate =
+  Kernel.EphemeralRelation.instantiate ~inputs:[relation] description
+    {Kernel.EphemeralRelation.schematics= `Temporary description}
+    (fun () -> enumerate relation)
+
+let rec execute plan =
+  let open Utilities.Result in
+  let* description = describe plan in
+  match plan with
+  | Base relation ->
+      let* relation =
+        Protocols.Handle.copy relation
+        |> Option.to_result ~none:(Error.released_relation (Protocols.Handle.to_string relation))
+      in
+      Ok (derive relation description enumerate)
+  | Project (plan, _) ->
+      let* relation = execute plan in
+      Ok (derive relation description (project description))
 
 class evaluator =
   object (self)
     inherit Kernel.Lifecycle.null
     inherit Kernel.Identity.of_id
     method to_string = "fol-evaluator"
-    method invoke = execute
-    method protocols : Protocols.Handle.protocol list = [Program.make self]
+
+    method invoke program =
+      Protocols.Handle.into program (function Plan plan -> Some plan | _ -> None)
+      |> Option.to_result ~none:(Error.not_a_plan (Protocols.Handle.to_string program))
+      |> Utilities.Result.fmap (fun plan -> Protocols.Handle.invoke plan execute)
+
+    method protocols : Protocols.Handle.protocol list = [Protocols.Evaluator.make self]
   end
 
 let make () = new evaluator |> Protocols.Handle.make