1 files changed, 47 insertions, 44 deletions

diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
index e436eeb..9e204a9 100644
--- a/lib/evaluators/FOL.ml
+++ b/lib/evaluators/FOL.ml
@@ -8,9 +8,8 @@ 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_plan () =
+    condition "not-a-fol-program" "The evaluator was given a program of another kind" empty
 
   let not_a_relation name =
     condition "not-a-relation" "A plan named an object that does not describe itself as a relation"
@@ -28,10 +27,6 @@ module Error = struct
     condition "malformed-fol-program"
       "A stored FOL program did not conform to what was expected. Is your database corrupted?" empty
 
-  let foreign_program evaluator =
-    condition "foreign-program" "A plan named a relation stored by another evaluator"
-      ("evaluator" |=| Concepts.Value.String evaluator)
-
   let cyclic_program code =
     condition "cyclic-program" "A stored program reads itself"
       ("program" |=| Concepts.Value.String (Concepts.Hash.to_hum_string code))
@@ -41,7 +36,7 @@ let name = "fol"
 
 type 'r term = Base of 'r | Project of 'r term * string BatFingerTree.t
 type plan = Protocols.Handle.t term
-type Protocols.Handle.protocol += Plan of plan
+type Kernel.Program.kind += Fol of Kernel.Path.t term
 
 module Bencode = Concepts.Encoding.Bencode
 
@@ -71,52 +66,38 @@ let rec term_of_bencode =
       Ok (Project (term, BatFingerTree.of_list attributes))
   | _ -> Error (Error.malformed_program ())
 
-let encode term = bencode_of_term term |> Bencode.to_blob
-let decode code = Bencode.of_blob code |> Utilities.Result.fmap term_of_bencode
-
-let stored relation =
-  Protocols.Handle.into relation (function
-    | Kernel.EphemeralRelation.Stored {evaluator; code} -> Some (evaluator, code)
-    | _ -> None )
-  |> Option.map (fun stored -> Protocols.Handle.invoke stored Fun.id)
+let encode term = bencode_of_term term |> Bencode.to_bytes |> Bytes.to_string
+let decode source = Bencode.of_bytes (Bytes.of_string source) |> Utilities.Result.fmap term_of_bencode
 
 (* TODO: To strenghten our checks for self references, we need to
    construct a graph and see raise a condition if there are self
    references. We partially do that here with the program calling
    self, but if the flow is alternated, say between program A and B,
    where B calls A and A calls B, we also must check. *)
-let instantiate resolve =
+let instantiate within =
   let open Utilities.Result in
   let rec bind expanding = function
     | Base reference -> (
-        let* relation = resolve reference in
-        match stored relation with
+        let* relation = Kernel.Path.lookup within reference in
+        match Kernel.Program.image relation with
         | None -> Ok (Base relation)
-        | Some (evaluator, code) ->
+        | Some {kind= Fol term; source; _} ->
             Protocols.Handle.release relation;
-            let identity = Concepts.Hash.hash_of_blob code in
-            if not (String.equal evaluator name) then Error (Error.foreign_program evaluator)
-            else if List.exists (Concepts.Hash.hash_equals identity) expanding then
+            let identity = Concepts.Hash.hash_of_bytes (Bytes.of_string source) in
+            if List.exists (Concepts.Hash.hash_equals identity) expanding then
               Error (Error.cyclic_program identity)
-            else
-              let* term = decode code in
-              bind (identity :: expanding) term )
+            else bind (identity :: expanding) term
+        | Some _ ->
+            Protocols.Handle.releasing relation (fun () ->
+                let* program = Protocols.Executable.require relation in
+                let* result = Protocols.Executable.invoke program [] ~within in
+                Ok (Base result) ) )
     | Project (term, attributes) ->
         let* plan = bind expanding term in
         Ok (Project (plan, attributes))
   in
   bind []
 
-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
-
-let program plan = new program plan |> Protocols.Handle.make
-
 let restrict attributes description =
   let open Utilities.Result in
   BatFingerTree.fold_left
@@ -140,6 +121,17 @@ let rec describe =
       | _ -> Error (Error.not_a_relation (Protocols.Handle.to_string relation)) )
   | Project (plan, attributes) -> describe plan |> fmap (restrict attributes)
 
+let rec modes =
+  let open Utilities.Result in
+  function
+  | Base relation ->
+      let* relation = Protocols.Relation.require relation in
+      Protocols.Relation.modes relation
+  | Project (plan, attributes) ->
+      modes plan
+      |> Result.map
+           (Concepts.Mode.project (BatSet.String.of_list (BatFingerTree.to_list attributes)))
+
 let enumerate relation =
   let open Utilities.Result in
   let* enumerable = Protocols.Enumerable.require relation in
@@ -173,37 +165,48 @@ let project description relation =
   in
   Ok (Kernel.Generator.cursor_of ~finally:(fun () -> Protocols.Handle.release cursor) produce)
 
-let derive relation description enumerate =
-  Kernel.EphemeralRelation.instantiate ~inputs:[relation] description
+let contains relation tuple =
+  Result.bind (Protocols.Relation.require relation) (fun r -> Protocols.Relation.contains r tuple)
+
+let derive ?decide relation description modes enumerate =
+  Kernel.EphemeralRelation.instantiate ~inputs:[relation] ?decide
+    ~modes:(fun () -> Ok modes)
+    description
     {Kernel.EphemeralRelation.name= None; schematics= `Temporary description; program= None}
     (fun () -> enumerate relation)
 
 let rec execute plan =
   let open Utilities.Result in
   let* description = describe plan in
+  let* modes = modes 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)
+      Ok (derive ~decide:(contains relation) relation description modes enumerate)
   | Project (plan, _) ->
       let* relation = execute plan in
-      Ok (derive relation description (project description))
+      Ok (derive relation description modes (project description))
 
 class evaluator =
   object (self)
     inherit Kernel.Lifecycle.null
     inherit Kernel.Identity.of_id
     method to_string = "fol-evaluator"
+    method parse source = decode source |> Result.map (fun term -> Fol term)
 
-    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 eval kind _inputs ~within =
+      let open Utilities.Result in
+      match kind with
+      | Fol term ->
+          let* plan = instantiate within term in
+          execute plan
+      | _ -> Error (Error.not_a_plan ())
 
     method protocols : Protocols.Handle.protocol list = [Protocols.Evaluator.make self]
   end
 
 let make () = new evaluator |> Protocols.Handle.make
+let program ?root term = Kernel.Program.make ?root ~evaluator:name ~source:(encode term) (Fol term)