diff --git a/CHANGES.md b/CHANGES.md index 9a24438609..902f71798d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,13 @@ -## 2.9.0 (TODO) +## 2.9.0 (2021-11-15) + +### Fixed + +- **irmin-pack** + - Improved the performance of Index encode and decode operations by + eliminating intermediate allocations (up to 5% fewer minor words + allocated) (#1577, @CraigFe) + - Reduce the number of backend nodes built during export + (up to 20% fewer minor words allocated) (#1553, @Ngoguey42) ### Added @@ -12,6 +21,7 @@ - **irmin-pack** - Limit inode depth (#1596, #samoht) + - Adapt to index 1.5.0 (#1593, @icristescu) ## 2.8.0 (2021-10-15) diff --git a/src/irmin-pack/inode.ml b/src/irmin-pack/inode.ml index de07360ca8..58cd2ab264 100644 --- a/src/irmin-pack/inode.ml +++ b/src/irmin-pack/inode.ml @@ -961,8 +961,36 @@ struct let of_seq l = let t = - let aux acc (s, v) = add Total ~copy:false acc s v in - Seq.fold_left aux (empty Total) l + let rec aux_big seq inode = + match seq () with + | Seq.Nil -> inode + | Seq.Cons ((s, v), rest) -> + aux_big rest (add Total ~copy:false inode s v) + in + let len = + (* [StepMap.cardinal] is (a bit) expensive to compute, let's track the + size of the map in a [ref] while doing [StepMap.update]. *) + ref 0 + in + let rec aux_small seq map = + match seq () with + | Seq.Nil -> + assert (!len <= Conf.entries); + values Total map + | Seq.Cons ((s, v), rest) -> + let map = + StepMap.update s + (function + | None -> + incr len; + Some v + | Some _ -> Some v) + map + in + if !len = Conf.entries then aux_big rest (values Total map) + else aux_small rest map + in + aux_small l StepMap.empty in stabilize Total t diff --git a/src/irmin-pack/pack_index.ml b/src/irmin-pack/pack_index.ml index 9b16df6250..b0881bb9e4 100644 --- a/src/irmin-pack/pack_index.ml +++ b/src/irmin-pack/pack_index.ml @@ -36,20 +36,21 @@ module Make (K : Irmin.Hash.S) = struct module Val = struct type t = int63 * int * Pack_value.Kind.t [@@deriving irmin] - let to_bin_string = - Irmin.Type.( - unstage (to_bin_string (triple int63_t int32 Pack_value.Kind.t))) - - let encode (off, len, kind) = to_bin_string (off, Int32.of_int len, kind) + let encoded_size = (64 / 8) + (32 / 8) + 1 - let decode_bin = - Irmin.Type.(unstage (decode_bin (triple int63_t int32 Pack_value.Kind.t))) + let encode ((off, len, kind) : t) = + let buf = Bytes.create encoded_size in + Bytes.set_int64_be buf 0 (Int63.to_int64 off); + Bytes.set_int32_be buf 8 (Int32.of_int len); + Bytes.set buf 12 (Pack_value.Kind.to_magic kind); + Bytes.unsafe_to_string buf - let decode s off = - let off, len, kind = snd (decode_bin s off) in - (off, Int32.to_int len, kind) - - let encoded_size = (64 / 8) + (32 / 8) + 1 + let decode s pos : t = + let buf = Bytes.unsafe_of_string s in + let off = Bytes.get_int64_be buf pos |> Int63.of_int64 in + let len = Bytes.get_int32_be buf (pos + 8) |> Int32.to_int in + let kind = Bytes.get buf (pos + 12) |> Pack_value.Kind.of_magic_exn in + (off, len, kind) end module Stats = Index.Stats diff --git a/src/irmin-pack/pack_value.ml b/src/irmin-pack/pack_value.ml index 47ebc27489..c3e6de7de9 100644 --- a/src/irmin-pack/pack_value.ml +++ b/src/irmin-pack/pack_value.ml @@ -10,14 +10,14 @@ module Kind = struct | Inode -> 'I' | Node -> 'N' - let of_magic = function + let of_magic_exn = function | 'C' -> Commit | 'B' -> Contents | 'I' -> Inode | 'N' -> Node | c -> Fmt.failwith "Kind.of_magic: unexpected magic char %C" c - let t = Irmin.Type.(map char) of_magic to_magic + let t = Irmin.Type.(map char) of_magic_exn to_magic let pp = Fmt.using to_magic Fmt.char end diff --git a/src/irmin-pack/pack_value_intf.ml b/src/irmin-pack/pack_value_intf.ml index 011efe4a11..d09e8324f4 100644 --- a/src/irmin-pack/pack_value_intf.ml +++ b/src/irmin-pack/pack_value_intf.ml @@ -32,6 +32,7 @@ module type Sigs = sig type t = Commit | Contents | Inode | Node [@@deriving irmin] val to_magic : t -> char + val of_magic_exn : char -> t val pp : t Fmt.t end diff --git a/src/irmin-test/store_watch.ml b/src/irmin-test/store_watch.ml index 76a405a15d..5e260184dc 100644 --- a/src/irmin-test/store_watch.ml +++ b/src/irmin-test/store_watch.ml @@ -351,8 +351,9 @@ module Make (Log : Logs.LOG) (S : S) = struct run x test let tests = - [ - ("Callbacks and exceptions", test_watch_exn); - ("Basic operations", test_watches); - ] + (* [test_watches] has been disabled for being flaky. + TODO: work out why, fix it, and re-enable it. + See https://github.com/mirage/irmin/issues/1447. *) + let _ = ("Basic operations", test_watches) in + [ ("Callbacks and exceptions", test_watch_exn) ] end diff --git a/src/irmin/tree.ml b/src/irmin/tree.ml index fa3b33bc54..069d84d1be 100644 --- a/src/irmin/tree.ml +++ b/src/irmin/tree.ml @@ -1464,10 +1464,19 @@ module Make (P : Private.S) = struct on_node_seq new_children_seq @@ fun () -> let* v = Node.to_value ~cache n in let v = get_ok "export" v in - let key = Node.hash ~cache n in cnt.node_add <- cnt.node_add + 1; - let* key' = P.Node.add node_t v in - assert (equal_hash key key'); + let* key = P.Node.add node_t v in + let () = + (* Sanity check: Did we just store the same hash as the one represented + by the Tree.Node [n]? *) + match Node.cached_hash n with + | None -> + (* No hash is in [n]. Computing it would result in getting it from + [v] or rebuilding a private node. *) + () + | Some key' -> assert (equal_hash key key') + in + Node.export ?clear (Some repo) n key; k ()) and on_contents (`Contents (c, _)) k =