Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add Tree.is_val and Tree.Contents.is_val functions #1864

Open
wants to merge 2 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
32 changes: 32 additions & 0 deletions src/irmin-test/store.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1417,6 +1417,37 @@ module Make (S : Generic_key) = struct
in
run x test

let test_lazy_tree x () =
let is_val_aux v t k =
let str = Fmt.str "empty is_val %a" Irmin.Type.(pp S.path_t) k in
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
let str = Fmt.str "empty is_val %a" Irmin.Type.(pp S.path_t) k in
let str = Fmt.str "is_val %a" Irmin.Type.(pp S.path_t) k in

let b = S.Tree.is_val t k in
Alcotest.(check bool) str v b
in
let is_val = is_val_aux true in
let is_not_val = is_val_aux false in
let test repo =
let v0 = S.Tree.empty () in
is_val v0 [];
is_val v0 [ "foo" ];
is_val v0 [ "foo"; "bar" ];

let* r1 = r1 ~repo in
let v1 = S.Commit.tree r1 in
is_not_val v1 [];
is_not_val v1 [ "a" ];

let* _ = S.Tree.find_tree v1 [ "a" ] in
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
let* _ = S.Tree.find_tree v1 [ "a" ] in
let* _ = S.Tree.find_tree v1 [ "a" ] in
is_val v1 [];
is_val v1 [ "a" ];
let* _ = S.Tree.find_tree v1 [ "b" ] in
is_val v1 [];
is_val v1 [ "b" ];

the returned value here is None, there is no node at "a" in r1 (see https://github.com/mirage/irmin/blob/main/src/irmin-test/common.ml#L197). I think you meant to test for an existing path in the tree.
However the test for "b" fails, I would have expected it to pass.

is_val v1 [];
is_val v1 [ "a" ];

S.Tree.clear v1;
is_not_val v1 [];
is_not_val v1 [ "a" ];
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
is_not_val v1 [ "a" ];
is_not_val v1 [ "b" ];


Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I propose to also add a test for an update in lazy tree, for instance:

      let* x = S.Tree.add v1 [ "c"; "d" ] "x" in
      is_val x [ "c"; "d" ];
      is_not_val v1 [ "b" ];

Lwt.return ()
in
run x test

let pp_proof = Irmin.Type.pp (S.Tree.Proof.t S.Tree.Proof.tree_t)
let pp_stream = Irmin.Type.pp (S.Tree.Proof.t S.Tree.Proof.stream_t)

Expand Down Expand Up @@ -2441,6 +2472,7 @@ let suite (speed, x) =
suite'
([
("High-level operations on trees", speed, T.test_trees x);
("Test lazy trees", speed, T.test_lazy_tree x);
("Basic operations on contents", speed, T.test_contents x);
("Basic operations on nodes", speed, T.test_nodes x);
("Basic operations on commits", speed, T.test_commits x);
Expand Down
29 changes: 29 additions & 0 deletions src/irmin/tree.ml
Original file line number Diff line number Diff line change
Expand Up @@ -320,6 +320,8 @@ module Make (P : Backend.S) = struct
if cache then c.info.ptr <- Hash h;
h)

let is_val t = match cached_value t with None -> false | Some _ -> true

let key t =
match t.v with Key (_, k) -> Some k | Value _ | Pruned _ -> None

Expand Down Expand Up @@ -1227,6 +1229,20 @@ module Make (P : Backend.S) = struct

let findv = findv_aux ~value_of_key ~return:Lwt.return ~bind:Lwt.bind

exception Lazy

let findv' ctx t k =
findv_aux ~cache:false
~value_of_key:(fun ~cache:_ _ _ _ -> raise Lazy)
~return:Fun.id
~bind:(fun x f -> f x)
ctx t k

let is_val t =
match (cached_map t, cached_value t) with
| None, None -> false
| _ -> true

let seq_of_map ?(offset = 0) ?length m : (step * elt) Seq.t =
let take seq =
match length with None -> seq | Some n -> Seq.take n seq
Expand Down Expand Up @@ -1691,6 +1707,19 @@ module Make (P : Backend.S) = struct
| `Node n -> (aux [@tailcall]) n path
| `Contents _ -> Lwt.return_none

let is_val t path =
let rec aux node path =
match Path.decons path with
| None -> Node.is_val node
| Some (h, p) -> (
match Node.findv' "is_val" node h with
| None -> true
| exception Node.Lazy -> false
| Some (`Contents (c, _)) -> Contents.is_val c
| Some (`Node n) -> aux n p)
in
match t with `Node n -> aux n path | `Contents (c, _) -> Contents.is_val c

let find_tree (t : t) path =
let cache = true in
[%log.debug "Tree.find_tree %a" pp_path path];
Expand Down
10 changes: 10 additions & 0 deletions src/irmin/tree_intf.ml
Original file line number Diff line number Diff line change
Expand Up @@ -82,6 +82,12 @@ module type S = sig
(** [is_empty t] is true iff [t] is {!empty} (i.e. a tree node with no
children). Trees with {!kind} = [`Contents] are never considered empty. *)

val is_val : t -> path -> bool
(** [is_val t k] is [true] iff the path [k] has already been forced in [t]. In
that case, that means that all the nodes traversed by [k] are loaded in
memory. If the leaf node is a contents [c], then [Contents.is_val c]
should also be [true]. *)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

maybe the doc should also mention that it returns true also when there is no node at the path given


(** {1 Diffs} *)

val diff : t -> t -> (path * (contents * metadata) Diff.t) list Lwt.t
Expand Down Expand Up @@ -128,6 +134,10 @@ module type S = sig
(** Equivalent to {!val-force}, but raises an exception if the lazy content
value is not present in the underlying repository. *)

val is_val : t -> bool
(** [is_val x] is [true] iff [x] has already been forced (and so is loaded
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
(** [is_val x] is [true] iff [x] has already been forced (and so is loaded
(** [is_val t] is [true] iff [t] has already been forced (and so is loaded

in memory). *)

val clear : t -> unit
(** [clear t] clears [t]'s cache. *)

Expand Down