tests and some pointer for program on ephemeral

1 files changed, 142 insertions, 96 deletions

diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml
index a0789aa..3254258 100644
--- a/test/unit/evaluators/FOL.ml
+++ b/test/unit/evaluators/FOL.ml
@@ -9,22 +9,25 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       attributes= BatMap.String.empty |> BatMap.String.add "name" (Concepts.Value.String "Alaric")
     }
 
-  let not_a_directory () =
-    Concepts.Condition.condition "not-a-directory"
-      "A handle was expected to carry the directory protocol and did not" Concepts.Condition.empty
-
-  let missing name =
-    Concepts.Condition.condition "missing" "A name was expected in the directory and was absent"
-      Concepts.Condition.("name" |=| Concepts.Value.String name)
-
   let employee name age =
     { Concepts.Tuple.type_= "employee";
       attributes=
         BatMap.String.of_list ["name", Concepts.Value.String name; "age", Concepts.Value.Integer age]
     }
 
-  (* a plan comes resolved, so it reads nothing through [within] *)
-  let nowhere = Kernel.Prototype.mixture []
+  let named name =
+    { Concepts.Tuple.type_= "employee";
+      attributes= BatMap.String.singleton "name" (Concepts.Value.String name) }
+
+  let employees = Rnt.Evaluators.FOL.Base Kernel.Path.("employee" @/ this)
+  let names = Rnt.Evaluators.FOL.Project (employees, BatFingerTree.singleton "name")
+  let heading = BatMap.String.singleton "name" {Protocols.Schematics.domain= "string"; provenance= []}
+  let directory entries = Kernel.Prototype.(mixture [Directory.of_properties entries])
+
+  let eval within term =
+    let open Utilities.Result in
+    let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
+    Protocols.Evaluator.eval evaluator (Rnt.Evaluators.FOL.Fol term) [] ~within
 
   let drain result =
     let open Utilities.Result in
@@ -36,26 +39,16 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     Protocols.Handle.release result;
     Ok (BatFingerTree.to_list tuples)
 
+  let bindings tuples =
+    List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes) tuples
+    |> List.sort compare
+
   let scan_a_base_relation conn =
     let scanned =
       begin
         let open Utilities.Result in
         let* employee = H.relation conn ["name"] [alaric] in
-        let root =
-          Kernel.Prototype.mixture
-            [ Kernel.Prototype.Directory.of_properties
-                ["employee", employee; "fol", Rnt.Evaluators.FOL.make ()] ]
-        in
-        let* directory =
-          Protocols.Directory.from root |> Option.to_result ~none:(not_a_directory ())
-        in
-        let* found = Protocols.Directory.find directory "fol" in
-        let* evaluator = Option.to_result ~none:(missing "fol") found in
-        let* evaluator = Protocols.Evaluator.require evaluator in
-        let* result =
-          Rnt.Evaluators.FOL.(program (Base employee))
-          |> Protocols.Evaluator.invoke evaluator ~within:nowhere
-        in
+        let* result = eval (directory ["employee", employee]) employees in
         drain result
       end
       |> Helpers.condition_as_failure
@@ -71,15 +64,11 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     let projected =
       begin
         let open Utilities.Result in
-        let* employees =
+        let* relation =
           H.relation conn ["name"; "age"]
             [employee "Alaric" 42; employee "Alaric" 30; employee "Brunhild" 42]
         in
-        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
-        let* result =
-          Rnt.Evaluators.FOL.(program (Project (Base employees, BatFingerTree.singleton "name")))
-          |> Protocols.Evaluator.invoke evaluator ~within:nowhere
-        in
+        let* result = eval (directory ["employee", relation]) names in
         drain result
       end
       |> Helpers.condition_as_failure
@@ -88,25 +77,15 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       (list (list (pair string Helpers.value)))
       "each name once, and nothing else"
       [["name", Concepts.Value.String "Alaric"]; ["name", Concepts.Value.String "Brunhild"]]
-      ( projected
-      |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes)
-      |> List.sort compare )
+      (bindings projected)
 
   let instantiate_a_program conn =
     let projected =
       begin
         let open Utilities.Result in
