aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel/SubstantialRelation.ml
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/kernel/SubstantialRelation.ml51
-rw-r--r--lib/kernel/SubstantialRelation.mli20
2 files changed, 41 insertions, 30 deletions
diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml
index b0c8a51..3094eb8 100644
--- a/lib/kernel/SubstantialRelation.ml
+++ b/lib/kernel/SubstantialRelation.ml
@@ -1,7 +1,4 @@
-module Make (S : Abstract.Storage.STORAGE) (Schematics : sig
- include Protocols.Schematics.S
- val of_blob : Concepts.Blob.t -> (Schema.t, Concepts.Condition.condition) result
-end) = struct
+module Make (S : Abstract.Storage.STORAGE) = struct
module SI = Storage.Make (S)
module Error = struct
@@ -40,7 +37,7 @@ end) = 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;
@@ -55,9 +52,9 @@ end) = 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;
@@ -66,7 +63,7 @@ end) = 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
@@ -78,13 +75,13 @@ end) = 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
@@ -96,10 +93,10 @@ end) = 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)
@@ -110,10 +107,20 @@ end) = struct
let* present = TupleSet.lookup tx tuple node in
Ok (Option.is_some present)
- let heading_value tx relation =
+ let schema_of tx relation =
let open Utilities.Result in
- let* data = SI.get_req tx (S.Hash relation.heading) in
- Schematics.of_blob data
+ 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
@@ -154,7 +161,6 @@ end) = struct
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
@@ -164,7 +170,10 @@ end) = struct
SI.with_transaction storage (fun tx ->
contains_tuple tx relation (Concepts.Tuple.Representation.to_blob tuple) )
- method schema = SI.with_transaction storage (fun tx -> heading_value tx relation)
+ 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
@@ -174,14 +183,16 @@ end) = struct
method enumerate (_ : Protocols.Context.t) = enumerate storage relation
method protocols : Protocols.Handle.protocol list =
- [Protocols.Relation.make self; Protocols.Enumerable.make self; Schematics.make self]
+ [ 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 866c3a0..be2ad28 100644
--- a/lib/kernel/SubstantialRelation.mli
+++ b/lib/kernel/SubstantialRelation.mli
@@ -1,7 +1,4 @@
-module Make (S : Abstract.Storage.STORAGE) (Schematics : sig
- include Protocols.Schematics.S
- val of_blob : Concepts.Blob.t -> (Schema.t, Concepts.Condition.condition) result
-end) : sig
+module Make (S : Abstract.Storage.STORAGE) : sig
type t
val encode : t -> Concepts.Blob.t
@@ -9,7 +6,7 @@ end) : 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 ->
@@ -20,7 +17,7 @@ end) : 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 ->
@@ -37,7 +34,7 @@ end) : 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
@@ -50,9 +47,12 @@ end) : sig
val contains_tuple :
S.transaction -> t -> Concepts.Blob.t -> (bool, Concepts.Condition.condition) result
- (** decodes the heading at [heading relation] -- the body of
- [Schematics.schema] for this kind of relation. *)
- val heading_value : S.transaction -> t -> (Schematics.Schema.t, 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] --
generated by cgit v1.2.3 (git 2.25.1) at 2026-11-04 13:48:59 +0000