diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/kernel/Merkle.ml | 33 | ||||
| -rw-r--r-- | lib/kernel/SubstantialRelation.ml | 20 |
2 files changed, 28 insertions, 25 deletions
diff --git a/lib/kernel/Merkle.ml b/lib/kernel/Merkle.ml index b8599d5..be4618b 100644 --- a/lib/kernel/Merkle.ml +++ b/lib/kernel/Merkle.ml @@ -37,6 +37,15 @@ module type TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> sig val remove : S.transaction -> K.t -> node -> (node, Concepts.Condition.condition) result val lookup : S.transaction -> K.t -> node -> (address option, Concepts.Condition.condition) result + val foldm_left : + ?from:K.t -> + ?until:(K.t -> bool) -> + S.transaction -> + ('c -> K.t -> address -> ('c, Concepts.Condition.condition) result) -> + 'c -> + node -> + ('c, Concepts.Condition.condition) result + val fold_left : ?from:K.t -> ?until:(K.t -> bool) -> @@ -349,19 +358,19 @@ functor let drop i ft = if i < BatFingerTree.size ft then snd (BatFingerTree.split_at ft i) else BatFingerTree.empty - let fold_left ?from ?(until = fun _ -> false) tx f acc node = + let foldm_left ?from ?(until = fun _ -> false) tx f acc node = let open Utilities.Result in let rec walk from acc = function | Leaf {keys; values} -> let i = Option.fold ~none:0 ~some:(fun key -> fst (lookup1 keys key)) from in Utilities.FingerTree.zip (drop i keys) (drop i values) - |> BatFingerTree.fold_left + |> Utilities.FingerTree.foldm_left (fun step (k, v) -> match step with - | `Continue acc -> if until k then `Stop acc else `Continue (f acc k v) - | `Stop _ -> step ) + | `Continue acc when until k -> Ok (`Stop acc) + | `Continue acc -> f acc k v |> Result.map (fun acc -> `Continue acc) + | `Stop _ -> Ok step ) (`Continue acc) - |> Result.ok | Trunk {keys; children} -> let i = Option.fold ~none:0 @@ -384,6 +393,8 @@ functor in walk from acc node |> Result.map (function `Continue acc | `Stop acc -> acc) + let fold_left ?from ?until tx f = foldm_left ?from ?until tx (fun acc k v -> Ok (f acc k v)) + let keys tx node = fold_left tx (fun acc k _ -> BatFingerTree.snoc acc k) BatFingerTree.empty node @@ -459,6 +470,8 @@ module type INTERFACE = functor (S : Abstract.Storage.STORAGE) (K : KEY) (V : VA val mem : S.transaction -> K.t -> node -> (bool, Concepts.Condition.condition) result val fold_left : + ?from:K.t -> + ?until:(K.t -> bool) -> S.transaction -> ('c -> K.t -> V.t -> 'c) -> 'c -> @@ -518,14 +531,8 @@ functor let mem tx k node = Tree.lookup tx k node |> Result.map Option.is_some - let fold_left tx f acc node = - Tree.fold_left tx - (fun acc k addr -> - let* acc = acc in - let* v = retrieve tx addr in - Ok (f acc k v) ) - (Ok acc) node - |> Result.join + let fold_left ?from ?until tx f = + Tree.foldm_left ?from ?until tx (fun acc k addr -> retrieve tx addr |> Result.map (f acc k)) let iter tx f node = fold_left tx (fun _ k v -> f k v |> ignore) () node let keys = Tree.keys diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml index 193df98..e89b008 100644 --- a/lib/kernel/SubstantialRelation.ml +++ b/lib/kernel/SubstantialRelation.ml @@ -61,7 +61,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct end module TupleSet = Merkle.Interface (S) (TupleKey) (TupleValue) - module Index = Merkle.Make (S) (Merkle.StringKey) + module Index = Merkle.Interface (S) (Merkle.StringKey) (TupleValue) type t = { schematics: Concepts.Hash.hash; @@ -150,19 +150,15 @@ module Make (S : Abstract.Storage.STORAGE) = struct BatMap.String.find_opt attribute relation.indexes |> Option.to_result ~none:(Error.unindexed_attribute attribute) in - let prefix = prefix value in + let start = prefix value in reading connection (fun tx -> Index.find tx root |>> Option.to_result ~none:(Error.invalid_index_root root)) (fun tx node ~yield -> - Index.fold_left ~from:prefix - ~until:(fun key -> not (String.starts_with ~prefix key)) + Index.fold_left ~from:start + ~until:(fun key -> not (String.starts_with ~prefix:start key)) tx - (fun read _ address -> - let* () = read in - let* tuple = SI.get_req tx (S.Hash address) |>> TupleValue.decode in - Ok (yield tuple) ) - (Ok ()) node - |> Result.join ) + (fun () _ tuple -> yield tuple) + () node ) class substantial_relation connection value description = object (self) @@ -223,8 +219,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct ^ Concepts.Hash.to_raw_string hash, hash ) ) hashed - |> Index.of_list tx - |> Result.map (fun node -> attribute, Index.hash_of node) + |> Index.Tree.of_list tx + |> Result.map (fun node -> attribute, Index.Tree.hash_of node) let store tx description tuples = let open Utilities.Result in |