-        let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
-        let root = Kernel.Prototype.(mixture [Directory.of_properties ["employee", employees]]) in
-        let* plan =
-          Rnt.Evaluators.FOL.(
-            instantiate (Kernel.Path.lookup root)
-              (Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name")) )
-        in
-        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
-        let* result =
-          Rnt.Evaluators.FOL.program plan |> Protocols.Evaluator.invoke evaluator ~within:nowhere
-        in
+        let* relation = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
+        let* plan = Rnt.Evaluators.FOL.instantiate (directory ["employee", relation]) names in
+        let* result = Rnt.Evaluators.FOL.execute plan in
         drain result
       end
       |> Helpers.condition_as_failure
@@ -115,14 +94,11 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       (list (list (pair string Helpers.value)))
       "the program ran over the relation its path resolved to"
       [["name", Concepts.Value.String "Alaric"]]
-      (projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
+      (bindings projected)
 
   module E = Kernel.EphemeralRelation.Make (S)
 
-  let store conn term =
-    E.persist conn ~name:"view" ~evaluator:Rnt.Evaluators.FOL.name
-      ~code:(Rnt.Evaluators.FOL.encode term)
-      (BatMap.String.singleton "name" {Protocols.Schematics.domain= "string"; provenance= []})
+  let store conn term = E.persist conn ~name:"stored" (Rnt.Evaluators.FOL.program term) heading
 
   let namespace entries =
     let open Utilities.Result in
@@ -141,21 +117,13 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     let projected =
       begin
         let open Utilities.Result in
-        let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
-        let* view =
-          store conn
-            Rnt.Evaluators.FOL.(
-              Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name") )
-        in
-        let* root = namespace ["employee", employees; "view", view] in
+        let* relation = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
+        let* stored = store conn names in
+        let* root = namespace ["employee", relation; "stored", stored] in
         let* plan =
-          Rnt.Evaluators.FOL.(
-            instantiate (Kernel.Path.lookup root) (Base Kernel.Path.("view" @/ this)) )
-        in
-        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
-        let* result =
-          Rnt.Evaluators.FOL.program plan |> Protocols.Evaluator.invoke evaluator ~within:nowhere
+          Rnt.Evaluators.FOL.(instantiate root (Base Kernel.Path.("stored" @/ this)))
         in
+        let* result = Rnt.Evaluators.FOL.execute plan in
         drain result
       end
       |> Helpers.condition_as_failure
@@ -164,39 +132,36 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       (list (list (pair string Helpers.value)))
       "the stored program ran in place of its name"
       [["name", Concepts.Value.String "Alaric"]]
-      (projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
+      (bindings projected)
 
-  let run_a_stored_program_within conn =
+  let run_a_program_within_a_state conn =
     let projected =
       begin
         let open Utilities.Result in
-        let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
-        let* view =
-          store conn
-            Rnt.Evaluators.FOL.(
-              Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name") )
-        in
-        let* root = namespace ["employee", employees] in
-        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
-        let* result = Protocols.Evaluator.invoke evaluator view ~within:root in
-        drain result
+        let* relation = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
+        let* evaluators = namespace ["fol", Rnt.Evaluators.FOL.make ()] in
+        let* system = namespace ["evaluator", evaluators] in
+        let* root = namespace ["system", system] in
+        let* within = namespace ["employee", relation] in
+        Kernel.EphemeralRelation.of_program ~within heading (Rnt.Evaluators.FOL.program ~root names)
+        |> drain
       end
       |> Helpers.condition_as_failure
     in
     check
       (list (list (pair string Helpers.value)))
-      "the stored source read its relations where it was told to"
+      "the program found its evaluator under the root and read the state it was given"
       [["name", Concepts.Value.String "Alaric"]]
-      (projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
+      (bindings projected)
 
   let refuse_a_program_that_reads_itself conn =
     let expanded =
       begin
         let open Utilities.Result in
-        let* view = store conn Rnt.Evaluators.FOL.(Base Kernel.Path.("view" @/ this)) in
-        let* root = namespace ["view", view] in
-        Rnt.Evaluators.FOL.(
-          instantiate (Kernel.Path.lookup root) (Base Kernel.Path.("view" @/ this)) )
+        let stored_path = Kernel.Path.("stored" @/ this) in
+        let* stored = store conn (Rnt.Evaluators.FOL.Base stored_path) in
+        let* root = namespace ["stored", stored] in
+        Rnt.Evaluators.FOL.(instantiate root (Base stored_path))
       end
     in
     check bool "the expansion stopped at the cycle" true
@@ -205,8 +170,42 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
           BatString.starts_with (Concepts.Condition.to_string_hum condition) "cyclic-program"
       | Ok _ -> false )
 
-  let pull_one_tuple_at_a_time () =
-    let produced = ref 0 and closed = ref false in
+  let shape modes =
+    List.map
+      (fun {Concepts.Mode.bound; yields} ->
+        BatSet.String.elements bound, Concepts.Cardinality.to_string yields )
+      modes
+
+  let a_projection_keeps_the_modes_it_can_bind conn =
+    let ask term f =
+      begin
+        let open Utilities.Result in
+        let* relation =
+          H.relation conn ["name"; "age"] [employee "Alaric" 42; employee "Brunhild" 30]
+        in
+        let* result = eval (directory ["employee", relation]) term in
+        Protocols.Handle.releasing result (fun () ->
+            Result.bind (Protocols.Relation.require result) f )
+      end
+      |> Helpers.condition_as_failure
+    in
+    let modes term = shape (ask term Protocols.Relation.modes) in
+    let holds term tuple = ask term (fun r -> Protocols.Relation.contains r tuple) in
+    check
+      (list (pair (list string) string))
+      "a base relation keeps the lookup by hash"
+      [[], "finite"; ["age"; "name"], "bounded(1)"]
+      (modes employees);
+    check
+      (list (pair (list string) string))
+      "its projection keeps only what a projected tuple can bind"
+      [[], "finite"]
+      (modes names);
+    check bool "the base decides by its own test" true (holds employees (employee "Alaric" 42));
+    check bool "the projection decides by reading" true (holds names (named "Alaric"));
+    check bool "and refuses a stranger" false (holds names (named "Gunther"))
+
+  let counter ?(produced = ref 0) ?(closed = ref false) () =
     let description =
       BatMap.String.singleton "value" {Protocols.Schematics.domain= "integer"; provenance= []}
     in
@@ -217,19 +216,19 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
           attributes= BatMap.String.singleton "value" (Concepts.Value.Integer n) };
       count ~yield (n + 1)
     in
-    let source =
-      Kernel.EphemeralRelation.instantiate description
-        {Kernel.EphemeralRelation.name= None; schematics= `Temporary description; program= None}
-        (fun () -> Ok (Kernel.Generator.cursor_of ~finally:(fun () -> closed := true) (count 0)))
-    in
+    Kernel.EphemeralRelation.instantiate description
+      ~modes:(fun () -> Ok [Concepts.(Mode.mode [] Cardinality.Countable)])
+      {Kernel.EphemeralRelation.name= None; schematics= `Temporary description; pointer= None}
+      (fun () -> Ok (Kernel.Generator.cursor_of ~finally:(fun () -> closed := true) (count 0)))
+
+  let values source = Rnt.Evaluators.FOL.(execute (Project (Base source, BatFingerTree.singleton "value")))
+
+  let pull_one_tuple_at_a_time () =
+    let produced = ref 0 and closed = ref false in
     let first =
       begin
         let open Utilities.Result in
-        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
-        let* result =
-          Rnt.Evaluators.FOL.(program (Project (Base source, BatFingerTree.singleton "value")))
-          |> Protocols.Evaluator.invoke evaluator ~within:nowhere
-        in
+        let* result = values (counter ~produced ~closed ()) in
         let* enumerable = Protocols.Enumerable.require result in
         let* cursor = Protocols.Enumerable.enumerate enumerable in
         let* scan = Protocols.Cursor.require cursor in
@@ -242,6 +241,48 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     check int "the source produced only that tuple" 1 !produced;
     check bool "and was closed with its consumer" true !closed
 
+  let an_endless_projection_cannot_decide () =
+    let asked =
+      begin
+        let open Utilities.Result in
+        let* result = values (counter ()) in
+        let* relation = Protocols.Relation.require result in
+        Protocols.Relation.contains relation
+          { Concepts.Tuple.type_= "counter";
+            attributes= BatMap.String.singleton "value" (Concepts.Value.Integer 7) }
+      end
+    in
+    check bool "it fails as undecidable instead of reading without end" true
+      ( match asked with
+      | Error condition ->
+          BatString.starts_with (Concepts.Condition.to_string_hum condition)
+            "undecidable-membership"
+      | Ok _ -> false )
+
+  let a_result_owns_the_relations_of_its_plan () =
+    let released = ref false in
+    let tracker =
+      Protocols.Handle.make
+        object
+          method reference = true
+          method release = released := true
+          method is_managed = false
+          method hash = Concepts.Hash.hash_of_int 0
+          method to_string = "tracker"
+          method protocols : Protocols.Handle.protocol list = []
+        end
+    in
+    let relation =
+      Kernel.EphemeralRelation.instantiate ~inputs:[tracker] heading
+        ~modes:(fun () -> Ok [])
+        {Kernel.EphemeralRelation.name= None; schematics= `Temporary heading; pointer= None}
+        (fun () -> Ok (Kernel.Generator.cursor_of (fun ~yield:_ -> Ok ())))
+    in
+    let result = Rnt.Evaluators.FOL.(execute (Base relation)) |> Helpers.condition_as_failure in
+    check bool "the relation in the plan lives as long as the result" false !released;
+    Protocols.Handle.release result;
+    check bool "and is released with it" true !released
+
   let suite =
     ( "evaluators/fol",
       [ test_case "scan-a-base-relation" `Quick (H.with_connection scan_a_base_relation "fol-test");
@@ -251,11 +292,16 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
           (H.with_connection instantiate_a_program "fol-test");
         test_case "expand-a-stored-program" `Quick
           (H.with_connection expand_a_stored_program "fol-test");
-        test_case "run-a-stored-program-within" `Quick
-          (H.with_connection run_a_stored_program_within "fol-test");
+        test_case "run-a-program-within-a-state" `Quick
+          (H.with_connection run_a_program_within_a_state "fol-test");
         test_case "refuse-a-program-that-reads-itself" `Quick
           (H.with_connection refuse_a_program_that_reads_itself "fol-test");
-        test_case "pull-one-tuple-at-a-time" `Quick pull_one_tuple_at_a_time ] )
+        test_case "a-projection-keeps-the-modes-it-can-bind" `Quick
+          (H.with_connection a_projection_keeps_the_modes_it_can_bind "fol-test");
+        test_case "pull-one-tuple-at-a-time" `Quick pull_one_tuple_at_a_time;
+        test_case "an-endless-projection-cannot-decide" `Quick an_endless_projection_cannot_decide;
+        test_case "a-result-owns-the-relations-of-its-plan" `Quick
+          a_result_owns_the_relations_of_its_plan ] )
 end
 
 module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)