where modes drop only the attribute its index reads

4 files changed, 72 insertions, 50 deletions

diff --git a/lib/concepts/Mode.ml b/lib/concepts/Mode.ml
index b3031fc..9c5daa9 100644
--- a/lib/concepts/Mode.ml
+++ b/lib/concepts/Mode.ml
@@ -17,5 +17,5 @@ let exhaustible modes bound =
 
 let project attributes = List.filter (fun {bound; _} -> BatSet.String.subset bound attributes)
 
-let given attributes =
-  List.map (fun {bound; yields} -> {bound= BatSet.String.diff bound attributes; yields})
+let given attribute =
+  List.map (fun {bound; yields} -> {bound= BatSet.String.remove attribute bound; yields})
diff --git a/lib/concepts/Mode.mli b/lib/concepts/Mode.mli
index ba1a04a..0518bca 100644
--- a/lib/concepts/Mode.mli
+++ b/lib/concepts/Mode.mli
@@ -13,4 +13,4 @@ val exhaustible : t -> attributes -> bool
 (** the modes still usable when only [attributes] can be bound. *)
 val project : attributes -> t -> t
 
-val given : attributes -> t -> t
+val given : string -> t -> t
diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
index 1064c74..60cc89f 100644
--- a/lib/evaluators/FOL.ml
+++ b/lib/evaluators/FOL.ml
@@ -171,8 +171,10 @@ let rec modes =
   | Where (plan, binding) -> (
       let* modes = modes plan in
       match plan with
-      | Base relation when Option.is_some (index_for relation binding) ->
-          Ok (Concepts.Mode.given (bound binding) modes)
+      | Base relation -> (
+        match index_for relation binding with
+        | Some (_, attribute) -> Ok (Concepts.Mode.given attribute modes)
+        | None -> Ok modes )
       | _ -> Ok modes )
 
 let project description relation =
diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml
index 2049f23..93eb8e7 100644
--- a/test/unit/evaluators/FOL.ml
+++ b/test/unit/evaluators/FOL.ml
@@ -208,47 +208,49 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
 
   module F = Rnt.Evaluators.FOL
 
-  let restrict_through_an_index () =
-    let scanned = ref false and looked = ref [] in
+  let indexed ?(scanned = ref false) ?(looked = ref []) modes =
     let cursor tuples = Kernel.Generator.cursor_of (fun ~yield -> List.iter yield tuples; Ok ()) in
     let schema domain = {Protocols.Schematics.domain; provenance= []} in
+    Kernel.Prototype.mixture
+      Protocols.
+        [ Relation.make
+            object
+              method contains _ = Ok false
+              method modes = Ok modes
+            end;
+          Enumerable.make
+            object
+              method enumerate =
+                scanned := true;
+                Ok (cursor staff)
+            end;
+          Indexed.make
+            object
+              method indexes = ["age"]
+
+              method lookup attribute value =
+                looked := attribute :: !looked;
+                Ok
+                  (cursor
+                     (List.filter
+                        (fun tuple ->
+                          BatMap.String.find_opt attribute tuple.Concepts.Tuple.attributes
+                          |> Option.fold ~none:false ~some:(Concepts.Value.equal value) )
+                        staff ) )
+            end;
+          Schematics.make
+            object
+              method describe () =
+                Ok
+                  (Schematics.Relation
+                     (BatMap.String.of_list ["name", schema "string"; "age", schema "integer"]) )
+            end ]
+
+  let restrict_through_an_index () =
+    let scanned = ref false and looked = ref [] in
     let relation =
-      Kernel.Prototype.mixture
-        Protocols.
-          [ Relation.make
-              object
-                method contains _ = Ok false
-
-                method modes =
-                  Ok Concepts.[Mode.mode [] Cardinality.Finite; Mode.mode ["age"] Cardinality.Finite]
-              end;
-            Enumerable.make
-              object
-                method enumerate =
-                  scanned := true;
-                  Ok (cursor staff)
-              end;
-            Indexed.make
-              object
-                method indexes = ["age"]
-
-                method lookup attribute value =
-                  looked := attribute :: !looked;
-                  Ok
-                    (cursor
-                       (List.filter
-                          (fun tuple ->
-                            BatMap.String.find_opt attribute tuple.Concepts.Tuple.attributes
-                            |> Option.fold ~none:false ~some:(Concepts.Value.equal value) )
-                          staff ) )
-              end;
-            Schematics.make
-              object
-                method describe () =
-                  Ok
-                    (Schematics.Relation
-                       (BatMap.String.of_list ["name", schema "string"; "age", schema "integer"]) )
-              end ]
+      indexed ~scanned ~looked
+        Concepts.[Mode.mode [] Cardinality.Finite; Mode.mode ["age"] Cardinality.Finite]
     in
     let found =
       F.(
@@ -268,6 +270,28 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     check bool "the relation was never scanned" false !scanned;
     check (list string) "its index was looked up once" ["age"] !looked
 
+  let a_restriction_ends_only_through_its_index () =
+    let ends modes binding =
+      F.execute (F.Where (F.Base (indexed modes), binding))
+      |> Utilities.Result.(
+           fun result ->
+             result
+             |>> fun relation ->
+             Protocols.Handle.releasing relation (fun () ->
+                 Result.bind (Protocols.Relation.require relation) Protocols.Relation.modes
+                 |> Result.map (fun modes -> Concepts.Mode.exhaustible modes BatSet.String.empty) ) )
+      |> Helpers.condition_as_failure
+    in
+    let endless = Concepts.Mode.mode [] Concepts.Cardinality.Countable in
+    let by attribute = Concepts.Mode.mode [attribute] Concepts.Cardinality.Finite in
+    check bool "a binding the index reads ends" true (ends [endless; by "age"] (aged 42));
+    check bool "a binding no index reads does not" false
+      (ends [endless; by "age"] (called "Alaric"));
+    check bool "nor does one that would end only through an attribute without an index" false
+      (ends
+         [endless; by "name"]
+         (BatMap.String.add "name" (Concepts.Value.String "Alaric") (aged 42)) )
+
   let restrict_a_stored_relation conn =
     let run term f =
       begin
@@ -301,13 +325,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     check bool "a tuple disagreeing with it is not" false
       (asking
          (F.Where (employees, aged 42))
-         (fun r -> Protocols.Relation.contains r (employee "Brunhild" 30)) );
-    check bool "through the index it ends with nothing bound" true
-      (asking
-         (F.Where (employees, aged 42))
-         (fun r ->
-           Protocols.Relation.modes r
-           |> Result.map (fun modes -> Concepts.Mode.exhaustible modes BatSet.String.empty) ) )
+         (fun r -> Protocols.Relation.contains r (employee "Brunhild" 30)) )
 
   let restrict_inside_a_stored_program conn =
     let inner = F.Project (F.Where (employees, aged 42), BatFingerTree.singleton "name") in
@@ -446,6 +464,8 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
         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 "restrict-through-an-index" `Quick restrict_through_an_index;
+        test_case "a-restriction-ends-only-through-its-index" `Quick
+          a_restriction_ends_only_through_its_index;
         test_case "restrict-a-stored-relation" `Quick
           (H.with_connection restrict_a_stored_relation "fol-test");
         test_case "restrict-inside-a-stored-program" `Quick