diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/kernel/EphemeralRelation.ml | 74 |
1 files changed, 48 insertions, 26 deletions
diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml index 8cae91f..c0ec241 100644 --- a/lib/kernel/EphemeralRelation.ml +++ b/lib/kernel/EphemeralRelation.ml @@ -18,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 @@ -59,7 +63,7 @@ let persisted = function Some {Persisted.name; schematics; program} | _ -> None -class ephemeral_relation ?program description value enumerate inputs = +class ephemeral_relation ?program ?decide description value modes enumerate inputs = object (self) inherit Lifecycle.counted inherit Identity.of_id @@ -67,19 +71,24 @@ class ephemeral_relation ?program 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 - 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) ) ) + 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 = @@ -96,11 +105,13 @@ class ephemeral_relation ?program description value enumerate inputs = :: protocols end -let instantiate ?(inputs = []) ?program description value enumerate = - new ephemeral_relation ?program 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 ()))) @@ -113,6 +124,7 @@ let enumerate_owned relation = object method reference = true method release = Protocols.Handle.release relation + method is_managed = true end in match @@ -128,18 +140,29 @@ let enumerate_owned relation = method to_string = Protocols.Handle.to_string cursor end ) -let run name program within () = - 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) enumerate_owned - | _ -> Error (Error.unbound_program name) - -let view ?within description program = - instantiate ~program description +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} - (run (Protocols.Handle.to_string program) (Some program) within) module Make (S : Abstract.Storage.STORAGE) = struct module SI = Storage.Make (S) @@ -147,9 +170,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct let restore ?program ?within ({Persisted.name; schematics; program= pointer} : Persisted.t) description = - instantiate ?program description + generated ?program ?within name description {name= Some name; schematics= `Persisted schematics; program= Some pointer} - (run name program within) let load ?bind connection (record : Persisted.t) = let open Utilities.Result in |