From 1a35fa647b3598111d7dcb281309651ab413b1bc Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Fri, 18 Sep 2026 00:18:43 -0300 Subject: make substantial relation use merkle.interface --- lib/kernel/SubstantialRelation.ml | 30 ++++++++++++------------------ lib/kernel/SubstantialRelation.mli | 4 ++-- test/unit/evaluators/FOL.ml | 4 +--- test/unit/evaluators/Lambda.ml | 2 +- test/unit/kernel/SubstantialRelation.ml | 7 +++---- 5 files changed, 19 insertions(+), 28 deletions(-) diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml index 077f255..5093ffc 100644 --- a/lib/kernel/SubstantialRelation.ml +++ b/lib/kernel/SubstantialRelation.ml @@ -34,7 +34,14 @@ module Make (S : Abstract.Storage.STORAGE) = struct let compare = Concepts.Hash.compare end - module TupleSet = Merkle.Make (S) (TupleKey) + module TupleValue = struct + type t = Concepts.Tuple.t + + let encode = Concepts.Tuple.Representation.to_blob + let decode = Concepts.Tuple.Representation.of_blob + end + + module TupleSet = Merkle.Interface (S) (TupleKey) (TupleValue) type t = { schematics: Concepts.Hash.hash; @@ -102,9 +109,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct let contains_tuple tx relation tuple = let open Utilities.Result in - let tuple = Concepts.Hash.hash_of_blob tuple in let* node = tuple_node tx relation in - let* present = TupleSet.lookup tx tuple node in + let* present = TupleSet.lookup tx (Concepts.Tuple.hash tuple) node in Ok (Option.is_some present) let schema_of tx relation = @@ -132,17 +138,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct 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 + let walked = TupleSet.iter tx (fun _ tuple -> yield tuple) node in close (); walked in @@ -159,8 +155,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct (* 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) ) + SI.with_transaction storage (fun tx -> contains_tuple tx relation tuple) method describe () = let open Utilities.Result in @@ -201,8 +196,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct let assert_tuple tx relation tuple = let open Utilities.Result in - let* tuple = SI.store_blob tx tuple in let* node = tuple_node tx relation in - let* node = TupleSet.insert tx tuple tuple node in + let* node = TupleSet.insert tx (Concepts.Tuple.hash tuple) tuple node in Ok {relation with tuples= TupleSet.hash_of node} end diff --git a/lib/kernel/SubstantialRelation.mli b/lib/kernel/SubstantialRelation.mli index be2ad28..5061e5d 100644 --- a/lib/kernel/SubstantialRelation.mli +++ b/lib/kernel/SubstantialRelation.mli @@ -42,10 +42,10 @@ module Make (S : Abstract.Storage.STORAGE) : sig val hash : t -> Concepts.Hash.hash val assert_tuple : - S.transaction -> t -> Concepts.Blob.t -> (t, Concepts.Condition.condition) result + S.transaction -> t -> Concepts.Tuple.t -> (t, Concepts.Condition.condition) result val contains_tuple : - S.transaction -> t -> Concepts.Blob.t -> (bool, Concepts.Condition.condition) result + S.transaction -> t -> Concepts.Tuple.t -> (bool, Concepts.Condition.condition) result (** decodes the schematics at [schematics relation] -- the body of [Protocols.Schematics.describe] for this kind of relation. *) diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml index 6bcbc41..cf8aedb 100644 --- a/test/unit/evaluators/FOL.ml +++ b/test/unit/evaluators/FOL.ml @@ -29,9 +29,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = let open Utilities.Result in let* tx = S.start conn in let* relation = SR.empty tx ~schematics:(hash "schema") () in - let* relation = - SR.assert_tuple tx relation (Concepts.Tuple.Representation.to_blob alaric) - in + let* relation = SR.assert_tuple tx relation alaric in let* () = S.commit tx in let* employee = SR.wrap conn relation in let root = diff --git a/test/unit/evaluators/Lambda.ml b/test/unit/evaluators/Lambda.ml index bc2a45d..b30fe33 100644 --- a/test/unit/evaluators/Lambda.ml +++ b/test/unit/evaluators/Lambda.ml @@ -38,7 +38,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = let* tx = S.start conn in let singleton tuple = let* relation = SR.empty tx ~schematics:(hash "schema") () in - SR.assert_tuple tx relation (Concepts.Tuple.Representation.to_blob tuple) + SR.assert_tuple tx relation tuple in let* noun = singleton datum in let* verb = singleton reticulare in diff --git a/test/unit/kernel/SubstantialRelation.ml b/test/unit/kernel/SubstantialRelation.ml index 9d60685..f639599 100644 --- a/test/unit/kernel/SubstantialRelation.ml +++ b/test/unit/kernel/SubstantialRelation.ml @@ -17,15 +17,14 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = |> BatMap.String.add "age" (Concepts.Value.Integer 42) } let assert_and_enumerate conn = - let tuple = Concepts.Tuple.Representation.to_blob alaric in let before, after, enumerated = begin let open Utilities.Result in let* tx = S.start conn in let* relation = SR.empty tx ~schematics:(hash "schema") () in - let* before = SR.contains_tuple tx relation tuple in - let* relation = SR.assert_tuple tx relation tuple in - let* after = SR.contains_tuple tx relation tuple in + let* before = SR.contains_tuple tx relation alaric in + let* relation = SR.assert_tuple tx relation alaric in + let* after = SR.contains_tuple tx relation alaric in let* () = S.commit tx in let* cursor = SR.enumerate conn relation in let* scan = Protocols.Cursor.require cursor in -- cgit v1.2.3