make substantial relation use merkle.interface

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