Add Tree.is_val and Tree.Contents.is_val functions

These functions check whether the node/contents are available in
memory or not (ie. if calling a function on those could incur IO
costs).

src/irmin-test/store.ml

@@ -1301,6 +1301,13 @@ module Make (S : Generic_key) = struct
 
       (* Testing other tree operations. *)
       let v0 = S.Tree.empty () in
+      let b0 = S.Tree.is_val v0 [] in
+      Alcotest.(check bool) "empty is_val /" true b0;
+      let b0 = S.Tree.is_val v0 [ "foo" ] in
+      Alcotest.(check bool) "empty is_val /foo" true b0;
+      let b0 = S.Tree.is_val v0 [ "foo"; "bar" ] in
+      Alcotest.(check bool) "empty is_val /foo/bar" true b0;
+
       let* c = S.Tree.to_concrete v0 in
       (match c with
       | `Tree [] -> ()

src/irmin/tree.ml

@@ -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
 
@@ -1227,6 +1229,24 @@ 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 =
+      match
+        findv_aux ~cache:false
+          ~value_of_key:(fun ~cache:_ _ _ _ -> raise Lazy)
+          ~return:Fun.id
+          ~bind:(fun x f -> f x)
+          ctx t k
+      with
+      | exception Lazy -> None
+      | e -> e
+
+    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
@@ -1691,6 +1711,18 @@ 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
+          | 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];

src/irmin/tree_intf.ml

@@ -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]. *)
+
   (** {1 Diffs} *)
 
   val diff : t -> t -> (path * (contents * metadata) Diff.t) list Lwt.t
@@ -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
+        in memory). *)
+
     val clear : t -> unit
     (** [clear t] clears [t]'s cache. *)