diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/kernel/SubstantialRelation.ml | 89 | ||||
| -rw-r--r-- | lib/kernel/SubstantialRelation.mli | 21 |
2 files changed, 91 insertions, 19 deletions
diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml index eebae3e..6592acb 100644 --- a/lib/kernel/SubstantialRelation.ml +++ b/lib/kernel/SubstantialRelation.ml @@ -37,7 +37,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct module TupleSet = Merkle.Make (S) (TupleKey) type t = - { heading: Concepts.Hash.hash; + { schematics: Concepts.Hash.hash; predicate: Concepts.Hash.hash option; local_constraints: Concepts.Hash.hash option; tuples: TupleSet.address; @@ -52,9 +52,9 @@ module Make (S : Abstract.Storage.STORAGE) = struct let tag = 'R' let malformed = Error.malformed_relation - let fields {heading; predicate; local_constraints; tuples; indexes} = + let fields {schematics; predicate; local_constraints; tuples; indexes} = let open Concepts.Encoding in - [ "heading", Value.bencode_of_hash heading; + [ "schema", Value.bencode_of_hash schematics; "predicate", Value.bencode_of_option Value.bencode_of_hash predicate; "local-constraints", Value.bencode_of_option Value.bencode_of_hash local_constraints; "tuples", Value.bencode_of_hash tuples; @@ -63,7 +63,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct let of_fields fields = let open Utilities.Result in let open Concepts.Encoding in - let* heading = Bencode.field "heading" fields |> fmap Value.hash_of_bencode in + let* schematics = Bencode.field "schema" fields |> fmap Value.hash_of_bencode in let* predicate = Bencode.field "predicate" fields |> fmap (Value.option_of_bencode Value.hash_of_bencode) in @@ -75,13 +75,13 @@ module Make (S : Abstract.Storage.STORAGE) = struct let* indexes = Bencode.field "indexes" fields |> fmap (Value.option_of_bencode Value.hash_of_bencode) in - Ok {heading; predicate; local_constraints; tuples; indexes} + Ok {schematics; predicate; local_constraints; tuples; indexes} end let encode = Representation.to_blob let decode = Representation.of_blob - let heading {heading; _} = heading + let schematics {schematics; _} = schematics let predicate {predicate; _} = predicate let local_constraints {local_constraints; _} = local_constraints let tuples {tuples; _} = tuples @@ -93,10 +93,10 @@ module Make (S : Abstract.Storage.STORAGE) = struct let* tuples = TupleSet.find tx relation.tuples in Option.to_result ~none:(Error.invalid_tuple_root relation.tuples) tuples - let empty tx ~heading ?predicate ?local_constraints ?indexes () = + let empty tx ~schematics ?predicate ?local_constraints ?indexes () = let open Utilities.Result in let* tuples = TupleSet.empty_under tx in - Ok {heading; predicate; local_constraints; tuples; indexes} + Ok {schematics; predicate; local_constraints; tuples; indexes} let store tx relation = SI.store_blob tx (Representation.to_blob relation) @@ -107,27 +107,84 @@ module Make (S : Abstract.Storage.STORAGE) = struct let* present = TupleSet.lookup tx tuple node in Ok (Option.is_some present) + let schema_of tx relation = + let open Utilities.Result in + let* data = SI.get_req tx (S.Hash relation.schematics) in + let* fields = Concepts.Encoding.Bencode.of_blob data in + let* kvs = Concepts.Encoding.Bencode.as_dict fields in + kvs + |> List.map (fun (name, domain) -> + Concepts.Encoding.Bencode.as_string domain + |> Result.map (fun domain -> (name, domain))) + |> Utilities.List.sequence + |> Result.map (fun kvs -> + List.fold_left + (fun acc (name, domain) -> BatMap.String.add name domain acc) + BatMap.String.empty kvs) + + let enumerate storage relation = + let open Utilities.Result in + let* tx = S.start storage in + let* node = tuple_node tx relation in + let closed = ref false in + let close () = if not !closed then begin closed := true; ignore (S.abort tx) end in + (* The fold is suspended by [yield], so the tree is walked one node + and one tuple at a time rather than materialized before the + first tuple is produced. *) + let produce ~yield = + let* walked = + TupleSet.fold_left tx + (fun acc _ addr -> + let* () = acc in + let* tuple = + SI.get_req tx (S.Hash addr) |> fmap Concepts.Tuple.Representation.of_blob + in + yield tuple; + Ok ()) + (Ok ()) node + in + close (); + walked + in + Ok (Generator.cursor_of ~on_release:close produce) + class relation storage value = object (self) inherit Lifecycle.null val storage : S.connection = storage val relation : t = value - method heading = Ok relation.heading method predicate = Ok relation.predicate method local_constraints = Ok relation.local_constraints - method tuples = Ok relation.tuples - - method contains tuple = - SI.with_transaction storage (fun tx -> contains_tuple tx relation tuple) - method protocols : Protocols.Handle.protocol list = Protocols.[Relation.make self] + (* The protocol takes a tuple, not bytes: encoding is this object's business, and a caller + that had to produce the exact stored bytes would have to know this encoding to do it. *) + method contains (tuple : Concepts.Tuple.t) = + SI.with_transaction storage (fun tx -> + contains_tuple tx relation (Concepts.Tuple.Representation.to_blob tuple) ) + + method describe () = + let open Utilities.Result in + let* description = SI.with_transaction storage (fun tx -> schema_of tx relation) in + Ok (Protocols.Schematics.Relation description) + + (* A substantial relation is finitely enumerable, so it carries [Enumerable] as well as + [Relation]. A procedural relation would carry only the latter, which is how an evaluator + discovers it cannot iterate one -- see [Protocols.Enumerable]. The context is accepted and + unused here: this enumeration reads through its own cursor-lifetime transaction and needs + no name resolution, but cancellation should eventually be checked between tuples. *) + method enumerate (_ : Protocols.Context.t) = enumerate storage relation + + method protocols : Protocols.Handle.protocol list = + [ Protocols.Relation.make self + ; Protocols.Enumerable.make self + ; Protocols.Schematics.make self ] method hash = hash relation end - let make conn ~heading ?predicate ?local_constraints ?indexes () = + let make conn ~schematics ?predicate ?local_constraints ?indexes () = let open Utilities.Result in SI.with_transaction conn (fun tx -> - let* relation = empty tx ~heading ?predicate ?local_constraints ?indexes () in + let* relation = empty tx ~schematics ?predicate ?local_constraints ?indexes () in let* _ = store tx relation in Ok (new relation conn relation |> Protocols.Handle.make) ) diff --git a/lib/kernel/SubstantialRelation.mli b/lib/kernel/SubstantialRelation.mli index 9e61411..be2ad28 100644 --- a/lib/kernel/SubstantialRelation.mli +++ b/lib/kernel/SubstantialRelation.mli @@ -6,7 +6,7 @@ module Make (S : Abstract.Storage.STORAGE) : sig val empty : S.transaction -> - heading:Concepts.Hash.hash -> + schematics:Concepts.Hash.hash -> ?predicate:Concepts.Hash.hash -> ?local_constraints:Concepts.Hash.hash -> ?indexes:Concepts.Hash.hash -> @@ -17,7 +17,7 @@ module Make (S : Abstract.Storage.STORAGE) : sig val make : S.connection -> - heading:Concepts.Hash.hash -> + schematics:Concepts.Hash.hash -> ?predicate:Concepts.Hash.hash -> ?local_constraints:Concepts.Hash.hash -> ?indexes:Concepts.Hash.hash -> @@ -34,7 +34,7 @@ module Make (S : Abstract.Storage.STORAGE) : sig Concepts.Hash.hash -> (Protocols.Handle.t, Concepts.Condition.condition) result - val heading : t -> Concepts.Hash.hash + val schematics : t -> Concepts.Hash.hash val predicate : t -> Concepts.Hash.hash option val local_constraints : t -> Concepts.Hash.hash option val tuples : t -> Concepts.Hash.hash @@ -46,4 +46,19 @@ module Make (S : Abstract.Storage.STORAGE) : sig val contains_tuple : S.transaction -> t -> Concepts.Blob.t -> (bool, Concepts.Condition.condition) result + + (** decodes the schematics at [schematics relation] -- the body of + [Protocols.Schematics.describe] for this kind of relation. *) + val schema_of : + S.transaction -> + t -> + (Protocols.Schematics.relation_description, Concepts.Condition.condition) result + + (** a handle carrying [Protocols.Cursor] over every tuple currently + asserted, decoded via [Concepts.Tuple.Representation.of_blob] -- + the body of [Protocols.Relation.enumerate] for this kind of + relation. Opens its own storage transaction, held for the + cursor's whole lifetime rather than just this call -- see + [Kernel.Generator] and docs/design/evaluator.md, "Shape". *) + val enumerate : S.connection -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result end |