diff --git a/dune b/dune
index 739ed4a262fd1864a39bd169c568bb9af2e3aee8..a313a1921b5e52124ac3b55f9d8fecb0d6cd3b0c 100644
--- a/dune
+++ b/dune
@@ -11,3 +11,5 @@
 (alias
  (name runtest)
  (deps (alias_rec runtest_sandbox)))
+
+(executable (name import) (libraries tezos-storage irmin-pack))
\ No newline at end of file
diff --git a/import.ml b/import.ml
new file mode 100644
index 0000000000000000000000000000000000000000..dc9a296ad743e2ee182ceba7c3aeeed55aab1dfe
--- /dev/null
+++ b/import.ml
@@ -0,0 +1,172 @@
+open Lwt.Infix
+
+module Store = Tezos_storage.Context.Irmin
+module P = Store.Private
+
+module Commit = Irmin.Private.Commit.V1(P.Commit.Val)
+
+module Node = struct
+
+  module M = Irmin.Private.Node.Make (P.Hash) (Store.Key) (Store.Metadata)
+
+  module Hash = Irmin.Hash.V1 (P.Hash)
+
+  type kind = [`Node | `Contents]
+
+  type entry = {key: string Lazy.t; kind: kind; name: M.step; node: Hash.t}
+
+  (* Irmin 1.4 uses int64 to store string lengths *)
+  let step_t =
+    let pre_hash = Irmin.Type.(pre_hash (string_of `Int64)) in
+    Irmin.Type.like M.step_t ~pre_hash
+
+  let metadata_t =
+    let some = "\255\000\000\000\000\000\000\000" in
+    let none = "\000\000\000\000\000\000\000\000" in
+    Irmin.Type.(map (string_of (`Fixed 8)))
+      (fun s ->
+         match s.[0] with
+         | '\255' -> Some ()
+         | '\000' -> None
+         | _ -> assert false )
+      (function Some _ -> some | None -> none)
+
+  (* Irmin 1.4 uses int64 to store list lengths *)
+  let entry_t : entry Irmin.Type.t =
+    let open Irmin.Type in
+    record "Tree.entry" (fun kind name node ->
+        let kind = match kind with None -> `Node | Some () -> `Contents in
+        let key =
+          match kind with
+          | `Node -> lazy (name ^ "/")
+          | `Contents -> lazy name
+        in
+        {key; kind; name; node} )
+    |+ field "kind" metadata_t (function
+        | {kind= `Node; _} -> None
+        | {kind= `Contents; _} -> Some () )
+    |+ field "name" step_t (fun {name; _} -> name)
+    |+ field "node" Hash.t (fun {node; _} -> node)
+    |> sealr
+
+  type t = entry list
+
+  let t : t Irmin.Type.t = Irmin.Type.(list ~len:`Int64 entry_t)
+
+  let export_entry e = match e.kind with
+    | `Node -> e.name, `Node e.node
+    | `Contents -> e.name, `Contents (e.node, ())
+
+  let export (t:t) = P.Node.Val.v (List.map export_entry t)
+end
+
+let (>>*) v f =
+  match v with
+  | Ok v -> f v
+  | Error e -> failwith (Lmdb.string_of_error e)
+
+let lmdb root =
+  Fmt.epr "Opening lmdb context in %s...\n%!" root;
+  let mapsize = 409_600_000_000L in
+  let flags = [ Lmdb.NoRdAhead ;Lmdb.NoTLS ] in
+  let file_flags =  0o444 in
+  Lmdb.opendir ~mapsize ~flags root file_flags >>* fun t ->
+  Lmdb.create_ro_txn t >>* fun txn ->
+  Lmdb.opendb txn >>* fun db ->
+  db, txn
+
+let of_string t s = match Irmin.Type.of_bin_string t s with
+  | Ok s -> s
+  | Error (`Msg e) -> failwith e
+
+let hash_of_string = of_string Store.Hash.t
+let contents_of_string = of_string P.Contents.Val.t
+let node_of_string = of_string Node.t
+let commit_of_string = of_string Commit.t
+
+let commits = ref 0
+let contents = ref 0
+let nodes = ref 0
+
+let pp_stats ppf () =
+  Fmt.pf ppf "%4dk blobs / %4dk trees / %4dk commits"
+    (!contents / 1000) (!nodes / 1000) (!commits / 1000)
+
+let classify k =
+  match Astring.String.cut ~sep:"/" k with
+  | Some ("commit", key) -> `Commit (hash_of_string key)
+  | Some ("contents", key) -> `Contents (hash_of_string key)
+  | Some ("node",key) -> `Node (hash_of_string key)
+  | _ -> failwith "invalid key"
+
+let skip _ = Lwt.return ()
+
+let key_of_entry e =
+  let hash = Irmin.Type.to_bin_string Store.Hash.t Node.(e.node) in
+  assert (String.length hash = 32);
+  match Node.(e.kind) with
+  | `Node -> "node/" ^ hash
+  | `Contents -> "contents/" ^ hash
+
+let rec append (db, txn) x y z k v =
+  let v = Bigstring.to_string v in
+  match classify k with
+  | `Contents k ->
+      incr contents;
+      P.Contents.unsafe_add x k (contents_of_string v)
+  | `Commit k ->
+      let c = commit_of_string v in
+      let c = Commit.export c in
+      incr commits;
+      P.Commit.unsafe_add z k c
+  | `Node k ->
+      P.Node.mem y k >>= function
+      | true -> Lwt.return ()
+      | false ->
+          let n = node_of_string v in
+          Lwt_list.iter_s (fun e ->
+              P.Node.mem y Node.(e.node) >>= function
+              | true -> Lwt.return ()
+              | false ->
+                  let k = key_of_entry e in
+                  match Lmdb.get txn db k with
+                  | Ok v    -> (append[@tailcall]) (db, txn) x y z k v
+                  | Error e ->
+                      Fmt.epr "\n[error] %S: %a\n%!" k Lmdb.pp_error e;
+                      Lwt.return ()
+            ) n
+          >>= fun () ->
+          let n = Node.export n in
+          incr nodes;
+          P.Node.unsafe_add y k n
+
+let move ~src:(db, txn) ~dst:repo =
+  let count = ref 0 in
+  Lmdb.opencursor txn db >>* fun c ->
+  Lmdb.cursor_first c >>* fun () ->
+  P.Repo.batch repo (fun x y z ->
+      Lmdb.cursor_fold_left c ~init:() ~f:(fun () (key, value) ->
+          incr count;
+          if !count mod 100 = 0 then Fmt.epr "\r%a%!" pp_stats ();
+          Lwt.async (fun () ->
+              append (db, txn) x y z (Bigstring.to_string key) value);
+          Ok ()
+        ) >>* fun () ->
+      Lwt.return ()
+    ) >|= fun () ->
+  Fmt.epr "\n[done]\n"
+
+let irmin root =
+  Fmt.epr "Creating an Irmin repository in %s...\n%!" root;
+  let config = Irmin_pack.config root in
+  Store.Repo.v config
+
+let run root =
+  let lmdb = lmdb (Filename.concat root "context") in
+  irmin (Filename.concat root "context-pack") >>= fun irmin ->
+  move ~src:lmdb ~dst:irmin
+
+let () =
+  if Array.length Sys.argv <> 2 then Fmt.epr "usage: %s <data-dir>" Sys.argv.(0);
+  let datadir = Sys.argv.(1) in
+  Lwt_main.run (run datadir)
diff --git a/scripts/install_build_deps.raw.sh b/scripts/install_build_deps.raw.sh
index 9ba20aef32301837d68a7c3fe90d3edd1ec4f03c..c9700e419004aa93fad3a89948e9323b90dd9d42 100755
--- a/scripts/install_build_deps.raw.sh
+++ b/scripts/install_build_deps.raw.sh
@@ -12,7 +12,7 @@ export OPAMYES=${OPAMYES:=true}
 ## In another ideal world, this list should be extracted from the pinned
 ## packages and filter only conf-* packages
 
-opam depext conf-gmp conf-libev conf-m4 conf-perl conf-pkg-config conf-which conf-hidapi
+opam depext conf-gmp conf-libev conf-m4 conf-perl conf-pkg-config conf-which conf-hidapi conf-autoconf
 
 ## In an ideal world, `--with-test` should be present only when using
 ## `--dev`. But this would probably break the CI, so we postponed this
diff --git a/src/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml
index 3bb91a9aef971bcea02cbe0c4096e8c6838132f7..d6ea4ac6fda91a728ac1992747e4776a959538a6 100644
--- a/src/lib_shell/prevalidation.ml
+++ b/src/lib_shell/prevalidation.ml
@@ -321,5 +321,5 @@ let preapply ~predecessor ~timestamp ~protocol_data operations =
           let context = Shell_context.unwrap_disk_context context in
           return (context, message)
   end >>=? fun (context, message) ->
-  Context.hash ?message ~time:timestamp context >>= fun context ->
+  let context = Context.hash ?message ~time:timestamp context in
   return ({ shell_header with context }, validation_result_list)
diff --git a/src/lib_shell/test/test_locator.ml b/src/lib_shell/test/test_locator.ml
index 534b5648e1e01e489e026878b0f5c3ff20bd77b4..70b2ff511045e5d7ffa5c84d05690c346c29be9a 100644
--- a/src/lib_shell/test/test_locator.ml
+++ b/src/lib_shell/test/test_locator.ml
@@ -107,8 +107,7 @@ let make_empty_chain (chain:State.Chain.t) n : Block_hash.t Lwt.t =
   State.Block.context genesis >>= fun empty_context ->
   let header = State.Block.header genesis in
   let timestamp = State.Block.timestamp genesis in
-  Context.hash ~time:timestamp empty_context
-  >>= fun empty_context_hash ->
+  let empty_context_hash = Context.hash ~time:timestamp empty_context in
   Context.commit
     ~time:header.shell.timestamp empty_context >>= fun context ->
   let header = { header with shell = { header.shell with context } } in
diff --git a/src/lib_storage/context.ml b/src/lib_storage/context.ml
index cfdbc0ecd7c2f3821a62a05f4f97b15d11f390f3..20351d7c5983590eb7d542bfc28939d0f89758bf 100644
--- a/src/lib_storage/context.ml
+++ b/src/lib_storage/context.ml
@@ -25,320 +25,271 @@
 
 (** Tezos - Versioned (key x value) store (over Irmin) *)
 
-module IrminPath = Irmin.Path.String_list
-
-module MBytesContent = struct
-  type t = MBytes.t
-  let t =
-    Irmin.Type.(like cstruct)
-      (fun x -> Cstruct.to_bigarray x)
-      (fun x -> Cstruct.of_bigarray x)
-  let merge = Irmin.Merge.default Irmin.Type.(option t)
-  let pp ppf b = Format.pp_print_string ppf (MBytes.to_string b)
-  let of_string s = Ok (MBytes.of_string s)
-end
+module Path = Irmin.Path.String_list
+module Metadata = Irmin.Metadata.None
 
-module Metadata = struct
-  type t = unit
-  let t = Irmin.Type.unit
-  let default = ()
-  let merge = Irmin.Merge.default t
-end
+exception TODO of string
 
-module IrminBlake2B : Irmin.Hash.S with type t = Context_hash.t = struct
+let todo fmt = Fmt.kstrf (fun s -> raise (TODO s)) fmt
 
-  type t = Context_hash.t
+let reporter () =
+  let report src level ~over k msgf =
+    let k _ =
+      over ();
+      k ()
+    in
+    let with_stamp h _tags k fmt =
+      let dt = Mtime.Span.to_us (Mtime_clock.elapsed ()) in
+      Fmt.kpf k Fmt.stderr
+        ("%+04.0fus %a %a @[" ^^ fmt ^^ "@]@.")
+        dt
+        Fmt.(styled `Magenta string)
+        (Logs.Src.name src)
+        Logs_fmt.pp_header (level, h)
+    in
+    msgf @@ fun ?header ?tags fmt ->
+    with_stamp header tags k fmt
+  in
+  { Logs.report }
 
-  let digest_size = Context_hash.size
+let index_log_size = ref None
 
-  let to_raw t = Cstruct.of_bigarray (Context_hash.to_bytes t)
-  let of_raw t =
-    match Context_hash.of_bytes_opt (Cstruct.to_bigarray t) with
-    | Some t -> t
-    | None ->
-        let str = Cstruct.to_string t in
-        Format.kasprintf invalid_arg "%s (%d)" str (String.length str)
+let () =
+  let verbose () =
+    Logs.set_level (Some Logs.Debug);
+    Logs.set_reporter (reporter ())
+  in
+  let index_log_size n =
+    index_log_size := Some (int_of_string n)
+  in
+  match Unix.getenv "TEZOS_STORAGE" with
+  | exception Not_found -> ()
+  | v ->
+      let args = String.split ',' v in
+      List.iter (function
+          | "v" | "verbose" | "vv" -> verbose ()
+          | v ->
+              match String.split '=' v with
+              | ["index-log-size"; n] -> index_log_size n
+              | _ -> ()
+        ) args
+
+module Hash : sig
+  include Irmin.Hash.S
+  val to_context_hash: t -> Context_hash.t
+  val of_context_hash: Context_hash.t -> t
+end = struct
+  module H = Digestif.Make_BLAKE2B(struct
+      let digest_size = 32
+    end)
 
-  let t = Irmin.Type.like Irmin.Type.cstruct of_raw to_raw
+  type t = H.t
 
-  let digest t x =
-    Context_hash.hash_bytes
-      [Cstruct.to_bigarray (Irmin.Type.encode_cstruct t x)]
+  let of_context_hash s = H.of_raw_string (Context_hash.to_string s)
 
-  let pp = Context_hash.pp
+  let to_context_hash h = Context_hash.of_string_exn (H.to_raw_string h)
+
+  let pp ppf t = Context_hash.pp ppf (to_context_hash t)
 
   let of_string x =
-    match Context_hash.of_b58check_exn x with
-    | exception (Invalid_argument s) -> Error (`Msg s)
-    | h -> Ok h
+    match Context_hash.of_b58check x with
+    | Ok x -> Ok (of_context_hash x)
+    | Error _ -> todo "Hash.of_string"
+
+  let short_hash t =
+    Irmin.Type.(short_hash string (H.to_raw_string t))
 
-  let has_kind = function
-    | `SHA1 -> true
-    | _ -> false
+  let t : t Irmin.Type.t =
+    Irmin.Type.map
+      ~cli:(pp, of_string) Irmin.Type.(string_of (`Fixed H.digest_size))
+      ~short_hash:short_hash
+      H.of_raw_string H.to_raw_string
 
-  let to_raw_int c =
-    Int64.to_int @@ MBytes.get_int64 (Context_hash.to_bytes c) 0
+  let hash_size = H.digest_size
 
+  let hash = H.digesti_string
 end
 
-module GitStore =
-  Irmin_lmdb.Make
-    (Metadata)
-    (MBytesContent)
-    (Irmin.Path.String_list)
-    (Irmin.Branch.String)
-    (IrminBlake2B)
+module Node = struct
+  module M = Irmin.Private.Node.Make (Hash) (Path) (Metadata)
 
-type index = {
-  path: string ;
-  repo: GitStore.Repo.t ;
-  patch_context: context -> context Lwt.t ;
-}
+  module V1 = struct
+    module Hash = Irmin.Hash.V1 (Hash)
 
-and context = {
-  index: index ;
-  parents: GitStore.Commit.t list ;
-  tree: GitStore.tree ;
-}
-type t = context
+    type kind = [`Node | `Contents of Metadata.t]
 
-(*-- Version Access and Update -----------------------------------------------*)
+    type entry = {key: string Lazy.t; kind: kind; name: M.step; node: Hash.t}
 
-let current_protocol_key = ["protocol"]
-let current_test_chain_key = ["test_chain"]
-let current_data_key = ["data"]
+    let compare_entries a b = compare (Lazy.force a.key) (Lazy.force b.key)
 
-let exists index key =
-  GitStore.Commit.of_hash index.repo key >>= function
-  | None -> Lwt.return_false
-  | Some _ -> Lwt.return_true
+    (* Irmin 1.4 uses int64 to store string lengths *)
+    let step_t =
+      let pre_hash = Irmin.Type.(pre_hash (string_of `Int64)) in
+      Irmin.Type.like M.step_t ~pre_hash
 
-let checkout index key =
-  GitStore.Commit.of_hash index.repo key >>= function
-  | None -> Lwt.return_none
-  | Some commit ->
-      GitStore.Commit.tree commit >>= fun tree ->
-      let ctxt = { index ; tree ; parents = [commit] } in
-      Lwt.return_some ctxt
+    let metadata_t =
+      let some = "\255\000\000\000\000\000\000\000" in
+      let none = "\000\000\000\000\000\000\000\000" in
+      Irmin.Type.(map (string_of (`Fixed 8)))
+        (fun s ->
+           match s.[0] with
+           | '\255' -> None
+           | '\000' -> Some ()
+           | _ -> assert false )
+        (function Some _ -> some | None -> none)
 
-let checkout_exn index key =
-  checkout index key >>= function
-  | None -> Lwt.fail Not_found
-  | Some p -> Lwt.return p
+    (* Irmin 1.4 uses int64 to store list lengths *)
+    let entry_t : entry Irmin.Type.t =
+      let open Irmin.Type in
+      record "Tree.entry" (fun kind name node ->
+          let kind = match kind with None -> `Node | Some m -> `Contents m in
+          let key =
+            match kind with
+            | `Node -> lazy (name ^ "/")
+            | `Contents _ -> lazy name
+          in
+          {key; kind; name; node} )
+      |+ field "kind" metadata_t (function
+          | {kind= `Node; _} -> None
+          | {kind= `Contents m; _} -> Some m )
+      |+ field "name" step_t (fun {name; _} -> name)
+      |+ field "node" Hash.t (fun {node; _} -> node)
+      |> sealr
 
-let raw_commit ~time ?(message = "") context =
-  let info =
-    Irmin.Info.v ~date:(Time.Protocol.to_seconds time) ~author:"Tezos" message in
-  GitStore.Commit.v
-    context.index.repo ~info ~parents:context.parents context.tree
+    let entries_t : entry list Irmin.Type.t =
+      Irmin.Type.(list ~len:`Int64 entry_t)
 
-module P = GitStore.Private
+    let import_entry (s, v) =
+      match v with
+      | `Node h -> {key= lazy (s ^ "/"); name= s; kind= `Node; node= h}
+      | `Contents (h, m) -> {key= lazy s; name= s; kind= `Contents m; node= h}
 
-(* --- FIXME(samoht): I am so sorry --- *)
-module Hack = struct
+    let import t = List.map import_entry (M.list t)
 
-  module StepMap = struct
-    module X = struct
-      type t = GitStore.step
-      let t = GitStore.step_t
-      let compare = Irmin.Type.compare t
-    end
-    include Map.Make(X)
+    (* store the entries before hashing to be compatible with Tezos v1 *)
+    let pre_hash entries =
+      let entries = List.fast_sort compare_entries entries in
+      Irmin.Type.pre_hash entries_t entries
   end
 
-  module Contents = struct
-
-    type key = P.Contents.key
-    type contents = P.Contents.value
+  include M
 
-    type t =
-      | Key      of key
-      | Contents of contents
-      | Both     of key * contents
+  let pre_hash_v1 x = V1.pre_hash (V1.import x)
 
-    let t =
-      let open Irmin.Type in
-      variant "Node.Contents" (fun key contents both -> function
-          | Key x       -> key x
-          | Contents x -> contents x
-          | Both (x, y) -> both (x, y))
-      |~ case1 "Key" P.Contents.Key.t (fun x -> Key x)
-      |~ case1 "Contents" P.Contents.Val.t (fun x -> Contents x)
-      |~ case1 "Both" (pair P.Contents.Key.t P.Contents.Val.t)
-        (fun (x, y) -> Both (x, y))
-      |> sealv
-
-    let hash = function
-      | Key k | Both (k, _) -> k
-      | Contents c -> P.Contents.Key.digest P.Contents.Val.t c
+  let t = Irmin.Type.(like t ~pre_hash:pre_hash_v1)
+end
 
-  end
+module Commit = struct
+  module M = Irmin.Private.Commit.Make (Hash)
+  module V1 = Irmin.Private.Commit.V1 (M)
+  include M
 
-  type key = P.Node.key
+  let pre_hash_v1 t = Irmin.Type.pre_hash V1.t (V1.import t)
 
-  type value = [ `Node of node | `Contents of Contents.t * Metadata.t ]
+  let t = Irmin.Type.like t ~pre_hash:pre_hash_v1
+end
 
-  and map = value StepMap.t
+module Contents = struct
+  type t = string
 
-  and node =
-    | Map  of map
-    | Key  of key
-    | Both of key * map
+  let pre_hash_v1 x =
+    let ty = Irmin.Type.(pair (string_of `Int64) unit) in
+    Irmin.Type.(pre_hash ty) (x, ())
 
-  let value t =
-    let open Irmin.Type in
-    variant "Node.value" (fun node contents -> function
-        | `Node x     -> node x
-        | `Contents x -> contents x)
-    |~ case1 "Node" t (fun x -> `Node x)
-    |~ case1 "Contents" (pair Contents.t Metadata.t) (fun x -> `Contents x)
-    |> sealv
+  let t = Irmin.Type.(like ~pre_hash:pre_hash_v1 string)
 
-  let map value =
-    let open Irmin.Type in
-    let to_map x =
-      List.fold_left (fun acc (k, v) -> StepMap.add k v acc) StepMap.empty x
-    in
-    let of_map m = StepMap.fold (fun k v acc -> (k, v) :: acc) m [] in
-    like (list (pair GitStore.step_t value)) to_map of_map
-
-  let node map =
-    let open Irmin.Type in
-    variant "Node.node" (fun map key both -> function
-        | Map x      -> map x
-        | Key y      -> key y
-        | Both (y,z) -> both (y, z))
-    |~ case1 "Map" map (fun x -> Map x)
-    |~ case1 "Key" P.Node.Key.t (fun x -> Key x)
-    |~ case1 "Both" (pair P.Node.Key.t map) (fun (x, y) -> Both (x, y))
-    |> sealv
-
-  let node_t = Irmin.Type.mu (fun n ->
-      let value = value n in
-      node (map value)
-    )
+  let merge = Irmin.Merge.(idempotent (Irmin.Type.option t))
+end
 
-  (* Mimick irmin-lmdb ordering *)
-  module Sort_key = struct
-
-    exception Result of int
-
-    let compare (x, vx) (y, vy) = match vx, vy with
-      | `Contents _, `Contents _ -> String.compare x y
-      | _  ->
-          let lenx = String.length x in
-          let leny = String.length y in
-          let i = ref 0 in
-          try
-            while !i < lenx && !i < leny do
-              match
-                Char.compare
-                  (String.unsafe_get x !i) (String.unsafe_get y !i)
-              with
-              | 0 -> incr i
-              | i -> raise (Result i)
-            done;
-            let get len k v i =
-              if i < len then String.unsafe_get k i
-              else if i = len then match v with
-                | `Node _     -> '/'
-                | `Contents _ -> '\000'
-              else '\000'
-            in
-            match Char.compare (get lenx x vx !i) (get leny y vy !i) with
-            | 0 -> Char.compare (get lenx x vx (!i + 1)) (get leny y vy (!i + 1))
-            | i -> i
-          with Result i ->
-            i
+module Conf = struct
+  let entries = 32
+  let stable_hash = 256
+end
 
-  end
+module Store =
+  Irmin_pack.Make_ext (Conf)(Irmin.Metadata.None) (Contents)
+    (Irmin.Path.String_list)
+    (Irmin.Branch.String)
+    (Hash)
+    (Node)
+    (Commit)
 
-  let sort_entries = List.fast_sort Sort_key.compare
+module P = Store.Private
 
-  module Entry = struct
-    type kind = [ `Node | `Contents of Metadata.t ]
-    type entry = { kind : kind; name : string; node : IrminBlake2B.t; }
+type index = {
+  path: string ;
+  repo: Store.Repo.t ;
+  patch_context: context -> context Lwt.t ;
+}
 
-    let entry_t =
-      let open Irmin.Type in
-      record "Tree.entry"
-        (fun kind name node ->
-           let kind =
-             match kind with
-             | None -> `Node
-             | Some m -> `Contents m in
-           { kind ; name ; node } )
-      |+ field "kind" (option Metadata.t) (function
-          | { kind = `Node ; _ } -> None
-          | { kind = `Contents m ; _ } -> Some m)
-      |+ field "name" string (fun { name ; _ } -> name)
-      |+ field "node" IrminBlake2B.t (fun { node ; _ } -> node)
-      |> sealr
+and context = {
+  index: index ;
+  parents: Store.Commit.t list ;
+  tree: Store.tree ;
+}
+type t = context
 
-    let of_entry e = e.name, match e.kind with
-      | `Node       -> `Node e.node
-      | `Contents m -> `Contents (e.node, m)
+(*-- Version Access and Update -----------------------------------------------*)
 
-    let to_entry (name, value) = match value with
-      | `Node node -> { name; kind = `Node; node }
-      | `Contents (node, m) -> { name; kind = `Contents m; node }
+let current_protocol_key = ["protocol"]
+let current_test_chain_key = ["test_chain"]
+let current_data_key = ["data"]
 
-    let t = Irmin.Type.like entry_t of_entry to_entry
 
-  end
+let exists index key =
+  Store.Commit.of_hash index.repo (Hash.of_context_hash key)
+  >|= function None -> false | Some _ -> true
 
-  let rec export_map map =
-    let alist =
-      StepMap.fold (fun step v acc ->
-          (step, hash_value v) :: acc
-        ) map []
-    in
-    let l = sort_entries alist in
-    P.Node.Val.v l
-
-  and hash_value = function
-    | `Contents (c, m) -> `Contents (Contents.hash c, m)
-    | `Node n          -> `Node (hash_node n)
-
-  and hash_node = function
-    | Both (k, _) | Key k -> k
-    | Map m ->
-        let v = export_map m in
-        let entries = P.Node.Val.list v in
-        (* This needs to match what is done in the backend... *)
-        let v = Irmin.Type.encode_cstruct (Irmin.Type.list Entry.t) entries in
-        IrminBlake2B.digest Irmin.Type.cstruct v
-
-  let cast: GitStore.node -> node = fun n ->
-    let buf = Irmin.Type.encode_cstruct GitStore.node_t n in
-    match Irmin.Type.decode_cstruct node_t buf with
-    | Error (`Msg e) -> Fmt.failwith "invalid cast\n%s" e
-    | Ok x -> x
+let checkout index key =
+  Store.Commit.of_hash index.repo (Hash.of_context_hash key)
+  >>= function
+  | None -> Lwt.return_none
+  | Some commit ->
+      let tree = Store.Commit.tree commit in
+      let ctxt = {index; tree; parents= [commit]} in
+      Lwt.return_some ctxt
 
-end
+let checkout_exn index key =
+  checkout index key
+  >>= function None -> Lwt.fail Not_found | Some p -> Lwt.return p
+
+(* unshalow possible 1-st level objects from previous partial
+   checkouts ; might be better to pass directly the list of shallow
+   objects. *)
+let unshallow context =
+  Store.Tree.list context.tree [] >>= fun childs ->
+  P.Repo.batch context.index.repo (fun x y _ ->
+      Lwt_list.iter_s (fun (s, k) -> match k with
+          | `Contents -> Lwt.return ()
+          | `Node ->
+              Store.Tree.get_tree context.tree [s] >>= fun tree ->
+              Store.save_tree ~clear:true context.index.repo x y tree >|= fun _ ->
+              ()
+        ) childs)
 
-let tree_hash: GitStore.tree -> GitStore.Tree.hash = function
-  | `Contents (c, m) -> `Contents (P.Contents.Key.digest P.Contents.Val.t c, m)
-  | `Node n          -> `Node (Hack.hash_node (Hack.cast n))
+let raw_commit ~time ?(message = "") context =
+  let info =
+    Irmin.Info.v ~date:(Time.Protocol.to_seconds time) ~author:"Tezos" message
+  in
+  let parents = List.map Store.Commit.hash context.parents in
+  unshallow context >>= fun () ->
+  Store.Commit.v context.index.repo ~info ~parents context.tree >|= fun h ->
+  Store.Tree.clear context.tree;
+  h
 
 let hash ~time ?(message = "") context =
   let info =
     Irmin.Info.v ~date:(Time.Protocol.to_seconds time) ~author:"Tezos" message
   in
-  let parents = List.map (fun c -> GitStore.Commit.hash c) context.parents in
-  let node = match tree_hash context.tree with
-    | `Contents _ -> assert false
-    | `Node node  -> node
-  in
+  let parents = List.map (fun c -> Store.Commit.hash c) context.parents in
+  let node = Store.Tree.hash context.tree in
   let commit = P.Commit.Val.v ~parents ~node ~info in
-  let x = P.Commit.Key.digest P.Commit.Val.t commit in
-  (* FIXME: this doesn't have to be lwt *)
-  Lwt.return x
+  let x = P.Commit.Key.hash commit in
+  Hash.to_context_hash x
 
 let commit ~time ?message context =
-  raw_commit ~time ?message context >>= fun commit ->
-  let h = GitStore.Commit.hash commit in
-  Lwt.return h
+  raw_commit ~time ?message context >|= fun commit ->
+  Hash.to_context_hash (Store.Commit.hash commit)
 
 (*-- Generic Store Primitives ------------------------------------------------*)
 
@@ -348,40 +299,42 @@ type key = string list
 type value = MBytes.t
 
 let mem ctxt key =
-  GitStore.Tree.mem ctxt.tree (data_key key) >>= fun v ->
+  Store.Tree.mem ctxt.tree (data_key key) >>= fun v ->
   Lwt.return v
 
 let dir_mem ctxt key =
-  GitStore.Tree.mem_tree ctxt.tree (data_key key) >>= fun v ->
+  Store.Tree.mem_tree ctxt.tree (data_key key) >>= fun v ->
   Lwt.return v
 
 let raw_get ctxt key =
-  GitStore.Tree.find ctxt.tree key
+  Store.Tree.find ctxt.tree key >|= Option.map ~f:MBytes.of_string
+
 let get t key = raw_get t (data_key key)
 
 let raw_set ctxt key data =
-  GitStore.Tree.add ctxt.tree key data >>= fun tree ->
+  Store.Tree.add ctxt.tree key data >>= fun tree ->
   Lwt.return { ctxt with tree }
-let set t key data = raw_set t (data_key key) data
+
+let set t key data = raw_set t (data_key key) (MBytes.to_string data)
 
 let raw_del ctxt key =
-  GitStore.Tree.remove ctxt.tree key >>= fun tree ->
+  Store.Tree.remove ctxt.tree key >>= fun tree ->
   Lwt.return { ctxt with tree }
 let del t key = raw_del t (data_key key)
 
 let remove_rec ctxt key =
-  GitStore.Tree.remove ctxt.tree (data_key key) >>= fun tree ->
+  Store.Tree.remove ctxt.tree (data_key key) >>= fun tree ->
   Lwt.return { ctxt with tree }
 
 let copy ctxt ~from ~to_ =
-  GitStore.Tree.find_tree ctxt.tree (data_key from) >>= function
+  Store.Tree.find_tree ctxt.tree (data_key from) >>= function
   | None -> Lwt.return_none
   | Some sub_tree ->
-      GitStore.Tree.add_tree ctxt.tree (data_key to_) sub_tree >>= fun tree ->
+      Store.Tree.add_tree ctxt.tree (data_key to_) sub_tree >>= fun tree ->
       Lwt.return_some { ctxt with tree }
 
 let fold ctxt key ~init ~f =
-  GitStore.Tree.list ctxt.tree (data_key key) >>= fun keys ->
+  Store.Tree.list ctxt.tree (data_key key) >>= fun keys ->
   Lwt_list.fold_left_s
     begin fun acc (name, kind) ->
       let key =
@@ -399,7 +352,8 @@ let get_protocol v =
   | None -> assert false
   | Some data -> Lwt.return (Protocol_hash.of_bytes_exn data)
 let set_protocol v key =
-  raw_set v current_protocol_key (Protocol_hash.to_bytes key)
+  let key = MBytes.to_string (Protocol_hash.to_bytes key) in
+  raw_set v current_protocol_key key
 
 let get_test_chain v =
   raw_get v current_test_chain_key >>= function
@@ -410,8 +364,9 @@ let get_test_chain v =
       | Some r -> Lwt.return r
 
 let set_test_chain v id =
-  raw_set v current_test_chain_key
-    (Data_encoding.Binary.to_bytes_exn Test_chain_status.encoding id)
+  let id = Data_encoding.Binary.to_bytes_exn Test_chain_status.encoding id in
+  raw_set v current_test_chain_key (MBytes.to_string id)
+
 let del_test_chain v  = raw_del v current_test_chain_key
 
 let fork_test_chain v ~protocol ~expiration =
@@ -419,30 +374,32 @@ let fork_test_chain v ~protocol ~expiration =
 
 (*-- Initialisation ----------------------------------------------------------*)
 
-let init ?patch_context ?mapsize ?readonly root =
-  GitStore.Repo.v
-    (Irmin_lmdb.config ?mapsize ?readonly root) >>= fun repo ->
-  Lwt.return {
-    path = root ;
-    repo ;
-    patch_context =
-      match patch_context with
-      | None -> (fun ctxt -> Lwt.return ctxt)
-      | Some patch_context -> patch_context
-  }
+let init ?patch_context ?mapsize:_ ?readonly root =
+  Store.Repo.v
+    (Irmin_pack.config ?readonly ?index_log_size:!index_log_size root)
+  >>= fun repo ->
+  let v =
+    { path= root
+    ; repo
+    ; patch_context=
+        ( match patch_context with
+          | None -> fun ctxt -> Lwt.return ctxt
+          | Some patch_context -> patch_context ) }
+  in
+  Gc.finalise (fun v -> Lwt.async (fun () -> Store.Repo.close v.repo)) v;
+  Lwt.return v
 
 let get_branch chain_id = Format.asprintf "%a" Chain_id.pp chain_id
 
-
 let commit_genesis index ~chain_id ~time ~protocol =
-  let tree = GitStore.Tree.empty in
+  let tree = Store.Tree.empty in
   let ctxt = { index ; tree ; parents = [] } in
   index.patch_context ctxt >>= fun ctxt ->
   set_protocol ctxt protocol >>= fun ctxt ->
   set_test_chain ctxt Not_running >>= fun ctxt ->
   raw_commit ~time ~message:"Genesis" ctxt >>= fun commit ->
-  GitStore.Branch.set index.repo (get_branch chain_id) commit >>= fun () ->
-  Lwt.return (GitStore.Commit.hash commit)
+  Store.Branch.set index.repo (get_branch chain_id) commit >|= fun () ->
+  Hash.to_context_hash (Store.Commit.hash commit)
 
 let compute_testchain_chain_id genesis =
   let genesis_hash = Block_hash.hash_bytes [Block_hash.to_bytes genesis] in
@@ -462,7 +419,7 @@ let commit_test_chain_genesis ctxt (forked_header : Block_header.t) =
     predecessor = Block_hash.zero ;
     validation_passes = 0 ;
     operations_hash = Operation_list_list_hash.empty ;
-    context = GitStore.Commit.hash commit ;
+    context = Hash.to_context_hash (Store.Commit.hash commit) ;
   } in
   let forked_block = Block_header.hash forked_header in
   let genesis_hash = compute_testchain_genesis forked_block in
@@ -471,27 +428,25 @@ let commit_test_chain_genesis ctxt (forked_header : Block_header.t) =
     { shell = { faked_shell_header with predecessor = genesis_hash } ;
       protocol_data = MBytes.create 0 } in
   let branch = get_branch chain_id in
-  GitStore.Branch.set ctxt.index.repo branch commit >>= fun () ->
+  Store.Branch.set ctxt.index.repo branch commit >>= fun () ->
   Lwt.return genesis_header
 
 
 let clear_test_chain index chain_id =
   (* TODO remove commits... ??? *)
   let branch = get_branch chain_id in
-  GitStore.Branch.remove index.repo branch
+  Store.Branch.remove index.repo branch
 
 let set_head index chain_id commit =
   let branch = get_branch chain_id in
-  GitStore.Commit.of_hash index.repo commit >>= function
+  Store.Commit.of_hash index.repo (Hash.of_context_hash commit) >>= function
   | None -> assert false
-  | Some commit ->
-      GitStore.Branch.set index.repo branch commit
+  | Some commit -> Store.Branch.set index.repo branch commit
 
 let set_master index commit =
-  GitStore.Commit.of_hash index.repo commit >>= function
+  Store.Commit.of_hash index.repo (Hash.of_context_hash commit) >>= function
   | None -> assert false
-  | Some commit ->
-      GitStore.Branch.set index.repo GitStore.Branch.master commit
+  | Some commit -> Store.Branch.set index.repo Store.Branch.master commit
 
 (* Context dumping *)
 
@@ -620,15 +575,20 @@ end
 module Dumpable_context = struct
   type nonrec index = index
   type nonrec context = context
-  type tree = GitStore.tree
-  type hash = GitStore.Tree.hash
+  type tree = Store.tree
+  type hash = [`Blob of Store.hash | `Node of Store.hash]
   type step = string
   type key = step list
   type commit_info = Irmin.Info.t
 
-  let hash_export = function
-    | `Contents ( h, () ) -> `Blob, Context_hash.to_bytes h
-    | `Node h -> `Node, Context_hash.to_bytes h
+  type batch =
+    | Batch of Store.repo
+               * [`Read | `Write] P.Contents.t
+               * [`Read | `Write] P.Node.t
+
+  let batch index f =
+    P.Repo.batch index.repo (fun x y _ -> f (Batch (index.repo, x, y)))
+
   let hash_import ty mb =
     Context_hash.of_bytes mb >>? fun h ->
     match ty with
@@ -673,83 +633,93 @@ module Dumpable_context = struct
     let open Data_encoding in
     let kind_encoding = string_enum [("node", `Node) ; ("blob", `Blob) ] in
     conv
-      begin fun hash -> hash_export hash end
       begin function
-        | (`Node, h) -> `Node (Context_hash.of_bytes_exn h)
-        | (`Blob, h) -> `Contents (Context_hash.of_bytes_exn h, ())
+        | `Blob h -> `Blob, (Context_hash.to_bytes (Hash.to_context_hash h))
+        | `Node h -> `Node, (Context_hash.to_bytes (Hash.to_context_hash h))
+      end
+      begin function
+        | `Blob, h -> `Blob (Hash.of_context_hash (Context_hash.of_bytes_exn h))
+        | `Node, h -> `Node (Hash.of_context_hash (Context_hash.of_bytes_exn h))
       end
       (obj2 (req "kind" kind_encoding) (req "value" bytes))
 
   let context_parents ctxt =
     match ctxt with
     | { parents = [commit]; _ } ->
-        (* XXX(samoht): fixed in irmin v2 *)
-        let key = GitStore.Commit.hash commit in
-        GitStore.Private.Commit.find
-          (GitStore.Private.Repo.commit_t ctxt.index.repo) key
-        >|= fun v ->
-        let commit = match v with None -> assert false | Some v -> v in
-        let parents = GitStore.Private.Commit.Val.parents commit in
+        let parents = Store.Commit.parents commit in
+        let parents = List.map Hash.to_context_hash parents in
         List.sort Context_hash.compare parents
     | _ -> assert false
 
   let context_info = function
-    | { parents = [c]; _ } -> GitStore.Commit.info c
+    | { parents = [c]; _ } -> Store.Commit.info c
     | _ -> assert false
   let context_info_export i = Irmin.Info.( date i, author i, message i )
-  let context_info_import ( date, author, message) = Irmin.Info.v ~date ~author message
+  let context_info_import ( date, author, message) =
+    Irmin.Info.v ~date ~author message
 
   let get_context idx bh = checkout idx bh.Block_header.shell.context
+
   let set_context ~info ~parents ctxt bh =
     let parents = List.sort Context_hash.compare parents in
-    GitStore.Tree.hash ctxt.index.repo ctxt.tree >>= function
-    | `Node node ->
-        let v = GitStore.Private.Commit.Val.v ~info ~node ~parents in
-        GitStore.Private.Commit.add (GitStore.Private.Repo.commit_t ctxt.index.repo) v
-        >>= fun ctxt_h ->
-        if Context_hash.equal bh.Block_header.shell.context ctxt_h
-        then Lwt.return_some bh
-        else Lwt.return_none
-    | `Contents _ -> assert false
+    let parents = List.map Hash.of_context_hash parents in
+    Store.Commit.v ctxt.index.repo ~info ~parents ctxt.tree >>= fun c ->
+    let h = Store.Commit.hash c in
+    if Context_hash.equal bh.Block_header.shell.context (Hash.to_context_hash h)
+    then Lwt.return_some bh
+    else Lwt.return_none
 
   let context_tree ctxt = ctxt.tree
-  let tree_hash ctxt = function
-    | `Node _ as node -> GitStore.Tree.hash ctxt.index.repo node
-    | contents -> Lwt.return (tree_hash contents)
-  let sub_tree tree key = GitStore.Tree.find_tree tree key
-  let tree_list tree = GitStore.Tree.list tree []
-  let tree_content tree = GitStore.Tree.find tree []
-
-  let make_context index = { index ; tree = GitStore.Tree.empty ; parents = [] ; }
+
+  let tree_hash = function
+    | `Node _  as tree -> `Node (Store.Tree.hash tree)
+    | `Contents (b, _) -> `Blob (Store.Contents.hash b)
+
+  let sub_tree tree key = Store.Tree.find_tree tree key
+  let tree_list tree = Store.Tree.list tree []
+  let tree_content tree = Store.Tree.find tree []
+
+  let make_context index = { index ; tree = Store.Tree.empty ; parents = [] ; }
   let update_context context tree = { context with tree ; }
 
-  let add_hash index tree key hash =
-    GitStore.Tree.of_hash index.repo hash >>= function
+  let add_blob_hash (Batch (repo, _, _)) tree key hash =
+    Store.Contents.of_hash repo hash >>= function
     | None -> Lwt.return_none
-    | Some sub_tree ->
-        GitStore.Tree.add_tree tree key sub_tree >>=
-        Lwt.return_some
+    | Some v -> Store.Tree.add tree key v >>= Lwt.return_some
 
-  let add_mbytes index bytes =
-    let tree = GitStore.Tree.of_contents bytes in
-    GitStore.Tree.hash index.repo tree >|= fun _ ->
-    tree
+  let add_node_hash (Batch (repo, _, _)) tree key hash =
+    Store.Tree.of_hash repo hash >>= function
+    | None -> Lwt.return_none
+    | Some t -> Store.Tree.add_tree tree key (t :> tree) >>= Lwt.return_some
+
+  let add_mbytes (Batch (_, t, _)) bytes =
+    (* Save the contents in the store *)
+    Store.save_contents t bytes >|= fun _ ->
+    Store.Tree.of_contents bytes
 
-  let add_dir index l =
+  let add_dir batch l =
     let rec fold_list sub_tree = function
       | [] -> Lwt.return_some sub_tree
-      | ( step, hash ) :: tl ->
-          begin
-            add_hash index sub_tree [step]hash >>= function
-            | None -> Lwt.return_none
-            | Some sub_tree -> fold_list sub_tree tl
-          end
+      | (step, hash) :: tl -> (
+          match hash with
+          | `Blob hash -> (
+              add_blob_hash batch sub_tree [step] hash >>= function
+              | None -> Lwt.return_none
+              | Some sub_tree -> fold_list sub_tree tl
+            )
+          | `Node hash -> (
+              add_node_hash batch sub_tree [step] hash >>= function
+              | None -> Lwt.return_none
+              | Some sub_tree -> fold_list sub_tree tl
+            ) )
     in
-    fold_list GitStore.Tree.empty l >>= function
+    fold_list Store.Tree.empty l >>= function
     | None -> Lwt.return_none
     | Some tree ->
-        GitStore.Tree.hash index.repo tree >>= fun _ ->
-        Lwt.return_some tree
+        let Batch (repo, x, y) = batch in
+        (* Save the node in the store ... *)
+        Store.save_tree ~clear:true repo x y tree >|= fun _ ->
+        Some tree
 
   module Commit_hash = Context_hash
   module Block_header = Block_header
@@ -760,10 +730,9 @@ end
 
 (* Protocol data *)
 
-let data_node_hash index context =
-  GitStore.Tree.get_tree context.tree current_data_key >>= fun dt ->
-  GitStore.Tree.hash index.repo dt >>= fun dt_hash ->
-  match dt_hash with `Node x -> Lwt.return x | _ -> assert false
+let data_node_hash context =
+  Store.Tree.get_tree context.tree current_data_key >|= fun tree ->
+  Hash.to_context_hash (Store.Tree.hash tree)
 
 let get_transition_block_headers pruned_blocks =
   let rec aux hs x bs = match bs with
@@ -793,10 +762,10 @@ let get_protocol_data_from_header index block_header =
     author ;
     message ;
   } in
-  Dumpable_context.context_parents context >>= fun parents ->
+  let parents = Dumpable_context.context_parents context in
   get_protocol context >>= fun protocol_hash ->
   get_test_chain context >>= fun test_chain_status ->
-  data_node_hash index context >>= fun data_key ->
+  data_node_hash context >>= fun data_key ->
   Lwt.return (level , {
       Protocol_data.parents ;
       protocol_hash ;
@@ -805,40 +774,6 @@ let get_protocol_data_from_header index block_header =
       info ;
     })
 
-(* Mock some GitStore types, so we can build our own Merkle tree. *)
-
-module Mock : sig
-
-  val node : GitStore.Repo.t -> P.Node.key -> GitStore.node
-
-  val commit : GitStore.repo -> Hack.key -> P.Commit.value -> GitStore.commit
-
-end = struct
-
-  [@@@ocaml.warning "-37"]
-
-  type commit = { r: GitStore.Repo.t ; h: Context_hash.t; v: P.Commit.value }
-
-  type empty
-
-  type u =
-    | Map : empty -> u
-    | Key : GitStore.Repo.t * P.Node.key -> u
-    | Both: empty * empty * empty -> u
-
-  and node = {mutable v : u}
-
-  let node repo key =
-    let t : u = Key (repo, key) in
-    let node : node = {v = t} in
-    (Obj.magic node : GitStore.node)
-
-  let commit r h v =
-    let c : commit = {r ; h ; v} in
-    (Obj.magic c : GitStore.commit)
-
-end
-
 let validate_context_hash_consistency_and_commit
     ~data_hash
     ~expected_context_hash
@@ -850,31 +785,36 @@ let validate_context_hash_consistency_and_commit
     ~parents
     ~index
   =
+  let data_hash = Hash.of_context_hash data_hash in
+  let parents = List.map Hash.of_context_hash parents in
   let protocol_value = Protocol_hash.to_bytes protocol_hash in
   let test_chain_value = Data_encoding.Binary.to_bytes_exn
       Test_chain_status.encoding test_chain in
-  let tree = GitStore.Tree.empty in
-  GitStore.Tree.add tree current_protocol_key protocol_value >>= fun tree ->
-  GitStore.Tree.add tree current_test_chain_key test_chain_value >>= fun tree ->
-  let info = Irmin.Info.v ~date:(Time.Protocol.to_seconds timestamp) ~author message in
-  let o_tree = Hack.cast (match tree with `Node n -> n | _ -> assert false) in
-  let map = match o_tree with Map m -> m | _ -> assert false in
-  let data_tree = Hack.Key data_hash in
-  let new_map = Hack.Map (Hack.StepMap.add "data" (`Node data_tree) map) in
-  let node = Hack.hash_node new_map in
+  let tree = Store.Tree.empty in
+  Store.Tree.add tree current_protocol_key (MBytes.to_string protocol_value)
+  >>= fun tree ->
+  Store.Tree.add tree current_test_chain_key (MBytes.to_string test_chain_value)
+  >>= fun tree ->
+  let info =
+    Irmin.Info.v ~date:(Time.Protocol.to_seconds timestamp) ~author message
+  in
+  let data_tree = Store.Tree.shallow index.repo data_hash in
+  Store.Tree.add_tree tree ["data"] data_tree >>= fun node ->
+  let node = Store.Tree.hash node in
   let commit = P.Commit.Val.v ~parents ~node ~info in
-  let computed_context_hash = P.Commit.Key.digest P.Commit.Val.t commit in
+  let computed_context_hash = Hash.to_context_hash (P.Commit.Key.hash commit) in
   if Context_hash.equal expected_context_hash computed_context_hash then
-    let mock_parents = List.map (fun h -> Mock.commit index.repo h commit) parents in
-    let ctxt = {index ; tree = GitStore.Tree.empty ; parents = mock_parents} in
+    let ctxt =
+      let parent = Store.of_private_commit index.repo commit in
+      {index ; tree = Store.Tree.empty ; parents = [parent]}
+    in
     set_test_chain ctxt test_chain >>= fun ctxt ->
     set_protocol ctxt protocol_hash >>= fun ctxt ->
-    let data_t = `Node (Mock.node index.repo data_hash) in
-    GitStore.Tree.add_tree ctxt.tree current_data_key data_t >>= fun new_tree ->
-    GitStore.Commit.v ctxt.index.repo ~info ~parents:ctxt.parents new_tree
-    >>= fun commit ->
-    let ctxt_h = GitStore.Commit.hash commit in
-    Lwt.return (Context_hash.equal ctxt_h expected_context_hash)
+    let data_t = Store.Tree.shallow index.repo data_hash in
+    Store.Tree.add_tree ctxt.tree current_data_key data_t >>= fun new_tree ->
+    Store.Commit.v ctxt.index.repo ~info ~parents new_tree >|= fun commit ->
+    let ctxt_h = Hash.to_context_hash (Store.Commit.hash commit) in
+    Context_hash.equal ctxt_h expected_context_hash
   else
     Lwt.return_false
 
@@ -966,3 +906,5 @@ let restore_contexts idx ~filename k_store_pruned_block pipeline_validation =
        else fail @@ Suspicious_file (total - current)
     )
     (fun () -> Lwt_unix.close fd)
+
+module Irmin = Store
diff --git a/src/lib_storage/context.mli b/src/lib_storage/context.mli
index c4ff1b737abc094b14b5b2a420e9281020a61188..0d24b51a09d2f8cd1fdfc6fc810618c3af26bfbf 100644
--- a/src/lib_storage/context.mli
+++ b/src/lib_storage/context.mli
@@ -87,8 +87,8 @@ val fold:
 val exists: index -> Context_hash.t -> bool Lwt.t
 val checkout: index -> Context_hash.t -> context option Lwt.t
 val checkout_exn: index -> Context_hash.t -> context Lwt.t
-val hash:   time:Time.Protocol.t ->
-  ?message:string -> t -> Context_hash.t Lwt.t
+val hash:   time:Time.Protocol.t -> ?message:string -> t -> Context_hash.t
+
 val commit:
   time:Time.Protocol.t ->
   ?message:string ->
@@ -193,3 +193,5 @@ val validate_context_hash_consistency_and_commit :
   parents:Context_hash.t list ->
   index:index ->
   bool Lwt.t
+
+module Irmin: Irmin.KV with type metadata = unit
diff --git a/src/lib_storage/context_dump.ml b/src/lib_storage/context_dump.ml
index 135cb052f9185a5a0635d938eab6a7cb5f5b6e46..59997825e1f6cdc8b644af27d4c4358b5af53963 100644
--- a/src/lib_storage/context_dump.ml
+++ b/src/lib_storage/context_dump.ml
@@ -36,11 +36,12 @@ module type Dump_interface = sig
   type key = step list
   type commit_info
 
+  type batch
+  val batch : index -> (batch -> 'a Lwt.t) -> 'a Lwt.t
+
   val commit_info_encoding : commit_info Data_encoding.t
 
   val hash_encoding : hash Data_encoding.t
-  val blob_encoding : [ `Blob of MBytes.t ] Data_encoding.t
-  val node_encoding : [ `Node of MBytes.t ] Data_encoding.t
 
   module Block_header : sig
     type t = Block_header.t
@@ -80,18 +81,11 @@ module type Dump_interface = sig
     val encoding : t Data_encoding.t
   end
 
-  (* hash manipulation *)
-  val hash_export : hash -> [ `Node | `Blob ] * MBytes.t
-  val hash_import : [ `Node | `Blob ]  -> MBytes.t -> hash tzresult
-  val hash_equal : hash -> hash -> bool
-
   (* commit manipulation (for parents) *)
-  val context_parents : context -> Commit_hash.t list Lwt.t
+  val context_parents : context -> Commit_hash.t list
 
   (* Commit info *)
   val context_info : context -> commit_info
-  val context_info_export : commit_info -> ( Int64.t * string * string )
-  val context_info_import : ( Int64.t * string * string ) -> commit_info
 
   (* block header manipulation *)
   val get_context : index -> Block_header.t -> context option Lwt.t
@@ -102,17 +96,16 @@ module type Dump_interface = sig
 
   (* for dumping *)
   val context_tree : context -> tree
-  val tree_hash : context -> tree -> hash Lwt.t
+  val tree_hash : tree -> hash
   val sub_tree : tree -> key -> tree option Lwt.t
   val tree_list : tree -> ( step * [`Contents|`Node] ) list Lwt.t
-  val tree_content : tree -> MBytes.t option Lwt.t
+  val tree_content : tree -> string option Lwt.t
 
   (* for restoring *)
   val make_context : index -> context
   val update_context : context -> tree -> context
-  val add_hash : index -> tree -> key -> hash -> tree option Lwt.t
-  val add_mbytes : index -> MBytes.t -> tree Lwt.t
-  val add_dir : index -> ( step * hash ) list -> tree option Lwt.t
+  val add_mbytes : batch -> string -> tree Lwt.t
+  val add_dir : batch -> ( step * hash) list -> tree option Lwt.t
 
 end
 
@@ -135,7 +128,8 @@ module type S = sig
     (block_header option ->
      Block_hash.t -> pruned_block -> unit tzresult Lwt.t) ->
     (block_header * block_data * History_mode.t *
-     Block_header.t option * Block_hash.t list * protocol_data list) tzresult Lwt.t
+     Block_header.t option * Block_hash.t list *
+     protocol_data list) tzresult Lwt.t
 
 end
 
@@ -263,7 +257,7 @@ let () = begin
           "Internal error while restoring the context.")
     empty
     (function Restore_context_failure -> Some () | _ -> None)
-    (fun () -> Restore_context_failure);
+    (fun () -> Restore_context_failure) ;
 
 end
 
@@ -277,7 +271,7 @@ module Make (I:Dump_interface) = struct
         block_data : I.Block_data.t ;
       }
     | Node of (string * I.hash) list
-    | Blob of MBytes.t
+    | Blob of string
     | Proot of I.Pruned_block.t
     | Loot of I.Protocol_data.t
     | End
@@ -287,7 +281,7 @@ module Make (I:Dump_interface) = struct
   let blob_encoding =
     let open Data_encoding in
     case ~title:"blob" (Tag (Char.code 'b'))
-      bytes
+      string
       (function Blob bytes -> Some bytes | _ -> None)
       (function bytes -> Blob bytes)
 
@@ -498,7 +492,7 @@ module Make (I:Dump_interface) = struct
             I.sub_tree tree [name] >>= function
             | None -> assert false
             | Some sub_tree ->
-                I.tree_hash ctxt sub_tree >>= fun hash ->
+                let hash = I.tree_hash sub_tree in
                 begin
                   if visited hash then Lwt.return_unit
                   else
@@ -521,8 +515,8 @@ module Make (I:Dump_interface) = struct
                                 maybe_flush ()
                           end
                     end
-                end >>= fun () ->
-                Lwt.return (name, hash)
+                end >|= fun () ->
+                (name, hash)
           end
           keys >>= fun sub_keys ->
         set_node buf sub_keys;
@@ -540,7 +534,7 @@ module Make (I:Dump_interface) = struct
           let tree = I.context_tree ctxt in
           fold_tree_path ctxt tree >>= fun () ->
           Tezos_stdlib_unix.Utils.display_progress_end ();
-          I.context_parents ctxt >>= fun parents ->
+          let parents = I.context_parents ctxt in
           set_root buf bh (I.context_info ctxt) parents block_data;
           (* Dump pruned blocks *)
           let dump_pruned cpt pruned =
@@ -591,19 +585,19 @@ module Make (I:Dump_interface) = struct
     let rbuf = ref (fd, Bytes.empty, 0, read) in
 
     (* Editing the repository *)
-    let add_blob blob =
-      I.add_mbytes index blob >>= fun tree ->
+    let add_blob t blob =
+      I.add_mbytes t blob >>= fun tree ->
       return tree
     in
 
-    let add_dir keys =
-      I.add_dir index keys >>= function
+    let add_dir t keys =
+      I.add_dir t keys >>= function
       | None -> fail Restore_context_failure
       | Some tree -> return tree
     in
 
     let restore history_mode =
-      let rec first_pass ctxt cpt =
+      let rec first_pass batch ctxt cpt =
         Tezos_stdlib_unix.Utils.display_progress
           ~refresh_rate:(cpt, 1_000)
           "Context: %dK elements, %dMiB read"
@@ -616,11 +610,11 @@ module Make (I:Dump_interface) = struct
                   return (block_header, block_data)
             end
         | Node contents ->
-            add_dir contents >>=? fun tree ->
-            first_pass (I.update_context ctxt tree) (cpt + 1)
+            add_dir batch contents >>=? fun tree ->
+            first_pass batch (I.update_context ctxt tree) (cpt + 1)
         | Blob data ->
-            add_blob data >>=? fun tree ->
-            first_pass (I.update_context ctxt tree) (cpt + 1)
+            add_blob batch data >>=? fun tree ->
+            first_pass batch (I.update_context ctxt tree) (cpt + 1)
         | _ -> fail Inconsistent_snapshot_data in
 
       let rec second_pass pred_header (rev_block_hashes, protocol_datas) todo cpt =
@@ -647,7 +641,9 @@ module Make (I:Dump_interface) = struct
         | End ->
             return (pred_header, rev_block_hashes, List.rev protocol_datas)
         | _ -> fail Inconsistent_snapshot_data in
-      first_pass (I.make_context index) 0 >>=? fun (block_header, block_data) ->
+      I.batch index (fun batch ->
+          first_pass batch (I.make_context index) 0
+        ) >>=? fun (block_header, block_data) ->
       Tezos_stdlib_unix.Utils.display_progress_end () ;
       second_pass None ([], []) [] 0 >>=? fun (oldest_header_opt, rev_block_hashes, protocol_datas) ->
       Tezos_stdlib_unix.Utils.display_progress_end () ;
diff --git a/src/lib_storage/context_dump.mli b/src/lib_storage/context_dump.mli
index 511b2f6bcbb4c13d68e45b8b15f06babe1aa9a3b..3bdefa5bc8eef1b87551df150919843b7a3b4a54 100644
--- a/src/lib_storage/context_dump.mli
+++ b/src/lib_storage/context_dump.mli
@@ -43,11 +43,12 @@ module type Dump_interface = sig
   type key = step list
   type commit_info
 
+  type batch
+  val batch : index -> (batch -> 'a Lwt.t) -> 'a Lwt.t
+
   val commit_info_encoding : commit_info Data_encoding.t
 
   val hash_encoding : hash Data_encoding.t
-  val blob_encoding : [ `Blob of MBytes.t ] Data_encoding.t
-  val node_encoding : [ `Node of MBytes.t ] Data_encoding.t
 
   module Block_header : sig
     type t = Block_header.t
@@ -87,18 +88,11 @@ module type Dump_interface = sig
     val encoding : t Data_encoding.t
   end
 
-  (* hash manipulation *)
-  val hash_export : hash -> [ `Node | `Blob ] * MBytes.t
-  val hash_import : [ `Node | `Blob ]  -> MBytes.t -> hash tzresult
-  val hash_equal : hash -> hash -> bool
-
   (* commit manipulation (for parents) *)
-  val context_parents : context -> Commit_hash.t list Lwt.t
+  val context_parents : context -> Commit_hash.t list
 
   (* Commit info *)
   val context_info : context -> commit_info
-  val context_info_export : commit_info -> ( Int64.t * string * string )
-  val context_info_import : ( Int64.t * string * string ) -> commit_info
 
   (* block header manipulation *)
   val get_context : index -> Block_header.t -> context option Lwt.t
@@ -109,17 +103,16 @@ module type Dump_interface = sig
 
   (* for dumping *)
   val context_tree : context -> tree
-  val tree_hash : context -> tree -> hash Lwt.t
+  val tree_hash : tree -> hash
   val sub_tree : tree -> key -> tree option Lwt.t
   val tree_list : tree -> ( step * [`Contents|`Node] ) list Lwt.t
-  val tree_content : tree -> MBytes.t option Lwt.t
+  val tree_content : tree -> string option Lwt.t
 
   (* for restoring *)
   val make_context : index -> context
   val update_context : context -> tree -> context
-  val add_hash : index -> tree -> key -> hash -> tree option Lwt.t
-  val add_mbytes : index -> MBytes.t -> tree Lwt.t
-  val add_dir : index -> ( step * hash ) list -> tree option Lwt.t
+  val add_mbytes : batch -> string -> tree Lwt.t
+  val add_dir : batch -> ( step * hash ) list -> tree option Lwt.t
 
 end
 
diff --git a/src/lib_storage/dune b/src/lib_storage/dune
index 513b4eb794d3d424276ce504413b474ba3c705d1..b963fa0f3564bb863bf1be3f5972f6de55a6f7d8 100644
--- a/src/lib_storage/dune
+++ b/src/lib_storage/dune
@@ -4,7 +4,9 @@
  (libraries tezos-base
             tezos-shell-services
             lmdb
-            irmin-lmdb
+            digestif.c
+            irmin
+            irmin-pack
             tezos-stdlib-unix)
  (flags (:standard -w -9+27-30-32-40@8
                    -safe-string
diff --git a/src/lib_storage/tezos-storage.opam b/src/lib_storage/tezos-storage.opam
index 8d2c5a138182c4d4c5c8a72f7c65922d099565c3..14a74d94a1836302f9c1a83b63c83044e44a893c 100644
--- a/src/lib_storage/tezos-storage.opam
+++ b/src/lib_storage/tezos-storage.opam
@@ -11,7 +11,9 @@ depends: [
   "dune" { build & >= "1.7" }
   "tezos-base"
   "lmdb"
-  "irmin-lmdb"
+  "irmin"
+  "irmin-pack"
+  "digestif" {>= "0.7.3"}
   "tezos-shell-services"
   "tezos-stdlib-unix"
   "alcotest-lwt" { with-test }
diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml
index 3061c938182274166b0aac851961361d57794435..95b9a3d03fcec942ec724eb904e0d822234e4805 100644
--- a/src/proto_alpha/lib_delegate/client_baking_forge.ml
+++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml
@@ -595,7 +595,7 @@ let finalize_block_header
           return context
     | Forking _ -> fail Forking_test_chain
   end >>=? fun context ->
-  Context.hash ~time:timestamp ?message context >>= fun context ->
+  let context = Context.hash ~time:timestamp ?message context in
   let header =
     Tezos_base.Block_header.
       { pred_shell_header with
diff --git a/vendors/index/.gitignore b/vendors/index/.gitignore
new file mode 100644
index 0000000000000000000000000000000000000000..231dab4b1edf24c2ca661c4224fc6f744a1445d9
--- /dev/null
+++ b/vendors/index/.gitignore
@@ -0,0 +1,3 @@
+_build
+*.install
+*.merlin
diff --git a/vendors/index/.ocamlformat b/vendors/index/.ocamlformat
new file mode 100644
index 0000000000000000000000000000000000000000..c74708f6a4e79fca6c50aff613abf912a492024a
--- /dev/null
+++ b/vendors/index/.ocamlformat
@@ -0,0 +1,2 @@
+version = 0.10
+profile = conventional
diff --git a/vendors/index/LICENSE b/vendors/index/LICENSE
new file mode 100644
index 0000000000000000000000000000000000000000..30046ee86c6f169f5573b667413ac6def0984fdd
--- /dev/null
+++ b/vendors/index/LICENSE
@@ -0,0 +1,21 @@
+The MIT License
+
+Copyright (c) 2019 Clément Pascutto, Thomas Gazagnaire
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
diff --git a/vendors/index/index.opam b/vendors/index/index.opam
new file mode 100644
index 0000000000000000000000000000000000000000..7d909786230fe2783561716e2408c5c42ef4d06a
--- /dev/null
+++ b/vendors/index/index.opam
@@ -0,0 +1,22 @@
+opam-version: "2.0"
+maintainer:   "Clement Pascutto"
+authors:      ["Clement Pascutto" "Thomas Gazagnaire"]
+license:      "MIT"
+homepage:     "https://github.com/mirage/index"
+bug-reports:  "https://github.com/mirage/index/issues"
+dev-repo:     "git+https://github.com/mirage/index.git"
+
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+ ["dune" "runtest" "-p" name] {with-test}
+]
+
+depends: [
+  "ocaml"   {>= "4.03.0"}
+  "dune"    {build & >= "1.7.0"}
+  "bloomf"
+  "fmt"
+  "logs"
+]
+synopsis: "Scalable indexes for Ocaml"
diff --git a/vendors/index/src/dune b/vendors/index/src/dune
new file mode 100644
index 0000000000000000000000000000000000000000..44208bb911ee9b4f02c3a1f25e783ec6adbeaa3c
--- /dev/null
+++ b/vendors/index/src/dune
@@ -0,0 +1,5 @@
+(library
+ (public_name index)
+ (name index)
+ (modules_without_implementation io)
+ (libraries logs fmt))
diff --git a/vendors/index/src/fan.ml b/vendors/index/src/fan.ml
new file mode 100644
index 0000000000000000000000000000000000000000..1f8da3f107153d82ff940220b6933aff87d57bf0
--- /dev/null
+++ b/vendors/index/src/fan.ml
@@ -0,0 +1,88 @@
+type t = { fans : int64 array; mask : int; shift : int }
+
+let equal t t' =
+  let rec loop i =
+    if i >= Array.length t.fans then true
+    else if Int64.equal t.fans.(i) t'.fans.(i) then loop (i + 1)
+    else false
+  in
+  t.mask = t'.mask && t.shift = t'.shift
+  && Array.length t.fans = Array.length t'.fans
+  && loop 0
+
+let log2 a = log a /. log 2.
+
+let v ~hash_size ~entry_size n =
+  let entry_sizef = float_of_int entry_size in
+  let entries_per_page = 4096. /. entry_sizef in
+  let entries_fan = float_of_int n /. (entries_per_page *. entries_per_page) in
+  let size = max 0 (int_of_float (ceil (log2 entries_fan))) in
+  let nb_fans = 1 lsl size in
+  let shift = hash_size - size in
+  { fans = Array.make nb_fans 0L; mask = (nb_fans - 1) lsl shift; shift }
+
+let fan t h = (h land t.mask) lsr t.shift
+
+let search t h =
+  let fan = fan t h in
+  let low = if fan = 0 then 0L else t.fans.(fan - 1) in
+  (low, t.fans.(fan))
+
+let update t hash off =
+  let fan = fan t hash in
+  t.fans.(fan) <- off
+
+let finalize t =
+  let rec loop curr i =
+    if i = Array.length t.fans then ()
+    else (
+      if t.fans.(i) = 0L then t.fans.(i) <- curr;
+      loop t.fans.(i) (i + 1) )
+  in
+  loop 0L 0
+
+external set_64 : Bytes.t -> int -> int64 -> unit = "%caml_string_set64u"
+
+external get_64 : string -> int -> int64 = "%caml_string_get64"
+
+external swap64 : int64 -> int64 = "%bswap_int64"
+
+let encode_int64 i =
+  let set_uint64 s off v =
+    if not Sys.big_endian then set_64 s off (swap64 v) else set_64 s off v
+  in
+  let b = Bytes.create 8 in
+  set_uint64 b 0 i;
+  Bytes.to_string b
+
+let decode_int64 buf =
+  let get_uint64 s off =
+    if not Sys.big_endian then swap64 (get_64 s off) else get_64 s off
+  in
+  get_uint64 buf 0
+
+let exported_size t = Array.length t.fans * 8
+
+let export t =
+  let encoded_size = exported_size t in
+  let buf = Buffer.create encoded_size in
+  let rec loop i =
+    if i >= Array.length t.fans then ()
+    else (
+      Buffer.add_string buf (encode_int64 t.fans.(i));
+      loop (i + 1) )
+  in
+  loop 0;
+  Buffer.contents buf
+
+let import ~hash_size buf =
+  let nb_fans = String.length buf / 8 in
+  let fans =
+    Array.init nb_fans (fun i ->
+        let sub = String.sub buf (i * 8) 8 in
+        decode_int64 sub)
+  in
+  let size = int_of_float (log2 (float_of_int nb_fans)) in
+  let shift = hash_size - size in
+  let mask = (nb_fans - 1) lsl shift in
+  { fans; mask; shift }
diff --git a/vendors/index/src/fan.mli b/vendors/index/src/fan.mli
new file mode 100644
index 0000000000000000000000000000000000000000..fb6620fb1600f7b0b30444761ef45e64d43cc640
--- /dev/null
+++ b/vendors/index/src/fan.mli
@@ -0,0 +1,32 @@
+type t
+
+val equal : t -> t -> bool
+(** The equality function for fan-out. *)
+
+val v : hash_size:int -> entry_size:int -> int -> t
+(** [v ~hash_size ~entry_size n] creates a fan_out for an index with [hash_size]
+    and [entry_size], containing [n] elements. *)
+
+val search : t -> int -> int64 * int64
+(** [search t hash] is the interval of offsets in witch [hash] is, if
+    present. *)
+
+val update : t -> int -> int64 -> unit
+(** [update t hash off] updates [t] so that [hash] is registered to be at
+    offset [off]. *)
+
+val finalize : t -> unit
+(** Finalizes the update of the fanout. This is mendatory before any [search]
+    query. *)
+
+val exported_size : t -> int
+(** [exported_size t] is the size of [export t]. This does not actually
+    compute the encoding of [t]. *)
+
+val export : t -> string
+(** [export t] is a string encoded form of [t]. *)
+
+val import : hash_size:int -> string -> t
+(** [import ~hash_size buf] decodes [buf] such that
+    [import ~hash_size (export t) = t] if [t] was initially created with
+    ~hash_size. *)
diff --git a/vendors/index/src/index.ml b/vendors/index/src/index.ml
new file mode 100644
index 0000000000000000000000000000000000000000..2501ab8a0653f8a2e1991dafeedd18c6d5c500da
--- /dev/null
+++ b/vendors/index/src/index.ml
@@ -0,0 +1,457 @@
+module Private = struct
+  module Fan = Fan
+  module Io_array = Io_array
+  module Search = Search
+end
+
+module type Key = sig
+  type t
+
+  val equal : t -> t -> bool
+
+  val hash : t -> int
+
+  val hash_size : int
+
+  val encode : t -> string
+
+  val decode : string -> int -> t
+
+  val encoded_size : int
+
+  val pp : t Fmt.t
+end
+
+module type Value = sig
+  type t
+
+  val encode : t -> string
+
+  val decode : string -> int -> t
+
+  val encoded_size : int
+
+  val pp : t Fmt.t
+end
+
+module type IO = Io.S
+
+module type S = sig
+  type t
+
+  type key
+
+  type value
+
+  val v : ?fresh:bool -> ?readonly:bool -> log_size:int -> string -> t
+
+  val clear : t -> unit
+
+  val find : t -> key -> value
+
+  val mem : t -> key -> bool
+
+  exception Invalid_key_size of key
+
+  exception Invalid_value_size of value
+
+  val replace : t -> key -> value -> unit
+
+  val iter : (key -> value -> unit) -> t -> unit
+
+  val flush : t -> unit
+
+  val close : t -> unit
+
+  val force_merge : t -> key -> value -> unit
+end
+
+let may f = function None -> () | Some bf -> f bf
+
+exception RO_not_allowed
+
+module Make (K : Key) (V : Value) (IO : IO) = struct
+  type key = K.t
+
+  type value = V.t
+
+  type entry = { key : key; key_hash : int; value : value }
+
+  let entry_size = K.encoded_size + V.encoded_size
+
+  let entry_sizeL = Int64.of_int entry_size
+
+  exception Invalid_key_size of key
+
+  exception Invalid_value_size of value
+
+  let append_entry io e =
+    let encoded_key = K.encode e.key in
+    let encoded_value = V.encode e.value in
+    if String.length encoded_key <> K.encoded_size then
+      raise (Invalid_key_size e.key);
+    if String.length encoded_value <> V.encoded_size then
+      raise (Invalid_value_size e.value);
+    IO.append io encoded_key;
+    IO.append io encoded_value
+
+  let decode_entry bytes off =
+    let string = Bytes.unsafe_to_string bytes in
+    let key = K.decode string off in
+    let value = V.decode string (off + K.encoded_size) in
+    { key; key_hash = K.hash key; value }
+
+  module Tbl = Hashtbl.Make (K)
+
+  type config = { log_size : int; readonly : bool }
+
+  type index = { io : IO.t; fan_out : Fan.t }
+
+  type t = {
+    config : config;
+    root : string;
+    mutable generation : int64;
+    mutable index : index option;
+    log : IO.t;
+    log_mem : entry Tbl.t;
+    mutable counter : int;
+    lock : IO.lock option;
+  }
+
+  let clear t =
+    Log.debug (fun l -> l "clear %S" t.root);
+    t.generation <- 0L;
+    IO.clear t.log;
+    Tbl.clear t.log_mem;
+    may
+      (fun i ->
+        IO.clear i.io;
+        IO.close i.io)
+      t.index;
+    t.index <- None
+
+  let ( // ) = Filename.concat
+
+  let index_dir root = root // "index"
+
+  let log_path root = index_dir root // "log"
+
+  let index_path root = index_dir root // "data"
+
+  let lock_path root = index_dir root // "lock"
+
+  let merge_path root = index_dir root // "merge"
+
+  let page_size = Int64.mul entry_sizeL 1_000L
+
+  let iter_io_off ?(min = 0L) ?max f io =
+    let max = match max with None -> IO.offset io | Some m -> m in
+    let rec aux offset =
+      let remaining = Int64.sub max offset in
+      if remaining <= 0L then ()
+      else
+        let size = Stdlib.min remaining page_size in
+        let raw = Bytes.create (Int64.to_int size) in
+        let n = IO.read io ~off:offset raw in
+        let rec read_page page off =
+          if off = n then ()
+          else
+            let entry = decode_entry page off in
+            f Int64.(add (of_int off) offset) entry;
+            (read_page [@tailcall]) page (off + entry_size)
+        in
+        read_page raw 0;
+        (aux [@tailcall]) Int64.(add offset page_size)
+    in
+    (aux [@tailcall]) min
+
+  let iter_io ?min ?max f io = iter_io_off ?min ?max (fun _ e -> f e) io
+
+  module Entry = struct
+    type t = entry
+
+    module Key = K
+    module Value = V
+
+    let encoded_size = entry_size
+
+    let decode = decode_entry
+
+    let to_key e = e.key
+
+    let to_value e = e.value
+  end
+
+  module IOArray = Io_array.Make (IO) (Entry)
+
+  module Search =
+    Search.Make (Entry) (IOArray)
+      (struct
+        type t = int
+
+        module Entry = Entry
+
+        let compare : int -> int -> int = compare
+
+        let of_entry e = e.key_hash
+
+        let of_key = K.hash
+
+        let linear_interpolate ~low:(low_index, low_metric)
+            ~high:(high_index, high_metric) key_metric =
+          let low_in = float_of_int low_metric in
+          let high_in = float_of_int high_metric in
+          let target_in = float_of_int key_metric in
+          let low_out = Int64.to_float low_index in
+          let high_out = Int64.to_float high_index in
+          (* Fractional position of [target_in] along the line from [low_in] to [high_in] *)
+          let proportion = (target_in -. low_in) /. (high_in -. low_in) in
+          (* Convert fractional position to position in output space *)
+          let position = low_out +. (proportion *. (high_out -. low_out)) in
+          let rounded = ceil (position -. 0.5) +. 0.5 in
+          Int64.of_float rounded
+      end)
+
+  let with_cache ~v ~clear =
+    let roots = Hashtbl.create 0 in
+    let f ?(fresh = false) ?(readonly = false) ~log_size root =
+      try
+        if not (Sys.file_exists (index_dir root)) then (
+          Log.debug (fun l ->
+              l "[%s] does not exist anymore, cleaning up the fd cache"
+                (Filename.basename root));
+          Hashtbl.remove roots (root, true);
+          Hashtbl.remove roots (root, false);
+          raise Not_found );
+        let t = Hashtbl.find roots (root, readonly) in
+        if t.counter <> 0 then (
+          Log.debug (fun l -> l "%s found in cache" root);
+          t.counter <- t.counter + 1;
+          if fresh then clear t;
+          t )
+        else (
+          Hashtbl.remove roots (root, readonly);
+          raise Not_found )
+      with Not_found ->
+        Log.debug (fun l ->
+            l "[%s] v fresh=%b readonly=%b" (Filename.basename root) fresh
+              readonly);
+        let t = v ~fresh ~readonly ~log_size root in
+        Hashtbl.add roots (root, readonly) t;
+        t
+    in
+    `Staged f
+
+  let v_no_cache ~fresh ~readonly ~log_size root =
+    let lock =
+      if not readonly then Some (IO.lock (lock_path root)) else None
+    in
+    let config = { log_size = log_size * entry_size; readonly } in
+    let log_path = log_path root in
+    let index_path = index_path root in
+    let log_mem = Tbl.create 1024 in
+    let log = IO.v ~fresh ~readonly ~generation:0L ~fan_size:0L log_path in
+    let generation = IO.get_generation log in
+    let index =
+      if Sys.file_exists index_path then
+        let io =
+          IO.v ~fresh ~readonly ~generation:0L ~fan_size:0L index_path
+        in
+        let fan_out = Fan.import ~hash_size:K.hash_size (IO.get_fanout io) in
+        Some { fan_out; io }
+      else None
+    in
+    iter_io (fun e -> Tbl.replace log_mem e.key e) log;
+    { config; generation; log_mem; root; log; index; counter = 1; lock }
+
+  let (`Staged v) = with_cache ~v:v_no_cache ~clear
+
+  let interpolation_search index key =
+    let hashed_key = K.hash key in
+    let low_bytes, high_bytes = Fan.search index.fan_out hashed_key in
+    let low, high =
+      Int64.(div low_bytes entry_sizeL, div high_bytes entry_sizeL)
+    in
+    Search.interpolation_search (IOArray.v index.io) key ~low ~high
+
+  let sync_log t =
+    let generation = IO.get_generation t.log in
+    let log_offset = IO.offset t.log in
+    let new_log_offset = IO.force_offset t.log in
+    let add_log_entry e = Tbl.replace t.log_mem e.key e in
+    if t.generation <> generation then (
+      Tbl.clear t.log_mem;
+      iter_io add_log_entry t.log;
+      may (fun i -> IO.close i.io) t.index;
+      if Int64.equal generation 0L then t.index <- None
+      else
+        let index_path = index_path t.root in
+        let io =
+          IO.v ~fresh:false ~readonly:true ~generation ~fan_size:0L index_path
+        in
+        let fan_out =
+          Fan.import ~hash_size:K.encoded_size (IO.get_fanout io)
+        in
+        t.index <- Some { fan_out; io };
+        t.generation <- generation )
+    else if log_offset < new_log_offset then
+      iter_io add_log_entry t.log ~min:log_offset
+    else if log_offset > new_log_offset then assert false
+
+  let find t key =
+    Log.debug (fun l -> l "find %a" K.pp key);
+    if t.config.readonly then sync_log t;
+    let look_on_disk () =
+      match Tbl.find t.log_mem key with
+      | e -> e.value
+      | exception Not_found -> (
+          match t.index with
+          | Some index -> interpolation_search index key
+          | None -> raise Not_found )
+    in
+    look_on_disk ()
+
+  let mem t key =
+    Log.debug (fun l -> l "mem %a" K.pp key);
+    match find t key with _ -> true | exception Not_found -> false
+
+  let append_buf_fanout fan_out hash buf_str dst_io =
+    Fan.update fan_out hash (IO.offset dst_io);
+    IO.append dst_io buf_str
+
+  let append_entry_fanout fan_out entry dst_io =
+    Fan.update fan_out entry.key_hash (IO.offset dst_io);
+    append_entry dst_io entry
+
+  let rec merge_from_log fan_out log log_i hash_e dst_io =
+    if log_i >= Array.length log then log_i
+    else
+      let v = log.(log_i) in
+      if v.key_hash > hash_e then log_i
+      else (
+        append_entry_fanout fan_out v dst_io;
+        (merge_from_log [@tailcall]) fan_out log (log_i + 1) hash_e dst_io )
+
+  let append_remaining_log fan_out log log_i dst_io =
+    for log_i = log_i to Array.length log - 1 do
+      append_entry_fanout fan_out log.(log_i) dst_io
+    done
+
+  (** Merge [log] with [t] into [dst_io].
+      [log] must be sorted by key hashes. *)
+  let merge_with log index dst_io =
+    let entries = 10_000 in
+    let buf = Bytes.create (entries * entry_size) in
+    let refill off = ignore (IO.read index.io ~off buf) in
+    let index_end = IO.offset index.io in
+    let fan_out = index.fan_out in
+    refill 0L;
+    let rec go index_offset buf_offset log_i =
+      if index_offset >= index_end then
+        append_remaining_log fan_out log log_i dst_io
+      else
+        let buf_str = Bytes.sub_string buf buf_offset entry_size in
+        let index_offset = Int64.add index_offset entry_sizeL in
+        let key_e = K.decode buf_str 0 in
+        let hash_e = K.hash key_e in
+        let log_i = merge_from_log fan_out log log_i hash_e dst_io in
+        if
+          log_i >= Array.length log
+          ||
+          let key = log.(log_i).key in
+          not (K.equal key key_e)
+        then append_buf_fanout fan_out hash_e buf_str dst_io;
+        let buf_offset =
+          let n = buf_offset + entry_size in
+          if n >= Bytes.length buf then (
+            refill index_offset;
+            0 )
+          else n
+        in
+        (go [@tailcall]) index_offset buf_offset log_i
+    in
+    (go [@tailcall]) 0L 0 0
+
+  let merge ~witness t =
+    Log.debug (fun l -> l "unforced merge %S\n" t.root);
+    let merge_path = merge_path t.root in
+    let generation = Int64.succ t.generation in
+    let log =
+      let compare_entry e e' = compare e.key_hash e'.key_hash in
+      let b = Array.make (Tbl.length t.log_mem) witness in
+      Tbl.fold
+        (fun _ e i ->
+          b.(i) <- e;
+          i + 1)
+        t.log_mem 0
+      |> ignore;
+      Array.fast_sort compare_entry b;
+      b
+    in
+    let fan_size =
+      match t.index with
+      | None -> Tbl.length t.log_mem
+      | Some index ->
+          (Int64.to_int (IO.offset index.io) / entry_size)
+          + Tbl.length t.log_mem
+    in
+    let fan_out = Fan.v ~hash_size:K.hash_size ~entry_size fan_size in
+    let merge =
+      IO.v ~readonly:false ~fresh:true ~generation
+        ~fan_size:(Int64.of_int (Fan.exported_size fan_out))
+        merge_path
+    in
+    ( match t.index with
+    | None ->
+        let io =
+          IO.v ~fresh:true ~readonly:false ~generation:0L ~fan_size:0L
+            (index_path t.root)
+        in
+        append_remaining_log fan_out log 0 merge;
+        t.index <- Some { io; fan_out }
+    | Some index ->
+        let index = { index with fan_out } in
+        merge_with log index merge;
+        t.index <- Some index );
+    match t.index with
+    | None -> assert false
+    | Some index ->
+        Fan.finalize index.fan_out;
+        IO.set_fanout merge (Fan.export index.fan_out);
+        IO.rename ~src:merge ~dst:index.io;
+        IO.clear t.log;
+        Tbl.clear t.log_mem;
+        IO.set_generation t.log generation;
+        t.generation <- generation
+
+  let force_merge t key value =
+    Log.debug (fun l -> l "forced merge %S\n" t.root);
+    merge ~witness:{ key; key_hash = K.hash key; value } t
+
+  let replace t key value =
+    Log.debug (fun l -> l "add %a %a" K.pp key V.pp value);
+    if t.config.readonly then raise RO_not_allowed;
+    let entry = { key; key_hash = K.hash key; value } in
+    append_entry t.log entry;
+    Tbl.replace t.log_mem key entry;
+    if Int64.compare (IO.offset t.log) (Int64.of_int t.config.log_size) > 0
+    then merge ~witness:entry t
+
+  (* XXX: Perform a merge beforehands to ensure duplicates are not hit twice. *)
+  let iter f t =
+    Tbl.iter (fun _ e -> f e.key e.value) t.log_mem;
+    may (fun index -> iter_io (fun e -> f e.key e.value) index.io) t.index
+
+  let flush t = IO.sync t.log
+
+  let close t =
+    t.counter <- t.counter - 1;
+    if t.counter = 0 then (
+      Log.debug (fun l -> l "close %S" t.root);
+      if not t.config.readonly then flush t;
+      IO.close t.log;
+      may (fun i -> IO.close i.io) t.index;
+      t.index <- None;
+      Tbl.reset t.log_mem;
+      may (fun lock -> IO.unlock lock) t.lock )
+end
diff --git a/vendors/index/src/index.mli b/vendors/index/src/index.mli
new file mode 100644
index 0000000000000000000000000000000000000000..e9161ce4d51aadbc94971c607db0c4ff9a9b45be
--- /dev/null
+++ b/vendors/index/src/index.mli
@@ -0,0 +1,132 @@
+(** Index
+
+    [Index] is a scalable implementation of persistent indices in OCaml.
+
+    [Index] provides the standard key-value interface: [find], [mem] and
+    [replace]. It requires three IO instances:
+
+    - A `log` IO containing all of the recently-added bindings; this is also
+      kept in memory.
+
+    - When the `log` IO is full, it is merged into the `index` IO. Search
+      is done first in `log` then in `index`, which makes recently added
+      bindings search faster.
+
+    - A `lock` IO to ensure safe concurrent access.
+*)
+
+(** The input of [Make] for keys. *)
+module type Key = sig
+  type t
+  (** The type for keys. *)
+
+  val equal : t -> t -> bool
+  (** The equality function for keys. *)
+
+  val hash : t -> int
+  (** Note: Unevenly distributed hash functions may result in performance
+      drops. *)
+
+  val hash_size : int
+  (** The maximum number of bits used to encode hashes. `Hashtbl.hash` uses 30
+      bits. *)
+
+  val encode : t -> string
+  (** [encode] is an encoding function. The resultant encoded values must have
+      size {!encoded_size} bytes. *)
+
+  val decode : string -> int -> t
+  (** [decode] is a decoding function such that [decode (encode t) 0 = t]. *)
+
+  val encoded_size : int
+  (** [encoded_size] is the size of the encoded keys, expressed in number of
+      bytes. *)
+
+  val pp : t Fmt.t
+  (** Formatter for keys *)
+end
+
+(** The input of [Make] for values. The same requirements as for [Key]
+    apply. *)
+module type Value = sig
+  type t
+
+  val encode : t -> string
+
+  val decode : string -> int -> t
+
+  val encoded_size : int
+
+  val pp : t Fmt.t
+end
+
+module type IO = Io.S
+
+exception RO_not_allowed
+(** The exception raised when illegal operation is attempted on a read_only
+    index. *)
+
+(** Index module signature. *)
+module type S = sig
+  type t
+  (** The type for indexes. *)
+
+  type key
+  (** The type for keys. *)
+
+  type value
+  (** The type for values. *)
+
+  val v : ?fresh:bool -> ?readonly:bool -> log_size:int -> string -> t
+  (** The constructor for indexes.
+      @param fresh
+      @param read_only whether read-only mode is enabled for this index.
+      @param log_size  the maximum number of bindings in the `log` IO.
+      *)
+
+  val clear : t -> unit
+  (** [clear t] clears [t] so that there are no more bindings in it. *)
+
+  val find : t -> key -> value
+  (** [find t k] is the binding of [k] in [t]. *)
+
+  val mem : t -> key -> bool
+  (** [mem t k] is [true] iff [k] is bound in [t]. *)
+
+  exception Invalid_key_size of key
+
+  exception Invalid_value_size of value
+  (** The exceptions raised when trying to add a key or a value of different
+      size than encoded_size *)
+
+  val replace : t -> key -> value -> unit
+  (** [replace t k v] binds [k] to [v] in [t], replacing any exising binding
+      of [k]. *)
+
+  val iter : (key -> value -> unit) -> t -> unit
+  (** Iterates over the index bindings. Order is not specified.
+      In case of recent replacements of existing values (after the last merge),
+      this will hit both the new and old bindings. *)
+
+  val flush : t -> unit
+  (** Flushes all buffers to the disk. *)
+
+  val close : t -> unit
+  (** Closes the files and clears the caches of [t]. *)
+
+  val force_merge : t -> key -> value -> unit
+  (** [force_merge t k v] forces a merge for [t], where [k] and [v] are any key
+      and value of [t]. *)
+end
+
+module Make (K : Key) (V : Value) (IO : IO) :
+  S with type key = K.t and type value = V.t
+
+(** These modules should not be used. They are exposed purely for testing purposes. *)
+module Private : sig
+  module Search : module type of Search
+
+  module Io_array : module type of Io_array
+
+  module Fan : module type of Fan
+end
diff --git a/vendors/index/src/io.mli b/vendors/index/src/io.mli
new file mode 100644
index 0000000000000000000000000000000000000000..815955ad3e0441dc2c13342bf9622a7b19e997a7
--- /dev/null
+++ b/vendors/index/src/io.mli
@@ -0,0 +1,47 @@
+module type S = sig
+  type t
+
+  val v :
+    readonly:bool ->
+    fresh:bool ->
+    generation:int64 ->
+    fan_size:int64 ->
+    string ->
+    t
+
+  val name : t -> string
+
+  val offset : t -> int64
+
+  val force_offset : t -> int64
+
+  val readonly : t -> bool
+
+  val read : t -> off:int64 -> bytes -> int
+
+  val clear : t -> unit
+
+  val sync : t -> unit
+
+  val version : t -> string
+
+  val set_generation : t -> int64 -> unit
+
+  val get_generation : t -> int64
+
+  val set_fanout : t -> string -> unit
+
+  val get_fanout : t -> string
+
+  val rename : src:t -> dst:t -> unit
+
+  val append : t -> string -> unit
+
+  val close : t -> unit
+
+  type lock
+
+  val lock : string -> lock
+
+  val unlock : lock -> unit
+end
diff --git a/vendors/index/src/io_array.ml b/vendors/index/src/io_array.ml
new file mode 100644
index 0000000000000000000000000000000000000000..405316b1b31d67aac907c81af8d5d5afdff4fb32
--- /dev/null
+++ b/vendors/index/src/io_array.ml
@@ -0,0 +1,105 @@
+module type ELT = sig
+  type t
+
+  val encoded_size : int
+
+  val decode : Bytes.t -> int -> t
+end
+
+module type S = sig
+  include Search.ARRAY
+
+  type io
+
+  val v : io -> t
+end
+
+module Make (IO : Io.S) (Elt : ELT) :
+  S with type io = IO.t and type elt = Elt.t = struct
+  module Elt = struct
+    include Elt
+
+    let encoded_sizeL = Int64.of_int encoded_size
+  end
+
+  type io = IO.t
+
+  type elt = Elt.t
+
+  type buffer = { buf : bytes; low_off : int64; high_off : int64 }
+
+  type t = { io : IO.t; mutable buffer : buffer option }
+
+  let v io = { io; buffer = None }
+
+  let get_entry_from_io io off =
+    let buf = Bytes.create Elt.encoded_size in
+    let n = IO.read io ~off buf in
+    assert (n = Elt.encoded_size);
+    Elt.decode buf 0
+
+  let ( -- ) = Int64.sub
+
+  let get_entry_from_buffer buf off =
+    let buf_off = Int64.(to_int @@ (off -- buf.low_off)) in
+    assert (buf_off <= Bytes.length buf.buf);
+    Elt.decode buf.buf buf_off
+
+  let is_in_buffer t off =
+    match t.buffer with
+    | None -> false
+    | Some b ->
+        Int64.compare off b.low_off >= 0 && Int64.compare off b.high_off <= 0
+
+  let get t i =
+    let off = Int64.(mul i Elt.encoded_sizeL) in
+    match t.buffer with
+    | Some b when is_in_buffer t off -> (
+        try get_entry_from_buffer b off with _ -> assert false )
+    | _ -> get_entry_from_io t.io off
+
+  let length t = Int64.(div (IO.offset t.io) Elt.encoded_sizeL)
+
+  let set_buffer t ~low ~high =
+    let range = Elt.encoded_size * (1 + Int64.to_int (high -- low)) in
+    let low_off = Int64.mul low Elt.encoded_sizeL in
+    let high_off = Int64.mul high Elt.encoded_sizeL in
+    let buf = Bytes.create range in
+    let n = IO.read t.io ~off:low_off buf in
+    assert (n = range);
+    t.buffer <- Some { buf; low_off; high_off }
+
+  let pre_fetch t ~low ~high =
+    let range = Elt.encoded_size * (1 + Int64.to_int (high -- low)) in
+    if Int64.compare low high > 0 then
+      Log.warn (fun m ->
+          m "Requested pre-fetch region is empty: [%Ld, %Ld]" low high)
+    else if range > 4096 then
+      Log.debug (fun m ->
+          m "Requested pre-fetch [%Ld, %Ld] is larger than 4096" low high)
+    else
+      match t.buffer with
+      | Some b ->
+          let low_buf, high_buf =
+            Int64.
+              ( div b.low_off Elt.encoded_sizeL,
+                div b.high_off Elt.encoded_sizeL )
+          in
+          if low >= low_buf && high <= high_buf then
+            Log.debug (fun m ->
+                m
+                  "Pre-existing buffer [%Ld, %Ld] encloses requested \
+                   pre-fetch [%Ld, %Ld]"
+                  low_buf high_buf low high)
+          else (
+            Log.debug (fun m ->
+                m
+                  "Current buffer [%Ld, %Ld] insufficient. Prefetching in \
+                   range [%Ld, %Ld]"
+                  low_buf high_buf low high);
+            set_buffer t ~low ~high )
+      | None ->
+          Log.debug (fun m ->
+              m "No existing buffer. Prefetching in range [%Ld, %Ld]" low high);
+          set_buffer t ~low ~high
+end
diff --git a/vendors/index/src/io_array.mli b/vendors/index/src/io_array.mli
new file mode 100644
index 0000000000000000000000000000000000000000..bc855576a0063553b3ad0b5c221343fe882dc071
--- /dev/null
+++ b/vendors/index/src/io_array.mli
@@ -0,0 +1,20 @@
+module type ELT = sig
+  type t
+
+  val encoded_size : int
+
+  val decode : Bytes.t -> int -> t
+end
+
+module type S = sig
+  include Search.ARRAY
+
+  type io
+
+  val v : io -> t
+end
+
+(** Takes an IO instance and wraps it in an Array interface with support for
+    prefetching sections of the array. *)
+module Make (IO : Io.S) (Elt : ELT) :
+  S with type io = IO.t and type elt = Elt.t
diff --git a/vendors/index/src/log.ml b/vendors/index/src/log.ml
new file mode 100644
index 0000000000000000000000000000000000000000..23d9e8d82155752ee3b117bc03bbb613a2300424
--- /dev/null
+++ b/vendors/index/src/log.ml
@@ -0,0 +1,5 @@
+let src = Logs.Src.create "index" ~doc:"Index"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+include Log
diff --git a/vendors/index/src/log.mli b/vendors/index/src/log.mli
new file mode 100644
index 0000000000000000000000000000000000000000..a813e55aba74bffac6e648593b5fbc9ebb382b6d
--- /dev/null
+++ b/vendors/index/src/log.mli
@@ -0,0 +1 @@
+include Logs.LOG
diff --git a/vendors/index/src/search.ml b/vendors/index/src/search.ml
new file mode 100644
index 0000000000000000000000000000000000000000..a1603df058ef0ddfe6c107ad1849b8011bc569b6
--- /dev/null
+++ b/vendors/index/src/search.ml
@@ -0,0 +1,142 @@
+module type ARRAY = sig
+  type t
+
+  type elt
+
+  val get : t -> int64 -> elt
+
+  val length : t -> int64
+
+  val pre_fetch : t -> low:int64 -> high:int64 -> unit
+end
+
+module type ENTRY = sig
+  type t
+
+  module Key : sig
+    type t
+
+    val equal : t -> t -> bool
+  end
+
+  module Value : sig
+    type t
+  end
+
+  val to_key : t -> Key.t
+
+  val to_value : t -> Value.t
+end
+
+(* Metrics must be
+    - totally ordered
+    - computable from entries and (potentially redundantly) from keys
+    - linearly interpolate-able on the int64 type *)
+module type METRIC = sig
+  type t
+
+  module Entry : ENTRY
+
+  val compare : t -> t -> int
+
+  val of_entry : Entry.t -> t
+
+  val of_key : Entry.Key.t -> t
+
+  val linear_interpolate : low:int64 * t -> high:int64 * t -> t -> int64
+end
+
+module type S = sig
+  module Entry : ENTRY
+
+  module Array : ARRAY with type elt = Entry.t
+
+  val interpolation_search :
+    Array.t -> Entry.Key.t -> low:int64 -> high:int64 -> Entry.Value.t
+end
+
+module Make
+    (Entry : ENTRY)
+    (Array : ARRAY with type elt = Entry.t)
+    (Metric : METRIC with module Entry := Entry) :
+  S with module Entry := Entry and module Array := Array = struct
+  module Entry = Entry
+  module Array = Array
+  module Value = Entry.Value
+
+  module Key = struct
+    include Entry.Key
+
+    let ( = ) a b = compare a b = 0
+  end
+
+  module Metric = struct
+    include Metric
+
+    let ( < ) a b = compare a b < 0
+
+    let ( = ) a b = compare a b = 0
+
+    let ( > ) a b = compare a b > 0
+  end
+
+  let look_around array key key_metric index =
+    let rec search (op : int64 -> int64) curr =
+      let i = op curr in
+      if i < 0L || i >= Array.length array then raise Not_found
+      else
+        let e = array.(i) in
+        let e_metric = Metric.of_entry e in
+        if not Metric.(key_metric = e_metric) then raise Not_found
+        else if Key.equal (Entry.to_key e) key then Entry.to_value e
+        else (search [@tailcall]) op i
+    in
+    match search Int64.succ index with
+    | e -> e
+    | exception Not_found -> (search [@tailcall]) Int64.pred index
+
+  (** Improves over binary search in cases where the values in some array are
+      uniformly distributed according to some metric (such as a hash). *)
+  let interpolation_search array key ~low ~high =
+    let key_metric = Metric.of_key key in
+    (* The core of the search *)
+    let rec search low high lowest_entry highest_entry =
+      if high < low then raise Not_found
+      else (
+        Array.pre_fetch array ~low ~high;
+        let lowest_entry = Lazy.force lowest_entry in
+        if high = low then
+          if Key.(key = Entry.to_key lowest_entry) then
+            Entry.to_value lowest_entry
+          else raise Not_found
+        else
+          let lowest_metric = Metric.of_entry lowest_entry in
+          if Metric.(lowest_metric > key_metric) then raise Not_found
+          else
+            let highest_entry = Lazy.force highest_entry in
+            let highest_metric = Metric.of_entry highest_entry in
+            if Metric.(highest_metric < key_metric) then raise Not_found
+            else
+              let next_index =
+                Metric.linear_interpolate ~low:(low, lowest_metric)
+                  ~high:(high, highest_metric) key_metric
+              in
+              let e = array.(next_index) in
+              let e_metric = Metric.of_entry e in
+              if Metric.(key_metric = e_metric) then
+                if Key.(key = Entry.to_key e) then Entry.to_value e
+                else look_around array key key_metric next_index
+              else if Metric.(key_metric > e_metric) then
+                (search [@tailcall])
+                  Int64.(succ next_index)
+                  high
+                  (lazy array.(Int64.(succ next_index)))
+                  (Lazy.from_val highest_entry)
+              else
+                (search [@tailcall]) low (Int64.pred next_index)
+                  (Lazy.from_val lowest_entry)
+                  (lazy array.(Int64.(pred next_index))) )
+    in
+    if high < 0L then raise Not_found
+    else (search [@tailcall]) low high (lazy array.(low)) (lazy array.(high))
+end
diff --git a/vendors/index/src/search.mli b/vendors/index/src/search.mli
new file mode 100644
index 0000000000000000000000000000000000000000..8ab54261e25978ecd9023a178e17e6338ef79bc6
--- /dev/null
+++ b/vendors/index/src/search.mli
@@ -0,0 +1,58 @@
+module type ARRAY = sig
+  type t
+
+  type elt
+
+  val get : t -> int64 -> elt
+
+  val length : t -> int64
+
+  val pre_fetch : t -> low:int64 -> high:int64 -> unit
+end
+
+module type ENTRY = sig
+  type t
+
+  module Key : sig
+    type t
+
+    val equal : t -> t -> bool
+  end
+
+  module Value : sig
+    type t
+  end
+
+  val to_key : t -> Key.t
+
+  val to_value : t -> Value.t
+end
+
+module type METRIC = sig
+  type t
+
+  module Entry : ENTRY
+
+  val compare : t -> t -> int
+
+  val of_entry : Entry.t -> t
+
+  val of_key : Entry.Key.t -> t
+
+  val linear_interpolate : low:int64 * t -> high:int64 * t -> t -> int64
+end
+
+module type S = sig
+  module Entry : ENTRY
+
+  module Array : ARRAY with type elt = Entry.t
+
+  val interpolation_search :
+    Array.t -> Entry.Key.t -> low:int64 -> high:int64 -> Entry.Value.t
+end
+
+module Make
+    (Entry : ENTRY)
+    (Array : ARRAY with type elt = Entry.t)
+    (Metric : METRIC with module Entry := Entry) :
+  S with module Entry := Entry and module Array := Array
diff --git a/vendors/index/src/unix/dune b/vendors/index/src/unix/dune
new file mode 100644
index 0000000000000000000000000000000000000000..22261fcb8e34626ae236d737d0b773e426535e8c
--- /dev/null
+++ b/vendors/index/src/unix/dune
@@ -0,0 +1,5 @@
+(library
+ (public_name index.unix)
+ (name index_unix)
+ (c_names pread pwrite)
+ (libraries unix index))
diff --git a/vendors/index/src/unix/index_unix.ml b/vendors/index/src/unix/index_unix.ml
new file mode 100644
index 0000000000000000000000000000000000000000..36125198681dbd70e46685fb62dd666815da5ed4
--- /dev/null
+++ b/vendors/index/src/unix/index_unix.ml
@@ -0,0 +1,344 @@
+exception RO_not_allowed
+
+let current_version = "00000001"
+
+module IO : Index.IO = struct
+  let ( ++ ) = Int64.add
+
+  let ( -- ) = Int64.sub
+
+  external set_64 : Bytes.t -> int -> int64 -> unit = "%caml_string_set64u"
+
+  external get_64 : string -> int -> int64 = "%caml_string_get64"
+
+  external swap64 : int64 -> int64 = "%bswap_int64"
+
+  let encode_int64 i =
+    let set_uint64 s off v =
+      if not Sys.big_endian then set_64 s off (swap64 v) else set_64 s off v
+    in
+    let b = Bytes.create 8 in
+    set_uint64 b 0 i;
+    Bytes.unsafe_to_string b
+
+  let decode_int64 buf =
+    let get_uint64 s off =
+      if not Sys.big_endian then swap64 (get_64 s off) else get_64 s off
+    in
+    get_uint64 buf 0
+
+  module Raw = struct
+    type t = { fd : Unix.file_descr; mutable cursor : int64 }
+
+    let v fd = { fd; cursor = 0L }
+
+    external pread : Unix.file_descr -> int64 -> bytes -> int -> int -> int
+      = "caml_pread"
+
+    external pwrite : Unix.file_descr -> int64 -> bytes -> int -> int -> int
+      = "caml_pwrite"
+
+    let really_write fd off buf =
+      let rec aux fd_off buf_off len =
+        let w = pwrite fd fd_off buf buf_off len in
+        if w = 0 then ()
+        else
+          (aux [@tailcall]) (fd_off ++ Int64.of_int w) (buf_off + w) (len - w)
+      in
+      (aux [@tailcall]) off 0 (Bytes.length buf)
+
+    let really_read fd off len buf =
+      let rec aux fd_off buf_off len =
+        let r = pread fd fd_off buf buf_off len in
+        if r = 0 then buf_off (* end of file *)
+        else if r = len then buf_off + r
+        else
+          (aux [@tailcall]) (fd_off ++ Int64.of_int r) (buf_off + r) (len - r)
+      in
+      (aux [@tailcall]) off 0 len
+
+    let unsafe_write t ~off buf =
+      let buf = Bytes.unsafe_of_string buf in
+      really_write t.fd off buf;
+      t.cursor <- off ++ Int64.of_int (Bytes.length buf)
+
+    let unsafe_read t ~off ~len buf =
+      let n = really_read t.fd off len buf in
+      t.cursor <- off ++ Int64.of_int n;
+      n
+
+    module Offset = struct
+      let set t n =
+        let buf = encode_int64 n in
+        unsafe_write t ~off:0L buf
+
+      let get t =
+        let buf = Bytes.create 8 in
+        let n = unsafe_read t ~off:0L ~len:8 buf in
+        assert (n = 8);
+        decode_int64 (Bytes.unsafe_to_string buf)
+    end
+
+    module Version = struct
+      let get t =
+        let buf = Bytes.create 8 in
+        let n = unsafe_read t ~off:8L ~len:8 buf in
+        assert (n = 8);
+        Bytes.unsafe_to_string buf
+
+      let set t = unsafe_write t ~off:8L current_version
+    end
+
+    module Generation = struct
+      let get t =
+        let buf = Bytes.create 8 in
+        let n = unsafe_read t ~off:16L ~len:8 buf in
+        assert (n = 8);
+        decode_int64 (Bytes.unsafe_to_string buf)
+
+      let set t gen =
+        let buf = encode_int64 gen in
+        unsafe_write t ~off:16L buf
+    end
+
+    module Fan = struct
+      let set t buf =
+        let size = encode_int64 (Int64.of_int (String.length buf)) in
+        unsafe_write t ~off:24L size;
+        if buf <> "" then unsafe_write t ~off:(24L ++ 8L) buf
+
+      let get_size t =
+        let size_buf = Bytes.create 8 in
+        let n = unsafe_read t ~off:24L ~len:8 size_buf in
+        assert (n = 8);
+        decode_int64 (Bytes.unsafe_to_string size_buf)
+
+      let set_size t size =
+        let buf = encode_int64 size in
+        unsafe_write t ~off:24L buf
+
+      let get t =
+        let size = Int64.to_int (get_size t) in
+        let buf = Bytes.create size in
+        let n = unsafe_read t ~off:(24L ++ 8L) ~len:size buf in
+        assert (n = size);
+        Bytes.unsafe_to_string buf
+    end
+  end
+
+  type t = {
+    file : string;
+    mutable header : int64;
+    mutable raw : Raw.t;
+    mutable offset : int64;
+    mutable flushed : int64;
+    mutable fan_size : int64;
+    readonly : bool;
+    version : string;
+    buf : Buffer.t;
+  }
+
+  let sync t =
+    if t.readonly then raise RO_not_allowed;
+    let buf = Buffer.contents t.buf in
+    let offset = t.offset in
+    Buffer.clear t.buf;
+    if buf = "" then ()
+    else (
+      Raw.unsafe_write t.raw ~off:t.flushed buf;
+      Raw.Offset.set t.raw offset;
+
+      (* concurrent append might happen so here t.offset might differ
+         from offset *)
+      if
+        not (t.flushed ++ Int64.of_int (String.length buf) = t.header ++ offset)
+      then
+        Fmt.failwith "sync error: %s flushed=%Ld buf=%Ld offset+header=%Ld\n%!"
+          t.file t.flushed
+          (Int64.of_int (String.length buf))
+          (offset ++ t.header);
+      t.flushed <- offset ++ t.header )
+
+  let name t = t.file
+
+  let rename ~src ~dst =
+    sync src;
+    Unix.close dst.raw.fd;
+    Unix.rename src.file dst.file;
+    dst.header <- src.header;
+    dst.fan_size <- src.fan_size;
+    dst.offset <- src.offset;
+    dst.flushed <- src.flushed;
+    dst.raw <- src.raw
+
+  let close t = Unix.close t.raw.fd
+
+  let auto_flush_limit = 1_000_000L
+
+  let append t buf =
+    if t.readonly then raise RO_not_allowed;
+    Buffer.add_string t.buf buf;
+    let len = Int64.of_int (String.length buf) in
+    t.offset <- t.offset ++ len;
+    if t.offset -- t.flushed > auto_flush_limit then sync t
+
+  let read t ~off buf =
+    if not t.readonly then assert (t.header ++ off <= t.flushed);
+    Raw.unsafe_read t.raw ~off:(t.header ++ off) ~len:(Bytes.length buf) buf
+
+  let offset t = t.offset
+
+  let force_offset t =
+    t.offset <- Raw.Offset.get t.raw;
+    t.offset
+
+  let version t = t.version
+
+  let get_generation t = Raw.Generation.get t.raw
+
+  let set_generation t = Raw.Generation.set t.raw
+
+  let get_fanout t = Raw.Fan.get t.raw
+
+  let set_fanout t buf =
+    assert (Int64.equal (Int64.of_int (String.length buf)) t.fan_size);
+    Raw.Fan.set t.raw buf
+
+  let readonly t = t.readonly
+
+  let protect_unix_exn = function
+    | Unix.Unix_error _ as e -> failwith (Printexc.to_string e)
+    | e -> raise e
+
+  let ignore_enoent = function
+    | Unix.Unix_error (Unix.ENOENT, _, _) -> ()
+    | e -> raise e
+
+  let protect f x = try f x with e -> protect_unix_exn e
+
+  let safe f x = try f x with e -> ignore_enoent e
+
+  let mkdir dirname =
+    let rec aux dir k =
+      if Sys.file_exists dir && Sys.is_directory dir then k ()
+      else (
+        if Sys.file_exists dir then safe Unix.unlink dir;
+        (aux [@tailcall]) (Filename.dirname dir) @@ fun () ->
+        protect (Unix.mkdir dir) 0o755;
+        k () )
+    in
+    (aux [@tailcall]) dirname (fun () -> ())
+
+  let clear t =
+    t.offset <- 0L;
+    t.flushed <- t.header;
+    Raw.Generation.set t.raw 0L;
+    Raw.Offset.set t.raw t.offset;
+    Raw.Fan.set t.raw "";
+    Buffer.clear t.buf
+
+  let buffers = Hashtbl.create 256
+
+  let buffer file =
+    try
+      let buf = Hashtbl.find buffers file in
+      Buffer.clear buf;
+      buf
+    with Not_found ->
+      let buf = Buffer.create (4 * 1024) in
+      Hashtbl.add buffers file buf;
+      buf
+
+  let () = assert (String.length current_version = 8)
+
+  let v ~readonly ~fresh ~generation ~fan_size file =
+    let v ~fan_size ~offset ~version raw =
+      let header = 8L ++ 8L ++ 8L ++ 8L ++ fan_size in
+      {
+        version;
+        header;
+        file;
+        offset;
+        raw;
+        readonly;
+        fan_size;
+        buf = buffer file;
+        flushed = header ++ offset;
+      }
+    in
+    let mode = Unix.(if readonly then O_RDONLY else O_RDWR) in
+    mkdir (Filename.dirname file);
+    match Sys.file_exists file with
+    | false ->
+        let x = Unix.openfile file Unix.[ O_CREAT; O_CLOEXEC; mode ] 0o644 in
+        let raw = Raw.v x in
+        Raw.Offset.set raw 0L;
+        Raw.Fan.set_size raw fan_size;
+        Raw.Version.set raw;
+        Raw.Generation.set raw generation;
+        v ~fan_size ~offset:0L ~version:current_version raw
+    | true ->
+        let x = Unix.openfile file Unix.[ O_EXCL; O_CLOEXEC; mode ] 0o644 in
+        let raw = Raw.v x in
+        if readonly && fresh then
+          Fmt.failwith "IO.v: cannot reset a readonly file"
+        else if fresh then (
+          Raw.Offset.set raw 0L;
+          Raw.Fan.set_size raw fan_size;
+          Raw.Version.set raw;
+          Raw.Generation.set raw generation;
+          v ~fan_size ~offset:0L ~version:current_version raw )
+        else
+          let offset = Raw.Offset.get raw in
+          let version = Raw.Version.get raw in
+          let fan_size = Raw.Fan.get_size raw in
+          v ~fan_size ~offset ~version raw
+
+  type lock = Unix.file_descr
+
+  let unsafe_lock op f =
+    mkdir (Filename.dirname f);
+    let fd = Unix.openfile f [ Unix.O_CREAT; Unix.O_RDWR ] 0o600
+    and pid = string_of_int (Unix.getpid ()) in
+    let pid_len = String.length pid in
+    try
+      Unix.lockf fd op 0;
+      if Unix.single_write_substring fd pid 0 pid_len <> pid_len then (
+        Unix.close fd;
+        failwith "Unable to write PID to lock file" )
+      else Some fd
+    with
+    | Unix.Unix_error (Unix.EAGAIN, _, _) ->
+        Unix.close fd;
+        None
+    | e ->
+        Unix.close fd;
+        raise e
+
+  exception Locked
+
+  let err_rw_lock lock =
+    let ic = open_in lock in
+    let line = input_line ic in
+    close_in ic;
+    let pid = int_of_string line in
+    Fmt.epr
+      "Cannot lock %s: index is already opened in write mode by PID %d. \
+       Current PID is %d.\n\
+       %!"
+      lock pid (Unix.getpid ());
+    raise Locked
+
+  let lock path =
+    match unsafe_lock Unix.F_TLOCK path with
+    | Some fd -> fd
+    | None -> err_rw_lock path
+
+  let unlock fd = Unix.close fd
+end
+
+module Make (K : Index.Key) (V : Index.Value) = Index.Make (K) (V) (IO)
+
+module Private = struct
+  module IO = IO
+end
diff --git a/vendors/index/src/unix/index_unix.mli b/vendors/index/src/unix/index_unix.mli
new file mode 100644
index 0000000000000000000000000000000000000000..532386af28d332b716d4d4b94c17f7ecf6a7f66d
--- /dev/null
+++ b/vendors/index/src/unix/index_unix.mli
@@ -0,0 +1,7 @@
+module Make (K : Index.Key) (V : Index.Value) :
+  Index.S with type key = K.t and type value = V.t
+
+(** These modules should not be used. They are exposed purely for testing purposes. *)
+module Private : sig
+  module IO : Index.IO
+end
diff --git a/vendors/index/src/unix/pread.c b/vendors/index/src/unix/pread.c
new file mode 100644
index 0000000000000000000000000000000000000000..319be8bb9371e19cbb07b90b5e9514a6dd5ccfed
--- /dev/null
+++ b/vendors/index/src/unix/pread.c
@@ -0,0 +1,28 @@
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/unixsupport.h>
+
+CAMLprim value caml_pread
+(value v_fd, value v_fd_off, value v_buf, value v_buf_off, value v_len)
+{
+  CAMLparam5(v_fd, v_fd_off, v_buf, v_buf_off, v_len);
+
+  ssize_t ret;
+  size_t fd = Int_val(v_fd);
+  size_t fd_off = Int64_val(v_fd_off);
+  size_t buf_off = Long_val(v_buf_off);
+  size_t len = Long_val(v_len);
+  char iobuf[UNIX_BUFFER_SIZE];
+
+  size_t numbytes = (len > UNIX_BUFFER_SIZE) ? UNIX_BUFFER_SIZE : len;
+  caml_enter_blocking_section();
+  ret = pread(fd, iobuf, numbytes, fd_off);
+  caml_leave_blocking_section();
+
+  if (ret == -1) uerror("read", Nothing);
+  memcpy(&Byte(v_buf, buf_off), iobuf, ret);
+
+  CAMLreturn(Val_long(ret));
+}
diff --git a/vendors/index/src/unix/pwrite.c b/vendors/index/src/unix/pwrite.c
new file mode 100644
index 0000000000000000000000000000000000000000..16b05f47f4256edb39bcb53977c28a2fc7b18143
--- /dev/null
+++ b/vendors/index/src/unix/pwrite.c
@@ -0,0 +1,29 @@
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/unixsupport.h>
+
+CAMLprim value caml_pwrite
+(value v_fd, value v_fd_off, value v_buf, value v_buf_off, value v_len)
+{
+  CAMLparam5(v_fd, v_fd_off, v_buf, v_buf_off, v_len);
+
+  ssize_t ret;
+  size_t fd = Int_val(v_fd);
+  size_t fd_off = Int64_val(v_fd_off);
+  size_t buf_off = Long_val(v_buf_off);
+  size_t len = Long_val(v_len);
+  char iobuf[UNIX_BUFFER_SIZE];
+
+  size_t numbytes = (len > UNIX_BUFFER_SIZE) ? UNIX_BUFFER_SIZE : len;
+  memcpy(iobuf, &Byte(v_buf, buf_off), numbytes);
+
+  caml_enter_blocking_section();
+  ret = pwrite(fd, iobuf, numbytes, fd_off);
+  caml_leave_blocking_section();
+
+  if (ret == -1) uerror("read", Nothing);
+
+  CAMLreturn(Val_long(ret));
+}
diff --git a/vendors/irmin-lmdb/dune b/vendors/irmin-lmdb/dune
deleted file mode 100644
index ab0458feb96d96fdd9f31528894961e3088ca233..0000000000000000000000000000000000000000
--- a/vendors/irmin-lmdb/dune
+++ /dev/null
@@ -1,5 +0,0 @@
-(library
- (name        irmin_lmdb)
- (public_name irmin-lmdb)
- (libraries   irmin lmdb)
- (flags (:standard -safe-string)))
diff --git a/vendors/irmin-lmdb/irmin-lmdb.opam b/vendors/irmin-lmdb/irmin-lmdb.opam
deleted file mode 100644
index d141ad00eeb94e5b43f713e455a224f7267efa87..0000000000000000000000000000000000000000
--- a/vendors/irmin-lmdb/irmin-lmdb.opam
+++ /dev/null
@@ -1,20 +0,0 @@
-opam-version: "2.0"
-maintainer:   "gregoire.henry@tezos.com"
-authors:      ["Grégoire Henry"]
-license:      "ISC"
-homepage:     "https://gitlab.com/tezos/irmin-lmdb"
-bug-reports:  "https://gitlab.com/tezos/irmin-lmdb/issues"
-dev-repo:     "git+https://gitlab.com/tezos/irmin-lmdb.git"
-doc:          "https://tezos.gitlab.io/irmin-lmdb/"
-synopsis:     "LMDB backend for Irmin"
-
-build: [
-  ["dune" "subst"] {pinned}
-  ["dune" "build" "-p" name "-j" jobs]
-  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
-]
-depends: [
-  "dune" {build & >= "1.7"}
-  "irmin"    {>= "1.4.0"}
-  "lmdb"     {>= "0.1"}
-]
diff --git a/vendors/irmin-lmdb/irmin_lmdb.ml b/vendors/irmin-lmdb/irmin_lmdb.ml
deleted file mode 100644
index 964216e9cb34ad0b0226b5d81652af3dfdb33524..0000000000000000000000000000000000000000
--- a/vendors/irmin-lmdb/irmin_lmdb.ml
+++ /dev/null
@@ -1,708 +0,0 @@
-(*
- * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
- *
- * Permission to use, copy, modify, and distribute this software for any
- * purpose with or without fee is hereby granted, provided that the above
- * copyright notice and this permission notice appear in all copies.
- *
- * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
- * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
- * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
- * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
- * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
- * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
- * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
- *)
-
-module Option = struct
-  let of_result = function
-    | Ok v -> Some v
-    | _ -> None
-
-  let value_map ~default ~f = function
-    | None -> default
-    | Some v -> f v
-end
-
-module Result = struct
-  let map ~f = function
-    | Ok v -> Ok (f v)
-    | Error err -> Error err
-end
-
-let cstruct_of_ba_copy ba =
-  let cs = Cstruct.of_bigarray ba in
-  let len = Cstruct.len cs in
-  let cs_copy = Cstruct.create_unsafe len in
-  Cstruct.blit cs 0 cs_copy 0 len ;
-  cs_copy
-
-open Lwt.Infix
-
-type t = {
-  db: Lmdb.t ;
-  root: string ;
-  mutable wtxn: (Lmdb.rw Lmdb.txn * Lmdb.db) option;
-}
-
-let of_result = function
-  | Ok v -> Lwt.return v
-  | Error err -> Lwt.fail_with (Lmdb.string_of_error err)
-
-let (|>>) v f =
-  match v with
-  | Ok v -> f v
-  | Error e -> Error e
-
-let get_wtxn db =
-  match db.wtxn with
-  | Some t -> Ok t
-  | None ->
-      Lmdb.create_rw_txn db.db |>> fun txn ->
-      Lmdb.opendb txn |>> fun ddb ->
-      db.wtxn <- Some (txn, ddb);
-      Ok (txn, ddb)
-
-let commit_wtxn db =
-  match db.wtxn with
-  | None -> Ok ()
-  | Some (t, _ddb) ->
-      db.wtxn <- None;
-      Lmdb.commit_txn t
-
-let add db k v =
-  get_wtxn db |>> fun (txn, ddb) ->
-  Lmdb.put_string txn ddb k v
-
-let add db k v =
-  of_result @@ add db k v
-
-let add_cstruct db k v =
-  get_wtxn db |>> fun (txn, ddb) ->
-  Lmdb.put txn ddb k (Cstruct.to_bigarray v)
-
-let add_cstruct db k v =
-  of_result @@ add_cstruct db k v
-
-let src = Logs.Src.create "irmin.lmdb" ~doc:"Irmin in a Lmdb store"
-module Log = (val Logs.src_log src : Logs.LOG)
-
-let int64_of_string s =
-  try Ok (Int64.of_string s)
-  with Failure _ ->
-    Error (`Msg (Printf.sprintf "%s is not the representation of an int64" s))
-
-let bool_of_string s =
-  try Ok (bool_of_string s)
-  with Failure _ ->
-    Error (`Msg (Printf.sprintf "%s is not the representation of a boolean" s))
-
-let int64_converter = int64_of_string, Fmt.uint64
-let bool_converter = bool_of_string, Fmt.bool
-
-module Conf = struct
-
-  let root = Irmin.Private.Conf.root
-  let mapsize =
-    Irmin.Private.Conf.key "mapsize" int64_converter 409_600_000_000L
-  let readonly = 
-    Irmin.Private.Conf.key "readonly" bool_converter false 
-
-end
-
-let config
-    ?(config=Irmin.Private.Conf.empty) ?mapsize ?(readonly=false) file =
-  let module C = Irmin.Private.Conf in
-  let config = C.add config Conf.root (Some file) in
-  let config = C.add config Conf.readonly readonly in
-  Option.value_map mapsize ~default:config ~f:(C.add config Conf.mapsize)
-
-type ('r) reader = { f : 'k. 'k Lmdb.txn -> Lmdb.db -> ('r, Lmdb.error) result } [@@unboxed]
-
-let with_read_db db ~f =
-  match db.wtxn with
-  | None ->
-      Lmdb.with_ro_db db.db ~f:f.f
-  | Some (txn, ddb) ->
-      f.f txn ddb
-
-let mem db k =
-  with_read_db db ~f:{ f = fun txn db -> Lmdb.mem txn db k } |>
-  of_result
-
-let find_bind db k ~f =
-  match with_read_db db ~f:{ f = fun txn db -> Result.map ~f (Lmdb.get txn db k) } with
-  | Error KeyNotFound -> Lwt.return_none
-  | Error err -> Lwt.fail_with (Lmdb.string_of_error err)
-  | Ok v -> Lwt.return v
-
-module Irmin_value_store
-    (M: Irmin.Metadata.S)
-    (H: Irmin.Hash.S)
-    (C: Irmin.Contents.S)
-    (P: Irmin.Path.S) = struct
-
-  module XContents = struct
-
-    type nonrec t = t
-    type key = H.t
-    type value = C.t
-
-    let lmdb_of_key h =
-      "contents/" ^ Cstruct.to_string (H.to_raw h)
-
-    let mem db key =
-      let key = lmdb_of_key key in
-      mem db key
-
-    let find db key =
-      let key = lmdb_of_key key in
-      find_bind db key ~f:begin fun v ->
-        Option.of_result (C.of_string Cstruct.(to_string (of_bigarray v)))
-      end
-
-    let to_string = Fmt.to_to_string C.pp
-
-    let add db v =
-      let k = H.digest C.t v in
-      let k_lmdb = lmdb_of_key k in
-      let v = to_string v in
-      add db k_lmdb v >|= fun () -> k
-
-    module Val = C
-    module Key = H
-  end
-
-  module Contents = Irmin.Contents.Store(XContents)
-
-  module XNode = struct
-    module Key = H
-    module Path = P
-
-    module Val = struct
-      module Metadata = M
-
-      type kind = [ `Node | `Contents of M.t ]
-      type metadata = M.t
-      type entry = { kind : kind; name : string; node : H.t; }
-      type t = entry list
-      type contents = Contents.key
-      type node = Key.t
-      type step = Path.step
-      type value = [`Node of node | `Contents of contents * metadata ]
-      let metadata_t = M.t
-      let contents_t = Contents.Key.t
-      let node_t = Key.t
-      let step_t = Path.step_t
-
-      let entry_t =
-        let open Irmin.Type in
-        record "Tree.entry"
-          (fun kind name node ->
-             let kind =
-               match kind with
-               | None -> `Node
-               | Some m -> `Contents m in
-             { kind ; name ; node } )
-        |+ field "kind" (option M.t) (function
-            | { kind = `Node ; _ } -> None
-            | { kind = `Contents m ; _ } -> Some m)
-        |+ field "name" string (fun { name ; _ } -> name)
-        |+ field "node" H.t (fun { node ; _ } -> node)
-        |> sealr
-
-      let value_t =
-        let open Irmin.Type in
-        variant "Tree.value" (fun node contents -> function
-            | `Node n          -> node n
-            | `Contents (c, m) -> contents (c, m))
-        |~ case1 "node"     node_t     (fun n -> `Node n)
-        |~ case1 "contents" (pair contents_t M.t) (fun (c, m) -> `Contents (c, m))
-        |> sealv
-
-      let of_step = Fmt.to_to_string P.pp_step
-
-      let to_step str = match P.step_of_string str with
-        | Ok x           -> x
-        | Error (`Msg e) -> failwith e
-
-      let to_entry kind (name, node) =
-        { kind; name = of_step name; node }
-
-      let list t  =
-        List.fold_left (fun acc { kind; name; node } ->
-            let name = to_step name in
-            match kind with
-            | `Node       -> (name, `Node node) :: acc
-            | `Contents m -> (name, `Contents (node, m)) :: acc
-          ) [] t
-        |> List.rev
-
-      let find t s =
-        let s = of_step s in
-        let rec aux = function
-          | [] -> None
-          | x::xs when x.name <> s -> aux xs
-          | { kind; node; _ } :: _ ->
-              match kind with
-              | `Node     -> Some (`Node node)
-              | `Contents m -> Some (`Contents (node, m))
-        in
-        aux t
-
-      type compare_result = LT | EQ | GT
-
-      module Sort_key: sig
-        type t
-        val of_entry: entry -> t
-        val of_contents: string -> t
-        val of_node: string -> t
-        val order: t -> t -> compare_result
-        val compare: t -> t -> int
-      end = struct
-
-        type t =
-          | Contents: string -> t
-          | Node    : string -> t
-
-        exception Result of int
-
-        let str = function Contents s | Node s -> s
-
-        let compare x y = match x, y with
-          | Contents x, Contents y -> String.compare x y
-          | _  ->
-              let xs = str x and ys = str y in
-              let lenx = String.length xs in
-              let leny = String.length ys in
-              let i = ref 0 in
-              try
-                while !i < lenx && !i < leny do
-                  match
-                    Char.compare
-                      (String.unsafe_get xs !i) (String.unsafe_get ys !i)
-                  with
-                  | 0 -> incr i
-                  | i -> raise (Result i)
-                done;
-                let get len s i =
-                  if i < len then String.unsafe_get (str s) i
-                  else if i = len then match s with
-                    | Node _     -> '/'
-                    | Contents _ -> '\000'
-                  else '\000'
-                in
-                match Char.compare (get lenx x !i) (get leny y !i) with
-                | 0 -> Char.compare (get lenx x (!i + 1)) (get leny y (!i + 1))
-                | i -> i
-              with Result i ->
-                i
-
-        let order a b = match compare a b with
-          | 0 -> EQ
-          | x when x > 0 -> GT
-          | _ -> LT
-
-        let of_contents c = Contents c
-        let of_node n = Node n
-
-        let of_entry = function
-          | {name = n; kind = `Node; _} -> of_node n
-          | {name = n; kind = `Contents _; _} -> of_contents n
-      end
-
-      let compare_entries a b =
-        Sort_key.(compare (of_entry a) (of_entry b))
-
-      (* the order is always:
-
-         [ ...; foo (content key); ...; foo/ (node key);  ... ]
-
-         So always scan until the 'node' key.
-      *)
-
-      let remove t step =
-        let step = of_step step in
-        let node_key = Sort_key.of_node step in
-        let contents_key = Sort_key.of_contents step in
-        let return ~acc rest = List.rev_append acc rest in
-        let rec aux acc = function
-          | []     -> t
-          | h :: l ->
-              let entry_key = Sort_key.of_entry h in
-              if Sort_key.order contents_key entry_key = EQ then
-                return ~acc l
-              else match Sort_key.order node_key entry_key with
-                | GT -> aux (h :: acc) l
-                | EQ -> return ~acc l
-                | LT -> t
-        in
-        aux [] t
-
-      let hash_of_v = function
-        | `Contents (x, _) | `Node x -> x
-
-      let update t step v =
-        let step = of_step step in
-        let node_key = Sort_key.of_node step in
-        let contents_key = Sort_key.of_contents step in
-        let return ~acc rest =
-          let kind, node = match v with
-            | `Node n          -> `Node, n
-            | `Contents (c, m) -> `Contents m, c
-          in
-          let e = { kind; name = step; node} in
-          List.rev_append acc (e :: rest)
-        in
-        let rec aux acc = function
-          | [] -> return ~acc []
-          | { node; _ } as h :: l ->
-              let entry_key = Sort_key.of_entry h in
-              (* Remove any contents entry with the same name. This will always
-                 come before the new succ entry. *)
-              if Sort_key.order contents_key entry_key = EQ then
-                aux acc l
-              else match Sort_key.order node_key entry_key with
-                | GT -> aux (h :: acc) l
-                | LT -> return ~acc (h::l)
-                | EQ when Cstruct.equal (H.to_raw (hash_of_v v)) (H.to_raw node) -> t
-                | EQ -> return ~acc l
-        in
-        aux [] t
-
-      let empty = []
-
-      let is_empty = function
-        | [] -> true
-        | _  -> false
-
-      let v alist =
-        let alist = List.map (fun (l, x) ->
-            let v k = l, k in
-            match x with
-            | `Node n             -> to_entry `Node (v n)
-            | `Contents (c, m) -> to_entry (`Contents m) (v c)
-          ) alist
-        in
-        List.fast_sort compare_entries alist
-
-      let alist t =
-        let mk_n k = `Node k in
-        let mk_c k m= `Contents (k, m) in
-        List.map (function
-            | { kind = `Node; name; node } -> (to_step name, mk_n node)
-            | { kind = `Contents m; name; node; _ } ->
-                (to_step name, mk_c node m)
-          ) t
-
-      module N = Irmin.Private.Node.Make (H)(H)(P)(M)
-      let to_n t = N.v (alist t)
-      let of_n n = v (N.list n)
-      let t = Irmin.Type.like N.t of_n to_n
-    end
-
-    module AO = struct
-
-      type nonrec t = t
-      type key = H.t
-      type value = Val.t
-
-      let lmdb_of_key h =
-        "node/" ^ Cstruct.to_string (H.to_raw h)
-
-      let mem db key =
-        let key = lmdb_of_key key in
-        mem db key
-
-      let of_cstruct v =
-        Irmin.Type.decode_cstruct (Irmin.Type.list Val.entry_t) v |>
-        Option.of_result
-
-      let find db key =
-        let key = lmdb_of_key key in
-        find_bind db key ~f:(fun v -> of_cstruct (cstruct_of_ba_copy v))
-
-      let add db v =
-        let v = Irmin.Type.encode_cstruct (Irmin.Type.list Val.entry_t) v in
-        let k = H.digest Irmin.Type.cstruct v in
-        let k_lmdb = lmdb_of_key k in
-        add_cstruct db k_lmdb v >|= fun () -> k
-    end
-    include AO
-
-  end
-  module Node = Irmin.Private.Node.Store(Contents)(P)(M)(XNode)
-
-  module XCommit = struct
-    module Val = struct
-      type t = {
-        node: H.t ;
-        parents: H.t list ;
-        info: Irmin.Info.t ;
-      }
-      type commit = H.t
-      type node = H.t
-
-      let commit_t = H.t
-      let node_t = H.t
-
-      let v ~info ~node ~parents = { info ; node ; parents }
-      let xnode { node; _ } = node
-      let node t = xnode t
-      let parents { parents; _ } = parents
-      let info { info; _ } = info
-
-      module C = Irmin.Private.Commit.Make(H)(H)
-
-      let of_c c = v ~info:(C.info c) ~node:(C.node c) ~parents:(C.parents c)
-
-      let to_c { info ; node ; parents } =
-        C.v ~info ~node ~parents
-
-      let t = Irmin.Type.like C.t of_c to_c
-    end
-
-    module Key = H
-
-    module AO = struct
-
-      let lmdb_of_key h =
-        "commit/" ^ Cstruct.to_string (H.to_raw h)
-
-      type nonrec t = t
-      type key = H.t
-      type value = Val.t
-
-      let mem db key =
-        let key = lmdb_of_key key in
-        mem db key
-
-      let of_cstruct v =
-        Irmin.Type.decode_cstruct Val.t v |>
-        Option.of_result
-
-      let find db key =
-        let key = lmdb_of_key key in
-        find_bind db key ~f:(fun v -> of_cstruct (cstruct_of_ba_copy v))
-
-      let add db v =
-        let v = Irmin.Type.encode_cstruct Val.t v in
-        let k = H.digest Irmin.Type.cstruct v in
-        let k_lmdb = lmdb_of_key k in
-        add_cstruct db k_lmdb v >>= fun () ->
-        of_result @@ commit_wtxn db >|= fun () -> k
-
-    end
-    include AO
-
-  end
-  module Commit = Irmin.Private.Commit.Store(Node)(XCommit)
-
-end
-
-module type Branch = sig
-  include Irmin.Branch.S
-  val pp_ref: t Fmt.t
-  val of_ref: string -> (t, [`Msg of string]) result
-end
-
-module Branch (B: Irmin.Branch.S): Branch with type t = B.t = struct
-  open Astring
-  include B
-  let pp_ref ppf b = Fmt.pf ppf "heads/%a" B.pp b
-
-  let of_ref str = match String.cuts ~sep:"/" str with
-    | "heads" :: b -> B.of_string (String.concat ~sep:"/" b)
-    | _ -> Error (`Msg (Fmt.strf "%s is not a valid branch" str))
-end
-
-
-module Irmin_branch_store (B: Branch) (H: Irmin.Hash.S) = struct
-
-  module Key = B
-  module Val = H
-
-  module W = Irmin.Private.Watch.Make(Key)(Val)
-
-  type nonrec t = {
-    db: t;
-    w: W.t;
-  }
-
-  let watches = Hashtbl.create 10
-
-  type key = Key.t
-  type value = Val.t
-  type watch = W.watch * (unit -> unit Lwt.t)
-
-  (* let branch_of_lmdb r = *)
-  (* let str = String.trim @@ Git.Reference.to_raw r in *)
-  (* match B.of_ref str with *)
-  (* | Ok r           -> Some r *)
-  (* | Error (`Msg _) -> None *)
-
-  let lmdb_of_branch r = Fmt.to_to_string B.pp_ref r
-
-  let mem db r =
-    mem db.db (lmdb_of_branch r)
-
-  let find db r =
-    find_bind db.db (lmdb_of_branch r)
-      ~f:(fun v -> Some (H.of_raw (cstruct_of_ba_copy v)))
-
-  let listen_dir _ =
-    Lwt.return (fun () -> Lwt.return_unit)
-
-  let watch_key t key ?init f =
-    listen_dir t >>= fun stop ->
-    W.watch_key t.w key ?init f >|= fun w ->
-    (w, stop)
-
-  let watch t ?init f =
-    listen_dir t >>= fun stop ->
-    W.watch t.w ?init f >|= fun w ->
-    (w, stop)
-
-  let unwatch t (w, stop) =
-    stop () >>= fun () ->
-    W.unwatch t.w w
-
-  let v db (* ~head *) =
-    let w =
-      try Hashtbl.find watches db.root
-      with Not_found ->
-        let w = W.v () in
-        (* FIXME: we might want to use a weak table *)
-        Hashtbl.add watches db.root w;
-        w
-    in
-    Lwt.return { db ; w }
-
-  let list _ = Lwt.return_nil (* TODO, or not *)
-
-  (* let write_index _t _gr _gk = *)
-  (* Lwt.return_unit *)
-
-  let set _t r _k =
-    Log.debug (fun f -> f "update %a" B.pp r);
-    Lwt.return_unit
-  (* let gr = git_of_branch r in *)
-  (* let gk = git_of_commit k in *)
-  (* G.write_reference t.t gr gk >>= fun () -> *)
-  (* W.notify t.w r (Some k) >>= fun () -> *)
-  (* write_index t gr (Git.Hash.to_commit gk) *)
-
-  let remove _t r =
-    Log.debug (fun f -> f "remove %a" B.pp r);
-    Lwt.return_unit
-  (* G.remove_reference t.t (git_of_branch r) >>= fun () -> *)
-  (* W.notify t.w r None *)
-
-  let test_and_set _t _r ~test:_ ~set:_ =
-    Log.debug (fun f -> f "test_and_set");
-    Lwt.return_true
-    (* let gr = git_of_branch r in *)
-    (* let c = function None -> None | Some h -> Some (git_of_commit h) in *)
-    (* G.test_and_set_reference t.t gr ~test:(c test) ~set:(c set) >>= fun b -> *)
-    (* (if b then W.notify t.w r set else Lwt.return_unit) >>= fun () -> *)
-    (* begin *)
-    (* We do not protect [write_index] because it can take a log
-       time and we don't want to hold the lock for too long. Would
-       be safer to grab a lock, although the expanded filesystem
-       is not critical for Irmin consistency (it's only a
-       convenience for the user). *)
-    (* if b then match set with *)
-    (* | None   -> Lwt.return_unit *)
-    (* | Some v -> write_index t gr (Git.Hash.to_commit (git_of_commit v)) *)
-    (* else *)
-    (* Lwt.return_unit *)
-    (* end >|= fun () -> *)
-    (* b *)
-
-end
-
-
-module Make
-    (M: Irmin.Metadata.S)
-    (C: Irmin.Contents.S)
-    (P: Irmin.Path.S)
-    (B: Irmin.Branch.S)
-    (H: Irmin.Hash.S) = struct
-
-  module P = struct
-
-    module Branch = Irmin_branch_store(Branch(B))(H)
-    include Irmin_value_store(M)(H)(C)(P)
-    module Slice = Irmin.Private.Slice.Make(Contents)(Node)(Commit)
-    module Sync = struct
-      type t = unit
-      type commit = H.t
-      type branch = B.t
-      let fetch _ ?depth:_ ~uri:_  _ = Lwt.return_error `Not_available
-      let push _ ?depth:_ ~uri:_ _ = Lwt.return_error `Not_available
-      let v _ = Lwt.return_unit
-    end
-
-    module Repo = struct
-      type nonrec t = {
-        config: Irmin.config ;
-        db: t ;
-        branch: Branch.t ;
-      }
-      let branch_t t : Branch.t = t.branch
-      let contents_t t : Contents.t = t.db
-      let node_t t : Node.t = contents_t t, t.db
-      let commit_t t : Commit.t = node_t t, t.db
-
-      type config = {
-        root   : string option ;
-        mapsize : int64 ;
-        readonly : bool ;
-        (* TODO *)
-        (* ?write_buffer_size:int -> *)
-        (* ?max_open_files:int -> *)
-        (* ?block_size:int -> *)
-        (* ?block_restart_interval:int -> *)
-        (* ?cache_size:int *)
-      }
-
-      let config c =
-        let root = Irmin.Private.Conf.get c Conf.root in
-        let mapsize = Irmin.Private.Conf.get c Conf.mapsize in
-        let readonly = Irmin.Private.Conf.get c Conf.readonly in
-        { root ; mapsize ; readonly }
-
-      let v conf =
-        let { root ; mapsize ; readonly } = config conf in
-        let root = match root with None -> "irmin.ldb" | Some root -> root in
-        if not (Sys.file_exists root) then Unix.mkdir root 0o755 ;
-        let flags = if readonly then [ Lmdb.RdOnly ] else [] in
-        let sync_flag =
-          match Sys.getenv_opt "TEZOS_CONTEXT_SYNC" with
-          | None -> []
-          | Some s ->
-              match String.lowercase_ascii s with
-              | "nosync" -> [ Lmdb.NoSync ]
-              | "nometasync" -> [ Lmdb.NoMetaSync ]
-              | _ ->
-                  Printf.eprintf "Unrecognized TEZOS_CONTEXT_SYNC option : %s\n\
-                                  allowed: nosync nometasync" s;
-                  []
-        in
-        let flags = sync_flag @ Lmdb.NoRdAhead :: Lmdb.NoTLS :: flags in
-        let file_flags = if readonly then 0o444 else 0o644 in
-        match Lmdb.opendir ~mapsize ~flags root file_flags with
-        | Error err -> Lwt.fail_with (Lmdb.string_of_error err)
-        | Ok db ->
-            let db = { db ; root ; wtxn = None } in
-            Branch.v db >|= fun branch ->
-            { db; branch; config = conf }
-
-    end
-  end
-
-  include Irmin.Make_ext(P)
-
-end
-
-include Conf
diff --git a/vendors/irmin-pack/IO.ml b/vendors/irmin-pack/IO.ml
new file mode 100644
index 0000000000000000000000000000000000000000..c3f5d3ff5fc7aea1c5bd522fdb2910272aaf7d40
--- /dev/null
+++ b/vendors/irmin-pack/IO.ml
@@ -0,0 +1,291 @@
+(*
+ * Copyright (c) 2013-2019 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+let src = Logs.Src.create "irmin.pack.io" ~doc:"IO for irmin-pack"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+module type S = sig
+  type t
+
+  exception RO_Not_Allowed
+
+  val v : fresh:bool -> version:string -> readonly:bool -> string -> t
+
+  val name : t -> string
+
+  val clear : t -> unit
+
+  val append : t -> string -> unit
+
+  val set : t -> off:int64 -> string -> unit
+
+  val read : t -> off:int64 -> bytes -> int
+
+  val offset : t -> int64
+
+  val force_offset : t -> int64
+
+  val readonly : t -> bool
+
+  val version : t -> string
+
+  val sync : t -> unit
+
+  val close : t -> unit
+end
+
+let ( ++ ) = Int64.add
+
+let ( -- ) = Int64.sub
+
+module Unix : S = struct
+  exception RO_Not_Allowed
+
+  module Raw = struct
+    type t = { fd : Unix.file_descr; mutable cursor : int64 }
+
+    let v fd = { fd; cursor = 0L }
+
+    let really_write fd buf =
+      let rec aux off len =
+        let w = Unix.write fd buf off len in
+        if w = 0 then () else (aux [@tailcall]) (off + w) (len - w)
+      in
+      (aux [@tailcall]) 0 (Bytes.length buf)
+
+    let really_read fd len buf =
+      let rec aux off len =
+        let r = Unix.read fd buf off len in
+        if r = 0 then off (* end of file *)
+        else if r = len then off + r
+        else (aux [@tailcall]) (off + r) (len - r)
+      in
+      (aux [@tailcall]) 0 len
+
+    let lseek t off =
+      if off = t.cursor then ()
+      else
+        let _ = Unix.LargeFile.lseek t.fd off Unix.SEEK_SET in
+        t.cursor <- off
+
+    let unsafe_write t ~off buf =
+      lseek t off;
+      let buf = Bytes.unsafe_of_string buf in
+      really_write t.fd buf;
+      t.cursor <- off ++ Int64.of_int (Bytes.length buf)
+
+    let unsafe_read t ~off ~len buf =
+      lseek t off;
+      let n = really_read t.fd len buf in
+      t.cursor <- off ++ Int64.of_int n;
+      n
+
+    let unsafe_set_offset t n =
+      let buf = Irmin.Type.(to_bin_string int64) n in
+      unsafe_write t ~off:0L buf
+
+    let unsafe_get_offset t =
+      let buf = Bytes.create 8 in
+      let n = unsafe_read t ~off:0L ~len:8 buf in
+      assert (n = 8);
+      match Irmin.Type.(of_bin_string int64) (Bytes.unsafe_to_string buf) with
+      | Ok t -> t
+      | Error (`Msg e) -> Fmt.failwith "get_offset: %s" e
+
+    let unsafe_get_version t =
+      let buf = Bytes.create 8 in
+      let n = unsafe_read t ~off:8L ~len:8 buf in
+      assert (n = 8);
+      Bytes.unsafe_to_string buf
+
+    let unsafe_set_version t v = unsafe_write t ~off:8L v
+  end
+
+  type t = {
+    file : string;
+    mutable raw : Raw.t;
+    mutable offset : int64;
+    mutable flushed : int64;
+    readonly : bool;
+    version : string;
+    buf : Buffer.t;
+  }
+
+  let name t = t.file
+
+  let header = 16L (* offset + version *)
+
+  let sync t =
+    if t.readonly then raise RO_Not_Allowed;
+    Log.debug (fun l -> l "IO sync %s" t.file);
+    let buf = Buffer.contents t.buf in
+    let offset = t.offset in
+    Buffer.clear t.buf;
+    if buf = "" then ()
+    else (
+      Raw.unsafe_write t.raw ~off:t.flushed buf;
+      Raw.unsafe_set_offset t.raw offset;
+
+      (* concurrent append might happen so here t.offset might differ
+         from offset *)
+      if not (t.flushed ++ Int64.of_int (String.length buf) = header ++ offset)
+      then
+        Fmt.failwith "sync error: %s flushed=%Ld offset+header=%Ld\n%!" t.file
+          t.flushed (offset ++ header);
+      t.flushed <- offset ++ header )
+
+  let auto_flush_limit = 1_000_000L
+
+  let append t buf =
+    Buffer.add_string t.buf buf;
+    let len = Int64.of_int (String.length buf) in
+    t.offset <- t.offset ++ len;
+    if t.offset -- t.flushed > auto_flush_limit then sync t
+
+  let set t ~off buf =
+    if t.readonly then raise RO_Not_Allowed;
+    sync t;
+    Raw.unsafe_write t.raw ~off:(header ++ off) buf;
+    let len = Int64.of_int (String.length buf) in
+    let off = header ++ off ++ len in
+    assert (off <= t.flushed)
+
+  let read t ~off buf =
+    if not t.readonly then assert (header ++ off <= t.flushed);
+    Raw.unsafe_read t.raw ~off:(header ++ off) ~len:(Bytes.length buf) buf
+
+  let offset t = t.offset
+
+  let force_offset t =
+    t.offset <- Raw.unsafe_get_offset t.raw;
+    t.offset
+
+  let version t = t.version
+
+  let readonly t = t.readonly
+
+  let protect_unix_exn = function
+    | Unix.Unix_error _ as e -> failwith (Printexc.to_string e)
+    | e -> raise e
+
+  let ignore_enoent = function
+    | Unix.Unix_error (Unix.ENOENT, _, _) -> ()
+    | e -> raise e
+
+  let protect f x = try f x with e -> protect_unix_exn e
+
+  let safe f x = try f x with e -> ignore_enoent e
+
+  let mkdir dirname =
+    let rec aux dir k =
+      if Sys.file_exists dir && Sys.is_directory dir then k ()
+      else (
+        if Sys.file_exists dir then safe Unix.unlink dir;
+        (aux [@tailcall]) (Filename.dirname dir) @@ fun () ->
+        protect (Unix.mkdir dir) 0o755;
+        k () )
+    in
+    (aux [@tailcall]) dirname (fun () -> ())
+
+  let clear t =
+    t.offset <- 0L;
+    t.flushed <- header;
+    Buffer.clear t.buf
+
+  let buffers = Hashtbl.create 256
+
+  let buffer file =
+    try
+      let buf = Hashtbl.find buffers file in
+      Buffer.clear buf;
+      buf
+    with Not_found ->
+      let buf = Buffer.create (4 * 1024) in
+      Hashtbl.add buffers file buf;
+      buf
+
+  let v ~fresh ~version:current_version ~readonly file =
+    assert (String.length current_version = 8);
+    let v ~offset ~version raw =
+      {
+        version;
+        file;
+        offset;
+        raw;
+        readonly;
+        buf = buffer file;
+        flushed = header ++ offset;
+      }
+    in
+    let mode = Unix.(if readonly then O_RDONLY else O_RDWR) in
+    mkdir (Filename.dirname file);
+    match Sys.file_exists file with
+    | false ->
+        let x = Unix.openfile file Unix.[ O_CREAT; mode; O_CLOEXEC ] 0o644 in
+        let raw = Raw.v x in
+        Raw.unsafe_set_offset raw 0L;
+        Raw.unsafe_set_version raw current_version;
+        v ~offset:0L ~version:current_version raw
+    | true ->
+        let x = Unix.openfile file Unix.[ O_EXCL; mode; O_CLOEXEC ] 0o644 in
+        let raw = Raw.v x in
+        if fresh then (
+          Raw.unsafe_set_offset raw 0L;
+          Raw.unsafe_set_version raw current_version;
+          v ~offset:0L ~version:current_version raw )
+        else
+          let offset = Raw.unsafe_get_offset raw in
+          let version = Raw.unsafe_get_version raw in
+          assert (version = current_version);
+          v ~offset ~version raw
+
+  let close t = Unix.close t.raw.fd
+end
+
+let ( // ) = Filename.concat
+
+let with_cache ~v ~clear ~valid file =
+  let files = Hashtbl.create 13 in
+  let cached_constructor extra_args ?(fresh = false) ?(readonly = false) root =
+    let file = root // file in
+    if fresh && readonly then invalid_arg "Read-only IO cannot be fresh";
+    try
+      if not (Sys.file_exists file) then (
+        Log.debug (fun l ->
+            l "[%s] does not exist anymore, cleaning up the fd cache"
+              (Filename.basename file));
+        Hashtbl.remove files (file, true);
+        Hashtbl.remove files (file, false);
+        raise Not_found );
+      let t = Hashtbl.find files (file, readonly) in
+      if valid t then (
+        Log.debug (fun l -> l "%s found in cache" file);
+        if fresh then clear t;
+        t )
+      else (
+        Hashtbl.remove files (file, readonly);
+        raise Not_found )
+    with Not_found ->
+      Log.debug (fun l ->
+          l "[%s] v fresh=%b readonly=%b" (Filename.basename file) fresh
+            readonly);
+      let t = v extra_args ~fresh ~readonly file in
+      if fresh then clear t;
+      Hashtbl.add files (file, readonly) t;
+      t
+  in
+  `Staged cached_constructor
diff --git a/vendors/irmin-pack/IO.mli b/vendors/irmin-pack/IO.mli
new file mode 100644
index 0000000000000000000000000000000000000000..cbeaf07b7f9decb790e5e5c8833a60a3ef9e916b
--- /dev/null
+++ b/vendors/irmin-pack/IO.mli
@@ -0,0 +1,54 @@
+(*
+ * Copyright (c) 2013-2019 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module type S = sig
+  type t
+
+  exception RO_Not_Allowed
+
+  val v : fresh:bool -> version:string -> readonly:bool -> string -> t
+
+  val name : t -> string
+
+  val clear : t -> unit
+
+  val append : t -> string -> unit
+
+  val set : t -> off:int64 -> string -> unit
+
+  val read : t -> off:int64 -> bytes -> int
+
+  val offset : t -> int64
+
+  val force_offset : t -> int64
+
+  val readonly : t -> bool
+
+  val version : t -> string
+
+  val sync : t -> unit
+
+  val close : t -> unit
+end
+
+module Unix : S
+
+val with_cache :
+  v:('a -> fresh:bool -> readonly:bool -> string -> 'b) ->
+  clear:('b -> unit) ->
+  valid:('b -> bool) ->
+  string ->
+  [ `Staged of 'a -> ?fresh:bool -> ?readonly:bool -> string -> 'b ]
diff --git a/vendors/irmin-pack/dict.ml b/vendors/irmin-pack/dict.ml
new file mode 100644
index 0000000000000000000000000000000000000000..72d6335a0feffef162daaf6e52a2f084af4b6e72
--- /dev/null
+++ b/vendors/irmin-pack/dict.ml
@@ -0,0 +1,129 @@
+(*
+ * Copyright (c) 2013-2019 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+let src =
+  Logs.Src.create "irmin.pack.dict" ~doc:"irmin-pack backend dictionaries"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let current_version = "00000001"
+
+let ( -- ) = Int64.sub
+
+module type S = sig
+  type t
+
+  val find : t -> int -> string option
+
+  val index : t -> string -> int option
+
+  val sync : t -> unit
+
+  val v : ?fresh:bool -> ?readonly:bool -> ?capacity:int -> string -> t
+
+  val clear : t -> unit
+
+  val close : t -> unit
+
+  val valid : t -> bool
+end
+
+module Make (IO : IO.S) : S = struct
+  type t = {
+    capacity : int;
+    cache : (string, int) Hashtbl.t;
+    index : (int, string) Hashtbl.t;
+    io : IO.t;
+    mutable counter : int;
+  }
+
+  let append_string t v =
+    let len = Int32.of_int (String.length v) in
+    let buf = Irmin.Type.(to_bin_string int32 len) ^ v in
+    IO.append t.io buf
+
+  let refill ~from t =
+    let len = Int64.to_int (IO.offset t.io -- from) in
+    let raw = Bytes.create len in
+    let n = IO.read t.io ~off:from raw in
+    assert (n = len);
+    let raw = Bytes.unsafe_to_string raw in
+    let rec aux n offset =
+      if offset >= len then ()
+      else
+        let _, v = Irmin.Type.(decode_bin int32) raw offset in
+        let len = Int32.to_int v in
+        let v = String.sub raw (offset + 4) len in
+        Hashtbl.add t.cache v n;
+        Hashtbl.add t.index n v;
+        (aux [@tailcall]) (n + 1) (offset + 4 + len)
+    in
+    (aux [@tailcall]) (Hashtbl.length t.cache) 0
+
+  let sync_offset t =
+    let former_log_offset = IO.offset t.io in
+    let log_offset = IO.force_offset t.io in
+    if log_offset > former_log_offset then refill ~from:former_log_offset t
+
+  let sync t = IO.sync t.io
+
+  let index t v =
+    Log.debug (fun l -> l "[dict] index %S" v);
+    if IO.readonly t.io then sync_offset t;
+    try Some (Hashtbl.find t.cache v)
+    with Not_found ->
+      let id = Hashtbl.length t.cache in
+      if id > t.capacity then None
+      else (
+        if IO.readonly t.io then raise IO.RO_Not_Allowed;
+        append_string t v;
+        Hashtbl.add t.cache v id;
+        Hashtbl.add t.index id v;
+        Some id )
+
+  let find t id =
+    if IO.readonly t.io then sync_offset t;
+    Log.debug (fun l -> l "[dict] find %d" id);
+    let v = try Some (Hashtbl.find t.index id) with Not_found -> None in
+    v
+
+  let clear t =
+    IO.clear t.io;
+    Hashtbl.clear t.cache;
+    Hashtbl.clear t.index
+
+  let v ?(fresh = true) ?(readonly = false) ?(capacity = 100_000) file =
+    let io = IO.v ~fresh ~version:current_version ~readonly file in
+    let cache = Hashtbl.create 997 in
+    let index = Hashtbl.create 997 in
+    let t = { capacity; index; cache; io; counter = 1 } in
+    refill ~from:0L t;
+    t
+
+  let close t =
+    t.counter <- t.counter - 1;
+    if t.counter = 0 then (
+      if not (IO.readonly t.io) then sync t;
+      IO.close t.io;
+      Hashtbl.reset t.cache;
+      Hashtbl.reset t.index )
+
+  let valid t =
+    if t.counter <> 0 then (
+      t.counter <- t.counter + 1;
+      true )
+    else false
+end
diff --git a/vendors/irmin-pack/dict.mli b/vendors/irmin-pack/dict.mli
new file mode 100644
index 0000000000000000000000000000000000000000..6f8748f0b7d35117cd7d4e20b7b3bf5bec461711
--- /dev/null
+++ b/vendors/irmin-pack/dict.mli
@@ -0,0 +1,35 @@
+(*
+ * Copyright (c) 2013-2019 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module type S = sig
+  type t
+
+  val find : t -> int -> string option
+
+  val index : t -> string -> int option
+
+  val sync : t -> unit
+
+  val v : ?fresh:bool -> ?readonly:bool -> ?capacity:int -> string -> t
+
+  val clear : t -> unit
+
+  val close : t -> unit
+
+  val valid : t -> bool
+end
+
+module Make (IO : IO.S) : S
diff --git a/vendors/irmin-pack/dune b/vendors/irmin-pack/dune
new file mode 100644
index 0000000000000000000000000000000000000000..99c2bca379e4b915fb478dc2659f5872ddf8f1c1
--- /dev/null
+++ b/vendors/irmin-pack/dune
@@ -0,0 +1,4 @@
+(library
+  (public_name irmin-pack)
+  (name        irmin_pack)
+  (libraries   irmin logs lwt.unix index.unix))
diff --git a/vendors/irmin-pack/inode.ml b/vendors/irmin-pack/inode.ml
new file mode 100644
index 0000000000000000000000000000000000000000..ca93d23eaa03be3c91411a3cd24eb2250a487875
--- /dev/null
+++ b/vendors/irmin-pack/inode.ml
@@ -0,0 +1,795 @@
+(*
+ * Copyright (c) 2013-2019 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+
+let src =
+  Logs.Src.create "irmin.pack.i" ~doc:"inodes for the irmin-pack backend"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+module type S = sig
+  include Irmin.CONTENT_ADDRESSABLE_STORE
+
+  type index
+
+  val v :
+    ?fresh:bool ->
+    ?readonly:bool ->
+    ?lru_size:int ->
+    index:index ->
+    string ->
+    [ `Read ] t Lwt.t
+
+  val batch : [ `Read ] t -> ([ `Read | `Write ] t -> 'a Lwt.t) -> 'a Lwt.t
+
+  module Key : Irmin.Hash.S with type t = key
+
+  module Val : Irmin.Private.Node.S with type t = value and type hash = key
+
+  val integrity_check : offset:int64 -> length:int -> key -> 'a t -> unit
+
+  val close : 'a t -> unit Lwt.t
+end
+
+module type CONFIG = sig
+  val entries : int
+
+  val stable_hash : int
+end
+
+module Make
+    (Conf : CONFIG)
+    (H : Irmin.Hash.S)
+    (Pack : Pack.MAKER with type key = H.t)
+    (Node : Irmin.Private.Node.S with type hash = H.t) =
+struct
+  type index = Pack.index
+
+  module Node = struct
+    include Node
+    module H = Irmin.Hash.Typed (H) (Node)
+
+    let hash = H.hash
+  end
+
+  module T = struct
+    type hash = H.t
+
+    type step = Node.step
+
+    type metadata = Node.metadata
+
+    let step_t = Node.step_t
+
+    let hash_t = H.t
+
+    let metadata_t = Node.metadata_t
+
+    let default = Node.default
+
+    type value = Node.value
+
+    let value_t = Node.value_t
+
+    let pp_hash = Irmin.Type.(pp hash_t)
+  end
+
+  module Inode = struct
+    module StepMap = struct
+      include Map.Make (struct
+        type t = T.step
+
+        let compare = Irmin.Type.compare T.step_t
+      end)
+
+      let of_list l = List.fold_left (fun acc (k, v) -> add k v acc) empty l
+
+      let t a =
+        let open Irmin.Type in
+        map (list (pair T.step_t a)) of_list bindings
+    end
+
+    (* Binary representation, useful to compute hashes *)
+    module Bin = struct
+      open T
+
+      type inode = { index : int; hash : H.t }
+
+      type inodes = { seed : int; length : int; entries : inode list }
+
+      type v = Values of (step * value) list | Inodes of inodes
+
+      let inode : inode Irmin.Type.t =
+        let open Irmin.Type in
+        record "Bin.inode" (fun index hash -> { index; hash })
+        |+ field "index" int (fun t -> t.index)
+        |+ field "hash" H.t (fun (t : inode) -> t.hash)
+        |> sealr
+
+      let inodes : inodes Irmin.Type.t =
+        let open Irmin.Type in
+        record "Bin.inodes" (fun seed length entries ->
+            { seed; length; entries })
+        |+ field "seed" int (fun t -> t.seed)
+        |+ field "length" int (fun t -> t.length)
+        |+ field "entries" (list inode) (fun t -> t.entries)
+        |> sealr
+
+      let v_t : v Irmin.Type.t =
+        let open Irmin.Type in
+        variant "Bin.v" (fun values inodes ->
+          function Values l -> values l | Inodes i -> inodes i)
+        |~ case1 "Values" (list (pair step_t value_t)) (fun t -> Values t)
+        |~ case1 "Inodes" inodes (fun t -> Inodes t)
+        |> sealv
+
+      module V =
+        Irmin.Hash.Typed
+          (H)
+          (struct
+            type t = v
+
+            let t = v_t
+          end)
+
+      type t = { hash : H.t Lazy.t; stable : bool; v : v }
+
+      let t : t Irmin.Type.t =
+        let open Irmin.Type in
+        let pre_hash x = Irmin.Type.pre_hash v_t x.v in
+        record "Bin.t" (fun hash stable v -> { hash = lazy hash; stable; v })
+        |+ field "hash" H.t (fun t -> Lazy.force t.hash)
+        |+ field "stable" bool (fun t -> t.stable)
+        |+ field "v" v_t (fun t -> t.v)
+        |> sealr |> like ~pre_hash
+
+      let node ~hash v = { stable = true; hash; v }
+
+      let inode ~hash v = { stable = false; hash; v }
+
+      let hash t = Lazy.force t.hash
+    end
+
+    (* Compressed binary representation *)
+    module Compress = struct
+      open T
+
+      type name = Indirect of int | Direct of step
+
+      type address = Indirect of int64 | Direct of H.t
+
+      let address : address Irmin.Type.t =
+        let open Irmin.Type in
+        variant "Compress.address" (fun i d ->
+          function Indirect x -> i x | Direct x -> d x)
+        |~ case1 "Indirect" int64 (fun x -> Indirect x)
+        |~ case1 "Direct" H.t (fun x -> Direct x)
+        |> sealv
+
+      type inode = { index : int; hash : address }
+
+      let inode : inode Irmin.Type.t =
+        let open Irmin.Type in
+        record "Compress.inode" (fun index hash -> { index; hash })
+        |+ field "index" int (fun t -> t.index)
+        |+ field "hash" address (fun t -> t.hash)
+        |> sealr
+
+      type inodes = { seed : int; length : int; entries : inode list }
+
+      let inodes : inodes Irmin.Type.t =
+        let open Irmin.Type in
+        record "Compress.inodes" (fun seed length entries ->
+            { seed; length; entries })
+        |+ field "seed" int (fun t -> t.seed)
+        |+ field "length" int (fun t -> t.length)
+        |+ field "entries" (list inode) (fun t -> t.entries)
+        |> sealr
+
+      type value =
+        | Contents of name * address * metadata
+        | Node of name * address
+
+      let is_default = Irmin.Type.equal T.metadata_t T.default
+
+      let value : value Irmin.Type.t =
+        let open Irmin.Type in
+        variant "Compress.value"
+          (fun contents_ii
+               contents_x_ii
+               node_ii
+               contents_id
+               contents_x_id
+               node_id
+               contents_di
+               contents_x_di
+               node_di
+               contents_dd
+               contents_x_dd
+               node_dd
+               ->
+          function
+          | Contents (Indirect n, Indirect h, m) ->
+              if is_default m then contents_ii (n, h)
+              else contents_x_ii (n, h, m)
+          | Node (Indirect n, Indirect h) -> node_ii (n, h)
+          | Contents (Indirect n, Direct h, m) ->
+              if is_default m then contents_id (n, h)
+              else contents_x_id (n, h, m)
+          | Node (Indirect n, Direct h) -> node_id (n, h)
+          | Contents (Direct n, Indirect h, m) ->
+              if is_default m then contents_di (n, h)
+              else contents_x_di (n, h, m)
+          | Node (Direct n, Indirect h) -> node_di (n, h)
+          | Contents (Direct n, Direct h, m) ->
+              if is_default m then contents_dd (n, h)
+              else contents_x_dd (n, h, m)
+          | Node (Direct n, Direct h) -> node_dd (n, h))
+        |~ case1 "contents-ii" (pair int int64) (fun (n, i) ->
+               Contents (Indirect n, Indirect i, T.default))
+        |~ case1 "contents-x-ii" (triple int int64 metadata_t)
+             (fun (n, i, m) -> Contents (Indirect n, Indirect i, m))
+        |~ case1 "node-ii" (pair int int64) (fun (n, i) ->
+               Node (Indirect n, Indirect i))
+        |~ case1 "contents-id" (pair int H.t) (fun (n, h) ->
+               Contents (Indirect n, Direct h, T.default))
+        |~ case1 "contents-x-id" (triple int H.t metadata_t) (fun (n, h, m) ->
+               Contents (Indirect n, Direct h, m))
+        |~ case1 "node-id" (pair int H.t) (fun (n, h) ->
+               Node (Indirect n, Direct h))
+        |~ case1 "contents-di" (pair step_t int64) (fun (n, i) ->
+               Contents (Direct n, Indirect i, T.default))
+        |~ case1 "contents-x-di" (triple step_t int64 metadata_t)
+             (fun (n, i, m) -> Contents (Direct n, Indirect i, m))
+        |~ case1 "node-di" (pair step_t int64) (fun (n, i) ->
+               Node (Direct n, Indirect i))
+        |~ case1 "contents-dd" (pair step_t H.t) (fun (n, i) ->
+               Contents (Direct n, Direct i, T.default))
+        |~ case1 "contents-x-dd" (triple step_t H.t metadata_t)
+             (fun (n, i, m) -> Contents (Direct n, Direct i, m))
+        |~ case1 "node-dd" (pair step_t H.t) (fun (n, i) ->
+               Node (Direct n, Direct i))
+        |> sealv
+
+      type v = Values of value list | Inodes of inodes
+
+      let v_t : v Irmin.Type.t =
+        let open Irmin.Type in
+        variant "Compress.v" (fun values inodes ->
+          function Values x -> values x | Inodes x -> inodes x)
+        |~ case1 "Values" (list value) (fun x -> Values x)
+        |~ case1 "Inodes" inodes (fun x -> Inodes x)
+        |> sealv
+
+      type t = { hash : H.t; stable : bool; v : v }
+
+      let node ~hash v = { hash; stable = true; v }
+
+      let inode ~hash v = { hash; stable = false; v }
+
+      let magic_node = 'N'
+
+      let magic_inode = 'I'
+
+      let stable : bool Irmin.Type.t =
+        Irmin.Type.(map char)
+          (fun n -> n = magic_node)
+          (function true -> magic_node | false -> magic_inode)
+
+      let t =
+        let open Irmin.Type in
+        record "Compress.t" (fun hash stable v -> { hash; stable; v })
+        |+ field "hash" H.t (fun t -> t.hash)
+        |+ field "stable" stable (fun t -> t.stable)
+        |+ field "v" v_t (fun t -> t.v)
+        |> sealr
+    end
+
+    module Val = struct
+      open T
+
+      type inode = { i_hash : hash Lazy.t; mutable tree : t option }
+
+      and entry = Empty | Inode of inode
+
+      and inodes = { seed : int; length : int; entries : entry array }
+
+      and v = Values of value StepMap.t | Inodes of inodes
+
+      and t = { hash : hash Lazy.t; stable : bool; v : v }
+
+      let hash_of_inode (i : inode) = Lazy.force i.i_hash
+
+      let inode_t t : inode Irmin.Type.t =
+        let same_hash x y =
+          Irmin.Type.equal hash_t (hash_of_inode x) (hash_of_inode y)
+        in
+        let open Irmin.Type in
+        record "Node.inode" (fun hash tree -> { i_hash = lazy hash; tree })
+        |+ field "hash" hash_t (fun t -> Lazy.force t.i_hash)
+        |+ field "tree" (option t) (fun t -> t.tree)
+        |> sealr |> like ~equal:same_hash
+
+      let entry_t inode : entry Irmin.Type.t =
+        let open Irmin.Type in
+        variant "Node.entry" (fun empty inode ->
+          function Empty -> empty | Inode i -> inode i)
+        |~ case0 "Empty" Empty
+        |~ case1 "Inode" inode (fun i -> Inode i)
+        |> sealv
+
+      let inodes entry : inodes Irmin.Type.t =
+        let open Irmin.Type in
+        record "Node.entries" (fun seed length entries ->
+            { seed; length; entries })
+        |+ field "seed" int (fun t -> t.seed)
+        |+ field "length" int (fun t -> t.length)
+        |+ field "entries" (array entry) (fun t -> t.entries)
+        |> sealr
+
+      let length t =
+        match t.v with
+        | Values vs -> StepMap.cardinal vs
+        | Inodes vs -> vs.length
+
+      let get_tree ~find t =
+        match t.tree with
+        | Some t -> t
+        | None -> (
+            let h = hash_of_inode t in
+            match find h with
+            | None -> Fmt.failwith "%a: unknown key" pp_hash h
+            | Some x ->
+                t.tree <- Some x;
+                x )
+
+      let rec list_entry ~find acc = function
+        | Empty -> acc
+        | Inode i -> list_values ~find acc (get_tree ~find i)
+
+      and list_inodes ~find acc t =
+        Array.fold_left (list_entry ~find) acc t.entries
+
+      and list_values ~find acc t =
+        match t.v with
+        | Values vs -> StepMap.bindings vs @ acc
+        | Inodes t -> list_inodes ~find acc t
+
+      let compare_step a b = Irmin.Type.compare step_t a b
+
+      let compare_entry x y = compare_step (fst x) (fst y)
+
+      let list ~find t =
+        let entries = list_values ~find [] t in
+        List.fast_sort compare_entry entries
+
+      let to_bin_v = function
+        | Values vs ->
+            let vs = StepMap.bindings vs in
+            Bin.Values vs
+        | Inodes t ->
+            let _, entries =
+              Array.fold_left
+                (fun (i, acc) -> function Empty -> (i + 1, acc)
+                  | Inode inode ->
+                      let hash = hash_of_inode inode in
+                      (i + 1, { Bin.index = i; hash } :: acc))
+                (0, []) t.entries
+            in
+            let entries = List.rev entries in
+            Bin.Inodes { seed = t.seed; length = t.length; entries }
+
+      let to_bin t =
+        let v = to_bin_v t.v in
+        if t.stable then Bin.node ~hash:t.hash v else Bin.inode ~hash:t.hash v
+
+      let hash t = Lazy.force t.hash
+
+      let stabilize ~find t =
+        if t.stable then t
+        else
+          let n = length t in
+          if n > Conf.stable_hash then t
+          else
+            let hash =
+              lazy
+                (let vs = list ~find t in
+                 Node.hash (Node.v vs))
+            in
+            { hash; stable = true; v = t.v }
+
+      let index ~seed k =
+        abs (Irmin.Type.short_hash step_t ~seed k) mod Conf.entries
+
+      let inode ?tree i_hash = Inode { tree; i_hash }
+
+      let of_bin t =
+        let v =
+          match t.Bin.v with
+          | Bin.Values vs ->
+              let vs = StepMap.of_list vs in
+              Values vs
+          | Inodes t ->
+              let entries = Array.make Conf.entries Empty in
+              List.iter
+                (fun { Bin.index; hash } ->
+                  entries.(index) <- inode (lazy hash))
+                t.entries;
+              Inodes { seed = t.Bin.seed; length = t.length; entries }
+        in
+        { hash = t.Bin.hash; stable = t.Bin.stable; v }
+
+      let v_t t : v Irmin.Type.t =
+        let open Irmin.Type in
+        let pre_hash x = pre_hash Bin.v_t (to_bin_v x) in
+        let entry = entry_t (inode_t t) in
+        variant "Inode.t" (fun values inodes ->
+          function Values v -> values v | Inodes i -> inodes i)
+        |~ case1 "Values" (StepMap.t value_t) (fun t -> Values t)
+        |~ case1 "Inodes" (inodes entry) (fun t -> Inodes t)
+        |> sealv |> like ~pre_hash
+
+      let t : t Irmin.Type.t =
+        let open Irmin.Type in
+        mu @@ fun t ->
+        let v = v_t t in
+        let t =
+          record "hash" (fun hash stable v -> { hash = lazy hash; stable; v })
+          |+ field "hash" H.t (fun t -> Lazy.force t.hash)
+          |+ field "stable" bool (fun t -> t.stable)
+          |+ field "v" v (fun t -> t.v)
+          |> sealr
+        in
+        let pre_hash x = Irmin.Type.pre_hash v x.v in
+        like ~pre_hash t
+
+      let empty =
+        let hash = lazy (Node.hash Node.empty) in
+        { stable = true; hash; v = Values StepMap.empty }
+
+      let values vs =
+        let length = StepMap.cardinal vs in
+        if length = 0 then empty
+        else
+          let v = Values vs in
+          let hash = lazy (Bin.V.hash (to_bin_v v)) in
+          { hash; stable = false; v }
+
+      let inodes is =
+        let v = Inodes is in
+        let hash = lazy (Bin.V.hash (to_bin_v v)) in
+        { hash; stable = false; v }
+
+      let of_values l = values (StepMap.of_list l)
+
+      let is_empty t =
+        match t.v with Values vs -> StepMap.is_empty vs | Inodes _ -> false
+
+      let find_value ~seed ~find t s =
+        let rec aux ~seed = function
+          | Values vs -> (
+              try Some (StepMap.find s vs) with Not_found -> None )
+          | Inodes t -> (
+              let i = index ~seed s in
+              let x = t.entries.(i) in
+              match x with
+              | Empty -> None
+              | Inode i -> aux ~seed:(seed + 1) (get_tree ~find i).v )
+        in
+        aux ~seed t.v
+
+      let find ~find t s = find_value ~seed:0 ~find t s
+
+      let rec add ~seed ~find ~copy t s v k =
+        match find_value ~seed ~find t s with
+        | Some v' when Irmin.Type.equal value_t v v' -> k t
+        | v' -> (
+            match t.v with
+            | Values vs ->
+                let length =
+                  match v' with
+                  | None -> StepMap.cardinal vs + 1
+                  | Some _ -> StepMap.cardinal vs
+                in
+                let t =
+                  if length <= Conf.entries then values (StepMap.add s v vs)
+                  else
+                    let vs = StepMap.bindings (StepMap.add s v vs) in
+                    let empty =
+                      inodes
+                        {
+                          length = 0;
+                          seed;
+                          entries = Array.make Conf.entries Empty;
+                        }
+                    in
+                    let aux t (s, v) =
+                      (add [@tailcall]) ~seed ~find ~copy:false t s v (fun x ->
+                          x)
+                    in
+                    List.fold_left aux empty vs
+                in
+                k t
+            | Inodes t -> (
+                let length =
+                  match v' with None -> t.length + 1 | Some _ -> t.length
+                in
+                let entries =
+                  if copy then Array.copy t.entries else t.entries
+                in
+                let i = index ~seed s in
+                match entries.(i) with
+                | Empty ->
+                    let tree = values (StepMap.singleton s v) in
+                    entries.(i) <- inode ~tree tree.hash;
+                    let t = inodes { seed; length; entries } in
+                    k t
+                | Inode n ->
+                    let t = get_tree ~find n in
+                    add ~seed:(seed + 1) ~find ~copy t s v @@ fun tree ->
+                    let inode = inode ~tree tree.hash in
+                    entries.(i) <- inode;
+                    let t = inodes { seed; length; entries } in
+                    k t ) )
+
+      let add ~find ~copy t s v =
+        add ~seed:0 ~find ~copy t s v (stabilize ~find)
+
+      let rec remove ~seed ~find t s k =
+        match find_value ~seed ~find t s with
+        | None -> k t
+        | Some _ -> (
+            match t.v with
+            | Values vs ->
+                let t = values (StepMap.remove s vs) in
+                k t
+            | Inodes t -> (
+                let length = t.length - 1 in
+                if length <= Conf.entries then
+                  let vs = list_inodes ~find [] t in
+                  let vs = StepMap.of_list vs in
+                  let vs = StepMap.remove s vs in
+                  let t = values vs in
+                  k t
+                else
+                  let entries = Array.copy t.entries in
+                  let i = index ~seed s in
+                  match entries.(i) with
+                  | Empty -> assert false
+                  | Inode t ->
+                      let t = get_tree ~find t in
+                      remove ~seed:(seed + 1) ~find t s @@ fun tree ->
+                      entries.(i) <- inode ~tree (lazy (hash tree));
+                      let t = inodes { seed; length; entries } in
+                      k t ) )
+
+      let remove ~find t s = remove ~find ~seed:0 t s (stabilize ~find)
+
+      let v l : t =
+        let len = List.length l in
+        let find _ = assert false in
+        let t =
+          if len <= Conf.entries then of_values l
+          else
+            let aux acc (s, v) = add ~find ~copy:false acc s v in
+            List.fold_left aux empty l
+        in
+        stabilize ~find t
+
+      let add ~find t s v = add ~find ~copy:true t s v
+
+      let save ~add ~mem t =
+        let rec aux ~seed t =
+          Log.debug (fun l -> l "save seed:%d" seed);
+          match t.v with
+          | Values _ -> add (Lazy.force t.hash) (to_bin t)
+          | Inodes n ->
+              Array.iter
+                (function
+                  | Empty | Inode { tree = None; _ } -> ()
+                  | Inode ({ tree = Some t; _ } as i) ->
+                      let hash = hash_of_inode i in
+                      if mem hash then () else aux ~seed:(seed + 1) t)
+                n.entries;
+              add (Lazy.force t.hash) (to_bin t)
+        in
+        aux ~seed:0 t
+    end
+
+    include Pack.Make (struct
+      type t = Bin.t
+
+      let t = Bin.t
+
+      let magic (t : t) =
+        if t.stable then Compress.magic_node else Compress.magic_inode
+
+      let hash t = Bin.hash t
+
+      let encode_bin ~dict ~offset (t : t) k =
+        let step s : Compress.name =
+          let str = Irmin.Type.to_bin_string T.step_t s in
+          if String.length str <= 3 then Direct s
+          else match dict str with Some i -> Indirect i | None -> Direct s
+        in
+        let hash h : Compress.address =
+          match offset h with
+          | None -> Compress.Direct h
+          | Some off -> Compress.Indirect off
+        in
+        let inode : Bin.inode -> Compress.inode =
+         fun n ->
+          let hash = hash n.hash in
+          { index = n.index; hash }
+        in
+        let value : T.step * T.value -> Compress.value = function
+          | s, `Contents (c, m) ->
+              let s = step s in
+              let v = hash c in
+              Compress.Contents (s, v, m)
+          | s, `Node n ->
+              let s = step s in
+              let v = hash n in
+              Compress.Node (s, v)
+        in
+        (* List.map is fine here as the number of entries is small *)
+        let v : Bin.v -> Compress.v = function
+          | Values vs -> Values (List.map value vs)
+          | Inodes { seed; length; entries } ->
+              let entries = List.map inode entries in
+              Inodes { Compress.seed; length; entries }
+        in
+        let t =
+          if t.stable then Compress.node ~hash:k (v t.v)
+          else Compress.inode ~hash:k (v t.v)
+        in
+        Irmin.Type.encode_bin Compress.t t
+
+      exception Exit of [ `Msg of string ]
+
+      let decode_bin ~dict ~hash t off : t =
+        let _, i = Irmin.Type.decode_bin ~headers:false Compress.t t off in
+        let step : Compress.name -> T.step = function
+          | Direct n -> n
+          | Indirect s -> (
+              match dict s with
+              | None -> raise_notrace (Exit (`Msg "dict"))
+              | Some s -> (
+                  match Irmin.Type.of_bin_string T.step_t s with
+                  | Error e -> raise_notrace (Exit e)
+                  | Ok v -> v ) )
+        in
+        let hash : Compress.address -> H.t = function
+          | Indirect off -> hash off
+          | Direct n -> n
+        in
+        let inode : Compress.inode -> Bin.inode =
+         fun n ->
+          let hash = hash n.hash in
+          { index = n.index; hash }
+        in
+        let value : Compress.value -> T.step * T.value = function
+          | Contents (n, h, metadata) ->
+              let name = step n in
+              let node = hash h in
+              (name, `Contents (node, metadata))
+          | Node (n, h) ->
+              let name = step n in
+              let node = hash h in
+              (name, `Node node)
+        in
+        let t : Compress.v -> Bin.v = function
+          | Values vs -> Values (List.map value vs)
+          | Inodes { seed; length; entries } ->
+              let entries = List.map inode entries in
+              Inodes { seed; length; entries }
+        in
+        if i.stable then Bin.node ~hash:(lazy i.hash) (t i.v)
+        else Bin.inode ~hash:(lazy i.hash) (t i.v)
+    end)
+  end
+
+  module Val = struct
+    include T
+    module I = Inode.Val
+
+    type t = { mutable find : H.t -> I.t option; v : I.t }
+
+    let niet _ = assert false
+
+    let v l = { find = niet; v = I.v l }
+
+    let list t = I.list ~find:t.find t.v
+
+    let empty = { find = niet; v = Inode.Val.empty }
+
+    let is_empty t = I.is_empty t.v
+
+    let find t s = I.find ~find:t.find t.v s
+
+    let add t s v =
+      let v = I.add ~find:t.find t.v s v in
+      if v == t.v then t else { find = t.find; v }
+
+    let remove t s =
+      let v = I.remove ~find:t.find t.v s in
+      if v == t.v then t else { find = t.find; v }
+
+    let t : t Irmin.Type.t =
+      let pre_hash x =
+        if not x.v.stable then Irmin.Type.pre_hash I.t x.v
+        else
+          let vs = list x in
+          Irmin.Type.pre_hash Node.t (Node.v vs)
+      in
+      Irmin.Type.map I.t ~pre_hash (fun v -> { find = niet; v }) (fun t -> t.v)
+  end
+
+  module Key = H
+
+  type 'a t = 'a Inode.t
+
+  type key = Key.t
+
+  type value = Val.t
+
+  let mem t k = Inode.mem t k
+
+  let unsafe_find t k =
+    match Inode.unsafe_find t k with
+    | None -> None
+    | Some v ->
+        let v = Inode.Val.of_bin v in
+        Some v
+
+  let find t k =
+    Inode.find t k >|= function
+    | None -> None
+    | Some v ->
+        let v = Inode.Val.of_bin v in
+        let find = unsafe_find t in
+        Some { Val.find; v }
+
+  let save t v =
+    let add k v = Inode.unsafe_append t k v in
+    Inode.Val.save ~add ~mem:(Inode.unsafe_mem t) v
+
+  let hash v = Lazy.force v.Val.v.Inode.Val.hash
+
+  let add t v =
+    save t v.Val.v;
+    Lwt.return (hash v)
+
+  let check_hash expected got =
+    if Irmin.Type.equal H.t expected got then ()
+    else
+      Fmt.invalid_arg "corrupted value: got %a, expecting %a" T.pp_hash
+        expected T.pp_hash got
+
+  let unsafe_add t k v =
+    check_hash k (hash v);
+    save t v.Val.v;
+    Lwt.return_unit
+
+  let batch = Inode.batch
+
+  let v = Inode.v
+
+  let integrity_check = Inode.integrity_check
+
+  let close = Inode.close
+end
diff --git a/vendors/irmin-pack/inode.mli b/vendors/irmin-pack/inode.mli
new file mode 100644
index 0000000000000000000000000000000000000000..2fdb0be88642a4f37535806e0b57edecd102c7e8
--- /dev/null
+++ b/vendors/irmin-pack/inode.mli
@@ -0,0 +1,56 @@
+(*
+ * Copyright (c) 2013-2019 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module type CONFIG = sig
+  val entries : int
+
+  val stable_hash : int
+end
+
+module type S = sig
+  include Irmin.CONTENT_ADDRESSABLE_STORE
+
+  type index
+
+  val v :
+    ?fresh:bool ->
+    ?readonly:bool ->
+    ?lru_size:int ->
+    index:index ->
+    string ->
+    [ `Read ] t Lwt.t
+
+  val batch : [ `Read ] t -> ([ `Read | `Write ] t -> 'a Lwt.t) -> 'a Lwt.t
+
+  module Key : Irmin.Hash.S with type t = key
+
+  module Val : Irmin.Private.Node.S with type t = value and type hash = key
+
+  val integrity_check : offset:int64 -> length:int -> key -> 'a t -> unit
+
+  val close : 'a t -> unit Lwt.t
+end
+
+module Make
+    (Conf : CONFIG)
+    (H : Irmin.Hash.S)
+    (P : Pack.MAKER with type key = H.t and type index = Pack_index.Make(H).t)
+    (Node : Irmin.Private.Node.S with type hash = H.t) :
+  S
+    with type key = H.t
+     and type Val.metadata = Node.metadata
+     and type Val.step = Node.step
+     and type index = Pack_index.Make(H).t
diff --git a/vendors/irmin-pack/irmin-pack.opam b/vendors/irmin-pack/irmin-pack.opam
new file mode 100644
index 0000000000000000000000000000000000000000..d3c35990ff9a73549d2b9ae2f63cf6dd5e40cd4c
--- /dev/null
+++ b/vendors/irmin-pack/irmin-pack.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+maintainer:   "thomas@gazagnaire.org"
+authors:      ["Thomas Gazagnaire"]
+license:      "ISC"
+homepage:     "https://github.com/mirage/irmin"
+bug-reports:  "https://github.com/mirage/irmin/issues"
+dev-repo:     "git+https://github.com/mirage/irmin.git"
+
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+ ["dune" "runtest" "-p" name] {with-test}
+]
+
+depends: [
+  "ocaml"      {>= "4.01.0"}
+  "dune"       {build  & >= "1.1.0"}
+  "index"
+  "irmin"      {>= "1.3.0"}
+  "lwt"
+]
+
+synopsis: "Irmin backend which stores values in a pack file"
diff --git a/vendors/irmin-pack/irmin_pack.ml b/vendors/irmin-pack/irmin_pack.ml
new file mode 100644
index 0000000000000000000000000000000000000000..9de9151861cd4985ea1094a3551b57171376fa20
--- /dev/null
+++ b/vendors/irmin-pack/irmin_pack.ml
@@ -0,0 +1,493 @@
+(*
+ * Copyright (c) 2013-2019 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+let src = Logs.Src.create "irmin.pack" ~doc:"irmin-pack backend"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let current_version = "00000001"
+
+module Default = struct
+  let fresh = false
+
+  let lru_size = 100_000
+
+  let index_log_size = 500_000
+
+  let readonly = false
+end
+
+let fresh_key =
+  Irmin.Private.Conf.key ~doc:"Start with a fresh disk." "fresh"
+    Irmin.Private.Conf.bool Default.fresh
+
+let lru_size_key =
+  Irmin.Private.Conf.key ~doc:"Size of the LRU cache for pack entries."
+    "lru-size" Irmin.Private.Conf.int Default.lru_size
+
+let index_log_size_key =
+  Irmin.Private.Conf.key ~doc:"Size of index logs." "index-log-size"
+    Irmin.Private.Conf.int Default.index_log_size
+
+let readonly_key =
+  Irmin.Private.Conf.key ~doc:"Start with a read-only disk." "readonly"
+    Irmin.Private.Conf.bool Default.readonly
+
+let fresh config = Irmin.Private.Conf.get config fresh_key
+
+let lru_size config = Irmin.Private.Conf.get config lru_size_key
+
+let readonly config = Irmin.Private.Conf.get config readonly_key
+
+let index_log_size config = Irmin.Private.Conf.get config index_log_size_key
+
+let root_key = Irmin.Private.Conf.root
+
+let root config =
+  match Irmin.Private.Conf.get config root_key with
+  | None -> failwith "no root set"
+  | Some r -> r
+
+let config ?(fresh = Default.fresh) ?(readonly = Default.readonly)
+    ?(lru_size = Default.lru_size) ?(index_log_size = Default.index_log_size)
+    root =
+  let config = Irmin.Private.Conf.empty in
+  let config = Irmin.Private.Conf.add config fresh_key fresh in
+  let config = Irmin.Private.Conf.add config root_key (Some root) in
+  let config = Irmin.Private.Conf.add config lru_size_key lru_size in
+  let config =
+    Irmin.Private.Conf.add config index_log_size_key index_log_size
+  in
+  let config = Irmin.Private.Conf.add config readonly_key readonly in
+  config
+
+let ( ++ ) = Int64.add
+
+let with_cache = IO.with_cache
+
+open Lwt.Infix
+module Pack = Pack
+module Dict = Pack_dict
+module Index = Pack_index
+module IO = IO.Unix
+
+exception RO_Not_Allowed = IO.RO_Not_Allowed
+
+module Table (K : Irmin.Type.S) = Hashtbl.Make (struct
+  type t = K.t
+
+  let hash (t : t) = Irmin.Type.short_hash K.t t
+
+  let equal (x : t) (y : t) = Irmin.Type.equal K.t x y
+end)
+
+module Atomic_write (K : Irmin.Type.S) (V : Irmin.Hash.S) = struct
+  module Tbl = Table (K)
+  module W = Irmin.Private.Watch.Make (K) (V)
+
+  type key = K.t
+
+  type value = V.t
+
+  type watch = W.watch
+
+  type t = {
+    index : int64 Tbl.t;
+    cache : V.t Tbl.t;
+    block : IO.t;
+    lock : Lwt_mutex.t;
+    w : W.t;
+    mutable counter : int;
+  }
+
+  let read_length32 ~off block =
+    let buf = Bytes.create 4 in
+    let n = IO.read block ~off buf in
+    assert (n = 4);
+    let n, v = Irmin.Type.(decode_bin int32) (Bytes.unsafe_to_string buf) 0 in
+    assert (n = 4);
+    Int32.to_int v
+
+  let entry = Irmin.Type.(pair (string_of `Int32) V.t)
+
+  let set_entry t ?off k v =
+    let k = Irmin.Type.to_bin_string K.t k in
+    let buf = Irmin.Type.to_bin_string entry (k, v) in
+    match off with
+    | None -> IO.append t.block buf
+    | Some off -> IO.set t.block buf ~off
+
+  let pp_branch = Irmin.Type.pp K.t
+
+  let unsafe_find t k =
+    Log.debug (fun l -> l "[branches] find %a" pp_branch k);
+    try Lwt.return_some (Tbl.find t.cache k)
+    with Not_found -> Lwt.return_none
+
+  let find t k = Lwt_mutex.with_lock t.lock (fun () -> unsafe_find t k)
+
+  let unsafe_mem t k =
+    Log.debug (fun l -> l "[branches] mem %a" pp_branch k);
+    try Lwt.return (Tbl.mem t.cache k) with Not_found -> Lwt.return_false
+
+  let mem t v = Lwt_mutex.with_lock t.lock (fun () -> unsafe_mem t v)
+
+  let zero =
+    match Irmin.Type.of_bin_string V.t (String.make V.hash_size '\000') with
+    | Ok x -> x
+    | Error _ -> assert false
+
+  let unsafe_remove t k =
+    Tbl.remove t.cache k;
+    try
+      let off = Tbl.find t.index k in
+      set_entry t ~off k zero
+    with Not_found -> ()
+
+  let remove t k =
+    Log.debug (fun l -> l "[branches] remove %a" pp_branch k);
+    Lwt_mutex.with_lock t.lock (fun () ->
+        unsafe_remove t k;
+        Lwt.return_unit)
+    >>= fun () -> W.notify t.w k None
+
+  let unsafe_clear t =
+    Lwt.async (fun () -> W.clear t.w);
+    IO.clear t.block;
+    Tbl.clear t.cache;
+    Tbl.clear t.index
+
+  let create = Lwt_mutex.create ()
+
+  let watches = W.v ()
+
+  let valid t =
+    if t.counter <> 0 then (
+      t.counter <- t.counter + 1;
+      true )
+    else false
+
+  let unsafe_v ~fresh ~readonly file =
+    let block = IO.v ~fresh ~version:current_version ~readonly file in
+    let cache = Tbl.create 997 in
+    let index = Tbl.create 997 in
+    let len = IO.offset block in
+    let rec aux offset k =
+      if offset >= len then k ()
+      else
+        let len = read_length32 ~off:offset block in
+        let buf = Bytes.create (len + V.hash_size) in
+        let off = offset ++ 4L in
+        let n = IO.read block ~off buf in
+        assert (n = Bytes.length buf);
+        let buf = Bytes.unsafe_to_string buf in
+        let h =
+          let h = String.sub buf 0 len in
+          match Irmin.Type.of_bin_string K.t h with
+          | Ok k -> k
+          | Error (`Msg e) -> failwith e
+        in
+        let n, v = Irmin.Type.decode_bin V.t buf len in
+        assert (n = String.length buf);
+        if not (Irmin.Type.equal V.t v zero) then Tbl.add cache h v;
+        Tbl.add index h offset;
+        (aux [@tailcall]) (off ++ Int64.(of_int @@ (len + V.hash_size))) k
+    in
+    (aux [@tailcall]) 0L @@ fun () ->
+    {
+      cache;
+      index;
+      block;
+      w = watches;
+      lock = Lwt_mutex.create ();
+      counter = 1;
+    }
+
+  let (`Staged unsafe_v) =
+    with_cache ~clear:unsafe_clear ~valid
+      ~v:(fun () -> unsafe_v)
+      "store.branches"
+
+  let v ?fresh ?readonly file =
+    Lwt_mutex.with_lock create (fun () ->
+        let v = unsafe_v () ?fresh ?readonly file in
+        Lwt.return v)
+
+  let unsafe_set t k v =
+    try
+      let off = Tbl.find t.index k in
+      Tbl.replace t.cache k v;
+      set_entry t ~off k v
+    with Not_found ->
+      let offset = IO.offset t.block in
+      set_entry t k v;
+      Tbl.add t.cache k v;
+      Tbl.add t.index k offset
+
+  let set t k v =
+    Log.debug (fun l -> l "[branches] set %a" pp_branch k);
+    Lwt_mutex.with_lock t.lock (fun () ->
+        unsafe_set t k v;
+        Lwt.return_unit)
+    >>= fun () -> W.notify t.w k (Some v)
+
+  let unsafe_test_and_set t k ~test ~set =
+    let v = try Some (Tbl.find t.cache k) with Not_found -> None in
+    if not (Irmin.Type.(equal (option V.t)) v test) then Lwt.return_false
+    else
+      let return () = Lwt.return_true in
+      match set with
+      | None -> unsafe_remove t k |> return
+      | Some v -> unsafe_set t k v |> return
+
+  let test_and_set t k ~test ~set =
+    Log.debug (fun l -> l "[branches] test-and-set %a" pp_branch k);
+    Lwt_mutex.with_lock t.lock (fun () -> unsafe_test_and_set t k ~test ~set)
+    >>= function
+    | true -> W.notify t.w k set >|= fun () -> true
+    | false -> Lwt.return_false
+
+  let list t =
+    Log.debug (fun l -> l "[branches] list");
+    let keys = Tbl.fold (fun k _ acc -> k :: acc) t.cache [] in
+    Lwt.return keys
+
+  let watch_key t = W.watch_key t.w
+
+  let watch t = W.watch t.w
+
+  let unwatch t = W.unwatch t.w
+
+  let unsafe_close t =
+    t.counter <- t.counter - 1;
+    if t.counter = 0 then (
+      Tbl.reset t.index;
+      Tbl.reset t.cache;
+      if not (IO.readonly t.block) then IO.sync t.block;
+      IO.close t.block;
+      W.clear t.w )
+    else Lwt.return_unit
+
+  let close t = Lwt_mutex.with_lock t.lock (fun () -> unsafe_close t)
+end
+
+module type CONFIG = Inode.CONFIG
+
+module Make_ext
+    (Config : CONFIG)
+    (M : Irmin.Metadata.S)
+    (C : Irmin.Contents.S)
+    (P : Irmin.Path.S)
+    (B : Irmin.Branch.S)
+    (H : Irmin.Hash.S)
+    (Node : Irmin.Private.Node.S
+              with type metadata = M.t
+               and type hash = H.t
+               and type step = P.step)
+    (Commit : Irmin.Private.Commit.S with type hash = H.t) =
+struct
+  module Index = Pack_index.Make (H)
+  module Pack = Pack.File (Index) (H)
+
+  module X = struct
+    module Hash = H
+
+    type 'a value = { magic : char; hash : H.t; v : 'a }
+
+    let value a =
+      let open Irmin.Type in
+      record "value" (fun hash magic v -> { magic; hash; v })
+      |+ field "hash" H.t (fun v -> v.hash)
+      |+ field "magic" char (fun v -> v.magic)
+      |+ field "v" a (fun v -> v.v)
+      |> sealr
+
+    module Contents = struct
+      module CA = struct
+        module Key = H
+        module Val = C
+
+        include Pack.Make (struct
+          include Val
+          module H = Irmin.Hash.Typed (H) (Val)
+
+          let hash = H.hash
+
+          let magic = 'B'
+
+          let value = value Val.t
+
+          let encode_bin ~dict:_ ~offset:_ v hash =
+            Irmin.Type.encode_bin value { magic; hash; v }
+
+          let decode_bin ~dict:_ ~hash:_ s off =
+            let _, t = Irmin.Type.decode_bin ~headers:false value s off in
+            t.v
+
+          let magic _ = magic
+        end)
+      end
+
+      include Irmin.Contents.Store (CA)
+    end
+
+    module Node = struct
+      module CA = Inode.Make (Config) (H) (Pack) (Node)
+      include Irmin.Private.Node.Store (Contents) (P) (M) (CA)
+    end
+
+    module Commit = struct
+      module CA = struct
+        module Key = H
+        module Val = Commit
+
+        include Pack.Make (struct
+          include Val
+          module H = Irmin.Hash.Typed (H) (Val)
+
+          let hash = H.hash
+
+          let value = value Val.t
+
+          let magic = 'C'
+
+          let encode_bin ~dict:_ ~offset:_ v hash =
+            Irmin.Type.encode_bin value { magic; hash; v }
+
+          let decode_bin ~dict:_ ~hash:_ s off =
+            let _, v = Irmin.Type.decode_bin ~headers:false value s off in
+            v.v
+
+          let magic _ = magic
+        end)
+      end
+
+      include Irmin.Private.Commit.Store (Node) (CA)
+    end
+
+    module Branch = struct
+      module Key = B
+      module Val = H
+      include Atomic_write (Key) (Val)
+    end
+
+    module Slice = Irmin.Private.Slice.Make (Contents) (Node) (Commit)
+    module Sync = Irmin.Private.Sync.None (H) (B)
+
+    module Repo = struct
+      type t = {
+        config : Irmin.Private.Conf.t;
+        contents : [ `Read ] Contents.CA.t;
+        node : [ `Read ] Node.CA.t;
+        commit : [ `Read ] Commit.CA.t;
+        branch : Branch.t;
+        index : Index.t;
+      }
+
+      let contents_t t : 'a Contents.t = t.contents
+
+      let node_t t : 'a Node.t = (contents_t t, t.node)
+
+      let commit_t t : 'a Commit.t = (node_t t, t.commit)
+
+      let branch_t t = t.branch
+
+      let batch t f =
+        Commit.CA.batch t.commit (fun commit ->
+            Node.CA.batch t.node (fun node ->
+                Contents.CA.batch t.contents (fun contents ->
+                    let contents : 'a Contents.t = contents in
+                    let node : 'a Node.t = (contents, node) in
+                    let commit : 'a Commit.t = (node, commit) in
+                    f contents node commit)))
+
+      let v config =
+        let root = root config in
+        let fresh = fresh config in
+        let lru_size = lru_size config in
+        let readonly = readonly config in
+        let log_size = index_log_size config in
+        let index = Index.v ~fresh ~readonly ~log_size root in
+        Contents.CA.v ~fresh ~readonly ~lru_size ~index root
+        >>= fun contents ->
+        Node.CA.v ~fresh ~readonly ~lru_size ~index root >>= fun node ->
+        Commit.CA.v ~fresh ~readonly ~lru_size ~index root >>= fun commit ->
+        Branch.v ~fresh ~readonly root >|= fun branch ->
+        { contents; node; commit; branch; config; index }
+
+      let close t =
+        Index.close t.index;
+        Contents.CA.close (contents_t t) >>= fun () ->
+        Node.CA.close (snd (node_t t)) >>= fun () ->
+        Commit.CA.close (snd (commit_t t)) >>= fun () -> Branch.close t.branch
+    end
+  end
+
+  let integrity_check ppf (t : X.Repo.t) =
+    Fmt.pf ppf "running the integrity check\n%!";
+    let commits = ref 0 in
+    let contents = ref 0 in
+    let nodes = ref 0 in
+    let pp_stats ppf () =
+      Fmt.pf ppf "%4dk blobs / %4dk trees / %4dk commits" (!contents / 1000)
+        (!nodes / 1000) (!commits / 1000)
+    in
+    let pr_stats () = Fmt.epr "\r%a%!" pp_stats () in
+    let count_increment count =
+      incr count;
+      if !count mod 100 = 0 then pr_stats ()
+    in
+    Index.iter
+      (fun k (offset, length, m) ->
+        match m with
+        | 'B' ->
+            let capability = X.Repo.contents_t t in
+            X.Contents.CA.integrity_check ~offset ~length k capability;
+            count_increment contents
+        | 'N' | 'I' ->
+            let _, capability = X.Repo.node_t t in
+            X.Node.CA.integrity_check ~offset ~length k capability;
+            count_increment nodes
+        | 'C' ->
+            let _, capability = X.Repo.commit_t t in
+            X.Commit.CA.integrity_check ~offset ~length k capability;
+            count_increment commits
+        | _ -> invalid_arg "unknown content type")
+      t.index;
+    pr_stats ()
+
+  include Irmin.Of_private (X)
+end
+
+module Hash = Irmin.Hash.BLAKE2B
+module Path = Irmin.Path.String_list
+module Metadata = Irmin.Metadata.None
+
+module Make
+    (Config : CONFIG)
+    (M : Irmin.Metadata.S)
+    (C : Irmin.Contents.S)
+    (P : Irmin.Path.S)
+    (B : Irmin.Branch.S)
+    (H : Irmin.Hash.S) =
+struct
+  module XNode = Irmin.Private.Node.Make (H) (P) (M)
+  module XCommit = Irmin.Private.Commit.Make (H)
+  include Make_ext (Config) (M) (C) (P) (B) (H) (XNode) (XCommit)
+end
+
+module KV (Config : CONFIG) (C : Irmin.Contents.S) =
+  Make (Config) (Metadata) (C) (Path) (Irmin.Branch.String) (Hash)
diff --git a/vendors/irmin-pack/irmin_pack.mli b/vendors/irmin-pack/irmin_pack.mli
new file mode 100644
index 0000000000000000000000000000000000000000..a77fbcf877ecd3a14f84ad4e7f04b2ad7994ee51
--- /dev/null
+++ b/vendors/irmin-pack/irmin_pack.mli
@@ -0,0 +1,89 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+val config :
+  ?fresh:bool ->
+  ?readonly:bool ->
+  ?lru_size:int ->
+  ?index_log_size:int ->
+  string ->
+  Irmin.config
+
+module Pack = Pack
+module Dict = Pack_dict
+module Index = Pack_index
+
+exception RO_Not_Allowed
+
+module type CONFIG = sig
+  val entries : int
+
+  val stable_hash : int
+end
+
+module Make_ext
+    (Config : CONFIG)
+    (Metadata : Irmin.Metadata.S)
+    (Contents : Irmin.Contents.S)
+    (Path : Irmin.Path.S)
+    (Branch : Irmin.Branch.S)
+    (Hash : Irmin.Hash.S)
+    (N : Irmin.Private.Node.S
+           with type metadata = Metadata.t
+            and type hash = Hash.t
+            and type step = Path.step)
+    (CT : Irmin.Private.Commit.S with type hash = Hash.t) : sig
+  include
+    Irmin.S
+      with type key = Path.t
+       and type contents = Contents.t
+       and type branch = Branch.t
+       and type hash = Hash.t
+       and type step = Path.step
+       and type metadata = Metadata.t
+       and type Key.step = Path.step
+
+  val integrity_check : Format.formatter -> repo -> unit
+end
+
+module Make
+    (Config : CONFIG)
+    (M : Irmin.Metadata.S)
+    (C : Irmin.Contents.S)
+    (P : Irmin.Path.S)
+    (B : Irmin.Branch.S)
+    (H : Irmin.Hash.S) : sig
+  include
+    Irmin.S
+      with type key = P.t
+       and type step = P.step
+       and type metadata = M.t
+       and type contents = C.t
+       and type branch = B.t
+       and type hash = H.t
+
+  val integrity_check : Format.formatter -> repo -> unit
+end
+
+module KV (Config : CONFIG) : Irmin.KV_MAKER
+
+module Atomic_write (K : Irmin.Type.S) (V : Irmin.Hash.S) : sig
+  include Irmin.ATOMIC_WRITE_STORE with type key = K.t and type value = V.t
+
+  val v : ?fresh:bool -> ?readonly:bool -> string -> t Lwt.t
+
+  val close : t -> unit Lwt.t
+end
diff --git a/vendors/irmin-pack/lru.ml b/vendors/irmin-pack/lru.ml
new file mode 100644
index 0000000000000000000000000000000000000000..c13199dfcee2103fc6e49ad157bcd6908aaa279d
--- /dev/null
+++ b/vendors/irmin-pack/lru.ml
@@ -0,0 +1,120 @@
+(* Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(* Extracted from https://github.com/pqwy/lru
+   Copyright (c) 2016 David Kaloper Meršinjak *)
+
+module Make (H : Hashtbl.HashedType) = struct
+  module HT = Hashtbl.Make (H)
+
+  module Q = struct
+    type 'a node = {
+      value : 'a;
+      mutable next : 'a node option;
+      mutable prev : 'a node option;
+    }
+
+    type 'a t = {
+      mutable first : 'a node option;
+      mutable last : 'a node option;
+    }
+
+    let detach t n =
+      let np = n.prev and nn = n.next in
+      ( match np with
+      | None -> t.first <- nn
+      | Some x ->
+          x.next <- nn;
+          n.prev <- None );
+      match nn with
+      | None -> t.last <- np
+      | Some x ->
+          x.prev <- np;
+          n.next <- None
+
+    let append t n =
+      let on = Some n in
+      match t.last with
+      | Some x as l ->
+          x.next <- on;
+          t.last <- on;
+          n.prev <- l
+      | None ->
+          t.first <- on;
+          t.last <- on
+
+    let node x = { value = x; prev = None; next = None }
+
+    let create () = { first = None; last = None }
+  end
+
+  type key = HT.key
+
+  type 'a t = {
+    ht : (key * 'a) Q.node HT.t;
+    q : (key * 'a) Q.t;
+    mutable cap : int;
+    mutable w : int;
+  }
+
+  let weight t = t.w
+
+  let create cap = { cap; w = 0; ht = HT.create cap; q = Q.create () }
+
+  let drop_lru t =
+    match t.q.first with
+    | None -> ()
+    | Some ({ Q.value = k, _; _ } as n) ->
+        t.w <- t.w - 1;
+        HT.remove t.ht k;
+        Q.detach t.q n
+
+  let remove t k =
+    try
+      let n = HT.find t.ht k in
+      t.w <- t.w - 1;
+      HT.remove t.ht k;
+      Q.detach t.q n
+    with Not_found -> ()
+
+  let add t k v =
+    if t.w = 0 then ()
+    else (
+      remove t k;
+      let n = Q.node (k, v) in
+      t.w <- t.w + 1;
+      if weight t > t.cap then drop_lru t;
+      HT.add t.ht k n;
+      Q.append t.q n )
+
+  let promote t k =
+    try
+      let n = HT.find t.ht k in
+      Q.(
+        detach t.q n;
+        append t.q n)
+    with Not_found -> ()
+
+  let find t k =
+    let v = HT.find t.ht k in
+    promote t k;
+    snd v.value
+
+  let mem t k =
+    match HT.mem t.ht k with
+    | false -> false
+    | true ->
+        promote t k;
+        true
+
+  let clear t = create t.cap
+end
diff --git a/vendors/irmin-pack/lru.mli b/vendors/irmin-pack/lru.mli
new file mode 100644
index 0000000000000000000000000000000000000000..a39d80d8d490b4b0e5f18b3b414883686eb7cfa6
--- /dev/null
+++ b/vendors/irmin-pack/lru.mli
@@ -0,0 +1,28 @@
+(* Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(* Extracted from https://github.com/pqwy/lru
+   Copyright (c) 2016 David Kaloper Meršinjak *)
+
+module Make (H : Hashtbl.HashedType) : sig
+  type 'a t
+
+  val create : int -> 'a t
+
+  val add : 'a t -> H.t -> 'a -> unit
+
+  val find : 'a t -> H.t -> 'a
+
+  val mem : 'a t -> H.t -> bool
+
+  val clear : 'a t -> 'a t
+end
diff --git a/vendors/irmin-pack/pack.ml b/vendors/irmin-pack/pack.ml
new file mode 100644
index 0000000000000000000000000000000000000000..f567fe6d37af12aa5ee44c40ddb1c55b2cab2381
--- /dev/null
+++ b/vendors/irmin-pack/pack.ml
@@ -0,0 +1,385 @@
+(*
+ * Copyright (c) 2013-2019 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+let src = Logs.Src.create "irmin.pack" ~doc:"irmin-pack backend"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let current_version = "00000001"
+
+let ( -- ) = Int64.sub
+
+type all_stats = {
+  mutable pack_finds : int;
+  mutable pack_cache_misses : int;
+  mutable appended_hashes : int;
+  mutable appended_offsets : int;
+}
+
+let fresh_stats () =
+  {
+    pack_finds = 0;
+    pack_cache_misses = 0;
+    appended_hashes = 0;
+    appended_offsets = 0;
+  }
+
+let stats = fresh_stats ()
+
+let reset_stats () =
+  stats.pack_finds <- 0;
+  stats.pack_cache_misses <- 0;
+  stats.appended_hashes <- 0;
+  stats.appended_offsets <- 0;
+  ()
+
+module type ELT = sig
+  include Irmin.Type.S
+
+  type hash
+
+  val hash : t -> hash
+
+  val magic : t -> char
+
+  val encode_bin :
+    dict:(string -> int option) ->
+    offset:(hash -> int64 option) ->
+    t ->
+    hash ->
+    (string -> unit) ->
+    unit
+
+  val decode_bin :
+    dict:(int -> string option) -> hash:(int64 -> hash) -> string -> int -> t
+end
+
+module type S = sig
+  include Irmin.CONTENT_ADDRESSABLE_STORE
+
+  type index
+
+  val v :
+    ?fresh:bool ->
+    ?readonly:bool ->
+    ?lru_size:int ->
+    index:index ->
+    string ->
+    [ `Read ] t Lwt.t
+
+  val batch : [ `Read ] t -> ([ `Read | `Write ] t -> 'a Lwt.t) -> 'a Lwt.t
+
+  val unsafe_append : 'a t -> key -> value -> unit
+
+  val unsafe_mem : 'a t -> key -> bool
+
+  val unsafe_find : 'a t -> key -> value option
+
+  val sync : 'a t -> unit
+
+  val integrity_check : offset:int64 -> length:int -> key -> 'a t -> unit
+
+  val close : 'a t -> unit Lwt.t
+end
+
+module type MAKER = sig
+  type key
+
+  type index
+
+  module Make (V : ELT with type hash := key) :
+    S with type key = key and type value = V.t and type index = index
+end
+
+open Lwt.Infix
+
+module Table (K : Irmin.Type.S) = Hashtbl.Make (struct
+  type t = K.t
+
+  let hash (t : t) = Irmin.Type.short_hash K.t t
+
+  let equal (x : t) (y : t) = Irmin.Type.equal K.t x y
+end)
+
+module Cache (K : Irmin.Type.S) = Lru.Make (struct
+  type t = K.t
+
+  let hash (t : t) = Irmin.Type.short_hash K.t t
+
+  let equal (x : t) (y : t) = Irmin.Type.equal K.t x y
+end)
+
+let with_cache = IO.with_cache
+
+module IO = IO.Unix
+
+module File (Index : Pack_index.S) (K : Irmin.Hash.S with type t = Index.key) =
+struct
+  module Tbl = Table (K)
+  module Dict = Pack_dict
+
+  type index = Index.t
+
+  type 'a t = {
+    block : IO.t;
+    index : Index.t;
+    dict : Dict.t;
+    lock : Lwt_mutex.t;
+    mutable counter : int;
+  }
+
+  let clear t =
+    IO.clear t.block;
+    Index.clear t.index;
+    Dict.clear t.dict
+
+  let valid t =
+    if t.counter <> 0 then (
+      t.counter <- t.counter + 1;
+      true )
+    else false
+
+  let unsafe_v ~index ~fresh ~readonly file =
+    let root = Filename.dirname file in
+    let lock = Lwt_mutex.create () in
+    let dict = Dict.v ~fresh ~readonly root in
+    let block = IO.v ~fresh ~version:current_version ~readonly file in
+    if IO.version block <> current_version then
+      Fmt.failwith "invalid version: got %S, expecting %S" (IO.version block)
+        current_version;
+    { block; index; lock; dict; counter = 1 }
+
+  let (`Staged v) =
+    with_cache ~clear ~valid ~v:(fun index -> unsafe_v ~index) "store.pack"
+
+  type key = K.t
+
+  let close t =
+    t.counter <- t.counter - 1;
+    if t.counter = 0 then (
+      if not (IO.readonly t.block) then IO.sync t.block;
+      IO.close t.block;
+      Dict.close t.dict )
+
+  module Make (V : ELT with type hash := K.t) = struct
+    module Tbl = Table (K)
+    module Lru = Cache (K)
+
+    type nonrec 'a t = {
+      pack : 'a t;
+      lru : V.t Lru.t;
+      staging : V.t Tbl.t;
+      mutable counter : int;
+    }
+
+    type key = K.t
+
+    type value = V.t
+
+    type index = Index.t
+
+    let clear t =
+      clear t.pack;
+      Tbl.clear t.staging
+
+    (* we need another cache here, as we want to share the LRU and
+       staging caches too. *)
+
+    let roots = Hashtbl.create 10
+
+    let create = Lwt_mutex.create ()
+
+    let valid t =
+      if t.counter <> 0 then (
+        t.counter <- t.counter + 1;
+        true )
+      else false
+
+    let unsafe_v_no_cache ~fresh ~readonly ~lru_size ~index root =
+      let pack = v index ~fresh ~readonly root in
+      let staging = Tbl.create 127 in
+      let lru = Lru.create lru_size in
+      { staging; lru; pack; counter = 1 }
+
+    let unsafe_v ?(fresh = false) ?(readonly = false) ?(lru_size = 10_000)
+        ~index root =
+      try
+        let t = Hashtbl.find roots (root, readonly) in
+        if valid t then (
+          if fresh then clear t;
+          t )
+        else (
+          Hashtbl.remove roots (root, readonly);
+          raise Not_found )
+      with Not_found ->
+        let t = unsafe_v_no_cache ~fresh ~readonly ~lru_size ~index root in
+        if fresh then clear t;
+        Hashtbl.add roots (root, readonly) t;
+        t
+
+    let v ?fresh ?readonly ?lru_size ~index root =
+      Lwt_mutex.with_lock create (fun () ->
+          let t = unsafe_v ?fresh ?readonly ?lru_size ~index root in
+          Lwt.return t)
+
+    let pp_hash = Irmin.Type.pp K.t
+
+    let io_read_and_decode_hash ~off t =
+      let buf = Bytes.create K.hash_size in
+      let n = IO.read t.pack.block ~off buf in
+      assert (n = K.hash_size);
+      let _, v =
+        Irmin.Type.decode_bin ~headers:false K.t (Bytes.unsafe_to_string buf) 0
+      in
+      v
+
+    let unsafe_mem t k =
+      Log.debug (fun l -> l "[pack] mem %a" pp_hash k);
+      Tbl.mem t.staging k || Lru.mem t.lru k || Index.mem t.pack.index k
+
+    let mem t k =
+      Lwt_mutex.with_lock create (fun () ->
+          let b = unsafe_mem t k in
+          Lwt.return b)
+
+    let check_key k v =
+      let k' = V.hash v in
+      if Irmin.Type.equal K.t k k' then ()
+      else
+        Fmt.failwith "corrupted value: got %a, expecting %a." pp_hash k'
+          pp_hash k
+
+    let io_read_and_decode ~off ~len t =
+      if not (IO.readonly t.pack.block) then
+        assert (off <= IO.offset t.pack.block);
+      let buf = Bytes.create len in
+      let n = IO.read t.pack.block ~off buf in
+      assert (n = len);
+      let hash off = io_read_and_decode_hash ~off t in
+      let dict = Dict.find t.pack.dict in
+      V.decode_bin ~hash ~dict (Bytes.unsafe_to_string buf) 0
+
+    let unsafe_find t k =
+      Log.debug (fun l -> l "[pack] find %a" pp_hash k);
+      stats.pack_finds <- succ stats.pack_finds;
+      match Tbl.find t.staging k with
+      | v ->
+          Lru.add t.lru k v;
+          Some v
+      | exception Not_found -> (
+          match Lru.find t.lru k with
+          | v -> Some v
+          | exception Not_found -> (
+              stats.pack_cache_misses <- succ stats.pack_cache_misses;
+              match Index.find t.pack.index k with
+              | None -> None
+              | Some (off, len, _) ->
+                  let v = io_read_and_decode ~off ~len t in
+                  check_key k v;
+                  Lru.add t.lru k v;
+                  Some v ) )
+
+    let find t k =
+      Lwt_mutex.with_lock t.pack.lock (fun () ->
+          let v = unsafe_find t k in
+          Lwt.return v)
+
+    let cast t = (t :> [ `Read | `Write ] t)
+
+    let sync t =
+      Dict.sync t.pack.dict;
+      Index.flush t.pack.index;
+      IO.sync t.pack.block;
+      Tbl.clear t.staging
+
+    let integrity_check ~offset ~length k t =
+      let value = io_read_and_decode ~off:offset ~len:length t in
+      check_key k value
+
+    let batch t f =
+      f (cast t) >>= fun r ->
+      if Tbl.length t.staging = 0 then Lwt.return r
+      else (
+        sync t;
+        Lwt.return r )
+
+    let auto_flush = 1024
+
+    let unsafe_append t k v =
+      match unsafe_mem t k with
+      | true -> ()
+      | false ->
+          Log.debug (fun l -> l "[pack] append %a" pp_hash k);
+          let offset k =
+            match Index.find t.pack.index k with
+            | None ->
+                stats.appended_hashes <- stats.appended_hashes + 1;
+                None
+            | Some (off, _, _) ->
+                stats.appended_offsets <- stats.appended_offsets + 1;
+                Some off
+          in
+          let dict = Dict.index t.pack.dict in
+          let off = IO.offset t.pack.block in
+          V.encode_bin ~offset ~dict v k (IO.append t.pack.block);
+          let len = Int64.to_int (IO.offset t.pack.block -- off) in
+          Index.add t.pack.index k (off, len, V.magic v);
+          if Tbl.length t.staging >= auto_flush then sync t
+          else Tbl.add t.staging k v;
+          Lru.add t.lru k v
+
+    let append t k v =
+      Lwt_mutex.with_lock t.pack.lock (fun () ->
+          unsafe_append t k v;
+          Lwt.return_unit)
+
+    let add t v =
+      let k = V.hash v in
+      append t k v >|= fun () -> k
+
+    let unsafe_add t k v = append t k v
+
+    let unsafe_close t =
+      t.counter <- t.counter - 1;
+      if t.counter = 0 then (
+        Log.debug (fun l -> l "[pack] close %s" (IO.name t.pack.block));
+        Tbl.clear t.staging;
+        ignore (Lru.clear t.lru);
+        close t.pack )
+
+    let close t =
+      Lwt_mutex.with_lock t.pack.lock (fun () ->
+          unsafe_close t;
+          Lwt.return_unit)
+  end
+end
+
+let div_or_zero a b = if b = 0 then 0. else float_of_int a /. float_of_int b
+
+type stats = {
+  pack_cache_misses : float;
+  offset_ratio : float;
+  offset_significance : int;
+}
+
+let stats () =
+  {
+    pack_cache_misses = div_or_zero stats.pack_cache_misses stats.pack_finds;
+    offset_ratio =
+      div_or_zero stats.appended_offsets
+        (stats.appended_offsets + stats.appended_hashes);
+    offset_significance = stats.appended_offsets + stats.appended_hashes;
+  }
diff --git a/vendors/irmin-pack/pack.mli b/vendors/irmin-pack/pack.mli
new file mode 100644
index 0000000000000000000000000000000000000000..271084625329ac752ded5b08d795c515a6e77720
--- /dev/null
+++ b/vendors/irmin-pack/pack.mli
@@ -0,0 +1,89 @@
+(*
+ * Copyright (c) 2013-2019 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module type ELT = sig
+  include Irmin.Type.S
+
+  type hash
+
+  val hash : t -> hash
+
+  val magic : t -> char
+
+  val encode_bin :
+    dict:(string -> int option) ->
+    offset:(hash -> int64 option) ->
+    t ->
+    hash ->
+    (string -> unit) ->
+    unit
+
+  val decode_bin :
+    dict:(int -> string option) -> hash:(int64 -> hash) -> string -> int -> t
+end
+
+module type S = sig
+  include Irmin.CONTENT_ADDRESSABLE_STORE
+
+  type index
+
+  val v :
+    ?fresh:bool ->
+    ?readonly:bool ->
+    ?lru_size:int ->
+    index:index ->
+    string ->
+    [ `Read ] t Lwt.t
+
+  val batch : [ `Read ] t -> ([ `Read | `Write ] t -> 'a Lwt.t) -> 'a Lwt.t
+
+  val unsafe_append : 'a t -> key -> value -> unit
+
+  val unsafe_mem : 'a t -> key -> bool
+
+  val unsafe_find : 'a t -> key -> value option
+
+  val sync : 'a t -> unit
+
+  val integrity_check : offset:int64 -> length:int -> key -> 'a t -> unit
+
+  val close : 'a t -> unit Lwt.t
+end
+
+module type MAKER = sig
+  type key
+
+  type index
+
+  (** Save multiple kind of values in the same pack file. Values will
+      be distinguished using [V.magic], so they have to all be
+      different. *)
+  module Make (V : ELT with type hash := key) :
+    S with type key = key and type value = V.t and type index = index
+end
+
+module File (Index : Pack_index.S) (K : Irmin.Hash.S with type t = Index.key) :
+  MAKER with type key = K.t and type index = Index.t
+
+type stats = {
+  pack_cache_misses : float;
+  offset_ratio : float;
+  offset_significance : int;
+}
+
+val reset_stats : unit -> unit
+
+val stats : unit -> stats
diff --git a/vendors/irmin-pack/pack_dict.ml b/vendors/irmin-pack/pack_dict.ml
new file mode 100644
index 0000000000000000000000000000000000000000..f5ce5c5dd26f71dad662de4ccbdc33f1a2928d87
--- /dev/null
+++ b/vendors/irmin-pack/pack_dict.ml
@@ -0,0 +1,23 @@
+(* Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+include Dict.Make (IO.Unix)
+
+(* Add IO caching around Dict.v *)
+let (`Staged v) =
+  let v_no_cache ~fresh ~readonly = v ~fresh ~readonly in
+  IO.with_cache ~clear ~valid
+    ~v:(fun capacity -> v_no_cache ~capacity)
+    "store.dict"
+
+let v ?fresh ?readonly ?(capacity = 100_000) root =
+  v capacity ?fresh ?readonly root
diff --git a/vendors/irmin-pack/pack_dict.mli b/vendors/irmin-pack/pack_dict.mli
new file mode 100644
index 0000000000000000000000000000000000000000..5de6b126f796796bbe3aa3be44b161978e530435
--- /dev/null
+++ b/vendors/irmin-pack/pack_dict.mli
@@ -0,0 +1,15 @@
+(* Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+include Dict.S
+
+val v : ?fresh:bool -> ?readonly:bool -> ?capacity:int -> string -> t
diff --git a/vendors/irmin-pack/pack_index.ml b/vendors/irmin-pack/pack_index.ml
new file mode 100644
index 0000000000000000000000000000000000000000..6b4c0d636bffdf64899e91a8ba9cf5849ea29d24
--- /dev/null
+++ b/vendors/irmin-pack/pack_index.ml
@@ -0,0 +1,69 @@
+(* Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+module type S = sig
+  include Index.S with type value = int64 * int * char
+
+  val find : t -> key -> value option
+
+  val add : t -> key -> value -> unit
+
+  val close : t -> unit
+end
+
+module Make (K : Irmin.Hash.S) = struct
+  module Key = struct
+    type t = K.t
+
+    let pp ppf t = Irmin.Type.pp K.t ppf t
+
+    let hash t = Irmin.Type.short_hash K.t t
+
+    let hash_size = 60
+
+    let equal x y = Irmin.Type.equal K.t x y
+
+    let encode x = Irmin.Type.to_bin_string K.t x
+
+    let encoded_size = K.hash_size
+
+    let decode s off =
+      let _, v = Irmin.Type.decode_bin ~headers:false K.t s off in
+      v
+  end
+
+  module Val = struct
+    type t = int64 * int * char
+
+    let pp = Irmin.Type.(pp (triple int64 int char))
+
+    let encode (off, len, kind) =
+      Irmin.Type.(to_bin_string (triple int64 int32 char))
+        (off, Int32.of_int len, kind)
+
+    let decode s off =
+      let off, len, kind =
+        snd (Irmin.Type.(decode_bin (triple int64 int32 char)) s off)
+      in
+      (off, Int32.to_int len, kind)
+
+    let encoded_size = (64 / 8) + (32 / 8) + 1
+  end
+
+  module Index = Index_unix.Make (Key) (Val)
+  include Index
+
+  let add t k v = replace t k v
+
+  let find t k =
+    match find t k with exception Not_found -> None | h -> Some h
+end
diff --git a/vendors/irmin-pack/pack_index.mli b/vendors/irmin-pack/pack_index.mli
new file mode 100644
index 0000000000000000000000000000000000000000..c43bc79d8cb7981d781b4cab5f66070fbc561a10
--- /dev/null
+++ b/vendors/irmin-pack/pack_index.mli
@@ -0,0 +1,23 @@
+(* Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+module type S = sig
+  include Index.S with type value = int64 * int * char
+
+  val find : t -> key -> value option
+
+  val add : t -> key -> value -> unit
+
+  val close : t -> unit
+end
+
+module Make (K : Irmin.Hash.S) : S with type key = K.t
diff --git a/vendors/irmin/bheap.ml b/vendors/irmin/bheap.ml
new file mode 100644
index 0000000000000000000000000000000000000000..e37019b650690cd1e41a29e1528fd73d5be330ff
--- /dev/null
+++ b/vendors/irmin/bheap.ml
@@ -0,0 +1,116 @@
+(**************************************************************************)
+(*                                                                        *)
+(*  Copyright (C) Jean-Christophe Filliatre                               *)
+(*                                                                        *)
+(*  This software is free software; you can redistribute it and/or        *)
+(*  modify it under the terms of the GNU Library General Public           *)
+(*  License version 2.1, with the special exception on linking            *)
+(*  described in file LICENSE.                                            *)
+(*                                                                        *)
+(*  This software is distributed in the hope that it will be useful,      *)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*s Heaps *)
+
+module type Ordered = sig
+  type t
+
+  val compare : t -> t -> int
+end
+
+exception Empty
+
+module Make (X : Ordered) = struct
+  (* The heap is encoded in the array [data], where elements are stored
+     from [0] to [size - 1]. From an element stored at [i], the left
+     (resp. right) subtree, if any, is rooted at [2*i+1] (resp. [2*i+2]). *)
+
+  type t = { mutable size : int; mutable data : X.t array }
+
+  (* When [create n] is called, we cannot allocate the array, since there is
+     no known value of type [X.t]; we'll wait for the first addition to
+     do it, and we remember this situation with a negative size. *)
+
+  let create n =
+    if n <= 0 then invalid_arg "create";
+    { size = -n; data = [||] }
+
+  let is_empty h = h.size <= 0
+
+  (* [resize] doubles the size of [data] *)
+
+  let resize h =
+    let n = h.size in
+    assert (n > 0);
+    let n' = 2 * n in
+    let d = h.data in
+    let d' = Array.make n' d.(0) in
+    Array.blit d 0 d' 0 n;
+    h.data <- d'
+
+  let add h x =
+    (* first addition: we allocate the array *)
+    if h.size < 0 then (
+      h.data <- Array.make (-h.size) x;
+      h.size <- 0 );
+    let n = h.size in
+    (* resizing if needed *)
+    if n == Array.length h.data then resize h;
+    let d = h.data in
+    (* moving [x] up in the heap *)
+    let rec moveup i =
+      let fi = (i - 1) / 2 in
+      if i > 0 && X.compare d.(fi) x < 0 then (
+        d.(i) <- d.(fi);
+        moveup fi )
+      else d.(i) <- x
+    in
+    moveup n;
+    h.size <- n + 1
+
+  let maximum h =
+    if h.size <= 0 then raise Empty;
+    h.data.(0)
+
+  let remove h =
+    if h.size <= 0 then raise Empty;
+    let n = h.size - 1 in
+    h.size <- n;
+    let d = h.data in
+    let x = d.(n) in
+    (* moving [x] down in the heap *)
+    let rec movedown i =
+      let j = (2 * i) + 1 in
+      if j < n then
+        let j =
+          let j' = j + 1 in
+          if j' < n && X.compare d.(j') d.(j) > 0 then j' else j
+        in
+        if X.compare d.(j) x > 0 then (
+          d.(i) <- d.(j);
+          movedown j )
+        else d.(i) <- x
+      else d.(i) <- x
+    in
+    movedown 0
+
+  let pop_maximum h =
+    let m = maximum h in
+    remove h;
+    m
+
+  let iter f h =
+    let d = h.data in
+    for i = 0 to h.size - 1 do
+      f d.(i)
+    done
+
+  let fold f h x0 =
+    let n = h.size in
+    let d = h.data in
+    let rec foldrec x i = if i >= n then x else foldrec (f d.(i) x) (succ i) in
+    foldrec x0 0
+end
diff --git a/vendors/irmin/bheap.mli b/vendors/irmin/bheap.mli
new file mode 100644
index 0000000000000000000000000000000000000000..df19fab9ad1d6c403c82f0049189cc5aec698ce4
--- /dev/null
+++ b/vendors/irmin/bheap.mli
@@ -0,0 +1,59 @@
+(**************************************************************************)
+(*                                                                        *)
+(*  Copyright (C) Jean-Christophe Filliatre                               *)
+(*                                                                        *)
+(*  This software is free software; you can redistribute it and/or        *)
+(*  modify it under the terms of the GNU Library General Public           *)
+(*  License version 2.1, with the special exception on linking            *)
+(*  described in file LICENSE.                                            *)
+(*                                                                        *)
+(*  This software is distributed in the hope that it will be useful,      *)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Traditional implementation of a binary heap using an array *)
+
+module type Ordered = sig
+  type t
+
+  val compare : t -> t -> int
+end
+
+exception Empty
+
+module Make (X : Ordered) : sig
+  (* Type of imperative heaps.
+     (In the following [n] refers to the number of elements in the heap) *)
+
+  type t
+
+  (* [create c] creates a new heap, with initial capacity of [c] *)
+  val create : int -> t
+
+  (* [is_empty h] checks the emptiness of [h] *)
+  val is_empty : t -> bool
+
+  (* [add x h] adds a new element [x] in heap [h]; size of [h] is doubled
+     when maximum capacity is reached; complexity $O(log(n))$ *)
+  val add : t -> X.t -> unit
+
+  (* [maximum h] returns the maximum element of [h]; raises [EmptyHeap]
+     when [h] is empty; complexity $O(1)$ *)
+  val maximum : t -> X.t
+
+  (* [remove h] removes the maximum element of [h]; raises [EmptyHeap]
+     when [h] is empty; complexity $O(log(n))$ *)
+  val remove : t -> unit
+
+  (* [pop_maximum h] removes the maximum element of [h] and returns it;
+     raises [EmptyHeap] when [h] is empty; complexity $O(log(n))$ *)
+  val pop_maximum : t -> X.t
+
+  (* usual iterators and combinators; elements are presented in
+     arbitrary order *)
+  val iter : (X.t -> unit) -> t -> unit
+
+  val fold : (X.t -> 'a -> 'a) -> t -> 'a -> 'a
+end
diff --git a/vendors/irmin/branch.ml b/vendors/irmin/branch.ml
new file mode 100644
index 0000000000000000000000000000000000000000..a5357850796298c7d22ce64588a6b9e0b5cc9bf0
--- /dev/null
+++ b/vendors/irmin/branch.ml
@@ -0,0 +1,35 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module String = struct
+  type t = string
+
+  let t = Type.string
+
+  let master = "master"
+
+  let is_valid s =
+    let ok = ref true in
+    let n = String.length s in
+    let i = ref 0 in
+    while !i < n do
+      ( match s.[!i] with
+      | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '-' | '_' | '.' -> ()
+      | _ -> ok := false );
+      incr i
+    done;
+    !ok
+end
diff --git a/vendors/irmin/branch.mli b/vendors/irmin/branch.mli
new file mode 100644
index 0000000000000000000000000000000000000000..a607e1e614d095d298588abe5c09f7c17d11f6e5
--- /dev/null
+++ b/vendors/irmin/branch.mli
@@ -0,0 +1,19 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Handling of branches. *)
+
+module String : S.BRANCH with type t = string
diff --git a/vendors/irmin/commit.ml b/vendors/irmin/commit.ml
new file mode 100644
index 0000000000000000000000000000000000000000..f0a3f5814ceac55d3f7ad82ce3f6fbef08740dc3
--- /dev/null
+++ b/vendors/irmin/commit.ml
@@ -0,0 +1,545 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+open Merge.Infix
+
+let src = Logs.Src.create "irmin.commit" ~doc:"Irmin commits"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+module Make (K : Type.S) = struct
+  type hash = K.t
+
+  type t = { node : hash; parents : hash list; info : Info.t }
+
+  let parents t = t.parents
+
+  let node t = t.node
+
+  let info t = t.info
+
+  let v ~info ~node ~parents =
+    let parents = List.fast_sort (Type.compare K.t) parents in
+    { node; parents; info }
+
+  let t =
+    let open Type in
+    record "commit" (fun node parents info -> { node; parents; info })
+    |+ field "node" K.t (fun t -> t.node)
+    |+ field "parents" (list K.t) (fun t -> t.parents)
+    |+ field "info" Info.t (fun t -> t.info)
+    |> sealr
+
+  let hash_t = K.t
+end
+
+module Store
+    (N : S.NODE_STORE) (S : sig
+      include S.CONTENT_ADDRESSABLE_STORE with type key = N.key
+
+      module Key : S.HASH with type t = key
+
+      module Val : S.COMMIT with type t = value and type hash = key
+    end) =
+struct
+  module Node = N
+
+  type 'a t = 'a N.t * 'a S.t
+
+  type key = S.key
+
+  type value = S.value
+
+  let add (_, t) = S.add t
+
+  let unsafe_add (_, t) = S.unsafe_add t
+
+  let mem (_, t) = S.mem t
+
+  let find (_, t) = S.find t
+
+  let merge_node (t, _) = Merge.f (N.merge t)
+
+  let pp_key = Type.pp S.Key.t
+
+  let err_not_found k =
+    Fmt.kstrf invalid_arg "Commit.get: %a not found" pp_key k
+
+  let get (_, t) k =
+    S.find t k >>= function None -> err_not_found k | Some v -> Lwt.return v
+
+  let empty_if_none (n, _) = function
+    | None -> N.add n N.Val.empty
+    | Some node -> Lwt.return node
+
+  let equal_opt_keys = Type.(equal (option S.Key.t))
+
+  let merge_commit info t ~old k1 k2 =
+    get t k1 >>= fun v1 ->
+    get t k2 >>= fun v2 ->
+    if List.mem k1 (S.Val.parents v2) then Merge.ok k2
+    else if List.mem k2 (S.Val.parents v1) then Merge.ok k1
+    else
+      (* If we get an error while looking the the lca, then we
+         assume that there is no common ancestor. Maybe we want to
+         expose this to the user in a more structured way. But maybe
+         that's too much low-level details. *)
+      (old () >>= function
+       | Error (`Conflict msg) ->
+           Log.debug (fun f -> f "old: conflict %s" msg);
+           Lwt.return_none
+       | Ok o -> Lwt.return o)
+      >>= fun old ->
+      if equal_opt_keys old (Some k1) then Merge.ok k2
+      else if equal_opt_keys old (Some k2) then Merge.ok k1
+      else
+        let old () =
+          match old with
+          | None -> Merge.ok None
+          | Some old ->
+              get t old >>= fun vold ->
+              Merge.ok (Some (Some (S.Val.node vold)))
+        in
+        merge_node t ~old (Some (S.Val.node v1)) (Some (S.Val.node v2))
+        >>=* fun node ->
+        empty_if_none t node >>= fun node ->
+        let parents = [ k1; k2 ] in
+        let commit = S.Val.v ~node ~parents ~info:(info ()) in
+        add t commit >>= fun key -> Merge.ok key
+
+  let merge t ~info = Merge.(option (v S.Key.t (merge_commit info t)))
+
+  module Key = Hash.Typed (S.Key) (S.Val)
+  module Val = S.Val
+end
+
+module History (S : S.COMMIT_STORE) = struct
+  type commit = S.key
+
+  type node = S.Node.key
+
+  type 'a t = 'a S.t
+
+  type v = S.Val.t
+
+  let commit_t = S.Key.t
+
+  let merge t ~info =
+    let f ~old c1 c2 =
+      let somify = Merge.map_promise (fun x -> Some x) in
+      let merge = S.merge t ~info in
+      Merge.f merge ~old:(somify old) (Some c1) (Some c2) >>=* function
+      | None -> Merge.conflict "History.merge"
+      | Some x -> Merge.ok x
+    in
+    Merge.v S.Key.t f
+
+  let v t ~node ~parents ~info =
+    let commit = S.Val.v ~node ~parents ~info in
+    S.add t commit >|= fun hash -> (hash, commit)
+
+  let pp_key = Type.pp S.Key.t
+
+  let parents t c =
+    Log.debug (fun f -> f "parents %a" pp_key c);
+    S.find t c >|= function None -> [] | Some c -> S.Val.parents c
+
+  module Graph =
+    Object_graph.Make (S.Node.Contents.Key) (S.Node.Metadata) (S.Node.Key)
+      (S.Key)
+      (struct
+        type t = unit
+
+        let t = Type.unit
+      end)
+
+  let edges t =
+    Log.debug (fun f -> f "edges");
+    [ `Node (S.Val.node t) ] @ List.map (fun k -> `Commit k) (S.Val.parents t)
+
+  let closure t ~min ~max =
+    Log.debug (fun f -> f "closure");
+    let pred = function
+      | `Commit k -> (
+          S.find t k >|= function Some r -> edges r | None -> [] )
+      | _ -> Lwt.return_nil
+    in
+    let min = List.map (fun k -> `Commit k) min in
+    let max = List.map (fun k -> `Commit k) max in
+    Graph.closure ~pred ~min ~max () >|= fun g ->
+    List.fold_left
+      (fun acc -> function `Commit k -> k :: acc | _ -> acc)
+      [] (Graph.vertex g)
+
+  module K = struct
+    type t = S.Key.t
+
+    let compare = Type.compare S.Key.t
+
+    let hash = S.Key.short_hash
+
+    let equal = Type.equal S.Key.t
+  end
+
+  module KSet = Set.Make (K)
+  module KHashtbl = Hashtbl.Make (K)
+
+  let read_parents t commit =
+    S.find t commit >|= function
+    | None -> KSet.empty
+    | Some c -> KSet.of_list (S.Val.parents c)
+
+  let equal_keys = Type.equal S.Key.t
+
+  let str_key k = String.sub (Type.to_string S.Key.t k) 0 4
+
+  let pp_key = Fmt.of_to_string str_key
+
+  let pp_keys ppf keys =
+    let keys = KSet.elements keys in
+    Fmt.pf ppf "[%a]" Fmt.(list ~sep:(unit " ") pp_key) keys
+
+  let str_keys = Fmt.to_to_string pp_keys
+
+  let lca_calls = ref 0
+
+  let rec unqueue todo seen =
+    if Queue.is_empty todo then None
+    else
+      let ((_, commit) as pop) = Queue.pop todo in
+      if KSet.mem commit seen then unqueue todo seen else Some pop
+
+  (* Traverse the graph of commits using a breadth first search
+     strategy. Start by visiting the commits in [init] and stops
+     either when [check] returns [`Stop] or when all the ancestors of
+     [init] have been visited. *)
+  let traverse_bfs t ~f ~pp:_ ~check ~init ~return =
+    let todo = Queue.create () in
+    let add_todo d x = Queue.add (d, x) todo in
+    KSet.iter (add_todo 0) init;
+    let rec aux seen =
+      match check () with
+      | (`Too_many_lcas | `Max_depth_reached) as x -> Lwt.return_error x
+      | `Stop -> return ()
+      | `Continue -> (
+          match unqueue todo seen with
+          | None -> return ()
+          | Some (depth, commit) ->
+              (* Log.debug "lca %d: %s.%d %a"
+             !lca_calls (pp_key commit) depth force (pp ()); *)
+              let seen = KSet.add commit seen in
+              read_parents t commit >>= fun parents ->
+              let () = f depth commit parents in
+              let parents = KSet.diff parents seen in
+              KSet.iter (add_todo (depth + 1)) parents;
+              aux seen )
+    in
+    aux KSet.empty
+
+  (* Initially the first node is marked as [Seen1] and the second as [Seen2].
+     Marks are updated as the search progresses, and may change. *)
+  type mark =
+    | Seen1 (* reachable from the first commit *)
+    | Seen2 (* reachable from the second commit *)
+    | SeenBoth (* reachable from both, but below an LCA *)
+    | LCA
+
+  (* reachable from both; candidate for the answer set *)
+
+  let _pp_mark = function
+    | Seen1 -> "seen1"
+    | Seen2 -> "seen2"
+    | SeenBoth -> "seenBoth"
+    | LCA -> "LCA"
+
+  (* Exploration state *)
+  type state = {
+    marks : mark KHashtbl.t;
+    (* marks of commits already explored *)
+    parents : KSet.t KHashtbl.t;
+    (* parents of commits already explored *)
+    layers : (int, KSet.t) Hashtbl.t;
+    (* layers of commit, sorted by depth *)
+    c1 : S.key;
+    (* initial state 1 *)
+    c2 : S.key;
+    (* initial state 2 *)
+    mutable depth : int;
+    (* the current exploration depth *)
+    mutable lcas : int;
+    (* number of commit marked with LCA *)
+    mutable complete : bool; (* is the exploration complete? *)
+  }
+
+  let pp_state t =
+    lazy
+      (let pp m =
+         KHashtbl.fold
+           (fun k v acc -> if v = m then str_key k :: acc else acc)
+           t.marks []
+         |> String.concat " "
+       in
+       Fmt.strf "d: %d, seen1: %s, seen2: %s, seenboth: %s, lcas: %s (%d) %s"
+         t.depth (pp Seen1) (pp Seen2) (pp SeenBoth) (pp LCA) t.lcas
+         (String.concat " | "
+            (Hashtbl.fold
+               (fun d ks acc -> Fmt.strf "(%d: %s)" d (str_keys ks) :: acc)
+               t.layers [])))
+
+  let get_mark_exn t elt = KHashtbl.find t.marks elt
+
+  let get_mark t elt = try Some (get_mark_exn t elt) with Not_found -> None
+
+  let set_mark t elt mark = KHashtbl.replace t.marks elt mark
+
+  let get_layer t d =
+    try Hashtbl.find t.layers d with Not_found -> KSet.empty
+
+  let add_to_layer t d k =
+    Hashtbl.replace t.layers d (KSet.add k (get_layer t d))
+
+  let add_parent t c p = KHashtbl.add t.parents c p
+
+  let get_parent t c =
+    try KHashtbl.find t.parents c with Not_found -> KSet.empty
+
+  let incr_lcas t = t.lcas <- t.lcas + 1
+
+  let decr_lcas t = t.lcas <- t.lcas - 1
+
+  let both_seen t k =
+    match get_mark t k with
+    | None | Some Seen1 | Some Seen2 -> false
+    | _ -> true
+
+  let empty_state c1 c2 =
+    let t =
+      {
+        marks = KHashtbl.create 10;
+        parents = KHashtbl.create 10;
+        layers = Hashtbl.create 10;
+        c1;
+        c2;
+        depth = 0;
+        lcas = 0;
+        complete = false;
+      }
+    in
+    set_mark t c1 Seen1;
+    set_mark t c2 Seen2;
+    t
+
+  (* update the parent mark and keep the number of lcas up-to-date. *)
+  let update_mark t mark commit =
+    let new_mark =
+      match (mark, get_mark t commit) with
+      | Seen1, Some Seen1 | Seen1, None -> Seen1
+      | Seen2, Some Seen2 | Seen2, None -> Seen2
+      | SeenBoth, Some LCA ->
+          decr_lcas t;
+          SeenBoth
+      | SeenBoth, _ -> SeenBoth
+      | Seen1, Some Seen2 | Seen2, Some Seen1 ->
+          incr_lcas t;
+          LCA
+      | _, Some LCA -> LCA
+      | _ -> SeenBoth
+    in
+    (* check for fast-forwards *)
+    let is_init () = equal_keys commit t.c1 || equal_keys commit t.c2 in
+    let is_shared () = new_mark = SeenBoth || new_mark = LCA in
+    if is_shared () && is_init () then (
+      Log.debug (fun f -> f "fast-forward");
+      t.complete <- true );
+    set_mark t commit new_mark;
+    new_mark
+
+  (* update the ancestors which have already been visisted. *)
+  let update_ancestors_marks t mark commit =
+    let todo = Queue.create () in
+    Queue.add commit todo;
+    let rec loop mark =
+      if Queue.is_empty todo then ()
+      else
+        let a = Queue.pop todo in
+        let old_mark = get_mark t a in
+        let mark = update_mark t mark a in
+        let () =
+          match old_mark with
+          | Some (SeenBoth | LCA) -> () (* Can't be an LCA lower down *)
+          | Some old when old = mark -> () (* No change *)
+          | _ -> KSet.iter (fun x -> Queue.push x todo) (get_parent t a)
+        in
+        loop (if mark = LCA then SeenBoth else mark)
+    in
+    loop mark
+
+  (* We are looking for LCAs, doing a breadth-first-search from the two starting commits.
+     This is called each time we visit a new commit.  *)
+  let update_parents t depth commit parents =
+    add_parent t commit parents;
+    add_to_layer t depth commit;
+    if depth <> t.depth then (
+      assert (depth = t.depth + 1);
+
+      (* before starting to explore a new layer, check if we really
+         have some work to do, ie. do we still have a commit seen only
+         by one node? *)
+      let layer = get_layer t t.depth in
+      let complete = KSet.for_all (both_seen t) layer in
+      if complete then t.complete <- true else t.depth <- depth );
+    let mark = get_mark_exn t commit in
+    KSet.iter (update_ancestors_marks t mark) parents
+
+  let lcas t =
+    KHashtbl.fold (fun k v acc -> if v = LCA then k :: acc else acc) t.marks []
+
+  let check ~max_depth ~n t =
+    if t.depth > max_depth then `Max_depth_reached
+    else if t.lcas > n then `Too_many_lcas
+    else if t.lcas = n || t.complete then `Stop
+    else `Continue
+
+  let lcas t ?(max_depth = max_int) ?(n = max_int) c1 c2 =
+    incr lca_calls;
+    if max_depth < 0 then Lwt.return_error `Max_depth_reached
+    else if n <= 0 then Lwt.return_error `Too_many_lcas
+    else if equal_keys c1 c2 then Lwt.return_ok [ c1 ]
+    else
+      let init = KSet.of_list [ c1; c2 ] in
+      let s = empty_state c1 c2 in
+      let check () = check ~max_depth ~n s in
+      let pp () = pp_state s in
+      let return () = Lwt.return_ok (lcas s) in
+      let t0 = Sys.time () in
+      Lwt.finalize
+        (fun () ->
+          traverse_bfs t ~f:(update_parents s) ~pp ~check ~init ~return)
+        (fun () ->
+          let t1 = Sys.time () -. t0 in
+          Log.debug (fun f ->
+              f "lcas %d: depth=%d time=%.4fs" !lca_calls s.depth t1);
+          Lwt.return_unit)
+
+  let rec three_way_merge t ~info ?max_depth ?n c1 c2 =
+    Log.debug (fun f -> f "3-way merge between %a and %a" pp_key c1 pp_key c2);
+    if equal_keys c1 c2 then Merge.ok c1
+    else
+      lcas t ?max_depth ?n c1 c2 >>= fun lcas ->
+      let old () =
+        match lcas with
+        | Error `Too_many_lcas -> Merge.conflict "Too many lcas"
+        | Error `Max_depth_reached -> Merge.conflict "Max depth reached"
+        | Ok [] -> Merge.ok None (* no common ancestor *)
+        | Ok (old :: olds) ->
+            let rec aux acc = function
+              | [] -> Merge.ok (Some acc)
+              | old :: olds ->
+                  three_way_merge t ~info acc old >>=* fun acc -> aux acc olds
+            in
+            aux old olds
+      in
+      let merge =
+        merge t ~info
+        |> Merge.with_conflict (fun msg ->
+               Fmt.strf "Recursive merging of common ancestors: %s" msg)
+        |> Merge.f
+      in
+      merge ~old c1 c2
+
+  let lca_aux t ~info ?max_depth ?n c1 c2 =
+    if equal_keys c1 c2 then Merge.ok (Some c1)
+    else
+      lcas t ?max_depth ?n c1 c2 >>= function
+      | Error `Too_many_lcas -> Merge.conflict "Too many lcas"
+      | Error `Max_depth_reached -> Merge.conflict "Max depth reached"
+      | Ok [] -> Merge.ok None (* no common ancestor *)
+      | Ok [ x ] -> Merge.ok (Some x)
+      | Ok (c :: cs) ->
+          let rec aux acc = function
+            | [] -> Merge.ok (Some acc)
+            | c :: cs -> (
+                three_way_merge t ~info ?max_depth ?n acc c >>= function
+                | Error (`Conflict _) -> Merge.ok None
+                | Ok acc -> aux acc cs )
+          in
+          aux c cs
+
+  let rec lca t ~info ?max_depth ?n = function
+    | [] -> Merge.conflict "History.lca: empty"
+    | [ c ] -> Merge.ok (Some c)
+    | c1 :: c2 :: cs -> (
+        lca_aux t ~info ?max_depth ?n c1 c2 >>=* function
+        | None -> Merge.ok None
+        | Some c -> lca t ~info ?max_depth ?n (c :: cs) )
+end
+
+module V1 (C : S.COMMIT) = struct
+  module K = struct
+    let h = Type.string_of `Int64
+
+    let size_of ?headers x =
+      Type.size_of ?headers h (Type.to_bin_string C.hash_t x)
+
+    let encode_bin ?headers e k =
+      Type.encode_bin ?headers h (Type.to_bin_string C.hash_t e) k
+
+    let decode_bin ?headers buf off =
+      let n, v = Type.decode_bin ?headers h buf off in
+      ( n,
+        match Type.of_bin_string C.hash_t v with
+        | Ok v -> v
+        | Error (`Msg e) -> Fmt.failwith "decode_bin: %s" e )
+
+    let t = Type.like C.hash_t ~bin:(encode_bin, decode_bin, size_of)
+  end
+
+  type hash = C.hash
+
+  let hash_t = K.t
+
+  type t = { parents : hash list; c : C.t }
+
+  let import c = { c; parents = C.parents c }
+
+  let export t = t.c
+
+  let node t = C.node t.c
+
+  let parents t = t.parents
+
+  let info t = C.info t.c
+
+  let v ~info ~node ~parents = { parents; c = C.v ~node ~parents ~info }
+
+  let make = v
+
+  let info_t : Info.t Type.t =
+    let open Type in
+    record "info" (fun date author message -> Info.v ~date ~author message)
+    |+ field "date" int64 (fun t -> Info.date t)
+    |+ field "author" (string_of `Int64) (fun t -> Info.author t)
+    |+ field "message" (string_of `Int64) (fun t -> Info.message t)
+    |> sealr
+
+  let t : t Type.t =
+    let open Type in
+    record "commit" (fun node parents info -> make ~info ~node ~parents)
+    |+ field "node" K.t node
+    |+ field "parents" (list ~len:`Int64 K.t) parents
+    |+ field "info" info_t info |> sealr
+end
diff --git a/vendors/irmin/commit.mli b/vendors/irmin/commit.mli
new file mode 100644
index 0000000000000000000000000000000000000000..024bfc9d28ca01ace7a0fbe958ac79a976ea05b2
--- /dev/null
+++ b/vendors/irmin/commit.mli
@@ -0,0 +1,49 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Manage the database history. *)
+
+module Make (K : Type.S) : S.COMMIT with type hash = K.t
+
+module Store
+    (N : S.NODE_STORE) (C : sig
+      include S.CONTENT_ADDRESSABLE_STORE with type key = N.key
+
+      module Key : S.HASH with type t = key
+
+      module Val : S.COMMIT with type t = value and type hash = key
+    end) :
+  S.COMMIT_STORE
+    with type 'a t = 'a N.t * 'a C.t
+     and type key = C.key
+     and type value = C.value
+     and type Key.t = C.Key.t
+     and module Val = C.Val
+
+module History (C : S.COMMIT_STORE) :
+  S.COMMIT_HISTORY
+    with type 'a t = 'a C.t
+     and type v = C.Val.t
+     and type node = C.Node.key
+     and type commit = C.key
+
+module V1 (C : S.COMMIT) : sig
+  include S.COMMIT with type hash = C.hash
+
+  val import : C.t -> t
+
+  val export : t -> C.t
+end
diff --git a/vendors/irmin/conf.ml b/vendors/irmin/conf.ml
new file mode 100644
index 0000000000000000000000000000000000000000..57a9e6ea28f6bcda366bdbe93311bb083f5cf214
--- /dev/null
+++ b/vendors/irmin/conf.ml
@@ -0,0 +1,149 @@
+(*
+ * Copyright (c) 2017 Daniel C. Bünzli
+ * Copyright (c) 2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type 'a parser = string -> ('a, [ `Msg of string ]) result
+
+type 'a printer = 'a Fmt.t
+
+type 'a converter = 'a parser * 'a printer
+
+let parser (p, _) = p
+
+let printer (_, p) = p
+
+let str = Printf.sprintf
+
+let quote s = str "`%s'" s
+
+module Err = struct
+  let alts = function
+    | [ a; b ] -> str "either %s or %s" a b
+    | alts -> str "one of: %s" (String.concat ", " alts)
+
+  let invalid kind s exp = str "invalid %s %s, %s" kind (quote s) exp
+
+  let invalid_val = invalid "value"
+end
+
+let bool =
+  ( (fun s ->
+      try Ok (bool_of_string s)
+      with Invalid_argument _ ->
+        Error (`Msg (Err.invalid_val s (Err.alts [ "true"; "false" ])))),
+    Fmt.bool )
+
+let parse_with t_of_str exp s =
+  try Ok (t_of_str s) with Failure _ -> Error (`Msg (Err.invalid_val s exp))
+
+let int = (parse_with int_of_string "expected an integer", Fmt.int)
+
+let string = ((fun s -> Ok s), Fmt.string)
+
+let some (parse, print) =
+  let none = "" in
+  ( (fun s -> match parse s with Ok v -> Ok (Some v) | Error _ as e -> e),
+    fun ppf v ->
+      match v with None -> Fmt.string ppf none | Some v -> print ppf v )
+
+let uri =
+  let parse s = Ok (Uri.of_string s) in
+  let print pp u = Fmt.string pp (Uri.to_string u) in
+  (parse, print)
+
+module Univ = struct
+  type t = exn
+
+  let create (type s) () =
+    let module M = struct
+      exception E of s option
+    end in
+    ((fun x -> M.E (Some x)), function M.E x -> x | _ -> None)
+end
+
+type 'a key = {
+  id : int;
+  to_univ : 'a -> Univ.t;
+  of_univ : Univ.t -> 'a option;
+  name : string;
+  doc : string option;
+  docv : string option;
+  docs : string option;
+  conv : 'a converter;
+  default : 'a;
+}
+
+let name t = t.name
+
+let doc t = t.doc
+
+let docv t = t.docv
+
+let docs t = t.docs
+
+let conv t = t.conv
+
+let default t = t.default
+
+let key ?docs ?docv ?doc name conv default =
+  let () =
+    String.iter
+      (function
+        | '-' | '_' | 'a' .. 'z' | '0' .. '9' -> ()
+        | _ -> raise @@ Invalid_argument name)
+      name
+  in
+  let to_univ, of_univ = Univ.create () in
+  let id = Oo.id (object end) in
+  { id; to_univ; of_univ; name; docs; docv; doc; conv; default }
+
+module Id = struct
+  type t = int
+
+  let compare (x : int) (y : int) = compare x y
+end
+
+module M = Map.Make (Id)
+
+type t = Univ.t M.t
+
+let empty = M.empty
+
+let singleton k v = M.singleton k.id (k.to_univ v)
+
+let is_empty = M.is_empty
+
+let mem d k = M.mem k.id d
+
+let add d k v = M.add k.id (k.to_univ v) d
+
+let union r s = M.fold M.add r s
+
+let rem d k = M.remove k.id d
+
+let find d k = try k.of_univ (M.find k.id d) with Not_found -> None
+
+let get d k =
+  try
+    match k.of_univ (M.find k.id d) with
+    | Some v -> v
+    | None -> raise Not_found
+  with Not_found -> k.default
+
+(* ~root *)
+let root =
+  key ~docv:"ROOT" ~doc:"The location of the Git repository root."
+    ~docs:"COMMON OPTIONS" "root" (some string) None
diff --git a/vendors/irmin/conf.mli b/vendors/irmin/conf.mli
new file mode 100644
index 0000000000000000000000000000000000000000..c8449b2e71943aff62ee79d2849eeb41d39ffe93
--- /dev/null
+++ b/vendors/irmin/conf.mli
@@ -0,0 +1,81 @@
+(*
+ * Copyright (c) 2017 Daniel C. Bünzli
+ * Copyright (c) 2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type 'a parser = string -> ('a, [ `Msg of string ]) result
+
+type 'a printer = 'a Fmt.t
+
+type 'a converter = 'a parser * 'a printer
+
+val parser : 'a converter -> 'a parser
+
+val printer : 'a converter -> 'a printer
+
+val bool : bool converter
+
+val int : int converter
+
+val string : string converter
+
+val some : 'a converter -> 'a option converter
+
+val uri : Uri.t converter
+
+type 'a key
+
+val key :
+  ?docs:string ->
+  ?docv:string ->
+  ?doc:string ->
+  string ->
+  'a converter ->
+  'a ->
+  'a key
+
+val name : 'a key -> string
+
+val docs : 'a key -> string option
+
+val docv : 'a key -> string option
+
+val doc : 'a key -> string option
+
+val conv : 'a key -> 'a converter
+
+val default : 'a key -> 'a
+
+val root : string option key
+
+type t
+
+val empty : t
+
+val singleton : 'a key -> 'a -> t
+
+val is_empty : t -> bool
+
+val mem : t -> 'a key -> bool
+
+val add : t -> 'a key -> 'a -> t
+
+val rem : t -> 'a key -> t
+
+val union : t -> t -> t
+
+val find : t -> 'a key -> 'a option
+
+val get : t -> 'a key -> 'a
diff --git a/vendors/irmin/contents.ml b/vendors/irmin/contents.ml
new file mode 100644
index 0000000000000000000000000000000000000000..16f39bbdac3876aa2937d55fa6cfa15accc9670c
--- /dev/null
+++ b/vendors/irmin/contents.ml
@@ -0,0 +1,317 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+
+let lexeme e x = ignore (Jsonm.encode e (`Lexeme x))
+
+let rec encode_json e = function
+  | `Null -> lexeme e `Null
+  | `Bool b -> lexeme e (`Bool b)
+  | `String s -> lexeme e (`String s)
+  | `Float f -> lexeme e (`Float f)
+  | `A a ->
+      lexeme e `As;
+      List.iter (encode_json e) a;
+      lexeme e `Ae
+  | `O o ->
+      lexeme e `Os;
+      List.iter
+        (fun (k, v) ->
+          lexeme e (`Name k);
+          encode_json e v)
+        o;
+      lexeme e `Oe
+
+let decode_json d =
+  let decode d =
+    match Jsonm.decode d with
+    | `Lexeme l -> l
+    | `Error e -> failwith (Fmt.strf "%a" Jsonm.pp_error e)
+    | _ -> failwith "invalid JSON encoding"
+  in
+  let rec unwrap v d =
+    match v with
+    | `Os -> obj [] d
+    | `As -> arr [] d
+    | (`Null | `Bool _ | `String _ | `Float _) as v -> v
+    | _ -> failwith "invalid JSON value"
+  and arr vs d =
+    match decode d with
+    | `Ae -> `A (List.rev vs)
+    | v ->
+        let v = unwrap v d in
+        arr (v :: vs) d
+  and obj ms d =
+    match decode d with
+    | `Oe -> `O (List.rev ms)
+    | `Name k ->
+        let v = unwrap (decode d) d in
+        obj ((k, v) :: ms) d
+    | _ -> failwith "invalid JSON object"
+  in
+  try Ok (unwrap (decode d) d) with Failure msg -> Error (`Msg msg)
+
+type json =
+  [ `Null
+  | `Bool of bool
+  | `String of string
+  | `Float of float
+  | `O of (string * json) list
+  | `A of json list ]
+
+module Json_value = struct
+  type t = json
+
+  let pp fmt x =
+    let buffer = Buffer.create 32 in
+    let encoder = Jsonm.encoder (`Buffer buffer) in
+    encode_json encoder x;
+    ignore @@ Jsonm.encode encoder `End;
+    let s = Buffer.contents buffer in
+    Fmt.pf fmt "%s" s
+
+  let of_string s =
+    let decoder = Jsonm.decoder (`String s) in
+    match decode_json decoder with Ok obj -> Ok obj | Error _ as err -> err
+
+  let t =
+    let open Type in
+    mu (fun ty ->
+        variant "json" (fun null bool string float obj arr ->
+          function
+          | `Null -> null
+          | `Bool b -> bool b
+          | `String s -> string s
+          | `Float f -> float f
+          | `O o -> obj o
+          | `A a -> arr a)
+        |~ case0 "null" `Null
+        |~ case1 "bool" bool (fun x -> `Bool x)
+        |~ case1 "string" string (fun x -> `String x)
+        |~ case1 "float" float (fun x -> `Float x)
+        |~ case1 "object" (list (pair string ty)) (fun obj -> `O obj)
+        |~ case1 "array" (list ty) (fun arr -> `A arr)
+        |> sealv)
+
+  let rec equal a b =
+    match (a, b) with
+    | `Null, `Null -> true
+    | `Bool a, `Bool b -> Type.(equal bool) a b
+    | `String a, `String b -> String.equal a b
+    | `Float a, `Float b -> Type.(equal float) a b
+    | `A a, `A b -> (
+        try List.for_all2 (fun a' b' -> equal a' b') a b
+        with Invalid_argument _ -> false )
+    | `O a, `O b -> (
+        let compare_fst (a, _) (b, _) = compare a b in
+        try
+          List.for_all2
+            (fun (k, v) (k', v') -> k = k' && equal v v')
+            (List.sort compare_fst a) (List.sort compare_fst b)
+        with Invalid_argument _ -> false )
+    | _, _ -> false
+
+  let t = Type.like ~equal ~cli:(pp, of_string) t
+
+  let rec merge_object ~old x y =
+    let open Merge.Infix in
+    let m =
+      Merge.(alist Type.string t (fun _key -> option (v t merge_value)))
+    in
+    Merge.(f m ~old x y) >>=* fun x -> Merge.ok (`O x)
+
+  and merge_float ~old x y =
+    let open Merge.Infix in
+    Merge.(f float ~old x y) >>=* fun f -> Merge.ok (`Float f)
+
+  and merge_string ~old x y =
+    let open Merge.Infix in
+    Merge.(f string ~old x y) >>=* fun s -> Merge.ok (`String s)
+
+  and merge_bool ~old x y =
+    let open Merge.Infix in
+    Merge.(f bool ~old x y) >>=* fun b -> Merge.ok (`Bool b)
+
+  and merge_array ~old x y =
+    let open Merge.Infix in
+    Merge.(f (Merge.idempotent (Type.list t)) ~old x y) >>=* fun x ->
+    Merge.ok (`A x)
+
+  and merge_value ~old x y =
+    let open Merge.Infix in
+    old () >>=* fun old ->
+    match (old, x, y) with
+    | Some `Null, _, _ -> merge_value ~old:(fun () -> Merge.ok None) x y
+    | None, `Null, `Null -> Merge.ok `Null
+    | Some (`Float old), `Float a, `Float b ->
+        merge_float ~old:(fun () -> Merge.ok (Some old)) a b
+    | None, `Float a, `Float b ->
+        merge_float ~old:(fun () -> Merge.ok None) a b
+    | Some (`String old), `String a, `String b ->
+        merge_string ~old:(fun () -> Merge.ok (Some old)) a b
+    | None, `String a, `String b ->
+        merge_string ~old:(fun () -> Merge.ok None) a b
+    | Some (`Bool old), `Bool a, `Bool b ->
+        merge_bool ~old:(fun () -> Merge.ok (Some old)) a b
+    | None, `Bool a, `Bool b -> merge_bool ~old:(fun () -> Merge.ok None) a b
+    | Some (`A old), `A a, `A b ->
+        merge_array ~old:(fun () -> Merge.ok (Some old)) a b
+    | None, `A a, `A b -> merge_array ~old:(fun () -> Merge.ok None) a b
+    | Some (`O old), `O a, `O b ->
+        merge_object ~old:(fun () -> Merge.ok (Some old)) a b
+    | None, `O a, `O b -> merge_object ~old:(fun () -> Merge.ok None) a b
+    | _, _, _ -> Merge.conflict "Conflicting JSON datatypes"
+
+  let merge_json = Merge.(v t merge_value)
+
+  let merge = Merge.(option merge_json)
+end
+
+module Json = struct
+  type t = (string * json) list
+
+  let pp fmt x =
+    let buffer = Buffer.create 32 in
+    let encoder = Jsonm.encoder (`Buffer buffer) in
+    encode_json encoder (`O x);
+    ignore @@ Jsonm.encode encoder `End;
+    let s = Buffer.contents buffer in
+    Fmt.pf fmt "%s" s
+
+  let of_string s =
+    let decoder = Jsonm.decoder (`String s) in
+    match decode_json decoder with
+    | Ok (`O obj) -> Ok obj
+    | Ok _ -> Error (`Msg "Irmin JSON values must be objects")
+    | Error _ as err -> err
+
+  let equal a b = Json_value.equal (`O a) (`O b)
+
+  let t = Type.(list (pair string Json_value.t))
+
+  let t = Type.like ~equal ~cli:(pp, of_string) t
+
+  let merge =
+    Merge.(option (alist Type.string Json_value.t (fun _ -> Json_value.merge)))
+end
+
+module Json_tree (Store : S.STORE with type contents = json) = struct
+  include Json_value
+
+  let to_concrete_tree j : Store.Tree.concrete =
+    let rec obj j acc =
+      match j with
+      | [] -> `Tree acc
+      | (k, v) :: l -> (
+          match Type.of_string Store.Key.step_t k with
+          | Ok key -> obj l ((key, node v []) :: acc)
+          | _ -> obj l acc )
+    and node j acc =
+      match j with
+      | `O j -> obj j acc
+      | _ -> `Contents (j, Store.Metadata.default)
+    in
+    node j []
+
+  let of_concrete_tree c : json =
+    let step = Type.to_string Store.Key.step_t in
+    let rec tree t acc =
+      match t with
+      | [] -> `O acc
+      | (k, v) :: l -> tree l ((step k, contents v []) :: acc)
+    and contents t acc =
+      match t with `Contents (c, _) -> c | `Tree c -> tree c acc
+    in
+    contents c []
+
+  let set_tree (tree : Store.tree) key j : Store.tree Lwt.t =
+    let c = to_concrete_tree j in
+    let c = Store.Tree.of_concrete c in
+    Store.Tree.add_tree tree key c
+
+  let get_tree (tree : Store.tree) key =
+    Store.Tree.get_tree tree key >>= fun t ->
+    Store.Tree.to_concrete t >|= fun c -> of_concrete_tree c
+
+  let set t key j ~info =
+    set_tree Store.Tree.empty Store.Key.empty j >>= function
+    | tree -> Store.set_tree_exn ~info t key tree
+
+  let get t key =
+    Store.get_tree t key >>= fun tree -> get_tree tree Store.Key.empty
+end
+
+module String = struct
+  type t = string
+
+  let t = Type.string
+
+  let merge = Merge.idempotent Type.(option string)
+end
+
+module type STORE = S.CONTENTS_STORE
+
+module Store (S : sig
+  include S.CONTENT_ADDRESSABLE_STORE
+
+  module Key : S.HASH with type t = key
+
+  module Val : S.CONTENTS with type t = value
+end) =
+struct
+  module Key = Hash.Typed (S.Key) (S.Val)
+  module Val = S.Val
+
+  type 'a t = 'a S.t
+
+  type key = S.key
+
+  type value = S.value
+
+  let find = S.find
+
+  let add = S.add
+
+  let unsafe_add = S.unsafe_add
+
+  let mem = S.mem
+
+  let read_opt t = function None -> Lwt.return_none | Some k -> find t k
+
+  let add_opt t = function
+    | None -> Lwt.return_none
+    | Some v -> add t v >>= fun k -> Lwt.return_some k
+
+  let merge t =
+    Merge.like_lwt Type.(option Key.t) Val.merge (read_opt t) (add_opt t)
+end
+
+module V1 = struct
+  module String = struct
+    include String
+
+    let t = Type.string_of `Int64
+
+    let size_of ?headers:_ = Type.size_of ~headers:true t
+
+    let decode_bin ?headers:_ = Type.decode_bin ~headers:true t
+
+    let encode_bin ?headers:_ = Type.encode_bin ~headers:true t
+
+    let t = Type.like t ~bin:(encode_bin, decode_bin, size_of)
+  end
+end
diff --git a/vendors/irmin/contents.mli b/vendors/irmin/contents.mli
new file mode 100644
index 0000000000000000000000000000000000000000..4a1d0fd840a30bf69c784f2029cbba3424d785c8
--- /dev/null
+++ b/vendors/irmin/contents.mli
@@ -0,0 +1,63 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Values. *)
+
+type json =
+  [ `Null
+  | `Bool of bool
+  | `String of string
+  | `Float of float
+  | `O of (string * json) list
+  | `A of json list ]
+
+module String : S.CONTENTS with type t = string
+
+module Json : S.CONTENTS with type t = (string * json) list
+
+module Json_value : S.CONTENTS with type t = json
+
+module Json_tree (Store : S.STORE with type contents = json) : sig
+  include S.CONTENTS with type t = json
+
+  val to_concrete_tree : t -> Store.Tree.concrete
+
+  val of_concrete_tree : Store.Tree.concrete -> t
+
+  val get_tree : Store.tree -> Store.key -> json Lwt.t
+
+  val set_tree : Store.tree -> Store.key -> json -> Store.tree Lwt.t
+
+  val get : Store.t -> Store.key -> json Lwt.t
+
+  val set : Store.t -> Store.key -> json -> info:Info.f -> unit Lwt.t
+end
+
+module V1 : sig
+  module String : S.CONTENTS with type t = string
+end
+
+module Store (C : sig
+  include S.CONTENT_ADDRESSABLE_STORE
+
+  module Key : S.HASH with type t = key
+
+  module Val : S.CONTENTS with type t = value
+end) :
+  S.CONTENTS_STORE
+    with type 'a t = 'a C.t
+     and type key = C.key
+     and type value = C.value
diff --git a/vendors/irmin/diff.ml b/vendors/irmin/diff.ml
new file mode 100644
index 0000000000000000000000000000000000000000..794237325fd3a0023b643f9fb26a02c2d7dae404
--- /dev/null
+++ b/vendors/irmin/diff.ml
@@ -0,0 +1,27 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type 'a t = [ `Updated of 'a * 'a | `Removed of 'a | `Added of 'a ]
+
+let t a =
+  let open Type in
+  variant "diff" (fun updated removed added ->
+    function
+    | `Updated x -> updated x | `Removed x -> removed x | `Added x -> added x)
+  |~ case1 "updated" (pair a a) (fun x -> `Updated x)
+  |~ case1 "removed" a (fun x -> `Removed x)
+  |~ case1 "added" a (fun x -> `Added x)
+  |> sealv
diff --git a/vendors/irmin/diff.mli b/vendors/irmin/diff.mli
new file mode 100644
index 0000000000000000000000000000000000000000..06b66ea1f47f9b7c1cd14c2c3229932b144f2e91
--- /dev/null
+++ b/vendors/irmin/diff.mli
@@ -0,0 +1,19 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type 'a t = [ `Updated of 'a * 'a | `Removed of 'a | `Added of 'a ]
+
+val t : 'a Type.t -> 'a t Type.t
diff --git a/vendors/irmin/dot.ml b/vendors/irmin/dot.ml
new file mode 100644
index 0000000000000000000000000000000000000000..30217f2a5d9e40246cbb36ec760087c84a1cb174
--- /dev/null
+++ b/vendors/irmin/dot.ml
@@ -0,0 +1,217 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+open Printf
+open Astring
+
+let src = Logs.Src.create "irmin.dot" ~doc:"Irmin dot graph output"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+module type S = sig
+  type db
+
+  val output_buffer :
+    db ->
+    ?html:bool ->
+    ?depth:int ->
+    ?full:bool ->
+    date:(int64 -> string) ->
+    Buffer.t ->
+    unit Lwt.t
+end
+
+exception Utf8_failure
+
+let is_valid_utf8 str =
+  try
+    Uutf.String.fold_utf_8
+      (fun _ _ -> function `Malformed _ -> raise Utf8_failure | _ -> ())
+      () str;
+    true
+  with Utf8_failure -> false
+
+module Make (S : S.STORE) = struct
+  type db = S.t
+
+  module Branch = S.Private.Branch
+  module Contents = S.Private.Contents
+  module Node = S.Private.Node
+  module Commit = S.Private.Commit
+  module Slice = S.Private.Slice
+  module Graph =
+    Object_graph.Make (Contents.Key) (Node.Metadata) (Node.Key) (Commit.Key)
+      (Branch.Key)
+
+  let fprintf (t : db) ?depth ?(html = false) ?full ~date name =
+    Log.debug (fun f ->
+        f "fprintf depth=%s html=%b full=%s"
+          (match depth with None -> "<none>" | Some d -> string_of_int d)
+          html
+          (match full with None -> "<none>" | Some b -> string_of_bool b));
+    S.Repo.export ?full ?depth (S.repo t) >>= fun slice ->
+    let vertex = Hashtbl.create 102 in
+    let add_vertex v l = Hashtbl.add vertex v l in
+    let mem_vertex v = Hashtbl.mem vertex v in
+    let edges = ref [] in
+    let add_edge v1 l v2 =
+      if mem_vertex v1 && mem_vertex v2 then edges := (v1, l, v2) :: !edges
+    in
+    let string_of_key t k =
+      let s = Type.to_string t k in
+      if String.length s <= 8 then s else String.with_range s ~len:8
+    in
+    let string_of_contents s =
+      let s =
+        if String.length s <= 10 then s else String.with_range s ~len:10
+      in
+      let s = if is_valid_utf8 s then s else "<blob>" in
+      s
+    in
+    let label_of_node k _ =
+      let s =
+        ( if html then
+          sprintf "<div class='node'><div class='sha1'>%s</div></div>"
+        else fun x -> x )
+          (string_of_key Node.Key.t k)
+      in
+      `Label s
+    in
+    let label_of_step l =
+      let l = Type.to_string S.Key.step_t l in
+      let s =
+        (if html then sprintf "<div class='path'>%s</div>" else fun x -> x)
+          (string_of_contents l)
+      in
+      `Label s
+    in
+    let label_of_commit k c =
+      let k = string_of_key Commit.Key.t k in
+      let o = Commit.Val.info c in
+      let s =
+        if html then
+          sprintf
+            "<div class='commit'>\n\
+            \  <div class='sha1'>%s</div>\n\
+            \  <div class='author'>%s</div>\n\
+            \  <div class='date'>%s</div>\n\
+            \  <div class='message'><pre>%s</pre></div>\n\
+            \  <div>&nbsp</div>\n\
+             </div>"
+            k (Info.author o)
+            (date (Info.date o))
+            (String.Ascii.escape (Info.message o))
+        else sprintf "%s" k
+      in
+      `Label s
+    in
+    let label_of_contents k v =
+      let k = string_of_key Contents.Key.t k in
+      let s =
+        if html then
+          sprintf
+            "<div class='contents'>\n\
+            \  <div class='sha1'>%s</div>\n\
+            \  <div>&nbsp</div>\n\
+             </div>"
+            k
+        else
+          let v = string_of_contents (Type.to_string Contents.Val.t v) in
+          sprintf "%s (%s)" k (String.Ascii.escape_string v)
+      in
+      `Label s
+    in
+    let label_of_tag t =
+      let s =
+        if html then
+          sprintf "<div class='tag'>%s</div>" (Type.to_string Branch.Key.t t)
+        else Type.to_string Branch.Key.t t
+      in
+      `Label s
+    in
+    let contents = ref [] in
+    let nodes = ref [] in
+    let commits = ref [] in
+    Slice.iter slice (function
+      | `Contents c ->
+          contents := c :: !contents;
+          Lwt.return_unit
+      | `Node n ->
+          nodes := n :: !nodes;
+          Lwt.return_unit
+      | `Commit c ->
+          commits := c :: !commits;
+          Lwt.return_unit)
+    >>= fun () ->
+    List.iter
+      (fun (k, c) ->
+        add_vertex (`Contents k) [ `Shape `Box; label_of_contents k c ])
+      !contents;
+    List.iter
+      (fun (k, t) ->
+        add_vertex (`Node k) [ `Shape `Box; `Style `Dotted; label_of_node k t ])
+      !nodes;
+    List.iter
+      (fun (k, r) ->
+        add_vertex (`Commit k)
+          [ `Shape `Box; `Style `Bold; label_of_commit k r ])
+      !commits;
+    List.iter
+      (fun (k, t) ->
+        List.iter
+          (fun (l, v) ->
+            match v with
+            | `Contents (v, _meta) ->
+                add_edge (`Node k)
+                  [ `Style `Dotted; label_of_step l ]
+                  (`Contents v)
+            | `Node n ->
+                add_edge (`Node k) [ `Style `Solid; label_of_step l ] (`Node n))
+          (Node.Val.list t))
+      !nodes;
+    List.iter
+      (fun (k, r) ->
+        List.iter
+          (fun c -> add_edge (`Commit k) [ `Style `Bold ] (`Commit c))
+          (Commit.Val.parents r);
+        add_edge (`Commit k) [ `Style `Dashed ] (`Node (Commit.Val.node r)))
+      !commits;
+    let branch_t = S.Private.Repo.branch_t (S.repo t) in
+    Branch.list branch_t >>= fun bs ->
+    Lwt_list.iter_s
+      (fun r ->
+        Branch.find branch_t r >|= function
+        | None -> ()
+        | Some k ->
+            add_vertex (`Branch r)
+              [ `Shape `Plaintext; label_of_tag r; `Style `Filled ];
+            add_edge (`Branch r) [ `Style `Bold ] (`Commit k))
+      bs
+    >|= fun () ->
+    let map = function
+      | `Contents c -> `Contents (c, Node.Metadata.default)
+      | (`Commit _ | `Node _ | `Branch _) as k -> k
+    in
+    let vertex = Hashtbl.fold (fun k v acc -> (map k, v) :: acc) vertex [] in
+    let edges = List.map (fun (k, l, v) -> (map k, l, map v)) !edges in
+    fun ppf -> Graph.output ppf vertex edges name
+
+  let output_buffer t ?html ?depth ?full ~date buf =
+    fprintf t ?depth ?full ?html ~date "graph" >|= fun fprintf ->
+    let ppf = Format.formatter_of_buffer buf in
+    fprintf ppf
+end
diff --git a/vendors/irmin/dot.mli b/vendors/irmin/dot.mli
new file mode 100644
index 0000000000000000000000000000000000000000..88c2cf2ab6325cacf4da5bb88f11b6b49327b85c
--- /dev/null
+++ b/vendors/irmin/dot.mli
@@ -0,0 +1,32 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Store dumps. *)
+
+module type S = sig
+  type db
+
+  val output_buffer :
+    db ->
+    ?html:bool ->
+    ?depth:int ->
+    ?full:bool ->
+    date:(int64 -> string) ->
+    Buffer.t ->
+    unit Lwt.t
+end
+
+module Make (S : S.STORE) : S with type db = S.t
diff --git a/vendors/irmin/dune b/vendors/irmin/dune
new file mode 100644
index 0000000000000000000000000000000000000000..b2bf4a0c89497f6e377888b167c254eddda56961
--- /dev/null
+++ b/vendors/irmin/dune
@@ -0,0 +1,4 @@
+(library
+ (name        irmin)
+ (public_name irmin)
+ (libraries   fmt uri jsonm lwt ocamlgraph logs astring base64 digestif logs.fmt))
diff --git a/vendors/irmin/hash.ml b/vendors/irmin/hash.ml
new file mode 100644
index 0000000000000000000000000000000000000000..487203c77cc1400d2b0f9cc1b87208e50e13bfdd
--- /dev/null
+++ b/vendors/irmin/hash.ml
@@ -0,0 +1,82 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module Make (H : Digestif.S) = struct
+  type t = H.t
+
+  external get_64 : string -> int -> int64 = "%caml_string_get64u"
+
+  let short_hash c = Int64.to_int (get_64 (H.to_raw_string c) 0)
+
+  let hash_size = H.digest_size
+
+  let of_hex s =
+    match H.consistent_of_hex s with
+    | x -> Ok x
+    | exception Invalid_argument e -> Error (`Msg e)
+
+  let pp_hex ppf x = Fmt.string ppf (H.to_hex x)
+
+  let t =
+    Type.map ~cli:(pp_hex, of_hex)
+      Type.(string_of (`Fixed hash_size))
+      H.of_raw_string H.to_raw_string
+
+  let hash s = H.digesti_string s
+end
+
+module SHA1 = Make (Digestif.SHA1)
+module RMD160 = Make (Digestif.RMD160)
+module SHA224 = Make (Digestif.SHA224)
+module SHA256 = Make (Digestif.SHA256)
+module SHA384 = Make (Digestif.SHA384)
+module SHA512 = Make (Digestif.SHA512)
+module BLAKE2B = Make (Digestif.BLAKE2B)
+module BLAKE2S = Make (Digestif.BLAKE2S)
+
+module Typed (K : S.HASH) (V : Type.S) = struct
+  include K
+
+  type value = V.t
+
+  let hash v = K.hash (Type.pre_hash V.t v)
+end
+
+module V1 (K : S.HASH) : S.HASH with type t = K.t = struct
+  type t = K.t
+
+  let hash = K.hash
+
+  let short_hash = K.short_hash
+
+  let hash_size = K.hash_size
+
+  let h = Type.string_of `Int64
+
+  let size_of ?headers x = Type.size_of ?headers h (Type.to_bin_string K.t x)
+
+  let encode_bin ?headers e k =
+    Type.encode_bin ?headers h (Type.to_bin_string K.t e) k
+
+  let decode_bin ?headers buf off =
+    let n, v = Type.decode_bin ?headers h buf off in
+    ( n,
+      match Type.of_bin_string K.t v with
+      | Ok v -> v
+      | Error (`Msg e) -> Fmt.failwith "decode_bin: %s" e )
+
+  let t = Type.like K.t ~bin:(encode_bin, decode_bin, size_of)
+end
diff --git a/vendors/irmin/hash.mli b/vendors/irmin/hash.mli
new file mode 100644
index 0000000000000000000000000000000000000000..b8a9b9f82b658444fb069868cff40307c237b0ec
--- /dev/null
+++ b/vendors/irmin/hash.mli
@@ -0,0 +1,40 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Implementation of keys *)
+
+module Make (H : Digestif.S) : S.HASH with type t = H.t
+
+module SHA1 : S.HASH
+
+module RMD160 : S.HASH
+
+module SHA224 : S.HASH
+
+module SHA256 : S.HASH
+
+module SHA384 : S.HASH
+
+module SHA512 : S.HASH
+
+module BLAKE2B : S.HASH
+
+module BLAKE2S : S.HASH
+
+module Typed (K : S.HASH) (V : Type.S) :
+  S.TYPED_HASH with type t = K.t and type value = V.t
+
+module V1 (H : S.HASH) : S.HASH with type t = H.t
diff --git a/vendors/irmin/info.ml b/vendors/irmin/info.ml
new file mode 100644
index 0000000000000000000000000000000000000000..55a7a6ffc2baa87c5b54eb5e1b667a47f14791c5
--- /dev/null
+++ b/vendors/irmin/info.ml
@@ -0,0 +1,45 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type t = { date : int64; author : string; message : string }
+
+let t =
+  let open Type in
+  record "info" (fun date author message -> { date; author; message })
+  |+ field "date" int64 (fun t -> t.date)
+  |+ field "author" string (fun t -> t.author)
+  |+ field "message" string (fun t -> t.message)
+  |> sealr
+
+type f = unit -> t
+
+let create ~date ~author message = { date; message; author }
+
+let with_message t message = { t with message }
+
+let empty = { date = 0L; author = ""; message = "" }
+
+let v ~date ~author message =
+  if date = 0L && author = "" && message = "" then empty
+  else create ~date ~author message
+
+let date t = t.date
+
+let author t = t.author
+
+let message t = t.message
+
+let none () = empty
diff --git a/vendors/irmin/info.mli b/vendors/irmin/info.mli
new file mode 100644
index 0000000000000000000000000000000000000000..131e787fac95bd09dc21b11060518d43ca35c453
--- /dev/null
+++ b/vendors/irmin/info.mli
@@ -0,0 +1,37 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Provenance tracking. *)
+
+type t
+
+val t : t Type.t
+
+val v : date:int64 -> author:string -> string -> t
+
+val date : t -> int64
+
+val author : t -> string
+
+val message : t -> string
+
+val with_message : t -> string -> t
+
+val empty : t
+
+type f = unit -> t
+
+val none : f
diff --git a/vendors/irmin/irmin.ml b/vendors/irmin/irmin.ml
new file mode 100644
index 0000000000000000000000000000000000000000..129b560478591ed024a34de05343d491d2171f9a
--- /dev/null
+++ b/vendors/irmin/irmin.ml
@@ -0,0 +1,375 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+module Type = Type
+module Diff = Diff
+module Content_addressable = Store.Content_addressable
+
+module Contents = struct
+  include Contents
+
+  module type S = S.CONTENTS
+
+  module type STORE = S.CONTENTS_STORE
+end
+
+module Merge = Merge
+
+module Branch = struct
+  include Branch
+
+  module type S = S.BRANCH
+
+  module type STORE = S.BRANCH_STORE
+end
+
+module Info = Info
+module Dot = Dot.Make
+
+module Hash = struct
+  include Hash
+
+  module type S = S.HASH
+
+  module type TYPED = S.TYPED_HASH
+end
+
+module Path = struct
+  include Path
+
+  module type S = S.PATH
+end
+
+exception Closed
+
+module CA_check_closed (CA : S.CONTENT_ADDRESSABLE_STORE_MAKER) :
+  S.CONTENT_ADDRESSABLE_STORE_MAKER =
+functor
+  (K : S.HASH)
+  (V : Type.S)
+  ->
+  struct
+    module S = CA (K) (V)
+
+    type 'a t = { closed : bool ref; t : 'a S.t }
+
+    type key = S.key
+
+    type value = S.value
+
+    let check_closed t = if !(t.closed) then raise Closed
+
+    let mem t k =
+      check_closed t;
+      S.mem t.t k
+
+    let find t k =
+      check_closed t;
+      S.find t.t k
+
+    let add t v =
+      check_closed t;
+      S.add t.t v
+
+    let unsafe_add t k v =
+      check_closed t;
+      S.unsafe_add t.t k v
+
+    let batch t f =
+      check_closed t;
+      S.batch t.t (fun w -> f { t = w; closed = t.closed })
+
+    let v conf = S.v conf >|= fun t -> { closed = ref false; t }
+
+    let close t =
+      if !(t.closed) then Lwt.return_unit
+      else (
+        t.closed := true;
+        S.close t.t )
+  end
+
+module AW_check_closed (AW : S.ATOMIC_WRITE_STORE_MAKER) :
+  S.ATOMIC_WRITE_STORE_MAKER =
+functor
+  (K : Type.S)
+  (V : Type.S)
+  ->
+  struct
+    module S = AW (K) (V)
+
+    type t = { closed : bool ref; t : S.t }
+
+    type key = S.key
+
+    type value = S.value
+
+    let check_closed t = if !(t.closed) then raise Closed
+
+    let mem t k =
+      check_closed t;
+      S.mem t.t k
+
+    let find t k =
+      check_closed t;
+      S.find t.t k
+
+    let set t k v =
+      check_closed t;
+      S.set t.t k v
+
+    let test_and_set t k ~test ~set =
+      check_closed t;
+      S.test_and_set t.t k ~test ~set
+
+    let remove t k =
+      check_closed t;
+      S.remove t.t k
+
+    let list t =
+      check_closed t;
+      S.list t.t
+
+    type watch = S.watch
+
+    let watch t ?init f =
+      check_closed t;
+      S.watch t.t ?init f
+
+    let watch_key t k ?init f =
+      check_closed t;
+      S.watch_key t.t k ?init f
+
+    let unwatch t w =
+      check_closed t;
+      S.unwatch t.t w
+
+    let v conf = S.v conf >|= fun t -> { closed = ref false; t }
+
+    let close t =
+      if !(t.closed) then Lwt.return_unit
+      else (
+        t.closed := true;
+        S.close t.t )
+  end
+
+module Make_ext
+    (CA : S.CONTENT_ADDRESSABLE_STORE_MAKER)
+    (AW : S.ATOMIC_WRITE_STORE_MAKER)
+    (M : S.METADATA)
+    (C : Contents.S)
+    (P : Path.S)
+    (B : Branch.S)
+    (H : Hash.S)
+    (N : S.NODE
+           with type metadata = M.t
+            and type hash = H.t
+            and type step = P.step)
+    (CT : S.COMMIT with type hash = H.t) =
+struct
+  module CA = CA_check_closed (CA)
+  module AW = AW_check_closed (AW)
+
+  module X = struct
+    module Hash = H
+
+    module Contents = struct
+      module CA = struct
+        module Key = Hash
+        module Val = C
+        include CA (Key) (Val)
+      end
+
+      include Contents.Store (CA)
+    end
+
+    module Node = struct
+      module CA = struct
+        module Key = Hash
+        module Val = N
+        include CA (Key) (Val)
+      end
+
+      include Node.Store (Contents) (P) (M) (CA)
+    end
+
+    module Commit = struct
+      module CA = struct
+        module Key = Hash
+        module Val = CT
+        include CA (Key) (Val)
+      end
+
+      include Commit.Store (Node) (CA)
+    end
+
+    module Branch = struct
+      module Key = B
+      module Val = H
+      include AW (Key) (Val)
+    end
+
+    module Slice = Slice.Make (Contents) (Node) (Commit)
+    module Sync = Sync.None (H) (B)
+
+    module Repo = struct
+      type t = {
+        config : Conf.t;
+        contents : [ `Read ] Contents.t;
+        nodes : [ `Read ] Node.t;
+        commits : [ `Read ] Commit.t;
+        branch : Branch.t;
+      }
+
+      let contents_t t = t.contents
+
+      let node_t t = t.nodes
+
+      let commit_t t = t.commits
+
+      let branch_t t = t.branch
+
+      let batch t f =
+        Contents.CA.batch t.contents @@ fun c ->
+        Node.CA.batch (snd t.nodes) @@ fun n ->
+        Commit.CA.batch (snd t.commits) @@ fun ct ->
+        let contents_t = c in
+        let node_t = (contents_t, n) in
+        let commit_t = (node_t, ct) in
+        f contents_t node_t commit_t
+
+      let v config =
+        Contents.CA.v config >>= fun contents ->
+        Node.CA.v config >>= fun nodes ->
+        Commit.CA.v config >>= fun commits ->
+        let nodes = (contents, nodes) in
+        let commits = (nodes, commits) in
+        Branch.v config >|= fun branch ->
+        { contents; nodes; commits; branch; config }
+
+      let close t =
+        Contents.CA.close t.contents >>= fun () ->
+        Node.CA.close (snd t.nodes) >>= fun () ->
+        Commit.CA.close (snd t.commits) >>= fun () -> Branch.close t.branch
+    end
+  end
+
+  include Store.Make (X)
+end
+
+module Make
+    (CA : S.CONTENT_ADDRESSABLE_STORE_MAKER)
+    (AW : S.ATOMIC_WRITE_STORE_MAKER)
+    (M : S.METADATA)
+    (C : S.CONTENTS)
+    (P : S.PATH)
+    (B : S.BRANCH)
+    (H : S.HASH) =
+struct
+  module N = Node.Make (H) (P) (M)
+  module CT = Commit.Make (H)
+  include Make_ext (CA) (AW) (M) (C) (P) (B) (H) (N) (CT)
+end
+
+module Of_private = Store.Make
+
+module type CONTENT_ADDRESSABLE_STORE = S.CONTENT_ADDRESSABLE_STORE
+
+module type APPEND_ONLY_STORE = S.APPEND_ONLY_STORE
+
+module type ATOMIC_WRITE_STORE = S.ATOMIC_WRITE_STORE
+
+module type TREE = S.TREE
+
+module type S = S.STORE
+
+type config = Conf.t
+
+type 'a diff = 'a Diff.t
+
+module type CONTENT_ADDRESSABLE_STORE_MAKER = S.CONTENT_ADDRESSABLE_STORE_MAKER
+
+module type APPEND_ONLY_STORE_MAKER = S.APPEND_ONLY_STORE_MAKER
+
+module type ATOMIC_WRITE_STORE_MAKER = S.ATOMIC_WRITE_STORE_MAKER
+
+module type S_MAKER = S.MAKER
+
+module type KV =
+  S with type key = string list and type step = string and type branch = string
+
+module type KV_MAKER = functor (C : Contents.S) -> KV with type contents = C.t
+
+module Private = struct
+  module Conf = Conf
+
+  module Node = struct
+    include Node
+
+    module type S = S.NODE
+
+    module type GRAPH = S.NODE_GRAPH
+
+    module type STORE = S.NODE_STORE
+  end
+
+  module Commit = struct
+    include Commit
+
+    module type S = S.COMMIT
+
+    module type STORE = S.COMMIT_STORE
+
+    module type HISTORY = S.COMMIT_HISTORY
+  end
+
+  module Slice = struct
+    include Slice
+
+    module type S = S.SLICE
+  end
+
+  module Sync = struct
+    include Sync
+
+    module type S = S.SYNC
+  end
+
+  module type S = S.PRIVATE
+
+  module Watch = Watch
+  module Lock = Lock
+end
+
+let version = Version.current
+
+module type SYNC = S.SYNC_STORE
+
+module Sync = Sync_ext.Make
+
+type remote = S.remote = ..
+
+let remote_store (type t) (module M : S with type t = t) (t : t) =
+  let module X : S.STORE with type t = t = M in
+  Sync_ext.remote_store (module X) t
+
+module Metadata = struct
+  module type S = S.METADATA
+
+  module None = Node.No_metadata
+end
+
+module Json_tree = Contents.Json_tree
diff --git a/vendors/irmin/irmin.mli b/vendors/irmin/irmin.mli
new file mode 100644
index 0000000000000000000000000000000000000000..28d4d95e3656349e3f8aef500028d12825f3a346
--- /dev/null
+++ b/vendors/irmin/irmin.mli
@@ -0,0 +1,3716 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Irmin public API.
+
+    [Irmin] is a library to design and use persistent stores with
+    built-in snapshot, branching and reverting mechanisms. Irmin uses
+    concepts similar to {{:http://git-scm.com/}Git} but it exposes
+    them as a high level library instead of a complex command-line
+    frontend. It features a {e bidirectional} Git backend, where an
+    application can read and persist its state using the Git format,
+    fully-compatible with the usual Git tools and workflows.
+
+    Irmin is designed to use a large variety of backends. It is
+    written in pure OCaml and does not depend on external C stubs; it
+    is thus very portable and aims to run everywhere, from Linux to
+    browser and MirageOS unikernels.
+
+    Consult the {!basics} and {!examples} of use for a quick
+    start. See also the {{!Irmin_unix}documentation} for the unix
+    backends.
+
+    {e Release %%VERSION%% - %%HOMEPAGE%% }
+*)
+
+val version : string
+(** The version of the library. *)
+
+(** {1 Preliminaries} *)
+
+(** Dynamic types for Irmin values. *)
+module Type : sig
+  (** Yet-an-other type combinator library
+
+      [Type] provides type combinators to define runtime
+      representation for OCaml types and {{!generics}generic
+      operations} to manipulate values with a runtime type
+      representation.
+
+      The type combinators supports all the usual {{!primitives}type
+      primitives} but also compact definitions of {{!records}records}
+      and {{!variants}variants}. It also allows the definition of
+      run-time representations of {{!recursive}recursive types}. *)
+
+  (** {1 Type Combinators} *)
+
+  type 'a t
+  (** The type for runtime representation of values of type ['a]. *)
+
+  type len = [ `Int | `Int8 | `Int16 | `Int32 | `Int64 | `Fixed of int ]
+  (** The type of integer used to store buffers, list or array
+     lengths. *)
+
+  (** {1:primitives Primitives} *)
+
+  val unit : unit t
+  (** [unit] is a representation of the unit type. *)
+
+  val bool : bool t
+  (** [bool] is a representation of the boolean type. *)
+
+  val char : char t
+  (** [char] is a representation of the character type. *)
+
+  val int : int t
+  (** [int] is a representation of integers. Binary serialization uses
+      a varying-width representation. *)
+
+  val int32 : int32 t
+  (** [int32] is a representation of the 32-bit integer type. *)
+
+  val int64 : int64 t
+  (** [int64] is a representation of the 64-bit integer type. *)
+
+  val float : float t
+  (** [float] is a representation of the [float] type. *)
+
+  val string : string t
+  (** [string] is a representation of the [string] type. *)
+
+  val bytes : bytes t
+  (** [bytes] is a representation of the [bytes] type. *)
+
+  val string_of : len -> string t
+  (** Like {!string} but with a given fixed size. *)
+
+  val bytes_of : len -> bytes t
+  (** Like {!bytes} but with a given fixed size. *)
+
+  val list : ?len:len -> 'a t -> 'a list t
+  (** [list t] is a representation of lists of values of type [t]. *)
+
+  val array : ?len:len -> 'a t -> 'a array t
+  (** [array t] is a representation of arrays of values of type [t]. *)
+
+  val option : 'a t -> 'a option t
+  (** [option t] is a representation of values of type [t option]. *)
+
+  val pair : 'a t -> 'b t -> ('a * 'b) t
+  (** [pair x y] is a representation of values of type [x * y]. *)
+
+  val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+  (** [triple x y z] is a representation of values of type
+      [x * y * z]. *)
+
+  val result : 'a t -> 'b t -> ('a, 'b) result t
+  (** [result a b] is a representation of values of type
+      [(a, b) result]. *)
+
+  (** {1:records Records} *)
+
+  type ('a, 'b, 'c) open_record
+  (** The type for representing open records of type ['a] with a constructor
+      of type ['b]. ['c] represents the remaining fields to be described using
+      the {!(|+)} operator. An open record initially satisfies ['c = 'b] and
+      can be {{!sealr}sealed} once ['c = 'a]. *)
+
+  val record : string -> 'b -> ('a, 'b, 'b) open_record
+  (** [record n f] is an incomplete representation of the record called [n] of
+      type ['a] with constructor [f]. To complete the representation, add fields
+      with {!(|+)} and then seal the record with {!sealr}. *)
+
+  type ('a, 'b) field
+  (** The type for fields holding values of type ['b] and belonging to a
+      record of type ['a]. *)
+
+  val field : string -> 'a t -> ('b -> 'a) -> ('b, 'a) field
+  (** [field n t g] is the representation of the field [n] of type [t]
+      with getter [g].
+
+      For instance:
+
+      {[
+        type manuscript = { title : string option }
+
+        let manuscript = field "title" (option string) (fun t -> t.title)]}
+  *)
+
+  val ( |+ ) :
+    ('a, 'b, 'c -> 'd) open_record ->
+    ('a, 'c) field ->
+    ('a, 'b, 'd) open_record
+  (** [r |+ f] is the open record [r] augmented with the field [f]. *)
+
+  val sealr : ('a, 'b, 'a) open_record -> 'a t
+  (** [sealr r] seals the open record [r]. *)
+
+  (** Putting all together:
+
+      {[
+        type menu = { restaurant: string; items: (string * int32) list; }
+
+        let t =
+          record "t" (fun restaurant items -> {restaurant; items})
+          |+ field "restaurant" string (fun t -> t.restaurant)
+          |+ field "items" (list (pair string int32)) (fun t -> t.items)
+          |> sealr]}
+  *)
+
+  (** {1:variants Variants} *)
+
+  type ('a, 'b, 'c) open_variant
+  (** The type for representing open variants of type ['a] with pattern
+      matching of type ['b]. ['c] represents the remaining constructors to
+      be described using the {!(|~)} operator. An open variant initially
+      satisfies [c' = 'b] and can be {{!sealv}sealed} once ['c = 'a]. *)
+
+  val variant : string -> 'b -> ('a, 'b, 'b) open_variant
+  (** [variant n p] is an incomplete representation of the variant type
+      called [n] of type ['a] using [p] to deconstruct values. To complete
+      the representation, add cases with {!(|~)} and then seal the variant
+      with {!sealv}. *)
+
+  type ('a, 'b) case
+  (** The type for representing variant cases of type ['a] with
+      patterns of type ['b]. *)
+
+  type 'a case_p
+  (** The type for representing patterns for a variant of type ['a]. *)
+
+  val case0 : string -> 'a -> ('a, 'a case_p) case
+  (** [case0 n v] is a representation of a variant constructor [v] with no
+      arguments and name [n]. e.g.
+
+      {[
+        type t = Foo
+
+        let foo = case0 "Foo" Foo]}
+  *)
+
+  val case1 : string -> 'b t -> ('b -> 'a) -> ('a, 'b -> 'a case_p) case
+  (** [case1 n t c] is a representation of a variant constructor [c] with an
+      argument of type [t] and name [n]. e.g.
+
+      {[
+        type t = Foo of string
+
+        let foo = case1 "Foo" string (fun s -> Foo s)]}
+  *)
+
+  val ( |~ ) :
+    ('a, 'b, 'c -> 'd) open_variant ->
+    ('a, 'c) case ->
+    ('a, 'b, 'd) open_variant
+  (** [v |~ c] is the open variant [v] augmented with the case [c]. *)
+
+  val sealv : ('a, 'b, 'a -> 'a case_p) open_variant -> 'a t
+  (** [sealv v] seals the open variant [v]. *)
+
+  (** Putting all together:
+      {[
+        type t = Foo | Bar of string
+
+        let t =
+          variant "t" (fun foo bar -> function
+              | Foo   -> foo
+              | Bar s -> bar s)
+          |~ case0 "Foo" Foo
+          |~ case1 "Bar" string (fun x -> Bar x)
+          |> sealv]}
+  *)
+
+  val enum : string -> (string * 'a) list -> 'a t
+  (** [enum n cs] is a representation of the variant type called [n]
+      with singleton cases [cs]. e.g.
+
+      {[
+        type t = Foo | Bar | Toto
+
+        let t = enum "t" ["Foo", Foo; "Bar", Bar; "Toto", Toto]]}
+  *)
+
+  (** {1:recursive Recursive definitions}
+
+      [Type] allows a limited description of recursive records and
+      variants.
+
+      {b TODO}: describe the limitations, e.g. only regular recursion
+      and no use of the generics inside the [mu*] functions and the
+      usual caveats with recursive values (such as infinite loops on
+      most of the generics which don't check sharing).
+
+  *)
+
+  val mu : ('a t -> 'a t) -> 'a t
+  (** [mu f] is the representation [r] such that [r = mu r].
+
+      For instance:
+
+      {[
+        type x = { x: x option }
+
+        let x = mu (fun x ->
+            record "x" (fun x -> { x })
+            |+ field "x" x (fun x -> x.x)
+            |> sealr)]}
+  *)
+
+  val mu2 : ('a t -> 'b t -> 'a t * 'b t) -> 'a t * 'b t
+  (** [mu2 f] is the representations [r] and [s] such that
+      [r, s = mu2 r s].
+
+      For instance:
+
+      {[
+        type r = { foo: int; bar: string list; z: z option }
+        and z = { x: int; r: r list }
+
+        (* Build the representation of [r] knowing [z]'s. *)
+        let mkr z =
+          record "r" (fun foo bar z -> { foo; bar; z })
+          |+ field "foo" int (fun t -> t.foo)
+          |+ field "bar" (list string) (fun t -> t.bar)
+          |+ field "z" (option z) (fun t -> t.z)
+          |> sealr
+
+        (* And the representation of [z] knowing [r]'s. *)
+        let mkz r =
+          record "z" (fun x r -> { x; r })
+          |+ field "x" int (fun t -> t.x)
+          |+ field "r" (list r) (fun t -> t.r)
+          |> sealr
+
+        (* Tie the loop. *)
+        let r, z = mu2 (fun r z -> mkr z, mkz y)]}
+  *)
+
+  (** {1:generics Generic Operations}
+
+      Given a value ['a t], it is possible to define generic operations
+      on value of type ['a] such as pretty-printing, parsing and
+      unparsing.
+  *)
+
+  val equal : 'a t -> 'a -> 'a -> bool
+  (** [equal t] is the equality function between values of type [t]. *)
+
+  val compare : 'a t -> 'a -> 'a -> int
+  (** [compare t] compares values of type [t]. *)
+
+  val short_hash : 'a t -> ?seed:int -> 'a -> int
+  (** [hash t x] is a short hash of [x] of type [t]. *)
+
+  type 'a pp = 'a Fmt.t
+  (** The type for pretty-printers. *)
+
+  type 'a of_string = string -> ('a, [ `Msg of string ]) result
+  (** The type for parsers. *)
+
+  val pp : 'a t -> 'a pp
+  (** [pp t] is the pretty-printer for values of type [t]. *)
+
+  val to_string : 'a t -> 'a -> string
+  (** [to_string t] is [Fmt.to_to_string (pp t)]. *)
+
+  val of_string : 'a t -> 'a of_string
+  (** [of_string t] parses values of type [t]. *)
+
+  (** {2 JSON converters} *)
+
+  module Json : sig
+    (** Overlay on top of Jsonm to work with rewindable streams. *)
+
+    type decoder
+    (** The type for JSON decoder. *)
+
+    val decoder : ?encoding:[< Jsonm.encoding ] -> [< Jsonm.src ] -> decoder
+    (** Same as {!Jsonm.decoder}. *)
+
+    val decode :
+      decoder ->
+      [> `Await | `End | `Error of Jsonm.error | `Lexeme of Jsonm.lexeme ]
+    (** Same as {!Jsonm.decode}. *)
+
+    val rewind : decoder -> Jsonm.lexeme -> unit
+    (** [rewind d l] rewinds [l] on top of the current state of
+        [d]. This allows to put back lexemes already seen. *)
+  end
+
+  type 'a encode_json = Jsonm.encoder -> 'a -> unit
+  (** The type for JSON encoders. *)
+
+  type 'a decode_json = Json.decoder -> ('a, [ `Msg of string ]) result
+  (** The type for JSON decoders. *)
+
+  val pp_json : ?minify:bool -> 'a t -> 'a Fmt.t
+  (** Similar to {!dump} but pretty-prints the JSON representation instead
+      of the OCaml one. See {!encode_json} for details about the encoding.
+
+      For instance:
+
+      {[
+        type t = { foo: int option; bar: string list };;
+
+        let t =
+          record "r" (fun foo bar -> { foo; bar })
+          |+ field "foo" (option int) (fun t -> t.foo)
+          |+ field "bar" (list string) (fun t -> t.bar)
+          |> sealr
+
+        let s = Fmt.strf "%a\n" (pp t) { foo = None; bar = ["foo"] }
+        (* s is "{ foo = None; bar = [\"foo\"]; }" *)
+
+        let j = Fmt.strf "%a\n" (pp_json t) { foo = None; bar = ["foo"] }
+        (* j is "{ \"bar\":[\"foo\"] }" *)]}
+
+      {b NOTE:} this will automatically convert JSON fragments to valid
+      JSON objects by adding an enclosing array if necessary. *)
+
+  val encode_json : 'a t -> Jsonm.encoder -> 'a -> unit
+  (** [encode_json t e] encodes [t] into the
+      {{:http://erratique.ch/software/jsonm}jsonm} encoder [e]. The
+      encoding is a relatively straightforward translation of the OCaml
+      structure into JSON. The main highlights are:
+
+      {ul
+      {- OCaml [ints] are translated into JSON floats.}
+      {- OCaml strings are translated into JSON strings. You must then
+         ensure that the OCaml strings contains only valid UTF-8
+         characters.}
+      {- OCaml record fields of type ['a option] are automatically
+         unboxed in their JSON representation. If the value if [None],
+         the field is removed from the JSON object.}
+      {- variant cases built using {!case0} are represented as strings.}
+      {- variant cases built using {!case1} are represented as a record
+         with one field; the field name is the name of the variant.}
+      }
+
+      {b NOTE:} this can be used to encode JSON fragments. It's the
+      responsibility of the caller to ensure that the encoded JSON
+      fragment fits properly into a well-formed JSON object. *)
+
+  val decode_json : 'a t -> Jsonm.decoder -> ('a, [ `Msg of string ]) result
+  (** [decode_json t e] decodes values of type [t] from the
+      {{:http://erratique.ch/software/jsonm}jsonm} decoder [e]. *)
+
+  val decode_json_lexemes :
+    'a t -> Jsonm.lexeme list -> ('a, [ `Msg of string ]) result
+  (** [decode_json_lexemes] is similar to {!decode_json} but uses an
+      already decoded list of JSON lexemes instead of a decoder. *)
+
+  val to_json_string : ?minify:bool -> 'a t -> 'a -> string
+  (** [to_json_string] is {!encode_json} with a string encoder. *)
+
+  val of_json_string : 'a t -> string -> ('a, [ `Msg of string ]) result
+  (** [of_json_string] is {!decode_json} with a string decoder .*)
+
+  (** {2 Binary Converters} *)
+
+  type 'a bin_seq = 'a -> (string -> unit) -> unit
+
+  type 'a encode_bin = ?headers:bool -> 'a bin_seq
+  (** The type for binary encoders. If [headers] is not set, do not
+     output extra length headers for buffers. *)
+
+  type 'a decode_bin = ?headers:bool -> string -> int -> int * 'a
+  (** The type for binary decoders. IF [headers] is not set, do not
+     read extra length header for buffers and consider the whole
+     buffer instead. *)
+
+  type 'a size_of = ?headers:bool -> 'a -> int option
+  (** The type for size function related to binary encoder/decoders. *)
+
+  val pre_hash : 'a t -> 'a bin_seq
+  (** [pre_hash t x] is the string representation of [x], of type
+      [t], which will be used to compute the digest of the value. By
+      default it's [to_bin_string t x] but it can be overriden by {!v},
+      {!like} and {!map} operators. *)
+
+  val encode_bin : 'a t -> 'a encode_bin
+  (** [encode_bin t] is the binary encoder for values of type [t]. *)
+
+  val decode_bin : 'a t -> 'a decode_bin
+  (** [decode_bin t] is the binary decoder for values of type [t]. *)
+
+  val to_bin_string : 'a t -> 'a -> string
+  (** [to_bin_string t x] use {!encode_bin} to convert [x], of type
+     [t], to a string.
+
+      {b NOTE:} When [t] is {!Type.string} or {!Type.bytes}, the
+     original buffer [x] is not prefixed by its size as {!encode_bin}
+     would do. If [t] is {!Type.string}, the result is [x] (without
+     copy). *)
+
+  val of_bin_string : 'a t -> string -> ('a, [ `Msg of string ]) result
+  (** [of_bin_string t s] is [v] such that [s = to_bin_string t v].
+
+      {b NOTE:} When [t] is {!Type.string}, the result is [s] (without
+     copy). *)
+
+  val size_of : 'a t -> 'a size_of
+  (** [size_of t x] is either the size of [encode_bin t x] or the
+     binary encoding of [x], if the backend is not able to pre-compute
+     serialisation lengths. *)
+
+  (** {1 Customs converters} *)
+
+  val v :
+    cli:'a pp * 'a of_string ->
+    json:'a encode_json * 'a decode_json ->
+    bin:'a encode_bin * 'a decode_bin * 'a size_of ->
+    equal:('a -> 'a -> bool) ->
+    compare:('a -> 'a -> int) ->
+    short_hash:(?seed:int -> 'a -> int) ->
+    pre_hash:'a bin_seq ->
+    'a t
+
+  val like :
+    ?cli:'a pp * 'a of_string ->
+    ?json:'a encode_json * 'a decode_json ->
+    ?bin:'a encode_bin * 'a decode_bin * 'a size_of ->
+    ?equal:('a -> 'a -> bool) ->
+    ?compare:('a -> 'a -> int) ->
+    ?short_hash:('a -> int) ->
+    ?pre_hash:'a bin_seq ->
+    'a t ->
+    'a t
+
+  val map :
+    ?cli:'a pp * 'a of_string ->
+    ?json:'a encode_json * 'a decode_json ->
+    ?bin:'a encode_bin * 'a decode_bin * 'a size_of ->
+    ?equal:('a -> 'a -> bool) ->
+    ?compare:('a -> 'a -> int) ->
+    ?short_hash:('a -> int) ->
+    ?pre_hash:'a bin_seq ->
+    'b t ->
+    ('b -> 'a) ->
+    ('a -> 'b) ->
+    'a t
+
+  type 'a ty = 'a t
+
+  module type S = sig
+    type t
+
+    val t : t ty
+  end
+end
+
+(** Commit info are used to keep track of the origin of write
+    operations in the stores. [Info] models the metadata associated
+    with commit objects in Git. *)
+module Info : sig
+  (** {1 Commit Info} *)
+
+  type t
+  (** The type for commit info. *)
+
+  val v : date:int64 -> author:string -> string -> t
+  (** Create a new commit info. *)
+
+  val date : t -> int64
+  (** [date t] is [t]'s commit date.
+
+      The date provided by the user when calling the {{!Info.v}create}
+      function. Rounding [Unix.gettimeofday ()] (when available) is a
+      good value for such date. On more esoteric platforms, any
+      monotonic counter is a fine value as well. On the Git backend,
+      the date is translated into the commit {e Date} field and is
+      expected to be the number of POSIX seconds (thus not counting
+      leap seconds) since the Epoch. *)
+
+  val author : t -> string
+  (** [author t] is [t]'s commit author.
+
+      The author identifies the entity (human, unikernel, process,
+      thread, etc) performing an operation. For the Git backend, this
+      will be directly translated into the {e Author} field. *)
+
+  val message : t -> string
+  (** [message t] is [t]'s commit message. *)
+
+  val empty : t
+  (** The empty commit info. *)
+
+  (** {1 Info Functions} *)
+
+  type f = unit -> t
+  (** Alias for functions which can build commit info. *)
+
+  val none : f
+  (** The empty info function. [none ()] is [empty] *)
+
+  (** {1 Value Types} *)
+
+  val t : t Type.t
+  (** [t] is the value type for {!t}. *)
+end
+
+(** [Merge] provides functions to build custom 3-way merge operators
+    for various user-defined contents. *)
+module Merge : sig
+  type conflict = [ `Conflict of string ]
+  (** The type for merge errors. *)
+
+  val ok : 'a -> ('a, conflict) result Lwt.t
+  (** Return [Ok x]. *)
+
+  val conflict : ('a, unit, string, ('b, conflict) result Lwt.t) format4 -> 'a
+  (** Return [Error (Conflict str)]. *)
+
+  val bind :
+    ('a, 'b) result Lwt.t ->
+    ('a -> ('c, 'b) result Lwt.t) ->
+    ('c, 'b) result Lwt.t
+  (** [bind r f] is the merge result which behaves as of the
+      application of the function [f] to the return value of [r]. If
+      [r] fails, [bind r f] also fails, with the same conflict. *)
+
+  val map : ('a -> 'c) -> ('a, 'b) result Lwt.t -> ('c, 'b) result Lwt.t
+  (** [map f m] maps the result of a merge. This is the same as
+      [bind m (fun x -> ok (f x))]. *)
+
+  (** {1 Merge Combinators} *)
+
+  type 'a promise = unit -> ('a option, conflict) result Lwt.t
+  (** An ['a] promise is a function which, when called, will
+      eventually return a value type of ['a]. A promise is an
+      optional, lazy and non-blocking value. *)
+
+  val promise : 'a -> 'a promise
+  (** [promise a] is the promise containing [a]. *)
+
+  val map_promise : ('a -> 'b) -> 'a promise -> 'b promise
+  (** [map_promise f a] is the promise containing [f] applied to what
+      is promised by [a]. *)
+
+  val bind_promise : 'a promise -> ('a -> 'b promise) -> 'b promise
+  (** [bind_promise a f] is the promise returned by [f] applied to
+      what is promised by [a]. *)
+
+  type 'a f = old:'a promise -> 'a -> 'a -> ('a, conflict) result Lwt.t
+  (** Signature of a merge function. [old] is the value of the
+      least-common ancestor.
+
+      {v
+              /----> t1 ----\
+      ----> old              |--> result
+              \----> t2 ----/
+      v}
+  *)
+
+  type 'a t
+  (** The type for merge combinators. *)
+
+  val v : 'a Type.t -> 'a f -> 'a t
+  (** [v dt f] create a merge combinator. *)
+
+  val f : 'a t -> 'a f
+  (** [f m] is [m]'s merge function. *)
+
+  val seq : 'a t list -> 'a t
+  (** Call the merge functions in sequence. Stop as soon as one is {e
+      not} returning a conflict. *)
+
+  val like : 'a Type.t -> 'b t -> ('a -> 'b) -> ('b -> 'a) -> 'a t
+  (** Use the merge function defined in another domain. If the
+      converting functions raise any exception the merge is a
+      conflict. *)
+
+  val like_lwt :
+    'a Type.t -> 'b t -> ('a -> 'b Lwt.t) -> ('b -> 'a Lwt.t) -> 'a t
+  (** Same as {{!Merge.biject}biject} but with blocking domain
+      converting functions. *)
+
+  (** {1 Basic Merges} *)
+
+  val default : 'a Type.t -> 'a t
+  (** [default t] is the default merge function for values of type
+      [t]. This is a simple merge function which supports changes in
+      one branch at a time:
+
+      {ul
+        {- if [t1=old] then the result of the merge is [OK t2];}
+        {- if [t2=old] then return [OK t1];}
+        {- otherwise the result is [Conflict].}
+      }
+  *)
+
+  val idempotent : 'a Type.t -> 'a t
+  (** [idempotent t] is the default merge function for values of type
+      [t] using idempotent operations. It follows the same rules as
+      the {!default} merge function but also adds:
+
+      {ul
+        {- if [t1=t2] then the result of the merge is [OK t1].}
+      }
+  *)
+
+  val unit : unit t
+  (** [unit] is the default merge function for unit values. *)
+
+  val bool : bool t
+  (** [bool] is the default merge function for booleans. *)
+
+  val char : char t
+  (** [char] is the default merge function for characters. *)
+
+  val int32 : int32 t
+  (** [int32] is the default merge function for 32-bits integers. *)
+
+  val int64 : int64 t
+  (** [int64] the default merge function for 64-bit integers. *)
+
+  val float : float t
+  (** [float] is the default merge function for floating point
+      numbers. *)
+
+  val string : string t
+  (** The default string merge function. Do not do anything clever, just
+      compare the strings using the [default] merge function. *)
+
+  val option : 'a t -> 'a option t
+  (** Lift a merge function to optional values of the same type. If all
+      the provided values are inhabited, then call the provided merge
+      function, otherwise use the same behavior as {!default}. *)
+
+  val pair : 'a t -> 'b t -> ('a * 'b) t
+  (** Lift merge functions to pairs of elements. *)
+
+  val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+  (** Lift merge functions to triples of elements. *)
+
+  (** {1 Counters and Multisets} *)
+
+  type counter = int64
+  (** The type for counter values. It is expected that the only valid
+      operations on counters are {e increment} and {e decrement}. The
+      following merge functions ensure that the counter semantics are
+      preserved: {e i.e.} it ensures that the number of increments and
+      decrements is preserved. *)
+
+  val counter : counter t
+  (** The merge function for mergeable counters. *)
+
+  (** Multi-sets. *)
+  module MultiSet (K : sig
+    include Set.OrderedType
+
+    val t : t Type.t
+  end) : sig
+    val merge : counter Map.Make(K).t t
+  end
+
+  (** {1 Maps and Association Lists} *)
+
+  (** We consider the only valid operations for maps and
+      association lists to be:
+
+      {ul
+      {- Adding a new bindings to the map.}
+      {- Removing a binding from the map.}
+      {- Replacing an existing binding with a different value.}
+      {- {e Trying to add an already existing binding is a no-op}.}
+      }
+
+      We thus assume that no operation on maps is modifying the {e
+      key} names. So the following merge functions ensures that {e
+      (i)} new bindings are preserved {e (ii)} removed bindings stay
+      removed and {e (iii)} modified bindings are merged using the
+      merge function of values.
+
+      {b Note:} We only consider sets of bindings, instead of
+      multisets. Application developers should take care of concurrent
+      addition and removal of similar bindings themselves, by using the
+      appropriate {{!Merge.MSet}multi-sets}. *)
+
+  (** Lift merge functions to sets. *)
+  module Set (E : sig
+    include Set.OrderedType
+
+    val t : t Type.t
+  end) : sig
+    val merge : Set.Make(E).t t
+  end
+
+  val alist : 'a Type.t -> 'b Type.t -> ('a -> 'b option t) -> ('a * 'b) list t
+  (** Lift the merge functions to association lists. *)
+
+  (** Lift the merge functions to maps. *)
+
+  module Map (K : sig
+    include Map.OrderedType
+
+    val t : t Type.t
+  end) : sig
+    val merge : 'a Type.t -> (K.t -> 'a option t) -> 'a Map.Make(K).t t
+  end
+
+  (** Infix operators for manipulating merge results and {!promise}s.
+
+      [open Irmin.Merge.Infix] at the top of your file to use them. *)
+  module Infix : sig
+    (** {1 Merge Result Combinators} *)
+
+    val ( >>=* ) :
+      ('a, conflict) result Lwt.t ->
+      ('a -> ('b, conflict) result Lwt.t) ->
+      ('b, conflict) result Lwt.t
+    (** [>>=*] is {!bind}. *)
+
+    val ( >|=* ) :
+      ('a, conflict) result Lwt.t -> ('a -> 'b) -> ('b, conflict) result Lwt.t
+    (** [>|=*] is {!map}. *)
+
+    (** {1 Promise Combinators}
+
+        This is useful to manipulate lca results. *)
+
+    val ( >>=? ) : 'a promise -> ('a -> 'b promise) -> 'b promise
+    (** [>>=?] is {!bind_promise}. *)
+
+    val ( >|=? ) : 'a promise -> ('a -> 'b) -> 'b promise
+    (** [>|=?] is {!map_promise}. *)
+  end
+  (** {1 Value Types} *)
+
+  val conflict_t : conflict Type.t
+  (** [conflict_t] is the value type for {!conflict}. *)
+
+  val result_t : 'a Type.t -> ('a, conflict) result Type.t
+  (** [result_t] is the value type for merge results. *)
+end
+
+(** Differences between values. *)
+module Diff : sig
+  type 'a t = [ `Updated of 'a * 'a | `Removed of 'a | `Added of 'a ]
+  (** The type for representing differences betwen values. *)
+
+  (** {1 Value Types} *)
+
+  val t : 'a Type.t -> 'a t Type.t
+  (** [t typ] is the value type for differences between values of type [typ]. *)
+end
+
+type 'a diff = 'a Diff.t
+(** The type for representing differences betwen values. *)
+
+(** {1 Low-level Stores} *)
+
+(** An Irmin store is automatically built from a number of lower-level
+    stores, each implementing fewer operations, such as
+    {{!CONTENT_ADDRESSABLE_STORE}content-addressable}
+    and {{!ATOMIC_WRITE_STORE}atomic-write} stores. These low-level stores
+    are provided
+    by various backends. *)
+
+(** Content-addressable backend store. *)
+module type CONTENT_ADDRESSABLE_STORE = sig
+  (** {1 Content-addressable stores}
+
+      Content-addressable stores are store where it is possible to read
+      and add new values. Keys are derived from the values raw contents
+      and hence are deterministic. *)
+
+  type 'a t
+  (** The type for content-addressable backend stores. The ['a]
+      phantom type carries information about the store mutability. *)
+
+  type key
+  (** The type for keys. *)
+
+  type value
+  (** The type for raw values. *)
+
+  val mem : [> `Read ] t -> key -> bool Lwt.t
+  (** [mem t k] is true iff [k] is present in [t]. *)
+
+  val find : [> `Read ] t -> key -> value option Lwt.t
+  (** [find t k] is [Some v] if [k] is associated to [v] in [t] and
+      [None] is [k] is not present in [t]. *)
+
+  val add : [> `Write ] t -> value -> key Lwt.t
+  (** Write the contents of a value to the store. It's the
+      responsibility of the content-addressable store to generate a
+      consistent key. *)
+
+  val unsafe_add : [> `Write ] t -> key -> value -> unit Lwt.t
+  (** Same as {!add} but allows to specify the key directly. The
+      backend might choose to discared that key and/or can be corrupt
+      if the key scheme is not consistent. *)
+end
+
+(** Append-only backend store. *)
+module type APPEND_ONLY_STORE = sig
+  (** {1 Append-only stores}
+
+      Append-onlye stores are store where it is possible to read
+      and add new values. *)
+
+  type 'a t
+  (** The type for append-only backend stores. The ['a]
+     phantom type carries information about the store mutability. *)
+
+  type key
+  (** The type for keys. *)
+
+  type value
+  (** The type for raw values. *)
+
+  val mem : [> `Read ] t -> key -> bool Lwt.t
+  (** [mem t k] is true iff [k] is present in [t]. *)
+
+  val find : [> `Read ] t -> key -> value option Lwt.t
+  (** [find t k] is [Some v] if [k] is associated to [v] in [t] and
+      [None] is [k] is not present in [t]. *)
+
+  val add : [> `Write ] t -> key -> value -> unit Lwt.t
+  (** Write the contents of a value to the store. *)
+end
+
+(** Atomic-write stores. *)
+module type ATOMIC_WRITE_STORE = sig
+  (** {1 Atomic write stores}
+
+      Atomic-write stores are stores where it is possible to read,
+      update and remove elements, with atomically guarantees. *)
+
+  type t
+  (** The type for atomic-write backend stores.  *)
+
+  type key
+  (** The type for keys. *)
+
+  type value
+  (** The type for raw values. *)
+
+  val mem : t -> key -> bool Lwt.t
+  (** [mem t k] is true iff [k] is present in [t]. *)
+
+  val find : t -> key -> value option Lwt.t
+  (** [find t k] is [Some v] if [k] is associated to [v] in [t] and
+      [None] is [k] is not present in [t]. *)
+
+  val set : t -> key -> value -> unit Lwt.t
+  (** [set t k v] replaces the contents of [k] by [v] in [t]. If [k]
+      is not already defined in [t], create a fresh binding.  Raise
+      [Invalid_argument] if [k] is the {{!Path.empty}empty path}. *)
+
+  val test_and_set :
+    t -> key -> test:value option -> set:value option -> bool Lwt.t
+  (** [test_and_set t key ~test ~set] sets [key] to [set] only if
+      the current value of [key] is [test] and in that case returns
+      [true]. If the current value of [key] is different, it returns
+      [false]. [None] means that the value does not have to exist or
+      is removed.
+
+      {b Note:} The operation is guaranteed to be atomic. *)
+
+  val remove : t -> key -> unit Lwt.t
+  (** [remove t k] remove the key [k] in [t]. *)
+
+  val list : t -> key list Lwt.t
+  (** [list t] it the list of keys in [t]. *)
+
+  type watch
+  (** The type of watch handlers. *)
+
+  val watch :
+    t ->
+    ?init:(key * value) list ->
+    (key -> value diff -> unit Lwt.t) ->
+    watch Lwt.t
+  (** [watch t ?init f] adds [f] to the list of [t]'s watch handlers
+      and returns the watch handler to be used with {!unwatch}. [init]
+      is the optional initial values. It is more efficient to use
+      {!watch_key} to watch only a single given key.*)
+
+  val watch_key :
+    t -> key -> ?init:value -> (value diff -> unit Lwt.t) -> watch Lwt.t
+  (** [watch_key t k ?init f] adds [f] to the list of [t]'s watch
+      handlers for the key [k] and returns the watch handler to be
+      used with {!unwatch}. [init] is the optional initial value of
+      the key. *)
+
+  val unwatch : t -> watch -> unit Lwt.t
+  (** [unwatch t w] removes [w] from [t]'s watch handlers. *)
+end
+
+(** {1 User-Defined Contents} *)
+
+(** Store paths.
+
+    An Irmin {{!Irmin.S}store} binds {{!Path.S.t}paths} to
+    user-defined {{!Contents.S}contents}. Paths are composed by basic
+    elements, that we call {{!Path.S.step}steps}. The following [Path]
+    module provides functions to manipulate steps and paths. *)
+module Path : sig
+  (** {1 Path} *)
+
+  (** Signature for path implementations.*)
+  module type S = sig
+    (** {1 Path} *)
+
+    type t
+    (** The type for path values. *)
+
+    type step
+    (** Type type for path's steps. *)
+
+    val empty : t
+    (** The empty path. *)
+
+    val v : step list -> t
+    (** Create a path from a list of steps. *)
+
+    val is_empty : t -> bool
+    (** Check if the path is empty. *)
+
+    val cons : step -> t -> t
+    (** Prepend a step to the path. *)
+
+    val rcons : t -> step -> t
+    (** Append a step to the path. *)
+
+    val decons : t -> (step * t) option
+    (** Deconstruct the first element of the path. Return [None] if
+        the path is empty. *)
+
+    val rdecons : t -> (t * step) option
+    (** Deconstruct the last element of the path. Return [None] if the
+        path is empty. *)
+
+    val map : t -> (step -> 'a) -> 'a list
+    (** [map t f] maps [f] over all steps of [t]. *)
+
+    (** {1 Value Types} *)
+
+    val t : t Type.t
+    (** [t] is the value type for {!t}. *)
+
+    val step_t : step Type.t
+    (** [step_t] is the value type for {!step}. *)
+  end
+
+  (** An implementation of paths as string lists. *)
+  module String_list : S with type step = string and type t = string list
+end
+
+(** Hashing functions.
+
+    [Hash] provides user-defined hash functions to digest serialized
+    contents. Some {{!backend}backends} might be parameterized by such
+    hash functions, others might work with a fixed one (for instance,
+    the Git format uses only {{!Hash.SHA1}SHA1}).
+
+    A {{!Hash.SHA1}SHA1} implementation is available to pass to the
+    backends. *)
+module Hash : sig
+  (** {1 Contents Hashing} *)
+
+  (** Signature for hash values. *)
+  module type S = sig
+    (** Signature for digest hashes, inspired by Digestif. *)
+
+    type t
+    (** The type for digest hashes. *)
+
+    val hash : ((string -> unit) -> unit) -> t
+    (** Compute a deterministic store key from a sequence of strings. *)
+
+    val short_hash : t -> int
+    (** [short_hash h] is a small hash of [h], to be used for instance as
+       the `hash` function of an OCaml [Hashtbl]. *)
+
+    val hash_size : int
+    (** [hash_size] is the size of hash results, in bytes. *)
+
+    (** {1 Value Types} *)
+
+    val t : t Type.t
+    (** [t] is the value type for {!t}. *)
+  end
+
+  (** Signature for typed hashes, where [hash] directly takes a value
+      as argument and incremental hashing is not possible. *)
+  module type TYPED = sig
+    type t
+
+    type value
+
+    val hash : value -> t
+    (** Compute a deterministic store key from a string. *)
+
+    val short_hash : t -> int
+    (** [short_hash h] is a small hash of [h], to be used for instance as
+       the `hash` function of an OCaml [Hashtbl]. *)
+
+    val hash_size : int
+    (** [hash_size] is the size of hash results, in bytes. *)
+
+    (** {1 Value Types} *)
+
+    val t : t Type.t
+    (** [t] is the value type for {!t}. *)
+  end
+
+  module Make (H : Digestif.S) : S with type t = H.t
+  (** Digestif hashes. *)
+
+  module SHA1 : S
+
+  module RMD160 : S
+
+  module SHA224 : S
+
+  module SHA256 : S
+
+  module SHA384 : S
+
+  module SHA512 : S
+
+  module BLAKE2B : S
+
+  module BLAKE2S : S
+
+  module V1 (H : S) : S with type t = H.t
+  (** v1 serialisation *)
+
+  (** Typed hashes. *)
+
+  module Typed (K : S) (E : Type.S) :
+    TYPED with type t = K.t and type value = E.t
+end
+
+(** [Metadata] defines metadata that is attached to contents but stored in
+    nodes. The Git backend uses this to indicate the type of file (normal,
+    executable or symlink). *)
+module Metadata : sig
+  module type S = sig
+    type t
+    (** The type for metadata. *)
+
+    val t : t Type.t
+    (** [t] is the value type for {!t}. *)
+
+    val merge : t Merge.t
+    (** [merge] is the merge function for metadata. *)
+
+    val default : t
+    (** The default metadata to attach, for APIs that don't
+        care about metadata. *)
+  end
+
+  module None : S with type t = unit
+  (** A metadata definition for systems that don't use metadata. *)
+end
+
+(** [Contents] specifies how user-defined contents need to be {e
+    serializable} and {e mergeable}.
+
+    The user needs to provide:
+
+    {ul
+    {- a type [t] to be used as store contents.}
+    {- a value type for [t] (built using the {{!Irmin.Type}Irmin.Type} combinators).}
+    {- a 3-way [merge] function, to handle conflicts between multiple
+    versions of the same contents.}
+    }
+
+    Default implementations for {{!Contents.String}idempotent string}
+    and {{!Contents.Json}JSON} contents are provided. *)
+module Contents : sig
+  module type S = sig
+    (** {1 Signature for store contents} *)
+
+    type t
+    (** The type for user-defined contents. *)
+
+    val t : t Type.t
+    (** [t] is the value type for {!t}. *)
+
+    val merge : t option Merge.t
+    (** Merge function. Evaluates to [`Conflict msg] if the values
+        cannot be merged properly. The arguments of the merge function
+        can take [None] to mean that the key does not exists for
+        either the least-common ancestor or one of the two merging
+        points. The merge function returns [None] when the key's value
+        should be deleted. *)
+  end
+
+  module String : S with type t = string
+  (** Contents of type [string], with the {{!Irmin.Merge.default}default}
+      3-way merge strategy: assume that update operations are idempotent and
+      conflict iff values are modified concurrently. *)
+
+  type json =
+    [ `Null
+    | `Bool of bool
+    | `String of string
+    | `Float of float
+    | `O of (string * json) list
+    | `A of json list ]
+
+  module Json : S with type t = (string * json) list
+  (** [Json] contents are associations from strings to [json] values
+     stored as JSON encoded strings.  If the same JSON key has been
+     modified concurrently with different values then the [merge]
+     function conflicts. *)
+
+  module Json_value : S with type t = json
+  (** [Json_value] allows any kind of json value to be stored, not only objects. *)
+
+  module V1 : sig
+    module String : S with type t = string
+    (** Same as {!String} but use v1 serialisation format. *)
+  end
+
+  (** Contents store. *)
+  module type STORE = sig
+    include CONTENT_ADDRESSABLE_STORE
+
+    val merge : [ `Read | `Write ] t -> key option Merge.t
+    (** [merge t] lifts the merge functions defined on contents values
+        to contents key. The merge function will: {e (i)} read the
+        values associated with the given keys, {e (ii)} use the merge
+        function defined on values and {e (iii)} write the resulting
+        values into the store to get the resulting key. See
+        {!Contents.S.merge}.
+
+        If any of these operations fail, return [`Conflict]. *)
+
+    (** [Key] provides base functions for user-defined contents keys. *)
+    module Key : Hash.TYPED with type t = key and type value = value
+
+    module Val : S with type t = value
+    (** [Val] provides base functions for user-defined contents values. *)
+  end
+
+  (** [Store] creates a contents store. *)
+  module Store (S : sig
+    include CONTENT_ADDRESSABLE_STORE
+
+    module Key : Hash.S with type t = key
+
+    module Val : S with type t = value
+  end) :
+    STORE with type 'a t = 'a S.t and type key = S.key and type value = S.value
+end
+
+(** User-defined branches. *)
+module Branch : sig
+  (** {1 Branches} *)
+
+  (** The signature for branches. Irmin branches are similar to Git
+      branches: they are used to associated user-defined names to head
+      commits. Branches have a default value: the
+      {{!Branch.S.master}master} branch. *)
+  module type S = sig
+    (** {1 Signature for Branches} *)
+
+    type t
+    (** The type for branches. *)
+
+    val t : t Type.t
+    (** [t] is the value type for {!t}. *)
+
+    val master : t
+    (** The name of the master branch. *)
+
+    val is_valid : t -> bool
+    (** Check if the branch is valid. *)
+  end
+
+  module String : S with type t = string
+  (** [String] is an implementation of {{!Branch.S}S} where branches
+      are strings. The [master] branch is ["master"]. Valid branch
+      names contain only alpha-numeric characters, [-], [_], [.], and
+      [/]. *)
+
+  (** [STORE] specifies the signature for branch stores.
+
+      A {i branch store} is a mutable and reactive key / value store,
+      where keys are branch names created by users and values are keys
+      are head commmits. *)
+  module type STORE = sig
+    (** {1 Branch Store} *)
+
+    include ATOMIC_WRITE_STORE
+
+    module Key : S with type t = key
+    (** Base functions on keys. *)
+
+    module Val : Hash.S with type t = value
+    (** Base functions on values. *)
+  end
+end
+
+type remote = ..
+(** The type for remote stores. *)
+
+type config
+(** The type for backend-specific configuration values.
+
+    Every backend has different configuration options, which are kept
+    abstract to the user. *)
+
+(** [Private] defines functions only useful for creating new
+    backends. If you are just using the library (and not developing a
+    new backend), you should not use this module. *)
+module Private : sig
+  (** Backend configuration.
+
+    A backend configuration is a set of {{!keys}keys} mapping to
+    typed values. Backends define their own keys. *)
+  module Conf : sig
+    (** {1 Configuration converters}
+
+        A configuration converter transforms a string value to an OCaml
+        value and vice-versa. There are a few
+        {{!builtin_converters}built-in converters}. *)
+
+    type 'a parser = string -> ('a, [ `Msg of string ]) result
+    (** The type for configuration converter parsers. *)
+
+    type 'a printer = 'a Fmt.t
+    (** The type for configuration converter printers. *)
+
+    type 'a converter = 'a parser * 'a printer
+    (** The type for configuration converters. *)
+
+    val parser : 'a converter -> 'a parser
+    (** [parser c] is [c]'s parser. *)
+
+    val printer : 'a converter -> 'a printer
+    (** [converter c] is [c]'s printer. *)
+
+    (** {1:keys Keys} *)
+
+    type 'a key
+    (** The type for configuration keys whose lookup value is ['a]. *)
+
+    val key :
+      ?docs:string ->
+      ?docv:string ->
+      ?doc:string ->
+      string ->
+      'a converter ->
+      'a ->
+      'a key
+    (** [key ~docs ~docv ~doc name conv default] is a configuration key named
+        [name] that maps to value [default] by default. [conv] is
+        used to convert key values provided by end users.
+
+        [docs] is the title of a documentation section under which the
+        key is documented. [doc] is a short documentation string for the
+        key, this should be a single sentence or paragraph starting with
+        a capital letter and ending with a dot.  [docv] is a
+        meta-variable for representing the values of the key
+        (e.g. ["BOOL"] for a boolean).
+
+        @raise Invalid_argument if the key name is not made of a
+        sequence of ASCII lowercase letter, digit, dash or underscore.
+
+        {b Warning.} No two keys should share the same [name] as this
+        may lead to difficulties in the UI. *)
+
+    val name : 'a key -> string
+    (** The key name. *)
+
+    val conv : 'a key -> 'a converter
+    (** [tc k] is [k]'s converter. *)
+
+    val default : 'a key -> 'a
+    (** [default k] is [k]'s default value. *)
+
+    val doc : 'a key -> string option
+    (** [doc k] is [k]'s documentation string (if any). *)
+
+    val docv : 'a key -> string option
+    (** [docv k] is [k]'s value documentation meta-variable (if any). *)
+
+    val docs : 'a key -> string option
+    (** [docs k] is [k]'s documentation section (if any). *)
+
+    val root : string option key
+    (** Default [--root=ROOT] argument. *)
+
+    (** {1:conf Configurations} *)
+
+    type t = config
+    (** The type for configurations. *)
+
+    val empty : t
+    (** [empty] is the empty configuration. *)
+
+    val singleton : 'a key -> 'a -> t
+    (** [singleton k v] is the configuration where [k] maps to [v]. *)
+
+    val is_empty : t -> bool
+    (** [is_empty c] is [true] iff [c] is empty. *)
+
+    val mem : t -> 'a key -> bool
+    (** [mem c k] is [true] iff [k] has a mapping in [c]. *)
+
+    val add : t -> 'a key -> 'a -> t
+    (** [add c k v] is [c] with [k] mapping to [v]. *)
+
+    val rem : t -> 'a key -> t
+    (** [rem c k] is [c] with [k] unbound. *)
+
+    val union : t -> t -> t
+    (** [union r s] is the union of the configurations [r] and [s]. *)
+
+    val find : t -> 'a key -> 'a option
+    (** [find c k] is [k]'s mapping in [c], if any. *)
+
+    val get : t -> 'a key -> 'a
+    (** [get c k] is [k]'s mapping in [c].
+
+        {b Raises.} [Not_found] if [k] is not bound in [d]. *)
+
+    (** {1:builtin_converters Built-in value converters}  *)
+
+    val bool : bool converter
+    (** [bool] converts values with [bool_of_string].  *)
+
+    val int : int converter
+    (** [int] converts values with [int_of_string]. *)
+
+    val string : string converter
+    (** [string] converts values with the identity function. *)
+
+    val uri : Uri.t converter
+    (** [uri] converts values with {!Uri.of_string}. *)
+
+    val some : 'a converter -> 'a option converter
+    (** [string] converts values with the identity function. *)
+  end
+
+  (** [Watch] provides helpers to register event notifications on
+      read-write stores. *)
+  module Watch : sig
+    (** {1 Watch Helpers} *)
+
+    (** The signature for watch helpers. *)
+    module type S = sig
+      (** {1 Watch Helpers} *)
+
+      type key
+      (** The type for store keys. *)
+
+      type value
+      (** The type for store values. *)
+
+      type watch
+      (** The type for watch handlers. *)
+
+      type t
+      (** The type for watch state. *)
+
+      val stats : t -> int * int
+      (** [stats t] is a tuple [(k,a)] represeting watch stats. [k] is
+          the number of single key watchers for the store [t] and [a] the
+          number of global watchers for [t]. *)
+
+      val notify : t -> key -> value option -> unit Lwt.t
+      (** Notify all listeners in the given watch state that a key has
+          changed, with the new value associated to this key. [None]
+          means the key has been removed. *)
+
+      val v : unit -> t
+      (** Create a watch state. *)
+
+      val clear : t -> unit Lwt.t
+      (** Clear all register listeners in the given watch state. *)
+
+      val watch_key :
+        t -> key -> ?init:value -> (value diff -> unit Lwt.t) -> watch Lwt.t
+      (** Watch a given key for changes. More efficient than {!watch}. *)
+
+      val watch :
+        t ->
+        ?init:(key * value) list ->
+        (key -> value diff -> unit Lwt.t) ->
+        watch Lwt.t
+      (** Add a watch handler. To watch a specific key, use
+          {!watch_key} which is more efficient. *)
+
+      val unwatch : t -> watch -> unit Lwt.t
+      (** Remove a watch handler. *)
+
+      val listen_dir :
+        t ->
+        string ->
+        key:(string -> key option) ->
+        value:(key -> value option Lwt.t) ->
+        (unit -> unit Lwt.t) Lwt.t
+      (** Register a thread looking for changes in the given directory
+          and return a function to stop watching and free up
+          resources. *)
+    end
+
+    val workers : unit -> int
+    (** [workers ()] is the number of background worker threads
+        managing event notification currently active. *)
+
+    type hook =
+      int -> string -> (string -> unit Lwt.t) -> (unit -> unit Lwt.t) Lwt.t
+    (** The type for watch hooks. *)
+
+    val none : hook
+    (** [none] is the hooks which asserts false. *)
+
+    val set_listen_dir_hook : hook -> unit
+    (** Register a function which looks for file changes in a
+        directory and return a function to stop watching. It is
+        probably best to use {!Irmin_watcher.hook} there. By default,
+        it uses {!none}. *)
+
+    (** [Make] builds an implementation of watch helpers. *)
+    module Make (K : Type.S) (V : Type.S) :
+      S with type key = K.t and type value = V.t
+  end
+
+  module Lock : sig
+    (** {1 Process locking helpers} *)
+
+    module type S = sig
+      type t
+      (** The type for lock manager. *)
+
+      type key
+      (** The type for key to be locked. *)
+
+      val v : unit -> t
+      (** Create a lock manager. *)
+
+      val with_lock : t -> key -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+      (** [with_lock t k f] executes [f ()] while holding the exclusive
+          lock associated to the key [k]. *)
+
+      val stats : t -> int
+    end
+
+    module Make (K : Type.S) : S with type key = K.t
+    (** Create a lock manager implementation. *)
+  end
+
+  (** [Node] provides functions to describe the graph-like structured
+      values.
+
+      The node blocks form a labeled directed acyclic graph, labeled
+      by {{!Path.S.step}steps}: a list of steps defines a
+      unique path from one node to an other.
+
+      Each node can point to user-defined {{!Contents.S}contents}
+      values. *)
+  module Node : sig
+    module type S = sig
+      (** {1 Node values} *)
+
+      type t
+      (** The type for node values. *)
+
+      type metadata
+      (** The type for node metadata. *)
+
+      type hash
+      (** The type for keys. *)
+
+      type step
+      (** The type for steps between nodes. *)
+
+      type value = [ `Node of hash | `Contents of hash * metadata ]
+      (** The type for either (node) keys or (contents) keys combined with
+          their metadata. *)
+
+      val v : (step * value) list -> t
+      (** [create l] is a new node. *)
+
+      val list : t -> (step * value) list
+      (** [list t] is the contents of [t]. *)
+
+      val empty : t
+      (** [empty] is the empty node. *)
+
+      val is_empty : t -> bool
+      (** [is_empty t] is true iff [t] is {!empty}. *)
+
+      val find : t -> step -> value option
+      (** [find t s] is the value associated with [s] in [t].
+
+          A node can point to user-defined
+          {{!Node.S.contents}contents}. The edge between the node and
+          the contents is labeled by a {{!Node.S.step}step}. *)
+
+      val add : t -> step -> value -> t
+      (** [add t s v] is the node where [find t v] is [Some s] but
+          is similar to [t] otherwise. *)
+
+      val remove : t -> step -> t
+      (** [remove t s] is the node where [find t s] is [None] but is
+          similar to [t] otherwise. *)
+
+      (** {1 Value types} *)
+
+      val t : t Type.t
+      (** [t] is the value type for {!t}. *)
+
+      val default : metadata
+      (** [default] is the default metadata value. *)
+
+      val metadata_t : metadata Type.t
+      (** [metadata_t] is the value type for {!metadata}. *)
+
+      val hash_t : hash Type.t
+      (** [hash_t] is the value type for {!hash}. *)
+
+      val step_t : step Type.t
+      (** [step_t] is the value type for {!step}. *)
+
+      val value_t : value Type.t
+      (** [value_t] is the value type for {!value}. *)
+    end
+
+    (** [Make] provides a simple node implementation, parameterized by
+        the contents and notes keys [K], paths [P] and metadata [M]. *)
+    module Make
+        (K : Type.S) (P : sig
+          type step
+
+          val step_t : step Type.t
+        end)
+        (M : Metadata.S) :
+      S with type hash = K.t and type step = P.step and type metadata = M.t
+
+    (** v1 serialisation *)
+    module V1 (S : S) : sig
+      include
+        S
+          with type hash = S.hash
+           and type step = S.step
+           and type metadata = S.metadata
+
+      val import : S.t -> t
+
+      val export : t -> S.t
+    end
+
+    (** [STORE] specifies the signature for node stores. *)
+    module type STORE = sig
+      include CONTENT_ADDRESSABLE_STORE
+
+      module Path : Path.S
+      (** [Path] provides base functions on node paths. *)
+
+      val merge : [ `Read | `Write ] t -> key option Merge.t
+      (** [merge] is the 3-way merge function for nodes keys. *)
+
+      (** [Key] provides base functions for node keys. *)
+      module Key : Hash.TYPED with type t = key and type value = value
+
+      module Metadata : Metadata.S
+      (** [Metadata] provides base functions for node metadata. *)
+
+      (** [Val] provides base functions for node values. *)
+      module Val :
+        S
+          with type t = value
+           and type hash = key
+           and type metadata = Metadata.t
+           and type step = Path.step
+
+      module Contents : Contents.STORE with type key = Val.hash
+      (** [Contents] is the underlying contents store. *)
+    end
+
+    (** [Store] creates node stores. *)
+    module Store
+        (C : Contents.STORE)
+        (P : Path.S)
+        (M : Metadata.S) (S : sig
+          include CONTENT_ADDRESSABLE_STORE with type key = C.key
+
+          module Key : Hash.S with type t = key
+
+          module Val :
+            S
+              with type t = value
+               and type hash = key
+               and type metadata = M.t
+               and type step = P.step
+        end) :
+      STORE
+        with type 'a t = 'a C.t * 'a S.t
+         and type key = S.key
+         and type value = S.value
+         and module Path = P
+         and module Metadata = M
+         and type Key.t = S.Key.t
+         and module Val = S.Val
+
+    (** [Graph] specifies the signature for node graphs. A node graph
+        is a deterministic DAG, labeled by steps. *)
+    module type GRAPH = sig
+      (** {1 Node Graphs} *)
+
+      type 'a t
+      (** The type for store handles. *)
+
+      type metadata
+      (** The type for node metadata. *)
+
+      type contents
+      (** The type of user-defined contents. *)
+
+      type node
+      (** The type for node values. *)
+
+      type step
+      (** The type of steps. A step is used to pass from one node to
+          another. *)
+
+      type path
+      (** The type of store paths. A path is composed of
+          {{!step}steps}. *)
+
+      type value = [ `Node of node | `Contents of contents * metadata ]
+      (** The type for store values. *)
+
+      val empty : [> `Write ] t -> node Lwt.t
+      (** The empty node. *)
+
+      val v : [> `Write ] t -> (step * value) list -> node Lwt.t
+      (** [v t n] is a new node containing [n]. *)
+
+      val list : [> `Read ] t -> node -> (step * value) list Lwt.t
+      (** [list t n] is the contents of the node [n]. *)
+
+      val find : [> `Read ] t -> node -> path -> value option Lwt.t
+      (** [find t n p] is the contents of the path [p] starting form
+          [n]. *)
+
+      val add : [ `Read | `Write ] t -> node -> path -> value -> node Lwt.t
+      (** [add t n p v] is the node [x] such that [find t x p] is
+          [Some v] and it behaves the same [n] for other
+          operations. *)
+
+      val remove : [ `Read | `Write ] t -> node -> path -> node Lwt.t
+      (** [remove t n path] is the node [x] such that [find t x] is
+          [None] and it behhaves then same as [n] for other
+          operations. *)
+
+      val closure :
+        [> `Read ] t -> min:node list -> max:node list -> node list Lwt.t
+      (** [closure t ~min ~max] is the transitive closure [c] of [t]'s
+          nodes such that:
+
+          {ul
+          {- There is a path in [t] from any nodes in [min] to nodes
+          in [c]. If [min] is empty, that condition is always true.}
+          {- There is a path in [t] from any nodes in [c] to nodes in
+          [max]. If [max] is empty, that condition is always false.}
+          }
+
+          {b Note:} Both [min] and [max] are subsets of [c].*)
+
+      (** {1 Value Types} *)
+
+      val metadata_t : metadata Type.t
+      (** [metadat_t] is the value type for {!metadata}. *)
+
+      val contents_t : contents Type.t
+      (** [contents_t] is the value type for {!contents}. *)
+
+      val node_t : node Type.t
+      (** [node_t] is the value type for {!node}. *)
+
+      val step_t : step Type.t
+      (** [step_t] is the value type for {!step}. *)
+
+      val path_t : path Type.t
+      (** [path_t] is the value type for {!path}. *)
+
+      val value_t : value Type.t
+      (** [value_t] is the value type for {!value}. *)
+    end
+
+    module Graph (S : STORE) :
+      GRAPH
+        with type 'a t = 'a S.t
+         and type contents = S.Contents.key
+         and type metadata = S.Val.metadata
+         and type node = S.key
+         and type path = S.Path.t
+         and type step = S.Path.step
+  end
+
+  (** Commit values represent the store history.
+
+      Every commit contains a list of predecessor commits, and the
+      collection of commits form an acyclic directed graph.
+
+      Every commit also can contain an optional key, pointing to a
+      {{!Private.Commit.STORE}node} value. See the
+      {{!Private.Node.STORE}Node} signature for more details on node
+      values. *)
+  module Commit : sig
+    module type S = sig
+      (** {1 Commit values} *)
+
+      type t
+      (** The type for commit values. *)
+
+      type hash
+      (** Type for keys. *)
+
+      val v : info:Info.t -> node:hash -> parents:hash list -> t
+      (** Create a commit. *)
+
+      val node : t -> hash
+      (** The underlying node. *)
+
+      val parents : t -> hash list
+      (** The commit parents. *)
+
+      val info : t -> Info.t
+      (** The commit info. *)
+
+      (** {1 Value Types} *)
+
+      val t : t Type.t
+      (** [t] is the value type for {!t}. *)
+
+      val hash_t : hash Type.t
+      (** [hash_t] is the value type for {!hash}. *)
+    end
+
+    module Make (K : Type.S) : S with type hash = K.t
+    (** [Make] provides a simple implementation of commit values,
+        parameterized by the commit and node keys [K]. *)
+
+    (** V1 serialisation. *)
+    module V1 (S : S) : sig
+      include S with type hash = S.hash
+
+      val import : S.t -> t
+
+      val export : t -> S.t
+    end
+
+    (** [STORE] specifies the signature for commit stores. *)
+    module type STORE = sig
+      (** {1 Commit Store} *)
+
+      include CONTENT_ADDRESSABLE_STORE
+
+      val merge : [ `Read | `Write ] t -> info:Info.f -> key option Merge.t
+      (** [merge] is the 3-way merge function for commit keys. *)
+
+      (** [Key] provides base functions for commit keys. *)
+      module Key : Hash.TYPED with type t = key and type value = value
+
+      (** [Val] provides functions for commit values. *)
+      module Val : S with type t = value and type hash = key
+
+      module Node : Node.STORE with type key = Val.hash
+      (** [Node] is the underlying node store. *)
+    end
+
+    (** [Store] creates a new commit store. *)
+    module Store
+        (N : Node.STORE) (S : sig
+          include CONTENT_ADDRESSABLE_STORE with type key = N.key
+
+          module Key : Hash.S with type t = key
+
+          module Val : S with type t = value and type hash = key
+        end) :
+      STORE
+        with type 'a t = 'a N.t * 'a S.t
+         and type key = S.key
+         and type value = S.value
+         and type Key.t = S.Key.t
+         and module Val = S.Val
+
+    (** [History] specifies the signature for commit history. The
+        history is represented as a partial-order of commits and basic
+        functions to search through that history are provided.
+
+        Every commit can point to an entry point in a node graph, where
+        user-defined contents are stored. *)
+    module type HISTORY = sig
+      (** {1 Commit History} *)
+
+      type 'a t
+      (** The type for store handles. *)
+
+      type node
+      (** The type for node values. *)
+
+      type commit
+      (** The type for commit values. *)
+
+      type v
+      (** The type for commit objects. *)
+
+      val v :
+        [> `Write ] t ->
+        node:node ->
+        parents:commit list ->
+        info:Info.t ->
+        (commit * v) Lwt.t
+      (** Create a new commit. *)
+
+      val parents : [> `Read ] t -> commit -> commit list Lwt.t
+      (** Get the commit parents.
+
+          Commits form a append-only, fully functional, partial-order
+          data-structure: every commit carries the list of its
+          immediate predecessors. *)
+
+      val merge : [ `Read | `Write ] t -> info:Info.f -> commit Merge.t
+      (** [merge t] is the 3-way merge function for commit.  *)
+
+      val lcas :
+        [> `Read ] t ->
+        ?max_depth:int ->
+        ?n:int ->
+        commit ->
+        commit ->
+        (commit list, [ `Max_depth_reached | `Too_many_lcas ]) result Lwt.t
+      (** Find the lowest common ancestors
+          {{:http://en.wikipedia.org/wiki/Lowest_common_ancestor}lca}
+          between two commits. *)
+
+      val lca :
+        [ `Read | `Write ] t ->
+        info:Info.f ->
+        ?max_depth:int ->
+        ?n:int ->
+        commit list ->
+        (commit option, Merge.conflict) result Lwt.t
+      (** Compute the lowest common ancestors ancestor of a list of
+          commits by recursively calling {!lcas} and merging the
+          results.
+
+          If one of the merges results in a conflict, or if a call to
+          {!lcas} returns either [Error `Max_depth_reached] or
+          [Error `Too_many_lcas] then the function returns the same
+          error. *)
+
+      val three_way_merge :
+        [ `Read | `Write ] t ->
+        info:Info.f ->
+        ?max_depth:int ->
+        ?n:int ->
+        commit ->
+        commit ->
+        (commit, Merge.conflict) result Lwt.t
+      (** Compute the {!lcas} of the two commit and 3-way merge the
+          result. *)
+
+      val closure :
+        [> `Read ] t -> min:commit list -> max:commit list -> commit list Lwt.t
+      (** Same as {{!Private.Node.GRAPH.closure}GRAPH.closure} but for
+          the history graph. *)
+
+      (** {1 Value Types} *)
+
+      val commit_t : commit Type.t
+      (** [commit_t] is the value type for {!commit}. *)
+    end
+
+    (** Build a commit history. *)
+    module History (S : STORE) :
+      HISTORY
+        with type 'a t = 'a S.t
+         and type node = S.Node.key
+         and type commit = S.key
+  end
+
+  (** The signature for slices. *)
+  module Slice : sig
+    module type S = sig
+      (** {1 Slices} *)
+
+      type t
+      (** The type for slices. *)
+
+      type contents
+      (** The type for exported contents. *)
+
+      type node
+      (** The type for exported nodes. *)
+
+      type commit
+      (** The type for exported commits. *)
+
+      type value = [ `Contents of contents | `Node of node | `Commit of commit ]
+      (** The type for exported values. *)
+
+      val empty : unit -> t Lwt.t
+      (** Create a new empty slice. *)
+
+      val add : t -> value -> unit Lwt.t
+      (** [add t v] adds [v] to [t]. *)
+
+      val iter : t -> (value -> unit Lwt.t) -> unit Lwt.t
+      (** [iter t f] calls [f] on all values of [t]. *)
+
+      (** {1 Value Types} *)
+
+      val t : t Type.t
+      (** [t] is the value type for {!t}. *)
+
+      val contents_t : contents Type.t
+      (** [content_t] is the value type for {!contents}. *)
+
+      val node_t : node Type.t
+      (** [node_t] is the value type for {!node}. *)
+
+      val commit_t : commit Type.t
+      (** [commit_t] is the value type for {!commit}. *)
+
+      val value_t : value Type.t
+      (** [value_t] is the value type for {!value}. *)
+    end
+
+    (** Build simple slices. *)
+    module Make (C : Contents.STORE) (N : Node.STORE) (H : Commit.STORE) :
+      S
+        with type contents = C.key * C.value
+         and type node = N.key * N.value
+         and type commit = H.key * H.value
+  end
+
+  module Sync : sig
+    module type S = sig
+      (** {1 Remote synchronization} *)
+
+      type t
+      (** The type for store handles. *)
+
+      type commit
+      (** The type for store heads. *)
+
+      type branch
+      (** The type for branch IDs. *)
+
+      type endpoint
+      (** The type for sync endpoints. *)
+
+      val fetch :
+        t ->
+        ?depth:int ->
+        endpoint ->
+        branch ->
+        (commit option, [ `Msg of string ]) result Lwt.t
+      (** [fetch t uri] fetches the contents of the remote store
+          located at [uri] into the local store [t]. Return the head
+          of the remote branch with the same name, which is now in the
+          local store. [No_head] means no such branch exists. *)
+
+      val push :
+        t ->
+        ?depth:int ->
+        endpoint ->
+        branch ->
+        (unit, [ `Msg of string | `Detached_head ]) result Lwt.t
+      (** [push t uri] pushes the contents of the local store [t] into
+          the remote store located at [uri]. *)
+    end
+
+    (** [None] is an implementation of {{!Private.Sync.S}S} which does
+        nothing. *)
+    module None (H : Type.S) (B : Type.S) : sig
+      include S with type commit = H.t and type branch = B.t
+
+      val v : 'a -> t Lwt.t
+      (** Create a remote store handle. *)
+    end
+  end
+
+  (** The complete collection of private implementations. *)
+  module type S = sig
+    (** {1 Private Implementations} *)
+
+    module Hash : Hash.S
+    (** Internal hashes. *)
+
+    module Contents : Contents.STORE with type key = Hash.t
+    (** Private content store. *)
+
+    (** Private node store. *)
+    module Node :
+      Node.STORE with type key = Hash.t and type Val.hash = Contents.key
+
+    (** Private commit store. *)
+    module Commit :
+      Commit.STORE with type key = Hash.t and type Val.hash = Node.key
+
+    module Branch : Branch.STORE with type value = Commit.key
+    (** Private branch store. *)
+
+    (** Private slices. *)
+    module Slice :
+      Slice.S
+        with type contents = Contents.key * Contents.value
+         and type node = Node.key * Node.value
+         and type commit = Commit.key * Commit.value
+
+    (** Private repositories. *)
+    module Repo : sig
+      type t
+
+      val v : config -> t Lwt.t
+
+      val close : t -> unit Lwt.t
+
+      val contents_t : t -> [ `Read ] Contents.t
+
+      val node_t : t -> [ `Read ] Node.t
+
+      val commit_t : t -> [ `Read ] Commit.t
+
+      val branch_t : t -> Branch.t
+
+      val batch :
+        t ->
+        ([ `Read | `Write ] Contents.t ->
+        [ `Read | `Write ] Node.t ->
+        [ `Read | `Write ] Commit.t ->
+        'a Lwt.t) ->
+        'a Lwt.t
+    end
+
+    (** URI-based low-level sync. *)
+    module Sync : sig
+      include Sync.S with type commit = Commit.key and type branch = Branch.key
+
+      val v : Repo.t -> t Lwt.t
+    end
+  end
+end
+
+(** {1 High-level Stores}
+
+    An Irmin store is a branch-consistent store where keys are lists
+    of steps.
+
+    An example is a Git repository where keys are filenames, {e i.e.}
+    lists of ['/']-separated strings. More complex examples are
+    structured values, where steps might contain first-class field
+    accessors and array offsets.
+
+    Irmin provides the following features:
+
+    {ul
+    {- Support for fast clones, branches and merges, in a fashion very
+       similar to Git.}
+    {- Efficient staging areas for fast, transient, in-memory operations.}
+    {- Fast {{!Sync}synchronization} primitives between remote
+       stores, using native backend protocols (as the Git protocol)
+       when available.}
+    }
+*)
+
+(** Irmin stores. *)
+module type S = sig
+  (** {1 Irmin stores}
+
+      Irmin stores are tree-like read-write stores with
+      extended capabilities. They allow an application (or a
+      collection of applications) to work with multiple local states,
+      which can be forked and merged programmatically, without having
+      to rely on a global state. In a way very similar to version
+      control systems, Irmin local states are called {i branches}.
+
+      There are two kinds of store in Irmin: the ones based on
+      {{!persistent}persistent} named branches and the ones based
+      {{!temporary}temporary} detached heads. These exist relative to a
+      local, larger (and shared) store, and have some (shared)
+      contents. This is exactly the same as usual version control
+      systems, that the informed user can see as an implicit purely
+      functional data-structure. *)
+
+  type repo
+  (** The type for Irmin repositories. *)
+
+  type t
+  (** The type for Irmin stores. *)
+
+  type step
+  (** The type for {!key} steps. *)
+
+  type key
+  (** The type for store keys. A key is a sequence of {!step}s. *)
+
+  type metadata
+  (** The type for store metadata. *)
+
+  type contents
+  (** The type for store contents. *)
+
+  type node
+  (** The type for store nodes. *)
+
+  type tree = [ `Node of node | `Contents of contents * metadata ]
+  (** The type for store trees. *)
+
+  type hash
+  (** The type for object hashes. *)
+
+  type commit
+  (** Type for commit identifiers. Similar to Git's commit SHA1s. *)
+
+  type branch
+  (** Type for persistent branch names. Branches usually share a
+      common global namespace and it's the user's responsibility to
+      avoid name clashes. *)
+
+  type slice
+  (** Type for store slices. *)
+
+  type lca_error = [ `Max_depth_reached | `Too_many_lcas ]
+  (** The type for errors associated with functions computing least
+      common ancestors *)
+
+  type ff_error = [ `No_change | `Rejected | lca_error ]
+  (** The type for errors for {!fast_forward}. *)
+
+  (** Repositories. *)
+  module Repo : sig
+    (** {1 Repositories}
+
+        A repository contains a set of branches. *)
+
+    type t = repo
+    (** The type of repository handles. *)
+
+    val v : config -> t Lwt.t
+    (** [v config] connects to a repository in a backend-specific
+        manner. *)
+
+    val close : t -> unit Lwt.t
+    (** [close t] frees up all resources associated with [t]. Any
+        operations run on a closed repository will raise [Closed]. *)
+
+    val heads : t -> commit list Lwt.t
+    (** [heads] is {!Head.list}. *)
+
+    val branches : t -> branch list Lwt.t
+    (** [branches] is {!Branch.list}. *)
+
+    val export :
+      ?full:bool ->
+      ?depth:int ->
+      ?min:commit list ->
+      ?max:commit list ->
+      t ->
+      slice Lwt.t
+    (** [export t ~depth ~min ~max] exports the store slice between
+        [min] and [max], using at most [depth] history depth (starting
+        from the max).
+
+        If [max] is not specified, use the current [heads]. If [min] is
+        not specified, use an unbound past (but can still be limited by
+        [depth]).
+
+        [depth] is used to limit the depth of the commit history. [None]
+        here means no limitation.
+
+        If [full] is set (default is true), the full graph, including the
+        commits, nodes and contents, is exported, otherwise it is the
+        commit history graph only. *)
+
+    val import : t -> slice -> (unit, [ `Msg of string ]) result Lwt.t
+    (** [import t s] imports the contents of the slice [s] in [t]. Does
+        not modify branches. *)
+  end
+
+  val empty : repo -> t Lwt.t
+  (** [empty repo] is a temporary, empty store. Becomes a normal
+      temporary store after the first update. *)
+
+  val master : repo -> t Lwt.t
+  (** [master repo] is a persistent store based on [r]'s master
+      branch. This operation is cheap, can be repeated multiple
+      times. *)
+
+  val of_branch : repo -> branch -> t Lwt.t
+  (** [of_branch r name] is a persistent store based on the branch
+      [name]. Similar to [master], but use [name] instead
+      {!Branch.S.master}. *)
+
+  val of_commit : commit -> t Lwt.t
+  (** [of_commit c] is a temporary store, based on the commit [c].
+
+      Temporary stores do not have stable names: instead they can be
+      addressed using the hash of the current commit. Temporary stores
+      are similar to Git's detached heads. In a temporary store, all
+      the operations are performed relative to the current head and
+      update operations can modify the current head: the current
+      stores's head will automatically become the new head obtained
+      after performing the update. *)
+
+  val repo : t -> repo
+  (** [repo t] is the repository containing [t]. *)
+
+  val tree : t -> tree Lwt.t
+  (** [tree t] is [t]'s current tree. Contents is not allowed at the
+      root of the tree. *)
+
+  (** [Status] provides base functions for store statuses. *)
+  module Status : sig
+    type t = [ `Empty | `Branch of branch | `Commit of commit ]
+    (** The type for store status. *)
+
+    val t : repo -> t Type.t
+    (** [t] is the value type for {!t}. *)
+
+    val pp : t Fmt.t
+    (** [pp] is the pretty-printer for store status. *)
+  end
+
+  val status : t -> Status.t
+  (** [status t] is [t]'s status. It can either be a branch, a commit
+      or empty. *)
+
+  (** Managing the store's heads. *)
+  module Head : sig
+    val list : repo -> commit list Lwt.t
+    (** [list t] is the list of all the heads in local store. Similar
+        to [git rev-list --all]. *)
+
+    val find : t -> commit option Lwt.t
+    (** [find t] is the current head of the store [t]. This works for
+        both persistent and temporary branches. In the case of a
+        persistent branch, this involves getting the the head
+        associated with the branch, so this may block. In the case of
+        a temporary store, it simply returns the current head. Returns
+        [None] if the store has no contents. Similar to
+        [git rev-parse HEAD]. *)
+
+    val get : t -> commit Lwt.t
+    (** Same as {!find} but raise [Invalid_argument] if the store does
+        not have any contents. *)
+
+    val set : t -> commit -> unit Lwt.t
+    (** [set t h] updates [t]'s contents with the contents of the
+        commit [h]. Can cause data loss as it discards the current
+        contents. Similar to [git reset --hard <hash>]. *)
+
+    val fast_forward :
+      t ->
+      ?max_depth:int ->
+      ?n:int ->
+      commit ->
+      (unit, [ `No_change | `Rejected | lca_error ]) result Lwt.t
+    (** [fast_forward t h] is similar to {!update} but the [t]'s head
+        is updated to [h] only if [h] is stricly in the future of
+        [t]'s current head. [max_depth] or [n] are used to limit the
+        search space of the lowest common ancestors (see {!lcas}).
+
+        The result is:
+        {ul
+        {- [Ok ()] if the operation is succesfull;}
+        {- [Error `No_change] if [h] is already [t]'s head;}
+        {- [Error `Rejected] if [h] is not in the strict future of [t]'s head.}
+        {- [Error e] if the history exploration has been cut before
+           getting useful results. In that case. the operation can be
+           retried using different parameters of [n] and [max_depth]
+           to get better results.}
+        }
+
+    *)
+
+    val test_and_set :
+      t -> test:commit option -> set:commit option -> bool Lwt.t
+    (** Same as {!update_head} but check that the value is [test] before
+        updating to [set]. Use {!update} or {!merge} instead if
+        possible. *)
+
+    val merge :
+      into:t ->
+      info:Info.f ->
+      ?max_depth:int ->
+      ?n:int ->
+      commit ->
+      (unit, Merge.conflict) result Lwt.t
+    (** [merge ~into:t ?max_head ?n commit] merges the contents of the
+        commit associated to [commit] into [t]. [max_depth] is the
+        maximal depth used for getting the lowest common ancestor. [n]
+        is the maximum number of lowest common ancestors. If present,
+        [max_depth] or [n] are used to limit the search space of the
+        lowest common ancestors (see {!lcas}). *)
+  end
+
+  module Hash : Hash.S with type t = hash
+  (** Object hashes. *)
+
+  (** [Commit] defines immutable objects to describe store updates. *)
+  module Commit : sig
+    type t = commit
+    (** The type for store commits. *)
+
+    val t : repo -> t Type.t
+    (** [t] is the value type for {!t}. *)
+
+    val pp_hash : t Fmt.t
+    (** [pp] is the pretty-printer for commit. Display only the
+        hash. *)
+
+    val v : repo -> info:Info.t -> parents:hash list -> tree -> commit Lwt.t
+    (** [v r i ~parents:p t] is the commit [c] such that:
+        {ul
+        {- [info c = i]}
+        {- [parents c = p]}
+        {- [tree c = t]}}
+    *)
+
+    val tree : commit -> tree
+    (** [tree c] is [c]'s root tree. *)
+
+    val parents : commit -> hash list
+    (** [parents c] are [c]'s parents. *)
+
+    val info : commit -> Info.t
+    (** [info c] is [c]'s info. *)
+
+    (** {1 Import/Export} *)
+
+    val hash : commit -> hash
+    (** [hash c] it [c]'s hash. *)
+
+    val of_hash : repo -> hash -> commit option Lwt.t
+    (** [of_hash r h] is the the commit object in [r] having [h] as
+        hash, or [None] is no such commit object exists. *)
+  end
+
+  (** [Contents] provides base functions for the store's contents. *)
+  module Contents : sig
+    include Contents.S with type t = contents
+
+    (** {1 Import/Export} *)
+
+    val hash : contents -> hash
+    (** [hash c] it [c]'s hash in the repository [r]. *)
+
+    val of_hash : repo -> hash -> contents option Lwt.t
+    (** [of_hash r h] is the the contents object in [r] having [h] as
+        hash, or [None] is no such contents object exists. *)
+  end
+
+  (** Managing store's trees. *)
+
+  module Tree : sig
+    (** [Tree] provides immutable, in-memory partial mirror of the
+        store, with lazy reads and delayed writes.
+
+        Trees are like staging area in Git: they are immutable
+        temporary non-persistent areas (they disappear if the host
+        crash), held in memory for efficiency, where reads are done
+        lazily and writes are done only when needed on commit: if you
+        modify a key twice, only the last change will be written to
+        the store when you commit. *)
+
+    (** {1 Constructors} *)
+
+    val empty : tree
+    (** [empty] is the empty tree. The empty tree does not have
+        associated backend configuration values, as they can perform
+        in-memory operation, independently of any given backend. *)
+
+    val of_contents : ?metadata:metadata -> contents -> tree
+    (** [of_contents c] is the subtree built from the contents [c]. *)
+
+    val of_node : node -> tree
+    (** [of_node n] is the subtree built from the node [n]. *)
+
+    val kind : tree -> key -> [ `Contents | `Node ] option Lwt.t
+    (** [kind t k] is the type of [s] in [t]. It could either be a
+        tree node or some file contents. It is [None] if [k] is not
+        present in [t]. *)
+
+    val list : tree -> key -> (step * [ `Contents | `Node ]) list Lwt.t
+    (** [list t key] is the list of files and sub-nodes stored under [k]
+        in [t]. *)
+
+    (** {1 Diffs} *)
+
+    val diff : tree -> tree -> (key * (contents * metadata) diff) list Lwt.t
+    (** [diff x y] is the difference of contents between [x] and [y]. *)
+
+    (** {1 Manipulating Contents} *)
+
+    val mem : tree -> key -> bool Lwt.t
+    (** [mem t k] is true iff [k] is associated to some contents in
+        [t]. *)
+
+    val find_all : tree -> key -> (contents * metadata) option Lwt.t
+    (** [find_all t k] is [Some (b, m)] if [k] is associated to the
+        contents [b] and metadata [m] in [t] and [None] if [k] is not
+        present in [t]. *)
+
+    val find : tree -> key -> contents option Lwt.t
+    (** [find] is similar to {!find_all} but it discards metadata. *)
+
+    val get_all : tree -> key -> (contents * metadata) Lwt.t
+    (** Same as {!find_all} but raise [Invalid_arg] if [k] is not
+        present in [t]. *)
+
+    val get : tree -> key -> contents Lwt.t
+    (** Same as {!get_all} but ignore the metadata. *)
+
+    val add : tree -> key -> ?metadata:metadata -> contents -> tree Lwt.t
+    (** [add t k c] is the tree where the key [k] is bound to the
+        contents [c] but is similar to [t] for other bindings. *)
+
+    val remove : tree -> key -> tree Lwt.t
+    (** [remove t k] is the tree where [k] bindings has been removed
+        but is similar to [t] for other bindings. *)
+
+    (** {1 Manipulating Subtrees} *)
+
+    val mem_tree : tree -> key -> bool Lwt.t
+    (** [mem_tree t k] is false iff [find_tree k = None]. *)
+
+    val find_tree : tree -> key -> tree option Lwt.t
+    (** [find_tree t k] is [Some v] if [k] is associated to [v] in
+        [t]. It is [None] if [k] is not present in [t]. *)
+
+    val get_tree : tree -> key -> tree Lwt.t
+    (** [get_tree t k] is [v] if [k] is associated to [v] in [t].
+        Raise [Invalid_arg] if [k] is not present in [t].*)
+
+    val add_tree : tree -> key -> tree -> tree Lwt.t
+    (** [add_tree t k v] is the tree where the key [k] is bound to the
+        tree [v] but is similar to [t] for other bindings *)
+
+    val merge : tree Merge.t
+    (** [merge] is the 3-way merge function for trees. *)
+
+    (** {1 Folds} *)
+
+    type marks
+    (** The type for fold marks. *)
+
+    val empty_marks : unit -> marks
+    (** [empty_marks ()] is an empty collection of marks. *)
+
+    type 'a force = [ `True | `False of key -> 'a -> 'a Lwt.t ]
+    (** The type for {!fold}'s [force] parameter. [`True] forces the
+        fold to read the objects of the lazy nodes. [`False f] is
+        applying [f] on every lazy node instead. *)
+
+    type uniq = [ `False | `True | `Marks of marks ]
+    (** The type for {!fold}'s [uniq] parameters. [`False] folds over
+        all the nodes. [`True] does not recurse on nodes already
+        seen. [`Marks m] uses the collection of marks [m] to store the
+        cache of keys: the fold will modify [m]. This can be used for
+        incremental folds.  *)
+
+    type 'a node_fn = key -> step list -> 'a -> 'a Lwt.t
+    (** The type for {!fold}'s [pre] and [post] parameters. *)
+
+    val fold :
+      ?force:'a force ->
+      ?uniq:uniq ->
+      ?pre:'a node_fn ->
+      ?post:'a node_fn ->
+      (key -> contents -> 'a -> 'a Lwt.t) ->
+      tree ->
+      'a ->
+      'a Lwt.t
+    (** [fold f t acc] folds [f] over [t]'s leafs.
+
+        For every node [n], ui [n] is a leaf node, call [f path n]. Otherwise:
+
+        {ul
+          {- Call [pre path n]. By default [pre] is the identity;}
+          {- Recursively call [fold] on each children, in lexicographic order;}
+          {- Call [post path n]; By default [post] is the identity.}}
+
+        See {!force} for details about the [force] parameters. By default
+        it is [`True].
+
+        See {!uniq} for details about the [uniq] parameters. By default
+        it is [`False].
+    *)
+
+    (** {1 Stats} *)
+
+    type stats = {
+      nodes : int;  (** Number of node. *)
+      leafs : int;  (** Number of leafs. *)
+      skips : int;  (** Number of lazy nodes. *)
+      depth : int;  (** Maximal depth. *)
+      width : int;  (** Maximal width. *)
+    }
+    (** The type for tree stats. *)
+
+    val pp_stats : stats Fmt.t
+    (** [pp_stats] is the pretty printer for tree statistics. *)
+
+    val stats : ?force:bool -> tree -> stats Lwt.t
+    (** [stats ~force t] are [t]'s statistics. If [force] is true,
+        this will force the reading of lazy nodes. By default it is
+        [false]. *)
+
+    (** {1 Concrete Trees} *)
+
+    type concrete =
+      [ `Tree of (step * concrete) list | `Contents of contents * metadata ]
+    (** The type for concrete trees. *)
+
+    val of_concrete : concrete -> tree
+    (** [of_concrete c] is the subtree equivalent to the concrete tree
+        [c]. *)
+
+    val to_concrete : tree -> concrete Lwt.t
+    (** [to_concrete t] is the concrete tree equivalent to the subtree
+        [t]. *)
+
+    (** {1 Caches} *)
+
+    val clear : ?depth:int -> tree -> unit
+    (** [clear ?depth t] clears all the cache in the tree [t] for
+        subtrees with a depth higher than [depth]. If [depth] is not
+        set, all the subtrees are cleared. *)
+
+    (** Global cache of key -> tree -- used for hash-consing and to
+        speed-up lookups. *)
+    module Cache : sig
+      val length : unit -> [ `Contents of int ] * [ `Nodes of int ]
+
+      val clear : ?depth:int -> unit -> unit
+      (** [clear ?depth ()] clears the global cache. If [depth] is
+          set, only keep entries with depth greater than [depth] and
+          prune these so that their depth is [depth]. *)
+
+      val dump : unit Fmt.t
+    end
+
+    (** {1 Performance counters} *)
+
+    type counters = {
+      mutable contents_hash : int;
+      mutable contents_find : int;
+      mutable contents_add : int;
+      mutable contents_cache_length : int;
+      mutable contents_cache_find : int;
+      mutable contents_cache_miss : int;
+      mutable node_hash : int;
+      mutable node_mem : int;
+      mutable node_add : int;
+      mutable node_find : int;
+      mutable node_cache_length : int;
+      mutable node_cache_find : int;
+      mutable node_cache_miss : int;
+      mutable node_val_v : int;
+      mutable node_val_find : int;
+      mutable node_val_list : int;
+    }
+
+    val counters : unit -> counters
+
+    val dump_counters : unit Fmt.t
+
+    val reset_counters : unit -> unit
+
+    val inspect : tree -> [ `Contents | `Node of [ `Map | `Hash | `Value ] ]
+
+    (** {1 Import/Export} *)
+
+    val hash : tree -> hash
+    (** [hash r c] it [c]'s hash in the repository [r]. *)
+
+    val of_hash : repo -> hash -> tree option Lwt.t
+    (** [of_hash r h] is the the tree object in [r] having [h] as
+        hash, or [None] is no such tree object exists. *)
+
+    val shallow : repo -> hash -> tree
+    (** [shallow r h] is the shallow tree object with the hash [h]. No
+        check is performed to verify if [h] actually exists in [r]. *)
+  end
+
+  (** {1 Reads} *)
+
+  val kind : t -> key -> [ `Contents | `Node ] option Lwt.t
+  (** [kind] is {!Tree.kind} applied to [t]'s root tree. *)
+
+  val list : t -> key -> (step * [ `Contents | `Node ]) list Lwt.t
+  (** [list t] is {!Tree.list} applied to [t]'s root tree. *)
+
+  val mem : t -> key -> bool Lwt.t
+  (** [mem t] is {!Tree.mem} applied to [t]'s root tree. *)
+
+  val mem_tree : t -> key -> bool Lwt.t
+  (** [mem_tree t] is {!Tree.mem_tree} applied to [t]'s root tree. *)
+
+  val find_all : t -> key -> (contents * metadata) option Lwt.t
+  (** [find_all t] is {!Tree.find_all} applied to [t]'s root tree. *)
+
+  val find : t -> key -> contents option Lwt.t
+  (** [find t] is {!Tree.find} applied to [t]'s root tree. *)
+
+  val get_all : t -> key -> (contents * metadata) Lwt.t
+  (** [get_all t] is {!Tree.get_all} applied on [t]'s root tree. *)
+
+  val get : t -> key -> contents Lwt.t
+  (** [get t] is {!Tree.get} applied to [t]'s root tree. *)
+
+  val find_tree : t -> key -> tree option Lwt.t
+  (** [find_tree t] is {!Tree.find_tree} applied to [t]'s root
+      tree. *)
+
+  val get_tree : t -> key -> tree Lwt.t
+  (** [get_tree t k] is {!Tree.get_tree} applied to [t]'s root
+      tree. *)
+
+  val hash : t -> key -> hash option Lwt.t
+  (** [hash t k] *)
+
+  (** {1 Udpates} *)
+
+  type write_error =
+    [ Merge.conflict | `Too_many_retries of int | `Test_was of tree option ]
+  (** The type for write errors.
+
+      {ul
+      {- Merge conflict. }
+      {- Concurrent transactions are competing to get the current
+         operation committed and too many attemps have been tried
+         (livelock). }
+      {- A "test and set" operation has failed and the current value
+         is [v] instead of the one we were waiting for. }}
+  *)
+
+  val set :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    contents ->
+    (unit, write_error) result Lwt.t
+  (** [set t k ~info v] sets [k] to the value [v] in [t]. Discard any
+     previous results but ensure that no operation is lost in the
+     history.
+
+     This function always uses {!Metadata.default} as metadata.
+     Use {!set_tree} with `[Contents (c, m)] for different ones.
+
+     The result is [Error `Too_many_retries] if the concurrent
+     operations do not allow the operation to commit to the underlying
+     storage layer (livelock).  *)
+
+  val set_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    contents ->
+    unit Lwt.t
+  (** [set_exn] is like {!set} but raise [Failure _] instead
+      of using a result type. *)
+
+  val set_tree :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    tree ->
+    (unit, write_error) result Lwt.t
+  (** [set_tree] is like {!set} but for trees. *)
+
+  val set_tree_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    tree ->
+    unit Lwt.t
+  (** [set_tree] is like {!set_exn} but for trees. *)
+
+  val remove :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    (unit, write_error) result Lwt.t
+  (** [remove t ~info k] remove any bindings to [k] in [t].
+
+      The result is [Error `Too_many_retries] if the concurrent
+     operations do not allow the operation to commit to the underlying
+     storage layer (livelock). *)
+
+  val remove_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    unit Lwt.t
+  (** [remove_exn] is like {!remove} but raise [Failure _] instead of
+     a using result type. *)
+
+  val test_and_set :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    test:contents option ->
+    set:contents option ->
+    (unit, write_error) result Lwt.t
+  (** [test_and_set ~test ~set] is like {!set} but it atomically
+     checks that the tree is [test] before modifying it to [set].
+
+     This function always uses {!Metadata.default} as metadata.
+     Use {!test_and_set_tree} with `[Contents (c, m)] for different ones.
+
+     The result is [Error (`Test t)] if the current tree is [t]
+     instead of [test].
+
+     The result is [Error `Too_many_retries] if the concurrent
+     operations do not allow the operation to commit to the underlying
+     storage layer (livelock). *)
+
+  val test_and_set_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    test:contents option ->
+    set:contents option ->
+    unit Lwt.t
+  (** [test_and_set_exn] is like {!test_and_set} but raise [Failure _]
+     instead of using a result type. *)
+
+  val test_and_set_tree :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    test:tree option ->
+    set:tree option ->
+    (unit, write_error) result Lwt.t
+  (** [test_and_set_tree] is like {!test_and_set} but for trees. *)
+
+  val test_and_set_tree_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    test:tree option ->
+    set:tree option ->
+    unit Lwt.t
+  (** [test_and_set_tree_exn] is like {!test_and_set_exn} but for
+     trees. *)
+
+  val merge :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    old:contents option ->
+    t ->
+    key ->
+    contents option ->
+    (unit, write_error) result Lwt.t
+  (** [merge ~old] is like {!set} but merge the current tree
+     and the new tree using [old] as ancestor in case of conflicts.
+
+      This function always uses {!Metadata.default} as metadata.
+      Use {!merge_tree} with `[Contents (c, m)] for different ones.
+
+      The result is [Error (`Conflict c)] if the merge failed with the
+      conflict [c].
+
+      The result is [Error `Too_many_retries] if the concurrent
+     operations do not allow the operation to commit to the underlying
+     storage layer (livelock). *)
+
+  val merge_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    old:contents option ->
+    t ->
+    key ->
+    contents option ->
+    unit Lwt.t
+  (** [merge_exn] is like {!merge} but raise [Failure _] instead of
+     using a result type. *)
+
+  val merge_tree :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    old:tree option ->
+    t ->
+    key ->
+    tree option ->
+    (unit, write_error) result Lwt.t
+  (** [merge_tree] is like {!merge_tree} but for trees. *)
+
+  val merge_tree_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    old:tree option ->
+    t ->
+    key ->
+    tree option ->
+    unit Lwt.t
+  (** [merge_tree] is like {!merge_tree} but for trees. *)
+
+  val with_tree :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    ?strategy:[ `Set | `Test_and_set | `Merge ] ->
+    info:Info.f ->
+    t ->
+    key ->
+    (tree option -> tree option Lwt.t) ->
+    (unit, write_error) result Lwt.t
+  (** [with_tree t k ~info f] replaces {i atomically} the subtree [v]
+      under [k] in the store [t] by the contents of the tree [f v],
+      using the commit info [info ()].
+
+      If [v = f v] and [allow_empty] is unset (default) then, the
+      operation is a no-op.
+
+      If [v != f v] and no other changes happen concurrently, [f v]
+      becomes the new subtree under [k]. If other changes happen
+      concurrently to that operations, the semantics depend on the
+      value of [strategy]:
+
+      {ul
+      {- if [strategy = `Set], use {!set} and discard any concurrent
+         updates to [k]. }
+      {- if [strategy = `Test_and_set] (default), use {!test_and_set}
+         and ensure that no concurrent operations are updating [k]. }
+      {- if [strategy = `Merge], use {!merge} and ensure
+         that concurrent updates and merged with the values present
+         at the beginning of the transaction. }}
+
+      {b Note:} Irmin transactions provides
+      {{:https://en.wikipedia.org/wiki/Snapshot_isolation}snapshot
+      isolation} guarantees: reads and writes are isolated in every
+      transaction, but only write conflicts are visible on commit. *)
+
+  val with_tree_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    ?strategy:[ `Set | `Test_and_set | `Merge ] ->
+    info:Info.f ->
+    t ->
+    key ->
+    (tree option -> tree option Lwt.t) ->
+    unit Lwt.t
+  (** [with_tree_exn] is like {!with_tree} but raise [Failure _]
+     instead of using a return type. *)
+
+  (** {1 Clones} *)
+
+  val clone : src:t -> dst:branch -> t Lwt.t
+  (** [clone ~src ~dst] makes [dst] points to [Head.get src]. [dst] is
+      created if needed. Remove the current contents en [dst] if [src]
+      is {!empty}. *)
+
+  (** {1 Watches} *)
+
+  type watch
+  (** The type for store watches. *)
+
+  val watch : t -> ?init:commit -> (commit diff -> unit Lwt.t) -> watch Lwt.t
+  (** [watch t f] calls [f] every time the contents of [t]'s head is
+      updated.
+
+      {b Note:} even if [f] might skip some head updates, it will
+      never be called concurrently: all consecutive calls to [f] are
+      done in sequence, so we ensure that the previous one ended
+      before calling the next one. *)
+
+  val watch_key :
+    t ->
+    key ->
+    ?init:commit ->
+    ((commit * tree) diff -> unit Lwt.t) ->
+    watch Lwt.t
+  (** [watch_key t key f] calls [f] every time the [key]'s value is
+      added, removed or updated. If the current branch is deleted,
+      no signal is sent to the watcher. *)
+
+  val unwatch : watch -> unit Lwt.t
+  (** [unwatch w] disable [w]. Return once the [w] is fully
+      disabled. *)
+
+  (** {1 Merges and Common Ancestors.} *)
+
+  type 'a merge =
+    info:Info.f ->
+    ?max_depth:int ->
+    ?n:int ->
+    'a ->
+    (unit, Merge.conflict) result Lwt.t
+  (** The type for merge functions. *)
+
+  val merge_into : into:t -> t merge
+  (** [merge_into ~into i t] merges [t]'s current branch into [x]'s
+      current branch using the info [i]. After that operation, the two
+      stores are still independent. Similar to [git merge <branch>]. *)
+
+  val merge_with_branch : t -> branch merge
+  (** Same as {!merge} but with a branch ID. *)
+
+  val merge_with_commit : t -> commit merge
+  (** Same as {!merge} but with a commit ID. *)
+
+  val lcas :
+    ?max_depth:int -> ?n:int -> t -> t -> (commit list, lca_error) result Lwt.t
+  (** [lca ?max_depth ?n msg t1 t2] returns the collection of least
+      common ancestors between the heads of [t1] and [t2] branches.
+
+      {ul
+      {- [max_depth] is the maximum depth of the exploration (default
+      is [max_int]). Return [Error `Max_depth_reached] if this depth
+      is exceeded.}
+      {- [n] is the maximum expected number of lcas. Stop the
+      exploration as soon as [n] lcas are found. Return
+      [Error `Too_many_lcas] if more [lcas] are found. }
+      }
+  *)
+
+  val lcas_with_branch :
+    t ->
+    ?max_depth:int ->
+    ?n:int ->
+    branch ->
+    (commit list, lca_error) result Lwt.t
+  (** Same as {!lcas} but takes a branch ID as argument. *)
+
+  val lcas_with_commit :
+    t ->
+    ?max_depth:int ->
+    ?n:int ->
+    commit ->
+    (commit list, lca_error) result Lwt.t
+  (** Same as {!lcas} but takes a commit ID as argument. *)
+
+  (** {1 History} *)
+
+  module History : Graph.Sig.P with type V.t = commit
+  (** An history is a DAG of heads. *)
+
+  val history :
+    ?depth:int -> ?min:commit list -> ?max:commit list -> t -> History.t Lwt.t
+  (** [history ?depth ?min ?max t] is a view of the history of the
+      store [t], of depth at most [depth], starting from the [max]
+      (or from the [t]'s head if the list of heads is empty) and
+      stopping at [min] if specified. *)
+
+  val last_modified : ?depth:int -> ?n:int -> t -> key -> commit list Lwt.t
+  (** [last_modified ?number c k] is the list of the last [number] commits
+      that modified [key], in ascending order of date. [depth] is the maximum
+      depth to be explored in the commit graph, if any. Default value for
+      [number] is 1. *)
+
+  (** Manipulate branches. *)
+  module Branch : sig
+    (** {1 Branch Store}
+
+        Manipulate relations between {{!branch}branches} and
+        {{!commit}commits}. *)
+
+    val mem : repo -> branch -> bool Lwt.t
+    (** [mem r b] is true iff [b] is present in [r]. *)
+
+    val find : repo -> branch -> commit option Lwt.t
+    (** [find r b] is [Some c] iff [c] is bound to [b] in [t]. It is
+        [None] if [b] is not present in [t]. *)
+
+    val get : repo -> branch -> commit Lwt.t
+    (** [get t b] is similar to {!find} but raise [Invalid_argument]
+        if [b] is not present in [t]. *)
+
+    val set : repo -> branch -> commit -> unit Lwt.t
+    (** [set t b c] bounds [c] to [b] in [t]. *)
+
+    val remove : repo -> branch -> unit Lwt.t
+    (** [remove t b] removes [b] from [t]. *)
+
+    val list : repo -> branch list Lwt.t
+    (** [list t] is the list of branches present in [t]. *)
+
+    val watch :
+      repo ->
+      branch ->
+      ?init:commit ->
+      (commit diff -> unit Lwt.t) ->
+      watch Lwt.t
+    (** [watch t b f] calls [f] on every change in [b]. *)
+
+    val watch_all :
+      repo ->
+      ?init:(branch * commit) list ->
+      (branch -> commit diff -> unit Lwt.t) ->
+      watch Lwt.t
+    (** [watch_all t f] calls [f] on every branch-related change in
+        [t], including creation/deletion events. *)
+
+    include Branch.S with type t = branch
+    (** Base functions for branches. *)
+  end
+
+  (** [Key] provides base functions for the stores's paths. *)
+  module Key : Path.S with type t = key and type step = step
+
+  module Metadata : Metadata.S with type t = metadata
+  (** [Metadata] provides base functions for node metadata. *)
+
+  (** {1 Value Types} *)
+
+  val step_t : step Type.t
+  (** [step_t] is the value type for {!step}. *)
+
+  val key_t : key Type.t
+  (** [key_t] is the value type for {!key}. *)
+
+  val metadata_t : metadata Type.t
+  (** [metadata_t] is the value type for {!metadata}. *)
+
+  val contents_t : contents Type.t
+  (** [contents_t] is the value type for {!contents}. *)
+
+  val node_t : node Type.t
+  (** [node_t] is the value type for {!node}. *)
+
+  val tree_t : tree Type.t
+  (** [tree_t] is the value type for {!tree}. *)
+
+  val commit_t : repo -> commit Type.t
+  (** [commit_t r] is the value type for {!commit}. *)
+
+  val branch_t : branch Type.t
+  (** [branch_t] is the value type for {!branch}. *)
+
+  val slice_t : slice Type.t
+  (** [slice_t] is the value type for {!slice}. *)
+
+  val kind_t : [ `Node | `Contents ] Type.t
+  (** [kind_t] is the value type for values returned by {!kind}. *)
+
+  val lca_error_t : lca_error Type.t
+  (** [lca_error_t] is the value type for {!lca_error}. *)
+
+  val ff_error_t : ff_error Type.t
+  (** [ff_error_t] is the value type for {!ff_error}. *)
+
+  val write_error_t : write_error Type.t
+  (** [write_error_t] is the value type for {!write_error}. *)
+
+  (** Private functions, which might be used by the backends. *)
+  module Private : sig
+    include
+      Private.S
+        with type Contents.value = contents
+         and module Node.Path = Key
+         and type Hash.t = Hash.t
+         and type Node.Metadata.t = metadata
+         and type Branch.key = branch
+         and type Slice.t = slice
+         and type Repo.t = repo
+  end
+
+  type remote +=
+    | E of Private.Sync.endpoint
+          (** Extend the [remote] type with [endpoint]. *)
+
+  (** {2 Converters to private types} *)
+
+  val to_private_node : node -> Private.Node.value option Lwt.t
+  (** [to_private_node n] is the private node objects built using [n].
+     The operation can fetch the database to read an object as [n]
+     could be represented as a hash. The result is [None] iff that
+     hash doesn't exist in the database. *)
+
+  val of_private_node : repo -> Private.Node.value -> node
+  (** [of_private_node r n] is the node build from the private node
+     object [n]. *)
+
+  val to_private_commit : commit -> Private.Commit.value
+  (** [to_private_commit c] is the private commit object associated
+     with the commit [c]. *)
+
+  val of_private_commit : repo -> Private.Commit.value -> commit
+  (** [of_private_commit r c] is the commit associated with the
+     private commit object [c]. *)
+
+  val save_contents : [> `Write ] Private.Contents.t -> contents -> hash Lwt.t
+  (** Save a content into the database *)
+
+  val save_tree :
+    ?clear:bool ->
+    repo ->
+    [> `Write ] Private.Contents.t ->
+    [ `Read | `Write ] Private.Node.t ->
+    tree ->
+    hash Lwt.t
+  (** Save a tree into the database. Does not do any reads. If
+        [clear] is set (it is by default), the tree cache will be
+        cleared after the save. *)
+end
+
+(** [Json_tree] is used to project JSON values onto trees. Instead of the entire
+    object being stored under one key, it is split across several keys starting
+    at the specified root key.  *)
+module Json_tree (Store : S with type contents = Contents.json) : sig
+  include Contents.S with type t = Contents.json
+
+  val to_concrete_tree : t -> Store.Tree.concrete
+
+  val of_concrete_tree : Store.Tree.concrete -> t
+
+  val get_tree : Store.tree -> Store.key -> t Lwt.t
+  (** Extract a [json] value from tree at the given key. *)
+
+  val set_tree : Store.tree -> Store.key -> t -> Store.tree Lwt.t
+  (** Project a [json] value onto a tree at the given key. *)
+
+  val get : Store.t -> Store.key -> t Lwt.t
+  (** Extract a [json] value from a store at the given key. *)
+
+  val set : Store.t -> Store.key -> t -> info:Info.f -> unit Lwt.t
+  (** Project a [json] value onto a store at the given key. *)
+end
+
+(** [S_MAKER] is the signature exposed by any backend providing {!S}
+    implementations. [M] is the implementation of user-defined
+    metadata, [C] is the one for user-defined contents, [B] is the
+    implementation for branches and [H] is the implementation for
+    object (blobs, trees, commits) hashes. It does not use any native
+    synchronization primitives. *)
+module type S_MAKER = functor
+  (M : Metadata.S)
+  (C : Contents.S)
+  (P : Path.S)
+  (B : Branch.S)
+  (H : Hash.S)
+  ->
+  S
+    with type key = P.t
+     and type step = P.step
+     and type metadata = M.t
+     and type contents = C.t
+     and type branch = B.t
+     and type hash = H.t
+
+(** [KV] is similar to {!S} but chooses sensible implementations for
+    path and branch. *)
+module type KV =
+  S with type key = string list and type step = string and type branch = string
+
+module type KV_MAKER = functor (C : Contents.S) -> KV with type contents = C.t
+(** [KV_MAKER] is like {!S_MAKER} but where everything except the
+    contents is replaced by sensible default implementations. *)
+
+(** {2 Synchronization} *)
+
+val remote_store : (module S with type t = 'a) -> 'a -> remote
+(** [remote_store t] is the remote corresponding to the local store
+    [t]. Synchronization is done by importing and exporting store
+    {{!BC.slice}slices}, so this is usually much slower than native
+    synchronization using {!Store.remote} but it works for all
+    backends. *)
+
+(** [SYNC] provides functions to synchronize an Irmin store with local
+    and remote Irmin stores. *)
+module type SYNC = sig
+  (** {1 Native Synchronization} *)
+
+  type db
+  (** Type type for store handles. *)
+
+  type commit
+  (** The type for store heads. *)
+
+  type status = [ `Empty | `Head of commit ]
+  (** The type for remote status. *)
+
+  val status_t : db -> status Type.t
+  (** [status_t db] is the value type for {!status} of remote [db]. *)
+
+  val pp_status : status Fmt.t
+  (** [pp_status] pretty-prints return statuses. *)
+
+  val fetch :
+    db -> ?depth:int -> remote -> (status, [ `Msg of string ]) result Lwt.t
+  (** [fetch t ?depth r] populate the local store [t] with objects for
+      the remote store [r], using [t]'s current branch. The [depth]
+      parameter limits the history depth. Return [`Empty] if either the
+      local or remote store do not have a valid head. *)
+
+  val fetch_exn : db -> ?depth:int -> remote -> status Lwt.t
+  (** Same as {!fetch} but raise [Invalid_argument] if either the
+      local or remote store do not have a valid head. *)
+
+  type pull_error = [ `Msg of string | Merge.conflict ]
+  (** The type for pull errors. *)
+
+  val pp_pull_error : pull_error Fmt.t
+  (** [pp_push_error] pretty-prints pull errors. *)
+
+  val pull :
+    db ->
+    ?depth:int ->
+    remote ->
+    [ `Merge of Info.f | `Set ] ->
+    (status, pull_error) result Lwt.t
+  (** [pull t ?depth r s] is similar to {{!Sync.fetch}fetch} but it
+      also updates [t]'s current branch. [s] is the update strategy:
+
+      {ul
+      {- [`Merge] uses [Head.merge]. Can return a conflict.}
+      {- [`Set] uses [S.Head.set].}
+      } *)
+
+  val pull_exn :
+    db -> ?depth:int -> remote -> [ `Merge of Info.f | `Set ] -> status Lwt.t
+  (** Same as {!pull} but raise [Invalid_arg] in case of conflict. *)
+
+  type push_error = [ `Msg of string | `Detached_head ]
+  (** The type for push errors. *)
+
+  val pp_push_error : push_error Fmt.t
+  (** [pp_push_error] pretty-prints push errors. *)
+
+  val push : db -> ?depth:int -> remote -> (status, push_error) result Lwt.t
+  (** [push t ?depth r] populates the remote store [r] with objects
+      from the current store [t], using [t]'s current branch. If [b]
+      is [t]'s current branch, [push] also updates the head of [b] in
+      [r] to be the same as in [t].
+
+      {b Note:} {e Git} semantics is to update [b] only if the new
+      head if more recent. This is not the case in {e Irmin}. *)
+
+  val push_exn : db -> ?depth:int -> remote -> status Lwt.t
+  (** Same as {!push} but raise [Invalid_argument] if an error
+      happens. *)
+end
+
+(** The default [Sync] implementation. *)
+module Sync (S : S) : SYNC with type db = S.t and type commit = S.commit
+
+(** {1:examples Examples}
+
+    These examples are in the [examples] directory of the
+    distribution.
+
+    {3 Syncing with a remote}
+
+    A simple synchronization example, using the
+    {{!Irmin_unix.Git}Git} backend and the {!Sync} helpers. The
+    code clones a fresh repository if the repository does not exist
+    locally, otherwise it performs a fetch: in this case, only
+    the missing contents are downloaded.
+
+{[
+open Lwt.Infix
+
+module S = Irmin_unix.Git.FS.KV(Irmin.Contents.String)
+module Sync = Irmin.Sync(S)
+let config = Irmin_git.config "/tmp/test"
+
+let upstream =
+  if Array.length Sys.argv = 2 then (Uri.of_string (Store.remote Sys.argv.(1)))
+  else (Printf.eprintf "Usage: sync [uri]\n%!"; exit 1)
+
+let test () =
+  S.Repo.v config >>= S.master
+  >>= fun t  -> Sync.pull_exn t upstream `Set
+  >>= fun () -> S.get t ["README.md"]
+  >|= fun r  -> Printf.printf "%s\n%!" r
+
+let () = Lwt_main.run (test ())
+]}
+
+    {3 Mergeable logs}
+
+    We will demonstrate the use of custom merge operators by
+    defining mergeable debug log files. We first define a log entry
+    as a pair of a timestamp and a message, using the combinator
+    exposed by {!Irmin.Type}:
+
+{[
+module Entry : sig
+  include Irmin.Type.S
+  val v: string -> t
+  val timestamp: t -> int
+end = struct
+
+  type t = { timestamp: int; message : string; }
+
+  let compare x y = compare x.timestamp y.timestamp
+
+  let time = ref 0
+
+  let v message =
+    incr time;
+    { timestamp = !time; message }
+
+  let timestamp t = t.timestamp
+
+  let pp ppf { timestamp; message } =
+    Fmt.pf ppf "%04d: %s" timestamp message
+
+  let of_string str =
+    match String.split_on_char '\t' str with
+    | [] -> Error (`Msg ("invalid entry: " ^ str))
+    | ts :: msg_sects ->
+      let message = String.concat "\t" msg_sects in
+      try Ok { timestamp = int_of_string ts; message }
+      with Failure e -> Error (`Msg e)
+
+  let t =
+    let open Irmin.Type in
+    record "entry" (fun t32 message -> { timestamp = Int32.to_int t32; message })
+    |+ field "timestamp" int32  (fun t -> Int32.of_int t.timestamp)
+    |+ field "message"   string (fun t -> t.message)
+    |> sealr
+
+  let t = Irmin.Type.like ~cli:(pp, of_string) ~compare t
+
+end
+]}
+
+    A log file is a list of entries (one per line), ordered by
+    decreasing order of timestamps. The 3-way [merge] operator for log
+    files concatenates and sorts the new entries and prepend them
+    to the common ancestor's ones.
+
+{[
+(* A log file *)
+module Log: sig
+  include Irmin.Contents.S
+  val add: t -> Entry.t -> t
+  val empty: t
+end = struct
+
+  type t = Entry.t list
+
+  let empty = []
+
+  let pp ppf l = List.iter (Fmt.pf ppf "%a\n" Entry.pp ) (List.rev l)
+
+  let of_string str =
+    let lines = String.cuts ~empty:false ~sep:"\n" str in
+    try
+      List.fold_left (fun acc l ->
+          match Entry.of_string l with
+          | Ok x           -> x :: acc
+          | Error (`Msg e) -> failwith e
+        ) [] lines
+      |> fun l -> Ok l
+    with Failure e ->
+      Error (`Msg e)
+
+  let t = Irmin.Type.(list Entry.t)
+  let t = Irmin.Type.like' ~cli:(pp, of_string) t
+
+  let timestamp = function
+    | [] -> 0
+    | e :: _ -> Entry.timestamp e
+
+  let newer_than timestamp file =
+    let rec aux acc = function
+      | [] -> List.rev acc
+      | h:: _ when Entry.timestamp h <= timestamp -> List.rev acc
+      | h::t -> aux (h::acc) t
+    in
+    aux [] file
+
+  let merge ~old t1 t2 =
+    let open Irmin.Merge.Infix in
+    old () >>=* fun old ->
+    let old = match old with None -> [] | Some o -> o in
+    let ts = timestamp old in
+    let t1 = newer_than ts t1 in
+    let t2 = newer_than ts t2 in
+    let t3 = List.sort Entry.compare (List.rev_append t1 t2) in
+    Irmin.Merge.ok (List.rev_append t3 old)
+
+  let merge = Irmin.Merge.(option (v t merge))
+
+  let add t e = e :: t
+
+end ]}
+
+    {b Note:} The serialisation primitives used in that example are
+    not very efficient in this case as they parse the file
+    every time. For real usage, you would write buffered versions of
+    [Log.pp] and [Log.of_string].
+
+    To persist the log file on disk, we need to choose a backend. We
+    show here how to use the on-disk [Git] backend on Unix.
+
+{[
+  (* Build an Irmin store containing log files. *)
+  module S = Irmin_unix.Git.FS.KV(Log)
+
+  (* Set-up the local configuration of the Git repository. *)
+  let config = Irmin_git.config ~bare:true "/tmp/irmin/test"
+
+  (* Set-up the commit info function *)
+  let info fmt = Irmin_unix.info ~author:"logger" fmt
+]}
+
+  We can now define a toy example to use our mergeable log files.
+
+{[
+  open Lwt.Infix
+
+  (* Name of the log file. *)
+  let file = [ "local"; "debug" ]
+
+  (* Read the entire log file. *)
+  let read_file t =
+    S.find t file >|= function
+    | None   -> []
+    | Some l -> l
+
+  (* Persist a new entry in the log. *)
+  let log t fmt =
+    Fmt.kstrf (fun message ->
+        read_file t >>= fun logs ->
+        let logs = Log.add logs (Entry.v message) in
+        S.set t (info "Adding a new entry") file logs
+      ) fmt
+
+  let () =
+    Lwt_main.run begin
+      S.Repo.v config >>= S.master
+      >>= fun t  -> log t "Adding a new log entry"
+      >>= fun () -> Irmin.clone_force ~src:t ~dst:"x"
+      >>= fun x  -> log x "Adding new stuff to x"
+      >>= fun () -> log x "Adding more stuff to x"
+      >>= fun () -> log x "More. Stuff. To x."
+      >>= fun () -> log t "I can add stuff on t also"
+      >>= fun () -> log t "Yes. On t!"
+      >>= fun () -> S.merge (info "Merging x into t") x ~into:t
+      >|= function Ok () -> () | Error _ -> failwith "merge conflict!"
+    end
+]}
+
+*)
+
+(** {1 Helpers} *)
+
+(** [Dot] provides functions to export a store to the Graphviz `dot`
+    format. *)
+module Dot (S : S) : sig
+  (** {1 Dot Export} *)
+
+  val output_buffer :
+    S.t ->
+    ?html:bool ->
+    ?depth:int ->
+    ?full:bool ->
+    date:(int64 -> string) ->
+    Buffer.t ->
+    unit Lwt.t
+  (** [output_buffer t ?html ?depth ?full buf] outputs the Graphviz
+        representation of [t] in the buffer [buf].
+
+        [html] (default is false) enables HTML labels.
+
+        [depth] is used to limit the depth of the commit history. [None]
+        here means no limitation.
+
+        If [full] is set (default is not) the full graph, including the
+        commits, nodes and contents, is exported, otherwise it is the
+        commit history graph only. *)
+end
+
+(** {1:backend Backends}
+
+    API to create new Irmin backends. A backend is an implementation
+    exposing either a concrete implementation of {!S} or a functor
+    providing {!S} once applied.
+
+    There are two ways to create a concrete {!Irmin.S} implementation:
+
+    {ul
+    {- {!Make} creates a store where all the objects are stored in the
+    same store, using the same internal keys format and a custom binary
+    format based on {{:https://github.com/janestreet/bin_prot}bin_prot},
+    with no native synchronization primitives: it is usually what is
+    needed to quickly create a new backend.}
+    {- {!Make_ext} creates a store with a {e deep} embedding of each
+    of the internal stores into separate store, with total control over
+    the binary format and using the native synchronization protocols
+    when available.}
+    }
+*)
+
+(** [APPEND_ONLY_STORE_MAKER] is the signature exposed by
+    append-only store backends. [K] is the implementation of keys
+    and [V] is the implementation of values. *)
+module type APPEND_ONLY_STORE_MAKER = functor (K : Type.S) (V : Type.S) -> sig
+  include APPEND_ONLY_STORE with type key = K.t and type value = V.t
+
+  val batch : [ `Read ] t -> ([ `Read | `Write ] t -> 'a Lwt.t) -> 'a Lwt.t
+  (** [batch t f] applies the writes in [f] in a separate batch. The
+     exact guarantees depends on the backends. *)
+
+  val v : config -> [ `Read ] t Lwt.t
+  (** [v config] is a function returning fresh store handles, with the
+      configuration [config], which is provided by the backend. *)
+
+  val close : 'a t -> unit Lwt.t
+  (** [close t] frees up all the resources associated to [t]. Any
+      operations run on a closed store will raise [Closed].*)
+end
+
+(** [CONTENT_ADDRESSABLE_STOREMAKER] is the signature exposed by
+    content-addressable store backends. [K] is the implementation of keys
+    and [V] is the implementation of values. *)
+module type CONTENT_ADDRESSABLE_STORE_MAKER = functor
+  (K : Hash.S)
+  (V : Type.S)
+  -> sig
+  include CONTENT_ADDRESSABLE_STORE with type key = K.t and type value = V.t
+
+  val batch : [ `Read ] t -> ([ `Read | `Write ] t -> 'a Lwt.t) -> 'a Lwt.t
+  (** [batch t f] applies the writes in [f] in a separate batch. The
+     exact guarantees depends on the backends. *)
+
+  val v : config -> [ `Read ] t Lwt.t
+  (** [v config] is a function returning fresh store handles, with the
+      configuration [config], which is provided by the backend. *)
+
+  val close : 'a t -> unit Lwt.t
+  (** [close t] frees up all the resources associated to [t]. Any
+      operations run on a closed store will raise [Closed].*)
+end
+
+module Content_addressable
+    (S : APPEND_ONLY_STORE_MAKER)
+    (K : Hash.S)
+    (V : Type.S) : sig
+  include
+    CONTENT_ADDRESSABLE_STORE
+      with type 'a t = 'a S(K)(V).t
+       and type key = K.t
+       and type value = V.t
+
+  val batch : [ `Read ] t -> ([ `Read | `Write ] t -> 'a Lwt.t) -> 'a Lwt.t
+  (** [batch t f] applies the writes in [f] in a separate batch. The
+      exact guarantees depends on the backends. *)
+
+  val v : config -> [ `Read ] t Lwt.t
+  (** [v config] is a function returning fresh store handles, with the
+      configuration [config], which is provided by the backend. *)
+
+  val close : 'a t -> unit Lwt.t
+  (** [close t] frees up all the resources associated to [t]. Any
+      operations run on a closed store will raise [Closed]. *)
+end
+
+(** [ATOMIC_WRITE_STORE_MAKER] is the signature exposed by atomic-write
+    store backends. [K] is the implementation of keys and [V] is the
+    implementation of values.*)
+module type ATOMIC_WRITE_STORE_MAKER = functor (K : Type.S) (V : Type.S) -> sig
+  include ATOMIC_WRITE_STORE with type key = K.t and type value = V.t
+
+  val v : config -> t Lwt.t
+  (** [v config] is a function returning fresh store handles, with the
+      configuration [config], which is provided by the backend. *)
+
+  val close : t -> unit Lwt.t
+  (** [close t] frees up all the resources associated to [t]. Any
+      operations run on a closed store will raise [Closed]. *)
+end
+
+module Make
+    (CA : CONTENT_ADDRESSABLE_STORE_MAKER)
+    (AW : ATOMIC_WRITE_STORE_MAKER) : S_MAKER
+(** Simple store creator. Use the same type of all of the internal
+    keys and store all the values in the same store. *)
+
+module Make_ext
+    (CA : CONTENT_ADDRESSABLE_STORE_MAKER)
+    (AW : ATOMIC_WRITE_STORE_MAKER)
+    (Metadata : Metadata.S)
+    (Contents : Contents.S)
+    (Path : Path.S)
+    (Branch : Branch.S)
+    (Hash : Hash.S)
+    (Node : Private.Node.S
+              with type metadata = Metadata.t
+               and type hash = Hash.t
+               and type step = Path.step)
+    (Commit : Private.Commit.S with type hash = Hash.t) :
+  S
+    with type key = Path.t
+     and type contents = Contents.t
+     and type branch = Branch.t
+     and type hash = Hash.t
+     and type step = Path.step
+     and type metadata = Metadata.t
+     and type Key.step = Path.step
+
+(** Advanced store creator. *)
+module Of_private (P : Private.S) :
+  S
+    with type key = P.Node.Path.t
+     and type contents = P.Contents.value
+     and type branch = P.Branch.key
+     and type hash = P.Hash.t
+     and type step = P.Node.Path.step
+     and type metadata = P.Node.Val.metadata
+     and type Key.step = P.Node.Path.step
+     and type repo = P.Repo.t
+     and type slice = P.Slice.t
+     and module Private = P
diff --git a/vendors/irmin/irmin.opam b/vendors/irmin/irmin.opam
new file mode 100644
index 0000000000000000000000000000000000000000..c75e65066c33b4d954eb073b4372ea0f58007e3e
--- /dev/null
+++ b/vendors/irmin/irmin.opam
@@ -0,0 +1,38 @@
+opam-version: "2.0"
+version:      "2.0"
+maintainer:   "thomas@gazagnaire.org"
+authors:      ["Thomas Gazagnaire" "Thomas Leonard"]
+license:      "ISC"
+homepage:     "https://github.com/mirage/irmin"
+bug-reports:  "https://github.com/mirage/irmin/issues"
+dev-repo:     "git+https://github.com/mirage/irmin.git"
+doc:          "https://mirage.github.io/irmin/"
+
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+
+depends: [
+  "ocaml"   {>= "4.03.0"}
+  "dune"    {build & >= "1.1.0"}
+  "fmt"     {>= "0.8.0"}
+  "uri"     {>= "1.3.12"}
+  "jsonm"   {>= "1.0.0"}
+  "lwt"     {>= "2.4.7"}
+  "base64"  {>= "2.0.0"}
+  "digestif"
+  "ocamlgraph"
+  "logs"    {>= "0.5.0"}
+  "astring"
+]
+synopsis: """
+Irmin, a distributed database that follows the same design principles as Git
+"""
+description: """
+Irmin is a library for persistent stores with built-in snapshot,
+branching and reverting mechanisms. It is designed to use a large
+variety of backends. Irmin is written in pure OCaml and does not
+depend on external C stubs; it aims to run everywhere, from Linux,
+to browsers and Xen unikernels.
+"""
diff --git a/vendors/irmin/lock.ml b/vendors/irmin/lock.ml
new file mode 100644
index 0000000000000000000000000000000000000000..5c6478a07979d6fe99cc9edf2adc015372162248
--- /dev/null
+++ b/vendors/irmin/lock.ml
@@ -0,0 +1,72 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+let ( >>= ) = Lwt.bind
+
+module type S = sig
+  type key
+
+  type t
+
+  val v : unit -> t
+
+  val with_lock : t -> key -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+
+  val stats : t -> int
+end
+
+module Make (K : Type.S) = struct
+  module K = struct
+    type t = K.t
+
+    let hash = Hashtbl.hash
+
+    let equal = Type.equal K.t
+  end
+
+  module KHashtbl = Hashtbl.Make (K)
+
+  type key = K.t
+
+  type t = { global : Lwt_mutex.t; locks : Lwt_mutex.t KHashtbl.t }
+
+  let v () = { global = Lwt_mutex.create (); locks = KHashtbl.create 1024 }
+
+  let stats t = KHashtbl.length t.locks
+
+  let lock t key () =
+    let lock =
+      try KHashtbl.find t.locks key
+      with Not_found ->
+        let lock = Lwt_mutex.create () in
+        KHashtbl.add t.locks key lock;
+        lock
+    in
+    Lwt.return lock
+
+  let unlock t key () =
+    let () =
+      if KHashtbl.mem t.locks key then
+        let lock = KHashtbl.find t.locks key in
+        if Lwt_mutex.is_empty lock then KHashtbl.remove t.locks key
+    in
+    Lwt.return_unit
+
+  let with_lock t k fn =
+    Lwt_mutex.with_lock t.global (lock t k) >>= fun lock ->
+    Lwt_mutex.with_lock lock fn >>= fun r ->
+    Lwt_mutex.with_lock t.global (unlock t k) >>= fun () -> Lwt.return r
+end
diff --git a/vendors/irmin-lmdb/irmin_lmdb.mli b/vendors/irmin/lock.mli
similarity index 76%
rename from vendors/irmin-lmdb/irmin_lmdb.mli
rename to vendors/irmin/lock.mli
index 34a1a3cbdb4ffa6c66a7a57905b0dafb853194ad..3c2ce73ff97530799b148eeeda7fea810e6b0e89 100644
--- a/vendors/irmin-lmdb/irmin_lmdb.mli
+++ b/vendors/irmin/lock.mli
@@ -1,6 +1,5 @@
 (*
  * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
- * Copyright (c) 2017 Dynamic Ledger Solutions <contact@tezos.com>
  *
  * Permission to use, copy, modify, and distribute this software for any
  * purpose with or without fee is hereby granted, provided that the above
@@ -15,9 +14,16 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-(** Quick-and-dirty LevelDB backend for Irmin. *)
+module type S = sig
+  type key
 
-val config:
-  ?config:Irmin.config -> ?mapsize:int64 -> ?readonly:bool -> string -> Irmin.config
+  type t
 
-module Make : Irmin.S_MAKER
+  val v : unit -> t
+
+  val with_lock : t -> key -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+
+  val stats : t -> int
+end
+
+module Make (K : Type.S) : S with type key = K.t
diff --git a/vendors/irmin/lru.ml b/vendors/irmin/lru.ml
new file mode 100644
index 0000000000000000000000000000000000000000..8b137891791fe96927ad78e64b0aad7bded08bdc
--- /dev/null
+++ b/vendors/irmin/lru.ml
@@ -0,0 +1 @@
+
diff --git a/vendors/irmin/merge.ml b/vendors/irmin/merge.ml
new file mode 100644
index 0000000000000000000000000000000000000000..cc1d8b3b0fd1b27b65dc00d64bf455e4da889dce
--- /dev/null
+++ b/vendors/irmin/merge.ml
@@ -0,0 +1,442 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+open Printf
+
+let src = Logs.Src.create "irmin.merge" ~doc:"Irmin merging"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+type conflict = [ `Conflict of string ]
+
+type 'a promise = unit -> ('a option, conflict) result Lwt.t
+
+let promise t : 'a promise = fun () -> Lwt.return_ok (Some t)
+
+let memo fn =
+  let r = ref None in
+  fun () ->
+    match !r with
+    | Some x -> x
+    | None ->
+        fn () >>= fun x ->
+        r := Some (Lwt.return x);
+        Lwt.return x
+
+type 'a f = old:'a promise -> 'a -> 'a -> ('a, conflict) result Lwt.t
+
+type 'a t = 'a Type.t * 'a f
+
+let v t f = (t, f)
+
+let f (x : 'a t) = snd x
+
+let conflict fmt =
+  ksprintf
+    (fun msg ->
+      Log.debug (fun f -> f "conflict: %s" msg);
+      Lwt.return_error (`Conflict msg))
+    fmt
+
+let bind x f = x >>= function Error e -> Lwt.return_error e | Ok x -> f x
+
+let map f x = x >|= function Error _ as x -> x | Ok x -> Ok (f x)
+
+let map_promise f t () =
+  t () >|= function
+  | Error _ as x -> x
+  | Ok None -> Ok None
+  | Ok (Some a) -> Ok (Some (f a))
+
+let bind_promise t f () =
+  t () >>= function
+  | Error e -> Lwt.return_error e
+  | Ok None -> Lwt.return_ok None
+  | Ok (Some a) -> f a ()
+
+let ok x = Lwt.return_ok x
+
+module Infix = struct
+  let ( >>=* ) = bind
+
+  let ( >|=* ) x f = map f x
+
+  let ( >>=? ) = bind_promise
+
+  let ( >|=? ) x f = map_promise f x
+end
+
+open Infix
+
+let default (type a) (t : a Type.t) : a t =
+  let pp = Type.pp t and ( = ) = Type.equal t in
+  ( t,
+    fun ~old t1 t2 ->
+      let open Infix in
+      Log.debug (fun f -> f "default %a | %a" pp t1 pp t2);
+      old () >>=* function
+      | None -> conflict "default: add/add and no common ancestor"
+      | Some old ->
+          Log.debug (fun f -> f "default old=%a" pp t1);
+          if old = t1 && t1 = t2 then ok t1
+          else if old = t1 then ok t2
+          else if old = t2 then ok t1
+          else conflict "default" )
+
+let idempotent dt =
+  let ( = ) = Type.equal dt in
+  let default = default dt in
+  let f ~old x y = if x = y then ok x else f default ~old x y in
+  v dt f
+
+let seq = function
+  | [] -> invalid_arg "nothing to merge"
+  | (t, _) :: _ as ts ->
+      ( t,
+        fun ~old v1 v2 ->
+          Lwt_list.fold_left_s
+            (fun acc (_, merge) ->
+              match acc with Ok x -> ok x | Error _ -> merge ~old v1 v2)
+            (Error (`Conflict "nothing to merge"))
+            ts )
+
+let option (type a) ((a, t) : a t) : a option t =
+  let dt = Type.option a in
+  let pp = Type.pp dt in
+  ( dt,
+    fun ~old t1 t2 ->
+      Log.debug (fun f -> f "some %a | %a" pp t1 pp t2);
+      f (default Type.(option a)) ~old t1 t2 >>= function
+      | Ok x -> ok x
+      | Error _ -> (
+          match (t1, t2) with
+          | None, None -> ok None
+          | Some v1, Some v2 ->
+              let open Infix in
+              let old () =
+                old () >>=* function
+                | None -> ok None
+                | Some o ->
+                    Log.debug (fun f -> f "option old=%a" pp o);
+                    ok o
+              in
+              t ~old v1 v2 >|=* fun x -> Some x
+          | Some x, None | None, Some x -> (
+              let open Infix in
+              old () >>=* function
+              | None | Some None -> ok (Some x)
+              | Some (Some o) ->
+                  let pp = Type.pp a and ( = ) = Type.equal a in
+                  Log.debug (fun f -> f "option old=%a" pp o);
+                  if x = o then ok (Some x) else conflict "option: add/del" ) )
+  )
+
+let pair (da, a) (db, b) =
+  let dt = Type.pair da db in
+  let pp = Type.pp dt in
+  ( dt,
+    fun ~old x y ->
+      Log.debug (fun f -> f "pair %a | %a" pp x pp y);
+      (snd (default dt)) ~old x y >>= function
+      | Ok x -> ok x
+      | Error _ ->
+          let (a1, b1), (a2, b2) = (x, y) in
+          let o1 = map_promise fst old in
+          let o2 = map_promise snd old in
+          a ~old:o1 a1 a2 >>=* fun a3 ->
+          b ~old:o2 b1 b2 >|=* fun b3 -> (a3, b3) )
+
+let triple (da, a) (db, b) (dc, c) =
+  let dt = Type.triple da db dc in
+  let pp = Type.pp dt in
+  ( dt,
+    fun ~old x y ->
+      Log.debug (fun f -> f "triple %a | %a" pp x pp y);
+      (snd (default dt)) ~old x y >>= function
+      | Ok x -> ok x
+      | Error _ ->
+          let (a1, b1, c1), (a2, b2, c2) = (x, y) in
+          let o1 = map_promise (fun (x, _, _) -> x) old in
+          let o2 = map_promise (fun (_, x, _) -> x) old in
+          let o3 = map_promise (fun (_, _, x) -> x) old in
+          a ~old:o1 a1 a2 >>=* fun a3 ->
+          b ~old:o2 b1 b2 >>=* fun b3 ->
+          c ~old:o3 c1 c2 >|=* fun c3 -> (a3, b3, c3) )
+
+exception C of string
+
+let merge_elt merge_v old key vs =
+  let v1, v2 =
+    match vs with
+    | `Left v -> (Some v, None)
+    | `Right v -> (None, Some v)
+    | `Both (v1, v2) -> (Some v1, Some v2)
+  in
+  let old () = old key in
+  merge_v key ~old v1 v2 >>= function
+  | Error (`Conflict msg) -> Lwt.fail (C msg)
+  | Ok x -> Lwt.return x
+
+(* assume l1 and l2 are key-sorted *)
+let alist_iter2 compare_k f l1 l2 =
+  let rec aux l1 l2 =
+    match (l1, l2) with
+    | [], t -> List.iter (fun (key, v) -> f key (`Right v)) t
+    | t, [] -> List.iter (fun (key, v) -> f key (`Left v)) t
+    | (k1, v1) :: t1, (k2, v2) :: t2 -> (
+        match compare_k k1 k2 with
+        | 0 ->
+            f k1 (`Both (v1, v2));
+            aux t1 t2
+        | x ->
+            if x < 0 then (
+              f k1 (`Left v1);
+              aux t1 l2 )
+            else (
+              f k2 (`Right v2);
+              aux l1 t2 ) )
+  in
+  aux l1 l2
+
+(* assume l1 and l2 are key-sorted *)
+let alist_iter2_lwt compare_k f l1 l2 =
+  let open Lwt in
+  let l3 = ref [] in
+  alist_iter2 compare_k (fun left right -> l3 := f left right :: !l3) l1 l2;
+  Lwt_list.iter_p (fun b -> b >>= fun () -> return_unit) (List.rev !l3)
+
+(* DO NOT assume l1 and l2 are key-sorted *)
+let alist_merge_lwt compare_k f l1 l2 =
+  let open Lwt in
+  let l3 = ref [] in
+  let sort l = List.sort (fun (x, _) (y, _) -> compare_k x y) l in
+  let l1 = sort l1 in
+  let l2 = sort l2 in
+  let f key data =
+    f key data >>= function
+    | None -> return_unit
+    | Some v ->
+        l3 := (key, v) :: !l3;
+        return_unit
+  in
+  alist_iter2_lwt compare_k f l1 l2 >>= fun () -> return !l3
+
+let alist dx dy merge_v =
+  let dt = Type.(list (pair dx dy)) in
+  ( dt,
+    fun ~old x y ->
+      let pair = Type.pair dx dy in
+      let pp = Type.pp dt in
+      Log.debug (fun l -> l "alist %a | %a" pp x pp y);
+      let sort = List.sort @@ Type.compare pair in
+      let x = sort x in
+      let y = sort y in
+      let old k =
+        let open Infix in
+        old () >|=* function
+        | None -> Some None (* no parent = parent with empty value *)
+        | Some old ->
+            let old = try Some (List.assoc k old) with Not_found -> None in
+            Some old
+      in
+      let merge_v k = f (merge_v k) in
+      Lwt.catch
+        (fun () ->
+          alist_merge_lwt Type.(compare dx) (merge_elt merge_v old) x y >>= ok)
+        (function C msg -> conflict "%s" msg | e -> Lwt.fail e) )
+
+module MultiSet (K : sig
+  include Set.OrderedType
+
+  val t : t Type.t
+end) =
+struct
+  module M = Map.Make (K)
+
+  let of_alist l = List.fold_left (fun map (k, v) -> M.add k v map) M.empty l
+
+  let t = Type.map Type.(list (pair K.t int64)) of_alist M.bindings
+
+  let merge ~old m1 m2 =
+    let get k m = try M.find k m with Not_found -> 0L in
+    let set k v m = match v with 0L -> M.remove k m | _ -> M.add k v m in
+    let add k v m = set k (Int64.add v @@ get k m) m in
+    let keys = ref M.empty in
+    old () >|=* fun old ->
+    let old =
+      match old with
+      | None -> M.empty (* no parent = parent with empty value *)
+      | Some o -> o
+    in
+    M.iter (fun k v -> keys := add k (Int64.neg v) !keys) old;
+    M.iter (fun k v -> keys := add k v !keys) m1;
+    M.iter (fun k v -> keys := add k v !keys) m2;
+    !keys
+
+  let merge = (t, merge)
+end
+
+module Set (K : sig
+  include Set.OrderedType
+
+  val t : t Type.t
+end) =
+struct
+  module S = Set.Make (K)
+
+  let of_list l = List.fold_left (fun set elt -> S.add elt set) S.empty l
+
+  let t = Type.(map @@ list K.t) of_list S.elements
+
+  let pp = Type.pp t
+
+  let merge ~old x y =
+    Log.debug (fun l -> l "merge %a %a" pp x pp y);
+    old () >|=* fun old ->
+    let old = match old with None -> S.empty | Some o -> o in
+    let ( ++ ) = S.union and ( -- ) = S.diff in
+    let to_add = x -- old ++ (y -- old) in
+    let to_del = old -- x ++ (old -- y) in
+    old -- to_del ++ to_add
+
+  let merge = (t, merge)
+end
+
+module Map (K : sig
+  include Map.OrderedType
+
+  val t : t Type.t
+end) =
+struct
+  module M = Map.Make (K)
+
+  let of_alist l = List.fold_left (fun map (k, v) -> M.add k v map) M.empty l
+
+  let t x = Type.map Type.(list @@ pair K.t x) of_alist M.bindings
+
+  let iter2 f t1 t2 = alist_iter2 K.compare f (M.bindings t1) (M.bindings t2)
+
+  let iter2 f m1 m2 =
+    let m3 = ref [] in
+    iter2 (fun key data -> m3 := f key data :: !m3) m1 m2;
+    Lwt_list.iter_p (fun b -> b >>= fun () -> Lwt.return_unit) (List.rev !m3)
+
+  let merge_maps f m1 m2 =
+    let l3 = ref [] in
+    let f key data =
+      f key data >|= function None -> () | Some v -> l3 := (key, v) :: !l3
+    in
+    iter2 f m1 m2 >>= fun () ->
+    let m3 = of_alist !l3 in
+    Lwt.return m3
+
+  let merge dv (merge_v : K.t -> 'a option t) =
+    let pp ppf m = Type.(pp (list (pair K.t dv))) ppf @@ M.bindings m in
+    let merge_v k = f (merge_v k) in
+    ( t dv,
+      fun ~old m1 m2 ->
+        Log.debug (fun f -> f "assoc %a | %a" pp m1 pp m2);
+        Lwt.catch
+          (fun () ->
+            let old key =
+              old () >>=* function
+              | None -> ok None
+              | Some old ->
+                  Log.debug (fun f -> f "assoc old=%a" pp old);
+                  let old =
+                    try Some (M.find key old) with Not_found -> None
+                  in
+                  ok (Some old)
+            in
+            merge_maps (merge_elt merge_v old) m1 m2 >>= ok)
+          (function C msg -> conflict "%s" msg | e -> Lwt.fail e) )
+end
+
+let like da t a_to_b b_to_a =
+  let pp = Type.pp da in
+  let merge ~old a1 a2 =
+    Log.debug (fun f -> f "biject %a | %a" pp a1 pp a2);
+    try
+      let b1 = a_to_b a1 in
+      let b2 = a_to_b a2 in
+      let old = memo (map_promise a_to_b old) in
+      (f t) ~old b1 b2 >|=* b_to_a
+    with Not_found -> conflict "biject"
+  in
+  seq [ default da; (da, merge) ]
+
+let like_lwt (type a b) da (t : b t) (a_to_b : a -> b Lwt.t)
+    (b_to_a : b -> a Lwt.t) : a t =
+  let pp = Type.pp da in
+  let merge ~old a1 a2 =
+    Log.debug (fun f -> f "biject' %a | %a" pp a1 pp a2);
+    try
+      a_to_b a1 >>= fun b1 ->
+      a_to_b a2 >>= fun b2 ->
+      let old =
+        memo (fun () ->
+            bind (old ()) @@ function
+            | None -> ok None
+            | Some a -> a_to_b a >|= fun b -> Ok (Some b))
+      in
+      bind ((f t) ~old b1 b2) @@ fun b3 -> b_to_a b3 >>= ok
+    with Not_found -> conflict "biject'"
+  in
+  seq [ default da; (da, merge) ]
+
+let unit = default Type.unit
+
+let bool = default Type.bool
+
+let char = default Type.char
+
+let int32 = default Type.int32
+
+let int64 = default Type.int64
+
+let float = default Type.float
+
+let string = default Type.string
+
+type counter = int64
+
+let counter =
+  ( Type.int64,
+    fun ~old x y ->
+      old () >|=* fun old ->
+      let old = match old with None -> 0L | Some o -> o in
+      let ( + ) = Int64.add and ( - ) = Int64.sub in
+      x + y - old )
+
+let with_conflict rewrite (d, f) =
+  let f ~old x y =
+    f ~old x y >>= function
+    | Error (`Conflict msg) -> conflict "%s" (rewrite msg)
+    | Ok x -> ok x
+  in
+  (d, f)
+
+let conflict_t =
+  Type.(map string) (fun x -> `Conflict x) (function `Conflict x -> x)
+
+let result_t ok =
+  let open Type in
+  variant "result" (fun ok error ->
+    function Ok x -> ok x | Error x -> error x)
+  |~ case1 "ok" ok (fun x -> Ok x)
+  |~ case1 "error" conflict_t (fun x -> Error x)
+  |> sealv
diff --git a/vendors/irmin/merge.mli b/vendors/irmin/merge.mli
new file mode 100644
index 0000000000000000000000000000000000000000..2e98985f4f679211edfb2e61c5cee6873810746a
--- /dev/null
+++ b/vendors/irmin/merge.mli
@@ -0,0 +1,127 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Merge operators. *)
+
+type conflict = [ `Conflict of string ]
+
+type 'a promise = unit -> ('a option, conflict) result Lwt.t
+
+type 'a f = old:'a promise -> 'a -> 'a -> ('a, conflict) result Lwt.t
+
+type 'a t
+
+val v : 'a Type.t -> 'a f -> 'a t
+
+val f : 'a t -> 'a f
+
+val bind :
+  ('a, 'b) result Lwt.t ->
+  ('a -> ('c, 'b) result Lwt.t) ->
+  ('c, 'b) result Lwt.t
+
+val map : ('a -> 'c) -> ('a, 'b) result Lwt.t -> ('c, 'b) result Lwt.t
+
+val promise : 'a -> 'a promise
+
+val map_promise : ('a -> 'b) -> 'a promise -> 'b promise
+
+val bind_promise : 'a promise -> ('a -> 'b promise) -> 'b promise
+
+val seq : 'a t list -> 'a t
+
+val default : 'a Type.t -> 'a t
+
+val idempotent : 'a Type.t -> 'a t
+
+val unit : unit t
+
+val bool : bool t
+
+val char : char t
+
+val int32 : int32 t
+
+val int64 : int64 t
+
+val float : float t
+
+val string : string t
+
+type counter = int64
+
+val counter : counter t
+
+val option : 'a t -> 'a option t
+
+val pair : 'a t -> 'b t -> ('a * 'b) t
+
+val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+
+module MultiSet (K : sig
+  include Set.OrderedType
+
+  val t : t Type.t
+end) : sig
+  val merge : counter Map.Make(K).t t
+end
+
+module Set (E : sig
+  include Set.OrderedType
+
+  val t : t Type.t
+end) : sig
+  val merge : Set.Make(E).t t
+end
+
+val alist : 'a Type.t -> 'b Type.t -> ('a -> 'b option t) -> ('a * 'b) list t
+
+module Map (K : sig
+  include Map.OrderedType
+
+  val t : t Type.t
+end) : sig
+  val merge : 'a Type.t -> (K.t -> 'a option t) -> 'a Map.Make(K).t t
+end
+
+val like : 'a Type.t -> 'b t -> ('a -> 'b) -> ('b -> 'a) -> 'a t
+
+val like_lwt :
+  'a Type.t -> 'b t -> ('a -> 'b Lwt.t) -> ('b -> 'a Lwt.t) -> 'a t
+
+val with_conflict : (string -> string) -> 'a t -> 'a t
+
+val ok : 'a -> ('a, conflict) result Lwt.t
+
+val conflict : ('a, unit, string, ('b, conflict) result Lwt.t) format4 -> 'a
+
+module Infix : sig
+  val ( >>=* ) :
+    ('a, conflict) result Lwt.t ->
+    ('a -> ('b, conflict) result Lwt.t) ->
+    ('b, conflict) result Lwt.t
+
+  val ( >|=* ) :
+    ('a, conflict) result Lwt.t -> ('a -> 'b) -> ('b, conflict) result Lwt.t
+
+  val ( >>=? ) : 'a promise -> ('a -> 'b promise) -> 'b promise
+
+  val ( >|=? ) : 'a promise -> ('a -> 'b) -> 'b promise
+end
+
+val conflict_t : conflict Type.t
+
+val result_t : 'a Type.t -> ('a, conflict) result Type.t
diff --git a/vendors/irmin/node.ml b/vendors/irmin/node.ml
new file mode 100644
index 0000000000000000000000000000000000000000..8bdc0d57abf886b9e3abcff51fa50b67f38f30f9
--- /dev/null
+++ b/vendors/irmin/node.ml
@@ -0,0 +1,474 @@
+(*
+ * Copyright (c) 2013      Louis Gesbert     <louis.gesbert@ocamlpro.com>
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+
+let src = Logs.Src.create "irmin.node" ~doc:"Irmin trees/nodes"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+module No_metadata = struct
+  type t = unit
+
+  let t = Type.unit
+
+  let default = ()
+
+  let merge = Merge.v t (fun ~old:_ () () -> Merge.ok ())
+end
+
+module Make
+    (K : Type.S) (P : sig
+      type step
+
+      val step_t : step Type.t
+    end)
+    (M : S.METADATA) =
+struct
+  type hash = K.t
+
+  type step = P.step
+
+  type metadata = M.t
+
+  type kind = [ `Node | `Contents of M.t ]
+
+  type entry = { kind : kind; name : P.step; node : K.t }
+
+  let kind_t =
+    let open Type in
+    variant "Tree.kind" (fun node contents contents_m ->
+      function
+      | `Node -> node
+      | `Contents m ->
+          if Type.equal M.t m M.default then contents else contents_m m)
+    |~ case0 "node" `Node
+    |~ case0 "contents" (`Contents M.default)
+    |~ case1 "contents" M.t (fun m -> `Contents m)
+    |> sealv
+
+  let entry_t : entry Type.t =
+    let open Type in
+    record "Tree.entry" (fun kind name node -> { kind; name; node })
+    |+ field "kind" kind_t (function { kind; _ } -> kind)
+    |+ field "name" P.step_t (fun { name; _ } -> name)
+    |+ field "node" K.t (fun { node; _ } -> node)
+    |> sealr
+
+  let to_entry (k, v) =
+    match v with
+    | `Node h -> { name = k; kind = `Node; node = h }
+    | `Contents (h, m) -> { name = k; kind = `Contents m; node = h }
+
+  let of_entry n =
+    ( n.name,
+      match n.kind with
+      | `Node -> `Node n.node
+      | `Contents m -> `Contents (n.node, m) )
+
+  module StepMap = Map.Make (struct
+    type t = P.step
+
+    let compare (x : t) (y : t) = Type.compare P.step_t y x
+  end)
+
+  type value = [ `Contents of hash * metadata | `Node of hash ]
+
+  type t = entry StepMap.t
+
+  let v l =
+    List.fold_left
+      (fun acc x -> StepMap.add (fst x) (to_entry x) acc)
+      StepMap.empty l
+
+  let list t = List.rev_map (fun (_, e) -> of_entry e) (StepMap.bindings t)
+
+  let find t s =
+    try
+      let _, v = of_entry (StepMap.find s t) in
+      Some v
+    with Not_found -> None
+
+  let empty = StepMap.empty
+
+  let is_empty e = list e = []
+
+  let add t k v =
+    let e = to_entry (k, v) in
+    StepMap.update k
+      (fun e' ->
+        if Type.equal (Type.option entry_t) (Some e) e' then e' else Some e)
+      t
+
+  let remove t k = StepMap.remove k t
+
+  let step_t = P.step_t
+
+  let hash_t = K.t
+
+  let metadata_t = M.t
+
+  let default = M.default
+
+  let value_t =
+    let open Type in
+    variant "value" (fun n c x ->
+      function
+      | `Node h -> n h
+      | `Contents (h, m) -> if Type.equal M.t m M.default then c h else x (h, m))
+    |~ case1 "node" K.t (fun k -> `Node k)
+    |~ case1 "contents" K.t (fun h -> `Contents (h, M.default))
+    |~ case1 "contents-x" (pair K.t M.t) (fun (h, m) -> `Contents (h, m))
+    |> sealv
+
+  let of_entries e = v (List.rev_map of_entry e)
+
+  let entries e = List.rev_map (fun (_, e) -> e) (StepMap.bindings e)
+
+  let t = Type.map Type.(list entry_t) of_entries entries
+end
+
+module Store
+    (C : S.CONTENTS_STORE)
+    (P : S.PATH)
+    (M : S.METADATA) (S : sig
+      include S.CONTENT_ADDRESSABLE_STORE with type key = C.key
+
+      module Key : S.HASH with type t = key
+
+      module Val :
+        S.NODE
+          with type t = value
+           and type hash = key
+           and type metadata = M.t
+           and type step = P.step
+    end) =
+struct
+  module Contents = C
+  module Key = Hash.Typed (S.Key) (S.Val)
+  module Path = P
+  module Metadata = M
+
+  type 'a t = 'a C.t * 'a S.t
+
+  type key = S.key
+
+  type value = S.value
+
+  let mem (_, t) = S.mem t
+
+  let find (_, t) = S.find t
+
+  let add (_, t) = S.add t
+
+  let unsafe_add (_, t) = S.unsafe_add t
+
+  let all_contents t =
+    let kvs = S.Val.list t in
+    List.fold_left
+      (fun acc -> function k, `Contents c -> (k, c) :: acc | _ -> acc)
+      [] kvs
+
+  let all_succ t =
+    let kvs = S.Val.list t in
+    List.fold_left
+      (fun acc -> function k, `Node n -> (k, n) :: acc | _ -> acc)
+      [] kvs
+
+  let contents_t = C.Key.t
+
+  let metadata_t = M.t
+
+  let step_t = Path.step_t
+
+  (* [Merge.alist] expects us to return an option. [C.merge] does
+     that, but we need to consider the metadata too... *)
+  let merge_contents_meta c =
+    (* This gets us [C.t option, S.Val.Metadata.t]. We want [(C.t *
+       S.Val.Metadata.t) option]. *)
+    let explode = function
+      | None -> (None, M.default)
+      | Some (c, m) -> (Some c, m)
+    in
+    let implode = function None, _ -> None | Some c, m -> Some (c, m) in
+    Merge.like
+      Type.(option (pair contents_t metadata_t))
+      (Merge.pair (C.merge c) M.merge)
+      explode implode
+
+  let merge_contents_meta c =
+    Merge.alist step_t
+      Type.(pair contents_t metadata_t)
+      (fun _step -> merge_contents_meta c)
+
+  let merge_parents merge_key =
+    Merge.alist step_t S.Key.t (fun _step -> merge_key)
+
+  let merge_value (c, _) merge_key =
+    let explode t = (all_contents t, all_succ t) in
+    let implode (contents, succ) =
+      let xs = List.rev_map (fun (s, c) -> (s, `Contents c)) contents in
+      let ys = List.rev_map (fun (s, n) -> (s, `Node n)) succ in
+      S.Val.v (xs @ ys)
+    in
+    let merge = Merge.pair (merge_contents_meta c) (merge_parents merge_key) in
+    Merge.like S.Val.t merge explode implode
+
+  let rec merge t =
+    let merge_key =
+      Merge.v (Type.option S.Key.t) (fun ~old x y ->
+          Merge.(f (merge t)) ~old x y)
+    in
+    let merge = merge_value t merge_key in
+    let read = function
+      | None -> Lwt.return S.Val.empty
+      | Some k -> ( find t k >|= function None -> S.Val.empty | Some v -> v )
+    in
+    let add v =
+      if S.Val.is_empty v then Lwt.return_none
+      else add t v >>= fun k -> Lwt.return_some k
+    in
+    Merge.like_lwt Type.(option S.Key.t) merge read add
+
+  module Val = S.Val
+end
+
+module Graph (S : S.NODE_STORE) = struct
+  module Path = S.Path
+  module Contents = S.Contents.Key
+  module Metadata = S.Metadata
+
+  type step = Path.step
+
+  type metadata = Metadata.t
+
+  type contents = Contents.t
+
+  type node = S.key
+
+  type path = Path.t
+
+  type 'a t = 'a S.t
+
+  type value = [ `Contents of contents * metadata | `Node of node ]
+
+  let empty t = S.add t S.Val.empty
+
+  let list t n =
+    Log.debug (fun f -> f "steps");
+    S.find t n >|= function None -> [] | Some n -> S.Val.list n
+
+  module U = struct
+    type t = unit
+
+    let t = Type.unit
+  end
+
+  module Graph = Object_graph.Make (Contents) (Metadata) (S.Key) (U) (U)
+
+  let edges t =
+    List.rev_map
+      (function _, `Node n -> `Node n | _, `Contents c -> `Contents c)
+      (S.Val.list t)
+
+  let pp_key = Type.pp S.Key.t
+
+  let pp_keys = Fmt.(Dump.list pp_key)
+
+  let pp_path = Type.pp S.Path.t
+
+  let closure t ~min ~max =
+    Log.debug (fun f -> f "closure min=%a max=%a" pp_keys min pp_keys max);
+    let pred = function
+      | `Node k -> ( S.find t k >|= function None -> [] | Some v -> edges v )
+      | _ -> Lwt.return_nil
+    in
+    let min = List.rev_map (fun x -> `Node x) min in
+    let max = List.rev_map (fun x -> `Node x) max in
+    Graph.closure ~pred ~min ~max () >>= fun g ->
+    let keys =
+      List.fold_left
+        (fun acc -> function `Node x -> x :: acc | _ -> acc)
+        [] (Graph.vertex g)
+    in
+    Lwt.return keys
+
+  let v t xs = S.add t (S.Val.v xs)
+
+  let find_step t node step =
+    Log.debug (fun f -> f "contents %a" pp_key node);
+    S.find t node >|= function None -> None | Some n -> S.Val.find n step
+
+  let find t node path =
+    Log.debug (fun f -> f "read_node_exn %a %a" pp_key node pp_path path);
+    let rec aux node path =
+      match Path.decons path with
+      | None -> Lwt.return_some (`Node node)
+      | Some (h, tl) -> (
+          find_step t node h >>= function
+          | (None | Some (`Contents _)) as x -> Lwt.return x
+          | Some (`Node node) -> aux node tl )
+    in
+    aux node path
+
+  let err_empty_path () = invalid_arg "Irmin.node: empty path"
+
+  let map_one t node f label =
+    Log.debug (fun f -> f "map_one %a" Type.(pp Path.step_t) label);
+    let old_key = S.Val.find node label in
+    ( match old_key with
+    | None | Some (`Contents _) -> Lwt.return S.Val.empty
+    | Some (`Node k) -> (
+        S.find t k >|= function None -> S.Val.empty | Some v -> v ) )
+    >>= fun old_node ->
+    f old_node >>= fun new_node ->
+    if Type.equal S.Val.t old_node new_node then Lwt.return node
+    else if S.Val.is_empty new_node then
+      let node = S.Val.remove node label in
+      if S.Val.is_empty node then Lwt.return S.Val.empty else Lwt.return node
+    else S.add t new_node >|= fun k -> S.Val.add node label (`Node k)
+
+  let map t node path f =
+    Log.debug (fun f -> f "map %a %a" pp_key node pp_path path);
+    let rec aux node path =
+      match Path.decons path with
+      | None -> Lwt.return (f node)
+      | Some (h, tl) -> map_one t node (fun node -> aux node tl) h
+    in
+    (S.find t node >|= function None -> S.Val.empty | Some n -> n)
+    >>= fun node -> aux node path >>= S.add t
+
+  let add t node path n =
+    Log.debug (fun f -> f "add %a %a" pp_key node pp_path path);
+    match Path.rdecons path with
+    | Some (path, file) -> map t node path (fun node -> S.Val.add node file n)
+    | None -> (
+        match n with
+        | `Node n -> Lwt.return n
+        | `Contents _ -> failwith "TODO: Node.add" )
+
+  let rdecons_exn path =
+    match Path.rdecons path with
+    | Some (l, t) -> (l, t)
+    | None -> err_empty_path ()
+
+  let remove t node path =
+    let path, file = rdecons_exn path in
+    map t node path (fun node -> S.Val.remove node file)
+
+  let path_t = Path.t
+
+  let node_t = S.Key.t
+
+  let metadata_t = Metadata.t
+
+  let step_t = Path.step_t
+
+  let contents_t = Contents.t
+
+  let value_t = S.Val.value_t
+end
+
+module V1 (N : S.NODE) = struct
+  module K = struct
+    let h = Type.string_of `Int64
+
+    let size_of ?headers x =
+      Type.size_of ?headers h (Type.to_bin_string N.hash_t x)
+
+    let encode_bin ?headers e k =
+      Type.encode_bin ?headers h (Type.to_bin_string N.hash_t e) k
+
+    let decode_bin ?headers buf off =
+      let n, v = Type.decode_bin ?headers h buf off in
+      ( n,
+        match Type.of_bin_string N.hash_t v with
+        | Ok v -> v
+        | Error (`Msg e) -> Fmt.failwith "decode_bin: %s" e )
+
+    let t = Type.like N.hash_t ~bin:(encode_bin, decode_bin, size_of)
+  end
+
+  type step = N.step
+
+  type hash = N.hash
+
+  type metadata = N.metadata
+
+  type value = N.value
+
+  let hash_t = N.hash_t
+
+  let metadata_t = N.metadata_t
+
+  type t = { n : N.t; entries : (step * value) list }
+
+  let import n = { n; entries = N.list n }
+
+  let export t = t.n
+
+  let v entries =
+    let n = N.v entries in
+    { n; entries }
+
+  let list t = t.entries
+
+  let empty = { n = N.empty; entries = [] }
+
+  let is_empty t = t.entries = []
+
+  let default = N.default
+
+  let find t k = N.find t.n k
+
+  let add t k v =
+    let n = N.add t.n k v in
+    if t.n == n then t else { n; entries = N.list n }
+
+  let remove t k =
+    let n = N.remove t.n k in
+    if t.n == n then t else { n; entries = N.list n }
+
+  let step_t : step Type.t =
+    let to_string p = Type.to_bin_string N.step_t p in
+    let of_string s =
+      Type.of_bin_string N.step_t s |> function
+      | Ok x -> x
+      | Error (`Msg e) -> Fmt.failwith "Step.of_string: %s" e
+    in
+    Type.(map (string_of `Int64)) of_string to_string
+
+  let value_t =
+    let open Type in
+    record "node" (fun contents metadata node ->
+        match (contents, metadata, node) with
+        | Some c, None, None -> `Contents (c, N.default)
+        | Some c, Some m, None -> `Contents (c, m)
+        | None, None, Some n -> `Node n
+        | _ -> failwith "invalid node")
+    |+ field "contents" (option K.t) (function
+         | `Contents (x, _) -> Some x
+         | _ -> None)
+    |+ field "metadata" (option N.metadata_t) (function
+         | `Contents (_, x) when not (equal N.metadata_t N.default x) -> Some x
+         | _ -> None)
+    |+ field "node" (option K.t) (function `Node n -> Some n | _ -> None)
+    |> sealr
+
+  let t : t Type.t =
+    Type.map Type.(list ~len:`Int64 (pair step_t value_t)) v list
+end
diff --git a/vendors/irmin/node.mli b/vendors/irmin/node.mli
new file mode 100644
index 0000000000000000000000000000000000000000..d2d706587a20e0070b46ef0607f21485e9516da3
--- /dev/null
+++ b/vendors/irmin/node.mli
@@ -0,0 +1,75 @@
+(*
+ * Copyright (c) 2013      Louis Gesbert     <louis.gesbert@ocamlpro.com>
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Nodes represent structured values serialized in the block
+    store. *)
+
+module No_metadata : S.METADATA with type t = unit
+
+module Make
+    (K : Type.S) (P : sig
+      type step
+
+      val step_t : step Type.t
+    end)
+    (M : S.METADATA) :
+  S.NODE with type hash = K.t and type step = P.step and type metadata = M.t
+
+module Store
+    (C : S.CONTENTS_STORE)
+    (P : S.PATH)
+    (M : S.METADATA) (N : sig
+      include S.CONTENT_ADDRESSABLE_STORE with type key = C.key
+
+      module Key : S.HASH with type t = key
+
+      module Val :
+        S.NODE
+          with type t = value
+           and type hash = key
+           and type metadata = M.t
+           and type step = P.step
+    end) :
+  S.NODE_STORE
+    with type 'a t = 'a C.t * 'a N.t
+     and type key = N.key
+     and type value = N.value
+     and module Path = P
+     and module Metadata = M
+     and type Key.t = N.key
+     and module Val = N.Val
+
+module Graph (N : S.NODE_STORE) :
+  S.NODE_GRAPH
+    with type 'a t = 'a N.t
+     and type contents = N.Contents.key
+     and type metadata = N.Val.metadata
+     and type node = N.key
+     and type step = N.Path.step
+     and type path = N.Path.t
+
+module V1 (N : S.NODE) : sig
+  include
+    S.NODE
+      with type hash = N.hash
+       and type step = N.step
+       and type metadata = N.metadata
+
+  val import : N.t -> t
+
+  val export : t -> N.t
+end
diff --git a/vendors/irmin/object_graph.ml b/vendors/irmin/object_graph.ml
new file mode 100644
index 0000000000000000000000000000000000000000..2e3bd7786df45e92621fa73a60e36a1c617639a6
--- /dev/null
+++ b/vendors/irmin/object_graph.ml
@@ -0,0 +1,237 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt
+
+let src = Logs.Src.create "irmin.graph" ~doc:"Irmin graph support"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let list_partition_map f t =
+  let rec aux fst snd = function
+    | [] -> (List.rev fst, List.rev snd)
+    | h :: t -> (
+        match f h with
+        | `Fst x -> aux (x :: fst) snd t
+        | `Snd x -> aux fst (x :: snd) t )
+  in
+  aux [] [] t
+
+module type S = sig
+  include Graph.Sig.I
+
+  include Graph.Oper.S with type g := t
+
+  module Topological : sig
+    val fold : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
+  end
+
+  val vertex : t -> vertex list
+
+  val edges : t -> (vertex * vertex) list
+
+  val closure :
+    ?depth:int ->
+    pred:(vertex -> vertex list Lwt.t) ->
+    min:vertex list ->
+    max:vertex list ->
+    unit ->
+    t Lwt.t
+
+  val output :
+    Format.formatter ->
+    (vertex * Graph.Graphviz.DotAttributes.vertex list) list ->
+    (vertex * Graph.Graphviz.DotAttributes.edge list * vertex) list ->
+    string ->
+    unit
+
+  val min : t -> vertex list
+
+  val max : t -> vertex list
+
+  type dump = vertex list * (vertex * vertex) list
+
+  val export : t -> dump
+
+  val import : dump -> t
+
+  module Dump : Type.S with type t = dump
+end
+
+module Make
+    (Contents : Type.S)
+    (Metadata : Type.S)
+    (Node : Type.S)
+    (Commit : Type.S)
+    (Branch : Type.S) =
+struct
+  module X = struct
+    type t =
+      [ `Contents of Contents.t * Metadata.t
+      | `Node of Node.t
+      | `Commit of Commit.t
+      | `Branch of Branch.t ]
+
+    let t =
+      let open Type in
+      variant "vertex" (fun contents node commit branch ->
+        function
+        | `Contents x -> contents x
+        | `Node x -> node x
+        | `Commit x -> commit x
+        | `Branch x -> branch x)
+      |~ case1 "contents" (pair Contents.t Metadata.t) (fun x -> `Contents x)
+      |~ case1 "node" Node.t (fun x -> `Node x)
+      |~ case1 "commit" Commit.t (fun x -> `Commit x)
+      |~ case1 "branch" Branch.t (fun x -> `Branch x)
+      |> sealv
+
+    let equal = Type.equal t
+
+    let compare = Type.compare t
+
+    (* we are using cryptographic hashes here, so the first bytes
+       are good enough to be used as short hashes. *)
+    let hash (t : t) : int =
+      match t with
+      | `Contents (c, _) -> Type.short_hash Contents.t c
+      | `Node n -> Type.short_hash Node.t n
+      | `Commit c -> Type.short_hash Commit.t c
+      | `Branch b -> Type.short_hash Branch.t b
+  end
+
+  module G = Graph.Imperative.Digraph.ConcreteBidirectional (X)
+  module GO = Graph.Oper.I (G)
+  module Topological = Graph.Topological.Make (G)
+  module Table = Hashtbl.Make (X)
+  include G
+  include GO
+
+  type dump = vertex list * (vertex * vertex) list
+
+  (* XXX: for the binary format, we can use offsets in the vertex list
+     to save space. *)
+  module Dump = struct
+    type t = X.t list * (X.t * X.t) list
+
+    let t = Type.(pair (list X.t) (list (pair X.t X.t)))
+  end
+
+  let vertex g = G.fold_vertex (fun k set -> k :: set) g []
+
+  let edges g = G.fold_edges (fun k1 k2 list -> (k1, k2) :: list) g []
+
+  let closure ?(depth = max_int) ~pred ~min ~max () =
+    Log.debug (fun f ->
+        f "closure depth=%d (%d elements)" depth (List.length max));
+    let g = G.create ~size:1024 () in
+    let marks = Table.create 1024 in
+    let mark key level = Table.add marks key level in
+    let has_mark key = Table.mem marks key in
+    List.iter (fun k -> mark k max_int) min;
+    List.iter (G.add_vertex g) max;
+    let todo = Queue.create () in
+    List.iter (fun k -> Queue.push (k, 0) todo) max;
+    let rec add () =
+      match Queue.pop todo with
+      | exception Queue.Empty -> return_unit
+      | key, level ->
+          if level >= depth then add ()
+          else if has_mark key then add ()
+          else (
+            mark key level;
+            Log.debug (fun f -> f "ADD %a %d" Type.(pp X.t) key level);
+            if not (G.mem_vertex g key) then G.add_vertex g key;
+            pred key >>= fun keys ->
+            List.iter (fun k -> G.add_edge g k key) keys;
+            List.iter (fun k -> Queue.push (k, level + 1) todo) keys;
+            add () )
+    in
+    add () >>= fun () -> Lwt.return g
+
+  let min g =
+    G.fold_vertex
+      (fun v acc -> if G.in_degree g v = 0 then v :: acc else acc)
+      g []
+
+  let max g =
+    G.fold_vertex
+      (fun v acc -> if G.out_degree g v = 0 then v :: acc else acc)
+      g []
+
+  let vertex_attributes = ref (fun _ -> [])
+
+  let edge_attributes = ref (fun _ -> [])
+
+  let graph_name = ref None
+
+  module Dot = Graph.Graphviz.Dot (struct
+    include G
+
+    let edge_attributes k = !edge_attributes k
+
+    let default_edge_attributes _ = []
+
+    let vertex_name k =
+      let str t v = Type.to_string t v in
+      match k with
+      | `Node n -> str Node.t n
+      | `Commit c -> str Commit.t c
+      | `Branch b -> str Branch.t b
+      | `Contents (c, _) -> str Contents.t c
+
+    let vertex_attributes k = !vertex_attributes k
+
+    let default_vertex_attributes _ = []
+
+    let get_subgraph _ = None
+
+    let graph_attributes _ =
+      match !graph_name with None -> [] | Some n -> [ `Label n ]
+  end)
+
+  let export t = (vertex t, edges t)
+
+  let import (vs, es) =
+    let g = G.create ~size:(List.length vs) () in
+    List.iter (G.add_vertex g) vs;
+    List.iter (fun (v1, v2) -> G.add_edge g v1 v2) es;
+    g
+
+  let output ppf vertex edges name =
+    Log.debug (fun f -> f "output %s" name);
+    let g = G.create ~size:(List.length vertex) () in
+    List.iter (fun (v, _) -> G.add_vertex g v) vertex;
+    List.iter (fun (v1, _, v2) -> G.add_edge g v1 v2) edges;
+    let eattrs (v1, v2) =
+      try
+        let l = List.filter (fun (x, _, y) -> x = v1 && y = v2) edges in
+        let l = List.fold_left (fun acc (_, l, _) -> l @ acc) [] l in
+        let labels, others =
+          list_partition_map (function `Label l -> `Fst l | x -> `Snd x) l
+        in
+        match labels with
+        | [] -> others
+        | [ l ] -> `Label l :: others
+        | _ -> `Label (String.concat "," labels) :: others
+      with Not_found -> []
+    in
+    let vattrs v = try List.assoc v vertex with Not_found -> [] in
+    vertex_attributes := vattrs;
+    edge_attributes := eattrs;
+    graph_name := Some name;
+    Dot.fprint_graph ppf g
+end
diff --git a/vendors/irmin/object_graph.mli b/vendors/irmin/object_graph.mli
new file mode 100644
index 0000000000000000000000000000000000000000..a74c52b02a3bfc2cc5cd426aa39fdc2fe48667ca
--- /dev/null
+++ b/vendors/irmin/object_graph.mli
@@ -0,0 +1,89 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Graphs. *)
+
+module type S = sig
+  include Graph.Sig.I
+  (** Directed graph *)
+
+  include Graph.Oper.S with type g := t
+  (** Basic operations. *)
+
+  (** Topoogical traversal *)
+  module Topological : sig
+    val fold : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
+  end
+
+  val vertex : t -> vertex list
+  (** Get all the vertices. *)
+
+  val edges : t -> (vertex * vertex) list
+  (** Get all the relations. *)
+
+  val closure :
+    ?depth:int ->
+    pred:(vertex -> vertex list Lwt.t) ->
+    min:vertex list ->
+    max:vertex list ->
+    unit ->
+    t Lwt.t
+  (** [closure min max pred] creates the clansitive closure of [max]
+      using the precedence relation [pred]. The closure will not
+      contain any keys before the the one specified in [min]. *)
+
+  val output :
+    Format.formatter ->
+    (vertex * Graph.Graphviz.DotAttributes.vertex list) list ->
+    (vertex * Graph.Graphviz.DotAttributes.edge list * vertex) list ->
+    string ->
+    unit
+  (** [output ppf vertex edges name] create aand dumps the graph
+      contents on [ppf]. The graph is defined by its [vertex] and
+      [edges]. [name] is the name of the output graph.*)
+
+  val min : t -> vertex list
+  (** Compute the minimum vertex. *)
+
+  val max : t -> vertex list
+  (** Compute the maximun vertex. *)
+
+  type dump = vertex list * (vertex * vertex) list
+  (** Expose the graph internals. *)
+
+  val export : t -> dump
+  (** Expose the graph as a pair of vertices and edges. *)
+
+  val import : dump -> t
+  (** Import a graph. *)
+
+  module Dump : Type.S with type t = dump
+  (** The base functions over graph internals. *)
+end
+
+module Make
+    (Contents : Type.S)
+    (Metadata : Type.S)
+    (Node : Type.S)
+    (Commit : Type.S)
+    (Branch : Type.S) :
+  S
+    with type V.t =
+          [ `Contents of Contents.t * Metadata.t
+          | `Node of Node.t
+          | `Commit of Commit.t
+          | `Branch of Branch.t ]
+(** Build a graph. *)
diff --git a/vendors/irmin/path.ml b/vendors/irmin/path.ml
new file mode 100644
index 0000000000000000000000000000000000000000..9dff1849995321d355e399f380df4ac40a6dcce0
--- /dev/null
+++ b/vendors/irmin/path.ml
@@ -0,0 +1,56 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Astring
+
+module String_list = struct
+  type step = string
+
+  let step_t = Type.string
+
+  type t = step list
+
+  let empty = []
+
+  let is_empty l = l = []
+
+  let cons s t = s :: t
+
+  let rcons t s = t @ [ s ]
+
+  let decons = function [] -> None | h :: t -> Some (h, t)
+
+  let rdecons l =
+    match List.rev l with [] -> None | h :: t -> Some (List.rev t, h)
+
+  let map l f = List.map f l
+
+  let v x = x
+
+  let pp ppf t =
+    let len = List.fold_left (fun acc s -> 1 + acc + String.length s) 1 t in
+    let buf = Buffer.create len in
+    List.iter
+      (fun s ->
+        Buffer.add_char buf '/';
+        Buffer.add_string buf s)
+      t;
+    Fmt.string ppf (Buffer.contents buf)
+
+  let of_string s = Ok (List.filter (( <> ) "") (String.cuts s ~sep:"/"))
+
+  let t = Type.like ~cli:(pp, of_string) Type.(list step_t)
+end
diff --git a/vendors/irmin/path.mli b/vendors/irmin/path.mli
new file mode 100644
index 0000000000000000000000000000000000000000..fcdf57b13bb32d86807992658e806a49d066b1b0
--- /dev/null
+++ b/vendors/irmin/path.mli
@@ -0,0 +1,19 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Tree path handling. *)
+
+module String_list : S.PATH with type step = string and type t = string list
diff --git a/vendors/irmin/s.ml b/vendors/irmin/s.ml
new file mode 100644
index 0000000000000000000000000000000000000000..495ab50e315da4aaffcd58853dfef3657209b1dc
--- /dev/null
+++ b/vendors/irmin/s.ml
@@ -0,0 +1,1159 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Irmin signatures *)
+
+module type PATH = sig
+  type t
+
+  type step
+
+  val empty : t
+
+  val v : step list -> t
+
+  val is_empty : t -> bool
+
+  val cons : step -> t -> t
+
+  val rcons : t -> step -> t
+
+  val decons : t -> (step * t) option
+
+  val rdecons : t -> (t * step) option
+
+  val map : t -> (step -> 'a) -> 'a list
+
+  val t : t Type.t
+
+  val step_t : step Type.t
+end
+
+module type HASH = sig
+  type t
+
+  val hash : ((string -> unit) -> unit) -> t
+
+  val short_hash : t -> int
+
+  val hash_size : int
+
+  val t : t Type.t
+end
+
+module type TYPED_HASH = sig
+  type t
+
+  type value
+
+  val hash : value -> t
+
+  val short_hash : t -> int
+
+  val hash_size : int
+
+  val t : t Type.t
+end
+
+module type CONTENTS = sig
+  include Type.S
+
+  val merge : t option Merge.t
+end
+
+module type CONTENT_ADDRESSABLE_STORE = sig
+  type 'a t
+
+  type key
+
+  type value
+
+  val mem : [> `Read ] t -> key -> bool Lwt.t
+
+  val find : [> `Read ] t -> key -> value option Lwt.t
+
+  val add : [> `Write ] t -> value -> key Lwt.t
+
+  val unsafe_add : [> `Write ] t -> key -> value -> unit Lwt.t
+end
+
+module type CONTENT_ADDRESSABLE_STORE_MAKER = functor
+  (K : HASH)
+  (V : Type.S)
+  -> sig
+  include CONTENT_ADDRESSABLE_STORE with type key = K.t and type value = V.t
+
+  val batch : [ `Read ] t -> ([ `Read | `Write ] t -> 'a Lwt.t) -> 'a Lwt.t
+
+  val v : Conf.t -> [ `Read ] t Lwt.t
+
+  val close : 'a t -> unit Lwt.t
+end
+
+module type APPEND_ONLY_STORE = sig
+  type 'a t
+
+  type key
+
+  type value
+
+  val mem : [> `Read ] t -> key -> bool Lwt.t
+
+  val find : [> `Read ] t -> key -> value option Lwt.t
+
+  val add : [> `Write ] t -> key -> value -> unit Lwt.t
+end
+
+module type APPEND_ONLY_STORE_MAKER = functor (K : Type.S) (V : Type.S) -> sig
+  include APPEND_ONLY_STORE with type key = K.t and type value = V.t
+
+  val batch : [ `Read ] t -> ([ `Read | `Write ] t -> 'a Lwt.t) -> 'a Lwt.t
+
+  val v : Conf.t -> [ `Read ] t Lwt.t
+
+  val close : 'a t -> unit Lwt.t
+end
+
+module type METADATA = sig
+  include Type.S
+
+  val merge : t Merge.t
+
+  val default : t
+end
+
+module type CONTENTS_STORE = sig
+  include CONTENT_ADDRESSABLE_STORE
+
+  val merge : [ `Read | `Write ] t -> key option Merge.t
+
+  module Key : TYPED_HASH with type t = key and type value = value
+
+  module Val : CONTENTS with type t = value
+end
+
+module type NODE = sig
+  type t
+
+  type metadata
+
+  type hash
+
+  type step
+
+  type value = [ `Node of hash | `Contents of hash * metadata ]
+
+  val v : (step * value) list -> t
+
+  val list : t -> (step * value) list
+
+  val empty : t
+
+  val is_empty : t -> bool
+
+  val find : t -> step -> value option
+
+  val add : t -> step -> value -> t
+
+  val remove : t -> step -> t
+
+  val t : t Type.t
+
+  val default : metadata
+
+  val metadata_t : metadata Type.t
+
+  val hash_t : hash Type.t
+
+  val step_t : step Type.t
+
+  val value_t : value Type.t
+end
+
+module type NODE_GRAPH = sig
+  type 'a t
+
+  type metadata
+
+  type contents
+
+  type node
+
+  type step
+
+  type path
+
+  type value = [ `Node of node | `Contents of contents * metadata ]
+
+  val empty : [> `Write ] t -> node Lwt.t
+
+  val v : [> `Write ] t -> (step * value) list -> node Lwt.t
+
+  val list : [> `Read ] t -> node -> (step * value) list Lwt.t
+
+  val find : [> `Read ] t -> node -> path -> value option Lwt.t
+
+  val add : [ `Read | `Write ] t -> node -> path -> value -> node Lwt.t
+
+  val remove : [ `Read | `Write ] t -> node -> path -> node Lwt.t
+
+  val closure :
+    [> `Read ] t -> min:node list -> max:node list -> node list Lwt.t
+
+  val metadata_t : metadata Type.t
+
+  val contents_t : contents Type.t
+
+  val node_t : node Type.t
+
+  val step_t : step Type.t
+
+  val path_t : path Type.t
+
+  val value_t : value Type.t
+end
+
+module type NODE_STORE = sig
+  include CONTENT_ADDRESSABLE_STORE
+
+  module Path : PATH
+
+  val merge : [ `Read | `Write ] t -> key option Merge.t
+
+  module Key : TYPED_HASH with type t = key and type value = value
+
+  module Metadata : METADATA
+
+  module Val :
+    NODE
+      with type t = value
+       and type hash = key
+       and type metadata = Metadata.t
+       and type step = Path.step
+
+  module Contents : CONTENTS_STORE with type key = Val.hash
+end
+
+type config = Conf.t
+
+type 'a diff = 'a Diff.t
+
+module type COMMIT = sig
+  type t
+
+  type hash
+
+  val v : info:Info.t -> node:hash -> parents:hash list -> t
+
+  val node : t -> hash
+
+  val parents : t -> hash list
+
+  val info : t -> Info.t
+
+  val t : t Type.t
+
+  val hash_t : hash Type.t
+end
+
+module type COMMIT_STORE = sig
+  include CONTENT_ADDRESSABLE_STORE
+
+  val merge : [ `Read | `Write ] t -> info:Info.f -> key option Merge.t
+
+  module Key : TYPED_HASH with type t = key and type value = value
+
+  module Val : COMMIT with type t = value and type hash = key
+
+  module Node : NODE_STORE with type key = Val.hash
+end
+
+module type COMMIT_HISTORY = sig
+  type 'a t
+
+  type node
+
+  type commit
+
+  type v
+
+  val v :
+    [> `Write ] t ->
+    node:node ->
+    parents:commit list ->
+    info:Info.t ->
+    (commit * v) Lwt.t
+
+  val parents : [> `Read ] t -> commit -> commit list Lwt.t
+
+  val merge : [ `Read | `Write ] t -> info:Info.f -> commit Merge.t
+
+  val lcas :
+    [> `Read ] t ->
+    ?max_depth:int ->
+    ?n:int ->
+    commit ->
+    commit ->
+    (commit list, [ `Max_depth_reached | `Too_many_lcas ]) result Lwt.t
+
+  val lca :
+    [ `Read | `Write ] t ->
+    info:Info.f ->
+    ?max_depth:int ->
+    ?n:int ->
+    commit list ->
+    (commit option, Merge.conflict) result Lwt.t
+
+  val three_way_merge :
+    [ `Read | `Write ] t ->
+    info:Info.f ->
+    ?max_depth:int ->
+    ?n:int ->
+    commit ->
+    commit ->
+    (commit, Merge.conflict) result Lwt.t
+
+  val closure :
+    [> `Read ] t -> min:commit list -> max:commit list -> commit list Lwt.t
+
+  val commit_t : commit Type.t
+end
+
+module type SLICE = sig
+  type t
+
+  type contents
+
+  type node
+
+  type commit
+
+  type value = [ `Contents of contents | `Node of node | `Commit of commit ]
+
+  val empty : unit -> t Lwt.t
+
+  val add : t -> value -> unit Lwt.t
+
+  val iter : t -> (value -> unit Lwt.t) -> unit Lwt.t
+
+  val t : t Type.t
+
+  val contents_t : contents Type.t
+
+  val node_t : node Type.t
+
+  val commit_t : commit Type.t
+
+  val value_t : value Type.t
+end
+
+module type BRANCH = sig
+  include Type.S
+
+  val master : t
+
+  val is_valid : t -> bool
+end
+
+(** Read-write stores. *)
+module type ATOMIC_WRITE_STORE = sig
+  type t
+
+  type key
+
+  type value
+
+  val mem : t -> key -> bool Lwt.t
+
+  val find : t -> key -> value option Lwt.t
+
+  val set : t -> key -> value -> unit Lwt.t
+
+  val test_and_set :
+    t -> key -> test:value option -> set:value option -> bool Lwt.t
+
+  val remove : t -> key -> unit Lwt.t
+
+  val list : t -> key list Lwt.t
+
+  type watch
+
+  val watch :
+    t ->
+    ?init:(key * value) list ->
+    (key -> value Diff.t -> unit Lwt.t) ->
+    watch Lwt.t
+
+  val watch_key :
+    t -> key -> ?init:value -> (value Diff.t -> unit Lwt.t) -> watch Lwt.t
+
+  val unwatch : t -> watch -> unit Lwt.t
+end
+
+module type ATOMIC_WRITE_STORE_MAKER = functor (K : Type.S) (V : Type.S) -> sig
+  include ATOMIC_WRITE_STORE with type key = K.t and type value = V.t
+
+  val v : Conf.t -> t Lwt.t
+
+  val close : t -> unit Lwt.t
+end
+
+module type BRANCH_STORE = sig
+  include ATOMIC_WRITE_STORE
+
+  module Key : BRANCH with type t = key
+
+  module Val : HASH with type t = value
+end
+
+type remote = ..
+
+module type SYNC = sig
+  type t
+
+  type commit
+
+  type branch
+
+  type endpoint
+
+  val fetch :
+    t ->
+    ?depth:int ->
+    endpoint ->
+    branch ->
+    (commit option, [ `Msg of string ]) result Lwt.t
+
+  val push :
+    t ->
+    ?depth:int ->
+    endpoint ->
+    branch ->
+    (unit, [ `Msg of string | `Detached_head ]) result Lwt.t
+end
+
+module type PRIVATE = sig
+  module Hash : HASH
+
+  module Contents : CONTENTS_STORE with type key = Hash.t
+
+  module Node :
+    NODE_STORE with type key = Hash.t and type Val.hash = Contents.key
+
+  module Commit :
+    COMMIT_STORE with type key = Hash.t and type Val.hash = Node.key
+
+  module Branch : BRANCH_STORE with type value = Commit.key
+
+  module Slice :
+    SLICE
+      with type contents = Contents.key * Contents.value
+       and type node = Node.key * Node.value
+       and type commit = Commit.key * Commit.value
+
+  module Repo : sig
+    type t
+
+    val v : Conf.t -> t Lwt.t
+
+    val close : t -> unit Lwt.t
+
+    val contents_t : t -> [ `Read ] Contents.t
+
+    val node_t : t -> [ `Read ] Node.t
+
+    val commit_t : t -> [ `Read ] Commit.t
+
+    val branch_t : t -> Branch.t
+
+    val batch :
+      t ->
+      ([ `Read | `Write ] Contents.t ->
+      [ `Read | `Write ] Node.t ->
+      [ `Read | `Write ] Commit.t ->
+      'a Lwt.t) ->
+      'a Lwt.t
+  end
+
+  module Sync : sig
+    include SYNC with type commit = Commit.key and type branch = Branch.key
+
+    val v : Repo.t -> t Lwt.t
+  end
+end
+
+module type TREE = sig
+  type key
+
+  type step
+
+  type metadata
+
+  type contents
+
+  type node
+
+  type tree = [ `Node of node | `Contents of contents * metadata ]
+
+  val empty : tree
+
+  val of_contents : ?metadata:metadata -> contents -> tree
+
+  val of_node : node -> tree
+
+  val kind : tree -> key -> [ `Contents | `Node ] option Lwt.t
+
+  val list : tree -> key -> (step * [ `Contents | `Node ]) list Lwt.t
+
+  val diff : tree -> tree -> (key * (contents * metadata) diff) list Lwt.t
+
+  val mem : tree -> key -> bool Lwt.t
+
+  val find_all : tree -> key -> (contents * metadata) option Lwt.t
+
+  val find : tree -> key -> contents option Lwt.t
+
+  val get_all : tree -> key -> (contents * metadata) Lwt.t
+
+  val get : tree -> key -> contents Lwt.t
+
+  val add : tree -> key -> ?metadata:metadata -> contents -> tree Lwt.t
+
+  val remove : tree -> key -> tree Lwt.t
+
+  val mem_tree : tree -> key -> bool Lwt.t
+
+  val find_tree : tree -> key -> tree option Lwt.t
+
+  val get_tree : tree -> key -> tree Lwt.t
+
+  val add_tree : tree -> key -> tree -> tree Lwt.t
+
+  val merge : tree Merge.t
+
+  type marks
+
+  val empty_marks : unit -> marks
+
+  type 'a force = [ `True | `False of key -> 'a -> 'a Lwt.t ]
+
+  type uniq = [ `False | `True | `Marks of marks ]
+
+  type 'a node_fn = key -> step list -> 'a -> 'a Lwt.t
+
+  val fold :
+    ?force:'a force ->
+    ?uniq:uniq ->
+    ?pre:'a node_fn ->
+    ?post:'a node_fn ->
+    (key -> contents -> 'a -> 'a Lwt.t) ->
+    tree ->
+    'a ->
+    'a Lwt.t
+
+  type stats = {
+    nodes : int;
+    leafs : int;
+    skips : int;
+    depth : int;
+    width : int;
+  }
+
+  val pp_stats : stats Fmt.t
+
+  val stats : ?force:bool -> tree -> stats Lwt.t
+
+  type concrete =
+    [ `Tree of (step * concrete) list | `Contents of contents * metadata ]
+
+  val of_concrete : concrete -> tree
+
+  val to_concrete : tree -> concrete Lwt.t
+
+  val clear : ?depth:int -> tree -> unit
+
+  module Cache : sig
+    val length : unit -> [ `Contents of int ] * [ `Nodes of int ]
+
+    val clear : ?depth:int -> unit -> unit
+
+    val dump : unit Fmt.t
+  end
+
+  type counters = {
+    mutable contents_hash : int;
+    mutable contents_find : int;
+    mutable contents_add : int;
+    mutable contents_cache_length : int;
+    mutable contents_cache_find : int;
+    mutable contents_cache_miss : int;
+    mutable node_hash : int;
+    mutable node_mem : int;
+    mutable node_add : int;
+    mutable node_find : int;
+    mutable node_cache_length : int;
+    mutable node_cache_find : int;
+    mutable node_cache_miss : int;
+    mutable node_val_v : int;
+    mutable node_val_find : int;
+    mutable node_val_list : int;
+  }
+
+  val counters : unit -> counters
+
+  val dump_counters : unit Fmt.t
+
+  val reset_counters : unit -> unit
+
+  val inspect : tree -> [ `Contents | `Node of [ `Map | `Hash | `Value ] ]
+end
+
+module type STORE = sig
+  type repo
+
+  type t
+
+  type step
+
+  type key
+
+  type metadata
+
+  type contents
+
+  type node
+
+  type tree = [ `Node of node | `Contents of contents * metadata ]
+
+  type hash
+
+  type commit
+
+  type branch
+
+  type slice
+
+  type lca_error = [ `Max_depth_reached | `Too_many_lcas ]
+
+  type ff_error = [ `No_change | `Rejected | lca_error ]
+
+  module Repo : sig
+    type t = repo
+
+    val v : config -> t Lwt.t
+
+    val close : t -> unit Lwt.t
+
+    val heads : t -> commit list Lwt.t
+
+    val branches : t -> branch list Lwt.t
+
+    val export :
+      ?full:bool ->
+      ?depth:int ->
+      ?min:commit list ->
+      ?max:commit list ->
+      t ->
+      slice Lwt.t
+
+    val import : t -> slice -> (unit, [ `Msg of string ]) result Lwt.t
+  end
+
+  val empty : Repo.t -> t Lwt.t
+
+  val master : Repo.t -> t Lwt.t
+
+  val of_branch : Repo.t -> branch -> t Lwt.t
+
+  val of_commit : commit -> t Lwt.t
+
+  val repo : t -> Repo.t
+
+  val tree : t -> tree Lwt.t
+
+  module Status : sig
+    type t = [ `Empty | `Branch of branch | `Commit of commit ]
+
+    val t : Repo.t -> t Type.t
+
+    val pp : t Fmt.t
+  end
+
+  val status : t -> Status.t
+
+  module Head : sig
+    val list : Repo.t -> commit list Lwt.t
+
+    val find : t -> commit option Lwt.t
+
+    val get : t -> commit Lwt.t
+
+    val set : t -> commit -> unit Lwt.t
+
+    val fast_forward :
+      t -> ?max_depth:int -> ?n:int -> commit -> (unit, ff_error) result Lwt.t
+
+    val test_and_set :
+      t -> test:commit option -> set:commit option -> bool Lwt.t
+
+    val merge :
+      into:t ->
+      info:Info.f ->
+      ?max_depth:int ->
+      ?n:int ->
+      commit ->
+      (unit, Merge.conflict) result Lwt.t
+  end
+
+  module Hash : HASH with type t = hash
+
+  module Commit : sig
+    type t = commit
+
+    val t : Repo.t -> t Type.t
+
+    val pp_hash : t Fmt.t
+
+    val v : Repo.t -> info:Info.t -> parents:hash list -> tree -> commit Lwt.t
+
+    val tree : commit -> tree
+
+    val parents : commit -> hash list
+
+    val info : commit -> Info.t
+
+    val hash : commit -> hash
+
+    val of_hash : Repo.t -> hash -> commit option Lwt.t
+  end
+
+  module Contents : sig
+    include CONTENTS with type t = contents
+
+    val hash : contents -> hash
+
+    val of_hash : Repo.t -> hash -> contents option Lwt.t
+  end
+
+  module Tree : sig
+    include
+      TREE
+        with type step := step
+         and type key := key
+         and type metadata := metadata
+         and type contents := contents
+         and type node := node
+         and type tree := tree
+
+    val hash : tree -> hash
+
+    val of_hash : Repo.t -> hash -> tree option Lwt.t
+
+    val shallow : Repo.t -> hash -> tree
+  end
+
+  val kind : t -> key -> [ `Contents | `Node ] option Lwt.t
+
+  val list : t -> key -> (step * [ `Contents | `Node ]) list Lwt.t
+
+  val mem : t -> key -> bool Lwt.t
+
+  val mem_tree : t -> key -> bool Lwt.t
+
+  val find_all : t -> key -> (contents * metadata) option Lwt.t
+
+  val find : t -> key -> contents option Lwt.t
+
+  val get_all : t -> key -> (contents * metadata) Lwt.t
+
+  val get : t -> key -> contents Lwt.t
+
+  val find_tree : t -> key -> tree option Lwt.t
+
+  val get_tree : t -> key -> tree Lwt.t
+
+  val hash : t -> key -> hash option Lwt.t
+
+  type write_error =
+    [ Merge.conflict | `Too_many_retries of int | `Test_was of tree option ]
+
+  val set :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    contents ->
+    (unit, write_error) result Lwt.t
+
+  val set_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    contents ->
+    unit Lwt.t
+
+  val set_tree :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    tree ->
+    (unit, write_error) result Lwt.t
+
+  val set_tree_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    tree ->
+    unit Lwt.t
+
+  val remove :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    (unit, write_error) result Lwt.t
+
+  val remove_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    unit Lwt.t
+
+  val test_and_set :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    test:contents option ->
+    set:contents option ->
+    (unit, write_error) result Lwt.t
+
+  val test_and_set_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    test:contents option ->
+    set:contents option ->
+    unit Lwt.t
+
+  val test_and_set_tree :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    test:tree option ->
+    set:tree option ->
+    (unit, write_error) result Lwt.t
+
+  val test_and_set_tree_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    t ->
+    key ->
+    test:tree option ->
+    set:tree option ->
+    unit Lwt.t
+
+  val merge :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    old:contents option ->
+    t ->
+    key ->
+    contents option ->
+    (unit, write_error) result Lwt.t
+
+  val merge_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    old:contents option ->
+    t ->
+    key ->
+    contents option ->
+    unit Lwt.t
+
+  val merge_tree :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    old:tree option ->
+    t ->
+    key ->
+    tree option ->
+    (unit, write_error) result Lwt.t
+
+  val merge_tree_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    info:Info.f ->
+    old:tree option ->
+    t ->
+    key ->
+    tree option ->
+    unit Lwt.t
+
+  val with_tree :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    ?strategy:[ `Set | `Test_and_set | `Merge ] ->
+    info:Info.f ->
+    t ->
+    key ->
+    (tree option -> tree option Lwt.t) ->
+    (unit, write_error) result Lwt.t
+
+  val with_tree_exn :
+    ?retries:int ->
+    ?allow_empty:bool ->
+    ?parents:commit list ->
+    ?strategy:[ `Set | `Test_and_set | `Merge ] ->
+    info:Info.f ->
+    t ->
+    key ->
+    (tree option -> tree option Lwt.t) ->
+    unit Lwt.t
+
+  val clone : src:t -> dst:branch -> t Lwt.t
+
+  type watch
+
+  val watch : t -> ?init:commit -> (commit diff -> unit Lwt.t) -> watch Lwt.t
+
+  val watch_key :
+    t ->
+    key ->
+    ?init:commit ->
+    ((commit * tree) diff -> unit Lwt.t) ->
+    watch Lwt.t
+
+  val unwatch : watch -> unit Lwt.t
+
+  type 'a merge =
+    info:Info.f ->
+    ?max_depth:int ->
+    ?n:int ->
+    'a ->
+    (unit, Merge.conflict) result Lwt.t
+
+  val merge_into : into:t -> t merge
+
+  val merge_with_branch : t -> branch merge
+
+  val merge_with_commit : t -> commit merge
+
+  val lcas :
+    ?max_depth:int -> ?n:int -> t -> t -> (commit list, lca_error) result Lwt.t
+
+  val lcas_with_branch :
+    t ->
+    ?max_depth:int ->
+    ?n:int ->
+    branch ->
+    (commit list, lca_error) result Lwt.t
+
+  val lcas_with_commit :
+    t ->
+    ?max_depth:int ->
+    ?n:int ->
+    commit ->
+    (commit list, lca_error) result Lwt.t
+
+  module History : Graph.Sig.P with type V.t = commit
+
+  val history :
+    ?depth:int -> ?min:commit list -> ?max:commit list -> t -> History.t Lwt.t
+
+  val last_modified : ?depth:int -> ?n:int -> t -> key -> commit list Lwt.t
+
+  module Branch : sig
+    val mem : Repo.t -> branch -> bool Lwt.t
+
+    val find : Repo.t -> branch -> commit option Lwt.t
+
+    val get : Repo.t -> branch -> commit Lwt.t
+
+    val set : Repo.t -> branch -> commit -> unit Lwt.t
+
+    val remove : Repo.t -> branch -> unit Lwt.t
+
+    val list : Repo.t -> branch list Lwt.t
+
+    val watch :
+      Repo.t ->
+      branch ->
+      ?init:commit ->
+      (commit diff -> unit Lwt.t) ->
+      watch Lwt.t
+
+    val watch_all :
+      Repo.t ->
+      ?init:(branch * commit) list ->
+      (branch -> commit diff -> unit Lwt.t) ->
+      watch Lwt.t
+
+    include BRANCH with type t = branch
+  end
+
+  module Key : PATH with type t = key and type step = step
+
+  module Metadata : METADATA with type t = metadata
+
+  val step_t : step Type.t
+
+  val key_t : key Type.t
+
+  val metadata_t : metadata Type.t
+
+  val contents_t : contents Type.t
+
+  val node_t : node Type.t
+
+  val tree_t : tree Type.t
+
+  val commit_t : Repo.t -> commit Type.t
+
+  val branch_t : branch Type.t
+
+  val slice_t : slice Type.t
+
+  val kind_t : [ `Contents | `Node ] Type.t
+
+  val lca_error_t : lca_error Type.t
+
+  val ff_error_t : ff_error Type.t
+
+  val write_error_t : write_error Type.t
+
+  module Private : sig
+    include
+      PRIVATE
+        with type Contents.value = contents
+         and module Hash = Hash
+         and module Node.Path = Key
+         and type Node.Metadata.t = metadata
+         and type Branch.key = branch
+         and type Slice.t = slice
+         and type Repo.t = repo
+  end
+
+  type remote += E of Private.Sync.endpoint
+
+  val to_private_node : node -> Private.Node.value option Lwt.t
+
+  val of_private_node : repo -> Private.Node.value -> node
+
+  val to_private_commit : commit -> Private.Commit.value
+
+  val of_private_commit : repo -> Private.Commit.value -> commit
+
+  val save_contents : [> `Write ] Private.Contents.t -> contents -> hash Lwt.t
+
+  val save_tree :
+    ?clear:bool ->
+    repo ->
+    [> `Write ] Private.Contents.t ->
+    [ `Read | `Write ] Private.Node.t ->
+    tree ->
+    hash Lwt.t
+end
+
+module type MAKER = functor
+  (M : METADATA)
+  (C : CONTENTS)
+  (P : PATH)
+  (B : BRANCH)
+  (H : HASH)
+  ->
+  STORE
+    with type key = P.t
+     and type step = P.step
+     and type metadata = M.t
+     and type contents = C.t
+     and type branch = B.t
+     and type hash = H.t
+
+type remote += Store : (module STORE with type t = 'a) * 'a -> remote
+
+module type SYNC_STORE = sig
+  type db
+
+  type commit
+
+  type push_error = [ `Msg of string | `Detached_head ]
+
+  type pull_error = [ `Msg of string | Merge.conflict ]
+
+  type status = [ `Empty | `Head of commit ]
+
+  val status_t : db -> status Type.t
+
+  val pp_status : status Fmt.t
+
+  val fetch :
+    db -> ?depth:int -> remote -> (status, [ `Msg of string ]) result Lwt.t
+
+  val fetch_exn : db -> ?depth:int -> remote -> status Lwt.t
+
+  val pp_pull_error : pull_error Fmt.t
+
+  val pull :
+    db ->
+    ?depth:int ->
+    remote ->
+    [ `Merge of Info.f | `Set ] ->
+    (status, pull_error) result Lwt.t
+
+  val pull_exn :
+    db -> ?depth:int -> remote -> [ `Merge of Info.f | `Set ] -> status Lwt.t
+
+  val pp_push_error : push_error Fmt.t
+
+  val push : db -> ?depth:int -> remote -> (status, push_error) result Lwt.t
+
+  val push_exn : db -> ?depth:int -> remote -> status Lwt.t
+end
diff --git a/vendors/irmin/slice.ml b/vendors/irmin/slice.ml
new file mode 100644
index 0000000000000000000000000000000000000000..54cd89bc2fb0e3da95e7aba05a96eb0c948f9f6f
--- /dev/null
+++ b/vendors/irmin/slice.ml
@@ -0,0 +1,84 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module Make
+    (Contents : S.CONTENTS_STORE)
+    (Node : S.NODE_STORE)
+    (Commit : S.COMMIT_STORE) =
+struct
+  type contents = Contents.key * Contents.value
+
+  type node = Node.key * Node.value
+
+  type commit = Commit.key * Commit.value
+
+  type value = [ `Contents of contents | `Node of node | `Commit of commit ]
+
+  type t = {
+    mutable contents : (Contents.key * Contents.value) list;
+    mutable nodes : (Node.key * Node.value) list;
+    mutable commits : (Commit.key * Commit.value) list;
+  }
+
+  let t =
+    let open Type in
+    record "slice" (fun contents nodes commits -> { contents; nodes; commits })
+    |+ field "contents"
+         (list (pair Contents.Key.t Contents.Val.t))
+         (fun t -> t.contents)
+    |+ field "nodes" (list (pair Node.Key.t Node.Val.t)) (fun t -> t.nodes)
+    |+ field "commits"
+         (list (pair Commit.Key.t Commit.Val.t))
+         (fun t -> t.commits)
+    |> sealr
+
+  let empty () = Lwt.return { contents = []; nodes = []; commits = [] }
+
+  let add t = function
+    | `Contents c ->
+        t.contents <- c :: t.contents;
+        Lwt.return_unit
+    | `Node n ->
+        t.nodes <- n :: t.nodes;
+        Lwt.return_unit
+    | `Commit c ->
+        t.commits <- c :: t.commits;
+        Lwt.return_unit
+
+  let iter t f =
+    Lwt.choose
+      [
+        Lwt_list.iter_p (fun c -> f (`Contents c)) t.contents;
+        Lwt_list.iter_p (fun n -> f (`Node n)) t.nodes;
+        Lwt_list.iter_p (fun c -> f (`Commit c)) t.commits;
+      ]
+
+  let contents_t = Type.pair Contents.Key.t Contents.Val.t
+
+  let node_t = Type.pair Node.Key.t Node.Val.t
+
+  let commit_t = Type.pair Commit.Key.t Commit.Val.t
+
+  let value_t =
+    let open Type in
+    variant "slice" (fun contents node commit ->
+      function
+      | `Contents x -> contents x | `Node x -> node x | `Commit x -> commit x)
+    |~ case1 "contents" contents_t (fun x -> `Contents x)
+    |~ case1 "node" node_t (fun x -> `Node x)
+    |~ case1 "commit" commit_t (fun x -> `Commit x)
+    |> sealv
+end
diff --git a/vendors/irmin/slice.mli b/vendors/irmin/slice.mli
new file mode 100644
index 0000000000000000000000000000000000000000..a45db8006fa83fbe72d2f54f8c68d87cf1565007
--- /dev/null
+++ b/vendors/irmin/slice.mli
@@ -0,0 +1,21 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module Make (C : S.CONTENTS_STORE) (N : S.NODE_STORE) (H : S.COMMIT_STORE) :
+  S.SLICE
+    with type contents = C.key * C.value
+     and type node = N.key * N.value
+     and type commit = H.key * H.value
diff --git a/vendors/irmin/store.ml b/vendors/irmin/store.ml
new file mode 100644
index 0000000000000000000000000000000000000000..aeedf0826aa601e599f714992dc6f76b0c0cb7ae
--- /dev/null
+++ b/vendors/irmin/store.ml
@@ -0,0 +1,1139 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+open Merge.Infix
+
+let src = Logs.Src.create "irmin" ~doc:"Irmin branch-consistent store"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+module Content_addressable
+    (AO : S.APPEND_ONLY_STORE_MAKER)
+    (K : S.HASH)
+    (V : Type.S) =
+struct
+  include AO (K) (V)
+  open Lwt.Infix
+  module H = Hash.Typed (K) (V)
+
+  let hash = H.hash
+
+  let pp_key = Type.pp K.t
+
+  let find t k =
+    find t k >>= function
+    | None -> Lwt.return_none
+    | Some v as r ->
+        let k' = hash v in
+        if Type.equal K.t k k' then Lwt.return r
+        else
+          Fmt.kstrf Lwt.fail_invalid_arg
+            "corrupted value: got %a, expecting %a" pp_key k' pp_key k
+
+  let unsafe_add t k v = add t k v
+
+  let add t v =
+    let k = hash v in
+    add t k v >|= fun () -> k
+end
+
+module Make (P : S.PRIVATE) = struct
+  module Branch_store = P.Branch
+
+  type branch = Branch_store.key
+
+  module Hash = P.Hash
+
+  type hash = Hash.t
+
+  type lca_error = [ `Max_depth_reached | `Too_many_lcas ]
+
+  type ff_error = [ `No_change | `Rejected | lca_error ]
+
+  module Key = P.Node.Path
+
+  type key = Key.t
+
+  module Metadata = P.Node.Metadata
+  module H = Commit.History (P.Commit)
+
+  type S.remote += E of P.Sync.endpoint
+
+  module Contents = struct
+    include P.Contents.Val
+
+    let of_hash r h = P.Contents.find (P.Repo.contents_t r) h
+
+    let hash c = P.Contents.Key.hash c
+  end
+
+  module Tree = struct
+    include Tree.Make (P)
+
+    let of_hash r h =
+      import r h >|= function Some t -> Some (`Node t) | None -> None
+
+    let shallow r h = `Node (import_no_check r h)
+
+    let hash : tree -> hash =
+     fun tr -> match hash tr with `Node h -> h | `Contents (h, _) -> h
+  end
+
+  let save_contents b c = P.Contents.add b c
+
+  let save_tree ?(clear = true) r x y (tr : Tree.tree) =
+    match tr with
+    | `Contents (c, _) -> save_contents x c
+    | `Node n -> Tree.export ~clear r x y n
+
+  type node = Tree.node
+
+  type contents = Contents.t
+
+  type metadata = Metadata.t
+
+  type tree = Tree.tree
+
+  type repo = P.Repo.t
+
+  module Commit = struct
+    type t = { r : repo; h : Hash.t; v : P.Commit.value }
+
+    let t r =
+      let open Type in
+      record "commit" (fun h v -> { r; h; v })
+      |+ field "hash" Hash.t (fun t -> t.h)
+      |+ field "value" P.Commit.Val.t (fun t -> t.v)
+      |> sealr
+
+    let v r ~info ~parents tree =
+      P.Repo.batch r @@ fun contents_t node_t commit_t ->
+      ( match tree with
+      | `Node n -> Tree.export r contents_t node_t n
+      | `Contents _ -> Lwt.fail_invalid_arg "cannot add contents at the root"
+      )
+      >>= fun node ->
+      let v = P.Commit.Val.v ~info ~node ~parents in
+      P.Commit.add commit_t v >|= fun h -> { r; h; v }
+
+    let node t = P.Commit.Val.node t.v
+
+    let tree t = Tree.import_no_check t.r (node t) |> fun n -> `Node n
+
+    let equal x y = Type.equal Hash.t x.h y.h
+
+    let hash t = t.h
+
+    let info t = P.Commit.Val.info t.v
+
+    let parents t = P.Commit.Val.parents t.v
+
+    let pp_hash ppf t = Type.pp Hash.t ppf t.h
+
+    let of_hash r h =
+      P.Commit.find (P.Repo.commit_t r) h >|= function
+      | None -> None
+      | Some v -> Some { r; h; v }
+
+    let to_private_commit t = t.v
+
+    let of_private_commit r v =
+      let h = P.Commit.Key.hash v in
+      { r; h; v }
+
+    let equal_opt x y =
+      match (x, y) with
+      | None, None -> true
+      | Some x, Some y -> equal x y
+      | _ -> false
+  end
+
+  type commit = Commit.t
+
+  let to_private_node = Tree.to_private_node
+
+  let of_private_node = Tree.of_private_node
+
+  let to_private_commit = Commit.to_private_commit
+
+  let of_private_commit = Commit.of_private_commit
+
+  type head_ref = [ `Branch of branch | `Head of commit option ref ]
+
+  module OCamlGraph = Graph
+  module Graph = Node.Graph (P.Node)
+  module KGraph =
+    Object_graph.Make (P.Contents.Key) (P.Node.Metadata) (P.Node.Key)
+      (P.Commit.Key)
+      (Branch_store.Key)
+
+  type slice = P.Slice.t
+
+  type watch = unit -> unit Lwt.t
+
+  let unwatch w = w ()
+
+  module Repo = struct
+    type t = repo
+
+    let v = P.Repo.v
+
+    let close = P.Repo.close
+
+    let graph_t t = P.Repo.node_t t
+
+    let history_t t = P.Repo.commit_t t
+
+    let branch_t t = P.Repo.branch_t t
+
+    let commit_t t = P.Repo.commit_t t
+
+    let node_t t = P.Repo.node_t t
+
+    let contents_t t = P.Repo.contents_t t
+
+    let branches t = P.Branch.list (branch_t t)
+
+    let heads repo =
+      let t = branch_t repo in
+      Branch_store.list t >>= fun bs ->
+      Lwt_list.fold_left_s
+        (fun acc r ->
+          Branch_store.find t r >>= function
+          | None -> Lwt.return acc
+          | Some h -> (
+              Commit.of_hash repo h >|= function
+              | None -> acc
+              | Some h -> h :: acc ))
+        [] bs
+
+    let export ?(full = true) ?depth ?(min = []) ?(max = []) t =
+      Log.debug (fun f ->
+          f "export depth=%s full=%b min=%d max=%d"
+            (match depth with None -> "<none>" | Some d -> string_of_int d)
+            full (List.length min) (List.length max));
+      (match max with [] -> heads t | m -> Lwt.return m) >>= fun max ->
+      P.Slice.empty () >>= fun slice ->
+      let max = List.map (fun x -> `Commit x.Commit.h) max in
+      let min = List.map (fun x -> `Commit x.Commit.h) min in
+      let pred = function
+        | `Commit k ->
+            H.parents (history_t t) k >|= fun parents ->
+            List.map (fun x -> `Commit x) parents
+        | _ -> Lwt.return_nil
+      in
+      KGraph.closure ?depth ~pred ~min ~max () >>= fun g ->
+      let keys =
+        List.fold_left
+          (fun acc -> function `Commit c -> c :: acc | _ -> acc)
+          [] (KGraph.vertex g)
+      in
+      let root_nodes = ref [] in
+      Lwt_list.iter_p
+        (fun k ->
+          P.Commit.find (commit_t t) k >>= function
+          | None -> Lwt.return_unit
+          | Some c ->
+              root_nodes := P.Commit.Val.node c :: !root_nodes;
+              P.Slice.add slice (`Commit (k, c)))
+        keys
+      >>= fun () ->
+      if not full then Lwt.return slice
+      else
+        (* XXX: we can compute a [min] if needed *)
+        Graph.closure (graph_t t) ~min:[] ~max:!root_nodes >>= fun nodes ->
+        let module KSet = Set.Make (struct
+          type t = P.Contents.key
+
+          let compare = Type.compare P.Contents.Key.t
+        end) in
+        let contents = ref KSet.empty in
+        Lwt_list.iter_p
+          (fun k ->
+            P.Node.find (node_t t) k >>= function
+            | None -> Lwt.return_unit
+            | Some v ->
+                List.iter
+                  (function
+                    | _, `Contents (c, _) -> contents := KSet.add c !contents
+                    | _ -> ())
+                  (P.Node.Val.list v);
+                P.Slice.add slice (`Node (k, v)))
+          nodes
+        >>= fun () ->
+        Lwt_list.iter_p
+          (fun k ->
+            P.Contents.find (contents_t t) k >>= function
+            | None -> Lwt.return_unit
+            | Some m -> P.Slice.add slice (`Contents (k, m)))
+          (KSet.elements !contents)
+        >|= fun () -> slice
+
+    exception Import_error of string
+
+    let import_error fmt = Fmt.kstrf (fun x -> Lwt.fail (Import_error x)) fmt
+
+    let import t s =
+      let aux name add dk (k, v) =
+        add v >>= fun k' ->
+        if not (Type.equal dk k k') then
+          import_error "%s import error: expected %a, got %a" name
+            Type.(pp dk)
+            k
+            Type.(pp dk)
+            k'
+        else Lwt.return_unit
+      in
+      let contents = ref [] in
+      let nodes = ref [] in
+      let commits = ref [] in
+      P.Slice.iter s (function
+        | `Contents c ->
+            contents := c :: !contents;
+            Lwt.return_unit
+        | `Node n ->
+            nodes := n :: !nodes;
+            Lwt.return_unit
+        | `Commit c ->
+            commits := c :: !commits;
+            Lwt.return_unit)
+      >>= fun () ->
+      P.Repo.batch t @@ fun contents_t node_t commit_t ->
+      Lwt.catch
+        (fun () ->
+          Lwt_list.iter_p
+            (aux "Contents" (P.Contents.add contents_t) P.Contents.Key.t)
+            !contents
+          >>= fun () ->
+          Lwt_list.iter_p (aux "Node" (P.Node.add node_t) P.Node.Key.t) !nodes
+          >>= fun () ->
+          Lwt_list.iter_p
+            (aux "Commit" (P.Commit.add commit_t) P.Commit.Key.t)
+            !commits
+          >|= fun () -> Ok ())
+        (function
+          | Import_error e -> Lwt.return_error (`Msg e)
+          | e -> Fmt.kstrf Lwt.fail_invalid_arg "impot error: %a" Fmt.exn e)
+  end
+
+  type t = {
+    repo : Repo.t;
+    head_ref : head_ref;
+    mutable tree : (commit * tree) option;
+    (* cache for the store tree *)
+    lock : Lwt_mutex.t;
+  }
+
+  type step = Key.step
+
+  let repo t = t.repo
+
+  let branch_t t = Repo.branch_t t.repo
+
+  let commit_t t = Repo.commit_t t.repo
+
+  let history_t t = commit_t t
+
+  let status t =
+    match t.head_ref with
+    | `Branch b -> `Branch b
+    | `Head h -> ( match !h with None -> `Empty | Some c -> `Commit c )
+
+  let head_ref t =
+    match t.head_ref with
+    | `Branch t -> `Branch t
+    | `Head h -> ( match !h with None -> `Empty | Some h -> `Head h )
+
+  let branch t =
+    match head_ref t with
+    | `Branch t -> Lwt.return_some t
+    | `Empty | `Head _ -> Lwt.return_none
+
+  let err_no_head s = Fmt.kstrf Lwt.fail_invalid_arg "Irmin.%s: no head" s
+
+  let retry_merge name fn =
+    let rec aux i =
+      fn () >>= function
+      | Error _ as c -> Lwt.return c
+      | Ok true -> Merge.ok ()
+      | Ok false ->
+          Log.debug (fun f -> f "Irmin.%s: conflict, retrying (%d)." name i);
+          aux (i + 1)
+    in
+    aux 1
+
+  let of_ref repo head_ref =
+    let lock = Lwt_mutex.create () in
+    Lwt.return { lock; head_ref; repo; tree = None }
+
+  let pp_branch = Type.pp Branch_store.Key.t
+
+  let err_invalid_branch t =
+    let err = Fmt.strf "%a is not a valid branch name." pp_branch t in
+    Lwt.fail (Invalid_argument err)
+
+  let of_branch repo id =
+    if Branch_store.Key.is_valid id then of_ref repo (`Branch id)
+    else err_invalid_branch id
+
+  let master repo = of_branch repo Branch_store.Key.master
+
+  let empty repo = of_ref repo (`Head (ref None))
+
+  let of_commit c = of_ref c.Commit.r (`Head (ref (Some c)))
+
+  let pp_key = Type.pp Key.t
+
+  let skip_key key =
+    Log.debug (fun l -> l "[watch-key] key %a has not changed" pp_key key);
+    Lwt.return_unit
+
+  let changed_key key =
+    Log.debug (fun l -> l "[watch-key] key %a has changed" pp_key key)
+
+  let with_tree ~key x f =
+    x >>= function
+    | None -> skip_key key
+    | Some x ->
+        changed_key key;
+        f x
+
+  let lift_tree_diff ~key tree fn = function
+    | `Removed x -> with_tree ~key (tree x) @@ fun v -> fn @@ `Removed (x, v)
+    | `Added x -> with_tree ~key (tree x) @@ fun v -> fn @@ `Added (x, v)
+    | `Updated (x, y) -> (
+        assert (not (Commit.equal x y));
+        tree x >>= fun vx ->
+        tree y >>= fun vy ->
+        match (vx, vy) with
+        | None, None -> skip_key key
+        | None, Some vy ->
+            changed_key key;
+            fn @@ `Added (y, vy)
+        | Some vx, None ->
+            changed_key key;
+            fn @@ `Removed (x, vx)
+        | Some vx, Some vy ->
+            if Tree.equal vx vy then skip_key key
+            else (
+              changed_key key;
+              fn @@ `Updated ((x, vx), (y, vy)) ) )
+
+  let head t =
+    let h =
+      match head_ref t with
+      | `Head key -> Lwt.return_some key
+      | `Empty -> Lwt.return_none
+      | `Branch name -> (
+          Branch_store.find (branch_t t) name >>= function
+          | None -> Lwt.return_none
+          | Some h -> Commit.of_hash t.repo h )
+    in
+    h >|= fun h ->
+    Log.debug (fun f -> f "Head.find -> %a" Fmt.(option Commit.pp_hash) h);
+    h
+
+  let tree_and_head t =
+    head t >|= function
+    | None -> None
+    | Some h -> (
+        match t.tree with
+        | Some (o, t) when Commit.equal o h -> Some (o, t)
+        | _ ->
+            t.tree <- None;
+
+            (* the tree cache needs to be invalidated *)
+            let n = Tree.import_no_check (repo t) (Commit.node h) in
+            let tree = `Node n in
+            t.tree <- Some (h, tree);
+            Some (h, tree) )
+
+  let tree t =
+    tree_and_head t >|= function
+    | None -> Tree.empty
+    | Some (_, tree) -> (tree :> tree)
+
+  let lift_head_diff repo fn = function
+    | `Removed x -> (
+        Commit.of_hash repo x >>= function
+        | None -> Lwt.return_unit
+        | Some x -> fn (`Removed x) )
+    | `Updated (x, y) -> (
+        Commit.of_hash repo x >>= fun x ->
+        Commit.of_hash repo y >>= fun y ->
+        match (x, y) with
+        | None, None -> Lwt.return_unit
+        | Some x, None -> fn (`Removed x)
+        | None, Some y -> fn (`Added y)
+        | Some x, Some y -> fn (`Updated (x, y)) )
+    | `Added x -> (
+        Commit.of_hash repo x >>= function
+        | None -> Lwt.return_unit
+        | Some x -> fn (`Added x) )
+
+  let watch t ?init fn =
+    branch t >>= function
+    | None -> failwith "watch a detached head: TODO"
+    | Some name0 ->
+        let init =
+          match init with
+          | None -> None
+          | Some head0 -> Some [ (name0, head0.Commit.h) ]
+        in
+        Branch_store.watch (branch_t t) ?init (fun name head ->
+            if Type.equal Branch_store.Key.t name0 name then
+              lift_head_diff t.repo fn head
+            else Lwt.return_unit)
+        >|= fun id () -> Branch_store.unwatch (branch_t t) id
+
+  let pp_key = Type.pp Key.t
+
+  let watch_key t key ?init fn =
+    Log.info (fun f -> f "watch-key %a" pp_key key);
+    let tree c = Tree.find_tree (Commit.tree c) key in
+    watch t ?init (lift_tree_diff ~key tree fn)
+
+  module Head = struct
+    let list = Repo.heads
+
+    let find = head
+
+    let get t =
+      find t >>= function None -> err_no_head "head" | Some k -> Lwt.return k
+
+    let set t c =
+      match t.head_ref with
+      | `Head h ->
+          h := Some c;
+          Lwt.return_unit
+      | `Branch name -> Branch_store.set (branch_t t) name c.Commit.h
+
+    let test_and_set_unsafe t ~test ~set =
+      match t.head_ref with
+      | `Head head ->
+          (* [head] is protected by [t.lock]. *)
+          if Commit.equal_opt !head test then (
+            head := set;
+            Lwt.return_true )
+          else Lwt.return_false
+      | `Branch name ->
+          let h = function None -> None | Some c -> Some c.Commit.h in
+          Branch_store.test_and_set (branch_t t) name ~test:(h test)
+            ~set:(h set)
+
+    let test_and_set t ~test ~set =
+      Lwt_mutex.with_lock t.lock (fun () -> test_and_set_unsafe t ~test ~set)
+
+    type ff_error = [ `Rejected | `No_change | lca_error ]
+
+    let fast_forward t ?max_depth ?n new_head =
+      let return x = if x then Ok () else Error (`Rejected :> ff_error) in
+      find t >>= function
+      | None -> test_and_set t ~test:None ~set:(Some new_head) >|= return
+      | Some old_head -> (
+          Log.debug (fun f ->
+              f "fast-forward-head old=%a new=%a" Commit.pp_hash old_head
+                Commit.pp_hash new_head);
+          if Commit.equal new_head old_head then
+            (* we only update if there is a change *)
+            Lwt.return_error `No_change
+          else
+            H.lcas (history_t t) ?max_depth ?n new_head.Commit.h
+              old_head.Commit.h
+            >>= function
+            | Ok [ x ] when Type.equal Hash.t x old_head.Commit.h ->
+                (* we only update if new_head > old_head *)
+                test_and_set t ~test:(Some old_head) ~set:(Some new_head)
+                >|= return
+            | Ok _ -> Lwt.return_error `Rejected
+            | Error e -> Lwt.return_error (e :> ff_error) )
+
+    (* Merge two commits:
+       - Search for common ancestors
+       - Perform recursive 3-way merges *)
+    let three_way_merge t ?max_depth ?n ~info c1 c2 =
+      P.Repo.batch (repo t) @@ fun _ _ commit_t ->
+      H.three_way_merge commit_t ?max_depth ?n ~info c1.Commit.h c2.Commit.h
+
+    (* FIXME: we might want to keep the new commit in case of conflict,
+         and use it as a base for the next merge. *)
+    let merge ~into:t ~info ?max_depth ?n c1 =
+      Log.debug (fun f -> f "merge_head");
+      let aux () =
+        head t >>= fun head ->
+        match head with
+        | None -> test_and_set_unsafe t ~test:head ~set:(Some c1) >>= Merge.ok
+        | Some c2 ->
+            three_way_merge t ~info ?max_depth ?n c1 c2 >>=* fun c3 ->
+            Commit.of_hash t.repo c3 >>= fun c3 ->
+            test_and_set_unsafe t ~test:head ~set:c3 >>= Merge.ok
+      in
+      Lwt_mutex.with_lock t.lock (fun () -> retry_merge "merge_head" aux)
+  end
+
+  (* Retry an operation until the optimistic lock is happy. Ensure
+     that the operation is done at least once. *)
+  let retry ~retries fn =
+    let done_once = ref false in
+    let rec aux i =
+      if !done_once && i > retries then
+        Lwt.return_error (`Too_many_retries retries)
+      else
+        fn () >>= function
+        | Ok true -> Lwt.return_ok ()
+        | Error e -> Lwt.return_error e
+        | Ok false ->
+            done_once := true;
+            aux (i + 1)
+    in
+    aux 0
+
+  let root_tree = function `Node _ as n -> n | `Contents _ -> assert false
+
+  let add_commit t old_head ((c, _) as tree) =
+    match t.head_ref with
+    | `Head head ->
+        Lwt_mutex.with_lock t.lock (fun () ->
+            if not (Commit.equal_opt old_head !head) then Lwt.return_false
+            else (
+              (* [head] is protected by [t.lock] *)
+              head := Some c;
+              t.tree <- Some tree;
+              Lwt.return_true ))
+    | `Branch name ->
+        (* concurrent handlers and/or process can modify the
+         branch. Need to check that we are still working on the same
+         head. *)
+        let test =
+          match old_head with None -> None | Some c -> Some (Commit.hash c)
+        in
+        let set = Some (Commit.hash c) in
+        Branch_store.test_and_set (branch_t t) name ~test ~set >|= fun r ->
+        if r then t.tree <- Some tree;
+        r
+
+  type write_error =
+    [ Merge.conflict | `Too_many_retries of int | `Test_was of tree option ]
+
+  let pp_write_error ppf = function
+    | `Conflict e -> Fmt.pf ppf "Got a conflict: %s" e
+    | `Too_many_retries i ->
+        Fmt.pf ppf
+          "Failure after %d attempts to retry the operation: Too many attempts."
+          i
+    | `Test_was t ->
+        Fmt.pf ppf "Test-and-set failed: got %a when reading the store"
+          Type.(pp (option Tree.tree_t))
+          t
+
+  let write_error e : ('a, write_error) result Lwt.t = Lwt.return_error e
+
+  let err_test v = write_error (`Test_was v)
+
+  type snapshot = {
+    head : commit option;
+    root : tree;
+    tree : tree option;
+    (* the subtree used by the transaction *)
+    parents : commit list;
+  }
+
+  let snapshot t key =
+    tree_and_head t >>= function
+    | None ->
+        Lwt.return
+          { head = None; root = Tree.empty; tree = None; parents = [] }
+    | Some (c, root) ->
+        let root = (root :> tree) in
+        Tree.find_tree root key >|= fun tree ->
+        { head = Some c; root; tree; parents = [ c ] }
+
+  let same_tree x y =
+    match (x, y) with
+    | None, None -> true
+    | None, _ | _, None -> false
+    | Some x, Some y -> Tree.equal x y
+
+  (* Update the store with a new commit. Ensure the no commit becomes orphan
+     in the process.  *)
+  let update ?(allow_empty = false) ~info ?parents t key merge_tree f =
+    snapshot t key >>= fun s ->
+    (* this might take a very long time *)
+    f s.tree >>= fun new_tree ->
+    (* if no change and [allow_empty = true] then, do nothing *)
+    if same_tree s.tree new_tree && (not allow_empty) && s.head <> None then
+      Lwt.return_ok true
+    else
+      merge_tree s.root key ~current_tree:s.tree ~new_tree >>= function
+      | Error e -> Lwt.return_error e
+      | Ok root ->
+          let info = info () in
+          let parents = match parents with None -> s.parents | Some p -> p in
+          let parents = List.map Commit.hash parents in
+          Commit.v (repo t) ~info ~parents root >>= fun c ->
+          add_commit t s.head (c, root_tree root) >>= Lwt.return_ok
+
+  let ok x = Ok x
+
+  let fail name = function
+    | Ok x -> Lwt.return x
+    | Error e -> Fmt.kstrf Lwt.fail_with "%s: %a" name pp_write_error e
+
+  let set_tree_once root key ~current_tree:_ ~new_tree =
+    match new_tree with
+    | None -> Tree.remove root key >|= ok
+    | Some tree -> Tree.add_tree root key tree >|= ok
+
+  let set_tree ?(retries = 13) ?allow_empty ?parents ~info t k v =
+    Log.debug (fun l -> l "set %a" pp_key k);
+    retry ~retries @@ fun () ->
+    update t k ?allow_empty ?parents ~info set_tree_once @@ fun _tree ->
+    Lwt.return_some v
+
+  let set_tree_exn ?retries ?allow_empty ?parents ~info t k v =
+    set_tree ?retries ?allow_empty ?parents ~info t k v >>= fail "set_exn"
+
+  let remove ?(retries = 13) ?allow_empty ?parents ~info t k =
+    Log.debug (fun l -> l "debug %a" pp_key k);
+    retry ~retries @@ fun () ->
+    update t k ?allow_empty ?parents ~info set_tree_once @@ fun _tree ->
+    Lwt.return_none
+
+  let remove_exn ?retries ?allow_empty ?parents ~info t k =
+    remove ?retries ?allow_empty ?parents ~info t k >>= fail "remove_exn"
+
+  let set ?retries ?allow_empty ?parents ~info t k v =
+    let v = `Contents (v, Metadata.default) in
+    set_tree t k ?retries ?allow_empty ?parents ~info v
+
+  let set_exn ?retries ?allow_empty ?parents ~info t k v =
+    set t k ?retries ?allow_empty ?parents ~info v >>= fail "set_exn"
+
+  let test_and_set_tree_once ~test root key ~current_tree ~new_tree =
+    match (test, current_tree) with
+    | None, None -> set_tree_once root key ~new_tree ~current_tree
+    | None, _ | _, None -> err_test current_tree
+    | Some test, Some v ->
+        if Tree.equal test v then
+          set_tree_once root key ~new_tree ~current_tree
+        else err_test current_tree
+
+  let test_and_set_tree ?(retries = 13) ?allow_empty ?parents ~info t k ~test
+      ~set =
+    Log.debug (fun l -> l "test-and-set %a" pp_key k);
+    retry ~retries @@ fun () ->
+    update t k ?allow_empty ?parents ~info (test_and_set_tree_once ~test)
+    @@ fun _tree -> Lwt.return set
+
+  let test_and_set_tree_exn ?retries ?allow_empty ?parents ~info t k ~test ~set
+      =
+    test_and_set_tree ?retries ?allow_empty ?parents ~info t k ~test ~set
+    >>= fail "test_and_set_tree_exn"
+
+  let test_and_set ?retries ?allow_empty ?parents ~info t k ~test ~set =
+    let test =
+      match test with
+      | None -> None
+      | Some t -> Some (`Contents (t, Metadata.default))
+    in
+    let set =
+      match set with
+      | None -> None
+      | Some s -> Some (`Contents (s, Metadata.default))
+    in
+    test_and_set_tree ?retries ?allow_empty ?parents ~info t k ~test ~set
+
+  let test_and_set_exn ?retries ?allow_empty ?parents ~info t k ~test ~set =
+    test_and_set ?retries ?allow_empty ?parents ~info t k ~test ~set
+    >>= fail "test_and_set_exn"
+
+  let merge_once ~old root key ~current_tree ~new_tree =
+    let old = Merge.promise old in
+    Merge.f (Merge.option Tree.merge) ~old current_tree new_tree >>= function
+    | Ok tr -> set_tree_once root key ~new_tree:tr ~current_tree
+    | Error e -> write_error (e :> write_error)
+
+  let merge_tree ?(retries = 13) ?allow_empty ?parents ~info ~old t k tree =
+    Log.debug (fun l -> l "merge %a" pp_key k);
+    retry ~retries @@ fun () ->
+    update t k ?allow_empty ?parents ~info (merge_once ~old) @@ fun _tree ->
+    Lwt.return tree
+
+  let merge_tree_exn ?retries ?allow_empty ?parents ~info ~old t k tree =
+    merge_tree ?retries ?allow_empty ?parents ~info ~old t k tree
+    >>= fail "merge_tree_exn"
+
+  let merge ?retries ?allow_empty ?parents ~info ~old t k v =
+    let old =
+      match old with
+      | None -> None
+      | Some v -> Some (`Contents (v, Metadata.default))
+    in
+    let v =
+      match v with
+      | None -> None
+      | Some v -> Some (`Contents (v, Metadata.default))
+    in
+    merge_tree ?retries ?allow_empty ?parents ~info ~old t k v
+
+  let merge_exn ?retries ?allow_empty ?parents ~info ~old t k v =
+    merge ?retries ?allow_empty ?parents ~info ~old t k v >>= fail "merge_exn"
+
+  let mem t k = tree t >>= fun tree -> Tree.mem tree k
+
+  let mem_tree t k = tree t >>= fun tree -> Tree.mem_tree tree k
+
+  let find_all t k = tree t >>= fun tree -> Tree.find_all tree k
+
+  let find t k = tree t >>= fun tree -> Tree.find tree k
+
+  let get t k = tree t >>= fun tree -> Tree.get tree k
+
+  let find_tree t k = tree t >>= fun tree -> Tree.find_tree tree k
+
+  let get_tree t k = tree t >>= fun tree -> Tree.get_tree tree k
+
+  let hash t k =
+    find_tree t k >|= function
+    | None -> None
+    | Some tree -> Some (Tree.hash tree)
+
+  let get_all t k = tree t >>= fun tree -> Tree.get_all tree k
+
+  let list t k = tree t >>= fun tree -> Tree.list tree k
+
+  let kind t k = tree t >>= fun tree -> Tree.kind tree k
+
+  let with_tree ?(retries = 13) ?allow_empty ?parents
+      ?(strategy = `Test_and_set) ~info t key f =
+    let done_once = ref false in
+    let rec aux n old_tree =
+      Log.debug (fun l -> l "with_tree %a (%d/%d)" pp_key key n retries);
+      if !done_once && n > retries then write_error (`Too_many_retries retries)
+      else
+        f old_tree >>= fun new_tree ->
+        match (strategy, new_tree) with
+        | `Set, Some tree ->
+            set_tree t key ~retries ?allow_empty ?parents tree ~info
+        | `Set, None -> remove t key ~retries ?allow_empty ~info ?parents
+        | `Test_and_set, _ -> (
+            test_and_set_tree t key ~retries ?allow_empty ?parents ~info
+              ~test:old_tree ~set:new_tree
+            >>= function
+            | Error (`Test_was tr) when retries > 0 && n <= retries ->
+                done_once := true;
+                aux (n + 1) tr
+            | e -> Lwt.return e )
+        | `Merge, _ -> (
+            merge_tree ~old:old_tree ~retries ?allow_empty ?parents ~info t key
+              new_tree
+            >>= function
+            | Ok _ as x -> Lwt.return x
+            | Error (`Conflict _) when retries > 0 && n <= retries ->
+                done_once := true;
+
+                (* use the store's current tree as the new 'old store' *)
+                (tree_and_head t >>= function
+                 | None -> Lwt.return_none
+                 | Some (_, tr) -> Tree.find_tree (tr :> tree) key)
+                >>= fun old_tree -> aux (n + 1) old_tree
+            | Error e -> write_error e )
+    in
+    find_tree t key >>= fun old_tree -> aux 0 old_tree
+
+  let with_tree_exn ?retries ?allow_empty ?parents ?strategy ~info f t key =
+    with_tree ?retries ?allow_empty ?strategy ?parents ~info f t key
+    >>= fail "with_tree_exn"
+
+  let clone ~src ~dst =
+    (Head.find src >>= function
+     | None -> Branch_store.remove (branch_t src) dst
+     | Some h -> Branch_store.set (branch_t src) dst h.Commit.h)
+    >>= fun () -> of_branch (repo src) dst
+
+  let return_lcas r = function
+    | Error _ as e -> Lwt.return e
+    | Ok commits ->
+        Lwt_list.filter_map_p (Commit.of_hash r) commits >|= fun x -> Ok x
+
+  let lcas ?max_depth ?n t1 t2 =
+    Head.get t1 >>= fun h1 ->
+    Head.get t2 >>= fun h2 ->
+    H.lcas (history_t t1) ?max_depth ?n h1.Commit.h h2.Commit.h
+    >>= return_lcas t1.repo
+
+  let lcas_with_commit t ?max_depth ?n c =
+    Head.get t >>= fun h ->
+    H.lcas (history_t t) ?max_depth ?n h.Commit.h c.Commit.h
+    >>= return_lcas t.repo
+
+  let lcas_with_branch t ?max_depth ?n b =
+    Head.get t >>= fun h ->
+    Head.get { t with head_ref = `Branch b } >>= fun head ->
+    H.lcas (history_t t) ?max_depth ?n h.Commit.h head.Commit.h
+    >>= return_lcas t.repo
+
+  module Private = P
+
+  type 'a merge =
+    info:Info.f ->
+    ?max_depth:int ->
+    ?n:int ->
+    'a ->
+    (unit, Merge.conflict) result Lwt.t
+
+  let merge_with_branch t ~info ?max_depth ?n other =
+    Log.debug (fun f -> f "merge_with_branch %a" pp_branch other);
+    Branch_store.find (branch_t t) other >>= function
+    | None ->
+        Fmt.kstrf Lwt.fail_invalid_arg
+          "merge_with_branch: %a is not a valid branch ID" pp_branch other
+    | Some c -> (
+        Commit.of_hash t.repo c >>= function
+        | None -> Lwt.fail_invalid_arg "invalid commit"
+        | Some c -> Head.merge ~into:t ~info ?max_depth ?n c )
+
+  let merge_with_commit t ~info ?max_depth ?n other =
+    Head.merge ~into:t ~info ?max_depth ?n other
+
+  let merge_into ~into ~info ?max_depth ?n t =
+    Log.debug (fun l -> l "merge");
+    match head_ref t with
+    | `Branch name -> merge_with_branch into ~info ?max_depth ?n name
+    | `Head h -> merge_with_commit into ~info ?max_depth ?n h
+    | `Empty -> Merge.ok ()
+
+  module History = OCamlGraph.Persistent.Digraph.ConcreteBidirectional (struct
+    type t = commit
+
+    let hash h = P.Commit.Key.short_hash h.Commit.h
+
+    let compare x y = Type.compare P.Commit.Key.t x.Commit.h y.Commit.h
+
+    let equal x y = Type.equal P.Commit.Key.t x.Commit.h y.Commit.h
+  end)
+
+  module Gmap = struct
+    module Src =
+      Object_graph.Make (P.Contents.Key) (P.Node.Metadata) (P.Node.Key)
+        (P.Commit.Key)
+        (Branch_store.Key)
+
+    module Dst = struct
+      include History
+
+      let empty () = empty
+    end
+
+    let filter_map f g =
+      let t = Dst.empty () in
+      Src.fold_edges
+        (fun x y t ->
+          t >>= fun t ->
+          f x >>= fun x ->
+          f y >|= fun y ->
+          match (x, y) with
+          | Some x, Some y ->
+              let t = Dst.add_vertex t x in
+              let t = Dst.add_vertex t y in
+              Dst.add_edge t x y
+          | _ -> t)
+        g (Lwt.return t)
+  end
+
+  let history ?depth ?(min = []) ?(max = []) t =
+    Log.debug (fun f -> f "history");
+    let pred = function
+      | `Commit k ->
+          H.parents (history_t t) k
+          >>= Lwt_list.filter_map_p (Commit.of_hash t.repo)
+          >|= fun parents -> List.map (fun x -> `Commit x.Commit.h) parents
+      | _ -> Lwt.return_nil
+    in
+    (Head.find t >>= function
+     | Some h -> Lwt.return [ h ]
+     | None -> Lwt.return max)
+    >>= fun max ->
+    let max = List.map (fun k -> `Commit k.Commit.h) max in
+    let min = List.map (fun k -> `Commit k.Commit.h) min in
+    Gmap.Src.closure ?depth ~min ~max ~pred () >>= fun g ->
+    Gmap.filter_map
+      (function `Commit k -> Commit.of_hash t.repo k | _ -> Lwt.return_none)
+      g
+
+  let pp_option = Type.pp (Type.option Type.int)
+
+  module Heap = Bheap.Make (struct
+    type t = commit * int
+
+    let compare c1 c2 =
+      Int64.compare
+        (Info.date (Commit.info (fst c1)))
+        (Info.date (Commit.info (fst c2)))
+  end)
+
+  let last_modified ?depth ?(n = 1) t key =
+    Log.debug (fun l ->
+        l "last_modified depth=%a number=%d key=%a" pp_option depth n pp_key
+          key);
+    Head.get t >>= fun commit ->
+    let heap = Heap.create 5 in
+    let () = Heap.add heap (commit, 0) in
+    let rec search acc =
+      if Heap.is_empty heap || List.length acc = n then Lwt.return acc
+      else
+        let current, current_depth = Heap.pop_maximum heap in
+        let parents = Commit.parents current in
+        of_commit current >>= fun store ->
+        find store key >>= fun current_value ->
+        if List.length parents = 0 then
+          if current_value <> None then Lwt.return (current :: acc)
+          else Lwt.return acc
+        else
+          let max_depth =
+            match depth with
+            | Some depth -> current_depth >= depth
+            | None -> false
+          in
+          Lwt_list.for_all_p
+            (fun hash ->
+              Commit.of_hash (repo store) hash >>= function
+              | Some commit -> (
+                  let () =
+                    if not max_depth then
+                      Heap.add heap (commit, current_depth + 1)
+                  in
+                  of_commit commit >>= fun store ->
+                  find store key >|= fun e ->
+                  match (e, current_value) with
+                  | Some x, Some y -> not (Type.equal Contents.t x y)
+                  | Some _, None -> true
+                  | _, _ -> false )
+              | None -> Lwt.return_false)
+            parents
+          >>= fun found ->
+          if found then search (current :: acc) else search acc
+    in
+    search []
+
+  module Branch = struct
+    include P.Branch.Key
+
+    let mem t = P.Branch.mem (P.Repo.branch_t t)
+
+    let find t br =
+      P.Branch.find (Repo.branch_t t) br >>= function
+      | None -> Lwt.return_none
+      | Some h -> Commit.of_hash t h
+
+    let set t br h = P.Branch.set (P.Repo.branch_t t) br (Commit.hash h)
+
+    let remove t = P.Branch.remove (P.Repo.branch_t t)
+
+    let list = Repo.branches
+
+    let watch t k ?init f =
+      let init = match init with None -> None | Some h -> Some h.Commit.h in
+      P.Branch.watch_key (Repo.branch_t t) k ?init (lift_head_diff t f)
+      >|= fun w () -> Branch_store.unwatch (Repo.branch_t t) w
+
+    let watch_all t ?init f =
+      let init =
+        match init with
+        | None -> None
+        | Some i -> Some (List.map (fun (k, v) -> (k, v.Commit.h)) i)
+      in
+      let f k v = lift_head_diff t (f k) v in
+      P.Branch.watch (Repo.branch_t t) ?init f >|= fun w () ->
+      Branch_store.unwatch (Repo.branch_t t) w
+
+    let err_not_found k =
+      Fmt.kstrf invalid_arg "Branch.get: %a not found" pp_branch k
+
+    let get t k =
+      find t k >>= function None -> err_not_found k | Some v -> Lwt.return v
+  end
+
+  module Status = struct
+    type t = [ `Empty | `Branch of branch | `Commit of commit ]
+
+    let t r =
+      let open Type in
+      variant "status" (fun empty branch commit ->
+        function
+        | `Empty -> empty | `Branch b -> branch b | `Commit c -> commit c)
+      |~ case0 "empty" `Empty
+      |~ case1 "branch" Branch.t (fun b -> `Branch b)
+      |~ case1 "commit" (Commit.t r) (fun c -> `Commit c)
+      |> sealv
+
+    let pp ppf = function
+      | `Empty -> Fmt.string ppf "empty"
+      | `Branch b -> Type.pp Branch.t ppf b
+      | `Commit c -> Type.pp Hash.t ppf (Commit.hash c)
+  end
+
+  let slice_t = P.Slice.t
+
+  let tree_t = Tree.tree_t
+
+  let contents_t = Contents.t
+
+  let metadata_t = Metadata.t
+
+  let key_t = Key.t
+
+  let step_t = Key.step_t
+
+  let node_t = Tree.node_t
+
+  let commit_t = Commit.t
+
+  let branch_t = Branch.t
+
+  let kind_t = Type.enum "kind" [ ("contents", `Contents); ("node", `Node) ]
+
+  let lca_error_t =
+    Type.enum "lca-error"
+      [
+        ("max-depth-reached", `Max_depth_reached);
+        ("too-many-lcas", `Too_many_lcas);
+      ]
+
+  let ff_error_t =
+    Type.enum "ff-error"
+      [
+        ("max-depth-reached", `Max_depth_reached);
+        ("too-many-lcas", `Too_many_lcas);
+        ("no-change", `No_change);
+        ("rejected", `Rejected);
+      ]
+
+  let write_error_t =
+    let open Type in
+    variant "write-error" (fun c m e ->
+      function
+      | `Conflict x -> c x | `Too_many_retries x -> m x | `Test_was x -> e x)
+    |~ case1 "conflict" string (fun x -> `Conflict x)
+    |~ case1 "too-many-retries" int (fun x -> `Too_many_retries x)
+    |~ case1 "test-got" (option tree_t) (fun x -> `Test_was x)
+    |> sealv
+
+  let write_error_t =
+    let of_string _ = assert false in
+    Type.like ~cli:(pp_write_error, of_string) write_error_t
+end
diff --git a/vendors/irmin/store.mli b/vendors/irmin/store.mli
new file mode 100644
index 0000000000000000000000000000000000000000..69a473dcf2194711693e055c12415522fda5f344
--- /dev/null
+++ b/vendors/irmin/store.mli
@@ -0,0 +1,48 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Branch-consistent stores: read-write store with support fork/merge
+    operations. *)
+
+module Make (P : S.PRIVATE) :
+  S.STORE
+    with type key = P.Node.Path.t
+     and type contents = P.Contents.value
+     and type branch = P.Branch.key
+     and type hash = P.Hash.t
+     and type slice = P.Slice.t
+     and type step = P.Node.Path.step
+     and type metadata = P.Node.Val.metadata
+     and module Key = P.Node.Path
+     and type repo = P.Repo.t
+     and module Private = P
+
+module Content_addressable
+    (X : S.APPEND_ONLY_STORE_MAKER)
+    (K : S.HASH)
+    (V : Type.S) : sig
+  include
+    S.CONTENT_ADDRESSABLE_STORE
+      with type 'a t = 'a X(K)(V).t
+       and type key = K.t
+       and type value = V.t
+
+  val batch : [ `Read ] t -> ([ `Read | `Write ] t -> 'a Lwt.t) -> 'a Lwt.t
+
+  val v : Conf.t -> [ `Read ] t Lwt.t
+
+  val close : 'a t -> unit Lwt.t
+end
diff --git a/vendors/irmin/sync.ml b/vendors/irmin/sync.ml
new file mode 100644
index 0000000000000000000000000000000000000000..d5e6f7efde8541bb4fd7fd6e68cc6edb98f230d4
--- /dev/null
+++ b/vendors/irmin/sync.ml
@@ -0,0 +1,33 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module None (H : Type.S) (R : Type.S) = struct
+  type t = unit
+
+  let v _ = Lwt.return_unit
+
+  type endpoint = unit
+
+  type commit = H.t
+
+  type branch = R.t
+
+  let fetch () ?depth:_ _ _br =
+    Lwt.return_error (`Msg "fetch operation is not available")
+
+  let push () ?depth:_ _ _br =
+    Lwt.return_error (`Msg "push operation is not available")
+end
diff --git a/vendors/irmin/sync.mli b/vendors/irmin/sync.mli
new file mode 100644
index 0000000000000000000000000000000000000000..a569c2598dfbd7a8b1f794fc901277749ab25a11
--- /dev/null
+++ b/vendors/irmin/sync.mli
@@ -0,0 +1,23 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Store Synchronisation signatures. *)
+
+module None (H : Type.S) (R : Type.S) : sig
+  include S.SYNC with type commit = H.t and type branch = R.t
+
+  val v : 'a -> t Lwt.t
+end
diff --git a/vendors/irmin/sync_ext.ml b/vendors/irmin/sync_ext.ml
new file mode 100644
index 0000000000000000000000000000000000000000..5099e0ae6a870b2c43c83731f1dae73a5cce6d5a
--- /dev/null
+++ b/vendors/irmin/sync_ext.ml
@@ -0,0 +1,198 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+open S
+
+let invalid_argf fmt = Fmt.kstrf Lwt.fail_invalid_arg fmt
+
+let src = Logs.Src.create "irmin.sync" ~doc:"Irmin remote sync"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let remote_store m x = S.Store (m, x)
+
+module Make (S : S.STORE) = struct
+  module B = S.Private.Sync
+
+  type db = S.t
+
+  type commit = S.commit
+
+  let conv dx dy x =
+    let str = Type.to_bin_string dx x in
+    Type.of_bin_string dy str
+
+  let convert_slice (type r s) (module RP : PRIVATE with type Slice.t = r)
+      (module SP : PRIVATE with type Slice.t = s) r =
+    SP.Slice.empty () >>= fun s ->
+    RP.Slice.iter r (function
+      | `Contents (k, v) -> (
+          let k = conv RP.Contents.Key.t SP.Contents.Key.t k in
+          let v = conv RP.Contents.Val.t SP.Contents.Val.t v in
+          match (k, v) with
+          | Ok k, Ok v -> SP.Slice.add s (`Contents (k, v))
+          | _ -> Lwt.return_unit )
+      | `Node (k, v) -> (
+          let k = conv RP.Node.Key.t SP.Node.Key.t k in
+          let v = conv RP.Node.Val.t SP.Node.Val.t v in
+          match (k, v) with
+          | Ok k, Ok v -> SP.Slice.add s (`Node (k, v))
+          | _ -> Lwt.return_unit )
+      | `Commit (k, v) -> (
+          let k = conv RP.Commit.Key.t SP.Commit.Key.t k in
+          let v = conv RP.Commit.Val.t SP.Commit.Val.t v in
+          match (k, v) with
+          | Ok k, Ok v -> SP.Slice.add s (`Commit (k, v))
+          | _ -> Lwt.return_unit ))
+    >>= fun () -> Lwt.return s
+
+  let convs src dst l =
+    List.fold_left
+      (fun acc x -> match conv src dst x with Ok x -> x :: acc | _ -> acc)
+      [] l
+
+  let pp_branch = Type.pp S.Branch.t
+
+  let pp_hash = Type.pp S.Hash.t
+
+  type status = [ `Empty | `Head of commit ]
+
+  let pp_status ppf = function
+    | `Empty -> Fmt.string ppf "empty"
+    | `Head c -> Type.pp S.Hash.t ppf (S.Commit.hash c)
+
+  let status_t t =
+    let open Type in
+    variant "status" (fun empty head ->
+      function `Empty -> empty | `Head c -> head c)
+    |~ case0 "empty" `Empty
+    |~ case1 "head" S.(commit_t @@ repo t) (fun c -> `Head c)
+    |> sealv
+
+  let fetch t ?depth remote =
+    match remote with
+    | Store ((module R), r) -> (
+        Log.debug (fun f -> f "fetch store");
+        let s_repo = S.repo t in
+        let r_repo = R.repo r in
+        S.Repo.heads s_repo >>= fun min ->
+        let min = convs S.(commit_t s_repo) R.(commit_t r_repo) min in
+        R.Head.find r >>= function
+        | None -> Lwt.return_ok `Empty
+        | Some h -> (
+            R.Repo.export (R.repo r) ?depth ~min ~max:[ h ] >>= fun r_slice ->
+            convert_slice (module R.Private) (module S.Private) r_slice
+            >>= fun s_slice ->
+            S.Repo.import s_repo s_slice >|= function
+            | Error e -> Error e
+            | Ok () -> (
+                match conv R.(commit_t r_repo) S.(commit_t s_repo) h with
+                | Ok h -> Ok (`Head h)
+                | Error e -> Error e ) ) )
+    | S.E e -> (
+        match S.status t with
+        | `Empty | `Commit _ -> Lwt.return_ok `Empty
+        | `Branch br -> (
+            Log.debug (fun l -> l "Fetching branch %a" pp_branch br);
+            B.v (S.repo t) >>= fun g ->
+            B.fetch g ?depth e br >>= function
+            | Error _ as e -> Lwt.return e
+            | Ok (Some c) -> (
+                Log.debug (fun l -> l "Fetched %a" pp_hash c);
+                S.Commit.of_hash (S.repo t) c >|= function
+                | None -> Ok `Empty
+                | Some x -> Ok (`Head x) )
+            | Ok None -> (
+                S.Head.find t >>= function
+                | Some h -> Lwt.return_ok (`Head h)
+                | None -> Lwt.return_ok `Empty ) ) )
+    | _ -> Lwt.return_error (`Msg "fetch operation is not available")
+
+  let fetch_exn t ?depth remote =
+    fetch t ?depth remote >>= function
+    | Ok h -> Lwt.return h
+    | Error (`Msg e) -> invalid_argf "Sync.fetch_exn: %s" e
+
+  type pull_error = [ `Msg of string | Merge.conflict ]
+
+  let pp_pull_error ppf = function
+    | `Msg s -> Fmt.string ppf s
+    | `Conflict c -> Fmt.pf ppf "conflict: %s" c
+
+  let pull t ?depth remote kind : (status, pull_error) result Lwt.t =
+    fetch t ?depth remote >>= function
+    | Error e -> Lwt.return_error (e :> pull_error)
+    | Ok (`Head k) -> (
+        match kind with
+        | `Set -> S.Head.set t k >|= fun () -> Ok (`Head k)
+        | `Merge info -> (
+            S.Head.merge ~into:t ~info k >>= function
+            | Ok () -> Lwt.return_ok (`Head k)
+            | Error e -> Lwt.return_error (e :> pull_error) ) )
+    | Ok `Empty -> Lwt.return_ok `Empty
+
+  let pull_exn t ?depth remote kind =
+    pull t ?depth remote kind >>= function
+    | Ok x -> Lwt.return x
+    | Error e -> invalid_argf "Sync.pull_exn: %a" pp_pull_error e
+
+  type push_error = [ `Msg of string | `Detached_head ]
+
+  let pp_push_error ppf = function
+    | `Msg s -> Fmt.string ppf s
+    | `Detached_head -> Fmt.string ppf "cannot push to a non-persistent store"
+
+  let push t ?depth remote =
+    Log.debug (fun f -> f "push");
+    match remote with
+    | Store ((module R), r) -> (
+        S.Head.find t >>= function
+        | None -> Lwt.return_ok `Empty
+        | Some h -> (
+            Log.debug (fun f -> f "push store");
+            R.Repo.heads (R.repo r) >>= fun min ->
+            let r_repo = R.repo r in
+            let s_repo = S.repo t in
+            let min = convs R.(commit_t r_repo) S.(commit_t s_repo) min in
+            S.Repo.export (S.repo t) ?depth ~min >>= fun s_slice ->
+            convert_slice (module S.Private) (module R.Private) s_slice
+            >>= fun r_slice ->
+            R.Repo.import (R.repo r) r_slice >>= function
+            | Error e -> Lwt.return_error (e :> push_error)
+            | Ok () -> (
+                match conv S.(commit_t s_repo) R.(commit_t r_repo) h with
+                | Error e -> Lwt.return_error (e :> push_error)
+                | Ok h ->
+                    R.Head.set r h >>= fun () ->
+                    S.Head.get t >|= fun head -> Ok (`Head head) ) ) )
+    | S.E e -> (
+        match S.status t with
+        | `Empty -> Lwt.return_ok `Empty
+        | `Commit _ -> Lwt.return_error `Detached_head
+        | `Branch br -> (
+            S.of_branch (S.repo t) br >>= S.Head.get >>= fun head ->
+            B.v (S.repo t) >>= fun g ->
+            B.push g ?depth e br >>= function
+            | Ok () -> Lwt.return_ok (`Head head)
+            | Error err -> Lwt.return_error (err :> push_error) ) )
+    | _ -> Lwt.return_error (`Msg "push operation is not available")
+
+  let push_exn t ?depth remote =
+    push t ?depth remote >>= function
+    | Ok x -> Lwt.return x
+    | Error e -> invalid_argf "Sync.push_exn: %a" pp_push_error e
+end
diff --git a/vendors/irmin/sync_ext.mli b/vendors/irmin/sync_ext.mli
new file mode 100644
index 0000000000000000000000000000000000000000..a293792ca6989e6808d6e166dac248f3250dc91b
--- /dev/null
+++ b/vendors/irmin/sync_ext.mli
@@ -0,0 +1,22 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Store Synchronisation. *)
+
+val remote_store : (module S.STORE with type t = 'a) -> 'a -> S.remote
+
+module Make (X : S.STORE) :
+  S.SYNC_STORE with type db = X.t and type commit = X.commit
diff --git a/vendors/irmin/tree.ml b/vendors/irmin/tree.ml
new file mode 100644
index 0000000000000000000000000000000000000000..dc1e1c400986480f883bcb1f9134cf397baec216
--- /dev/null
+++ b/vendors/irmin/tree.ml
@@ -0,0 +1,1790 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ * Copyright (c) 2017 Grégoire Henry <gregoire.henry@ocamlpro.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+
+let src = Logs.Src.create "irmin.tree" ~doc:"Persistent lazy trees for Irmin"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+(* assume l1 and l2 are key-sorted *)
+let alist_iter2 compare_k f l1 l2 =
+  let rec aux l1 l2 =
+    match (l1, l2) with
+    | [], t -> List.iter (fun (key, v) -> f key (`Right v)) t
+    | t, [] -> List.iter (fun (key, v) -> f key (`Left v)) t
+    | (k1, v1) :: t1, (k2, v2) :: t2 -> (
+        match compare_k k1 k2 with
+        | 0 ->
+            f k1 (`Both (v1, v2));
+            (aux [@tailcall]) t1 t2
+        | x ->
+            if x < 0 then (
+              f k1 (`Left v1);
+              (aux [@tailcall]) t1 l2 )
+            else (
+              f k2 (`Right v2);
+              (aux [@tailcall]) l1 t2 ) )
+  in
+  aux l1 l2
+
+(* assume l1 and l2 are key-sorted *)
+let alist_iter2_lwt compare_k f l1 l2 =
+  let l3 = ref [] in
+  alist_iter2 compare_k (fun left right -> l3 := f left right :: !l3) l1 l2;
+  Lwt_list.iter_s (fun b -> b >>= fun () -> Lwt.return_unit) (List.rev !l3)
+
+module Cache (K : Type.S) : sig
+  type 'a t
+
+  type key = K.t
+
+  val create : is_empty:('a -> bool) -> int -> 'a t
+
+  val find : 'a t -> key -> 'a
+
+  val add : 'a t -> key -> 'a -> unit
+
+  val iter : (key -> 'a -> unit) -> 'a t -> unit
+
+  val length : 'a t -> int
+end = struct
+  module M = Ephemeron.K1.Make (struct
+    type t = K.t
+
+    let equal (x : t) (y : t) = Type.equal K.t x y
+
+    let hash (x : t) = Type.short_hash K.t x
+  end)
+
+  type 'a t = { is_empty : 'a -> bool; m : 'a M.t }
+
+  type key = K.t
+
+  let create ~is_empty x = { is_empty; m = M.create x }
+
+  let length t =
+    M.fold (fun _ v acc -> if t.is_empty v then acc else acc + 1) t.m 0
+
+  let add t k v = M.add t.m k v
+
+  let find t k = M.find t.m k
+
+  let iter f t = M.iter f t.m
+end
+
+module Make (P : S.PRIVATE) = struct
+  type counters = {
+    mutable contents_hash : int;
+    mutable contents_find : int;
+    mutable contents_add : int;
+    mutable contents_cache_length : int;
+    mutable contents_cache_find : int;
+    mutable contents_cache_miss : int;
+    mutable node_hash : int;
+    mutable node_mem : int;
+    mutable node_add : int;
+    mutable node_find : int;
+    mutable node_cache_length : int;
+    mutable node_cache_find : int;
+    mutable node_cache_miss : int;
+    mutable node_val_v : int;
+    mutable node_val_find : int;
+    mutable node_val_list : int;
+  }
+
+  let counters_t =
+    let open Type in
+    record "counters"
+      (fun contents_hash
+           contents_find
+           contents_add
+           contents_cache_length
+           contents_cache_find
+           contents_cache_miss
+           node_hash
+           node_mem
+           node_add
+           node_find
+           node_cache_length
+           node_cache_find
+           node_cache_miss
+           node_val_v
+           node_val_find
+           node_val_list
+           ->
+        {
+          contents_hash;
+          contents_find;
+          contents_add;
+          contents_cache_length;
+          contents_cache_find;
+          contents_cache_miss;
+          node_hash;
+          node_mem;
+          node_add;
+          node_find;
+          node_cache_length;
+          node_cache_find;
+          node_cache_miss;
+          node_val_v;
+          node_val_find;
+          node_val_list;
+        })
+    |+ field "contents_hash" int (fun x -> x.contents_hash)
+    |+ field "contents_find" int (fun x -> x.contents_find)
+    |+ field "contents_add" int (fun x -> x.contents_add)
+    |+ field "contents_cache_length" int (fun x -> x.contents_cache_length)
+    |+ field "contents_cache_find" int (fun x -> x.contents_cache_find)
+    |+ field "contents_cache_miss" int (fun x -> x.contents_cache_miss)
+    |+ field "node_hash" int (fun x -> x.node_hash)
+    |+ field "node_mem" int (fun x -> x.node_mem)
+    |+ field "node_add" int (fun x -> x.node_add)
+    |+ field "node_find" int (fun x -> x.node_find)
+    |+ field "node_cache_length" int (fun x -> x.node_cache_length)
+    |+ field "node_cache_find" int (fun x -> x.node_cache_find)
+    |+ field "node_cache_miss" int (fun x -> x.node_cache_miss)
+    |+ field "node_val_v" int (fun x -> x.node_val_v)
+    |+ field "node_val_find" int (fun x -> x.node_val_find)
+    |+ field "node_val_list" int (fun x -> x.node_val_list)
+    |> sealr
+
+  let dump_counters ppf t = Type.pp_json ~minify:false counters_t ppf t
+
+  let fresh_counters () =
+    {
+      contents_hash = 0;
+      contents_add = 0;
+      contents_find = 0;
+      contents_cache_length = 0;
+      contents_cache_find = 0;
+      contents_cache_miss = 0;
+      node_hash = 0;
+      node_mem = 0;
+      node_add = 0;
+      node_find = 0;
+      node_cache_length = 0;
+      node_cache_find = 0;
+      node_cache_miss = 0;
+      node_val_v = 0;
+      node_val_find = 0;
+      node_val_list = 0;
+    }
+
+  let reset_counters t =
+    t.contents_hash <- 0;
+    t.contents_add <- 0;
+    t.contents_find <- 0;
+    t.contents_cache_length <- 0;
+    t.contents_cache_find <- 0;
+    t.contents_cache_miss <- 0;
+    t.node_hash <- 0;
+    t.node_mem <- 0;
+    t.node_add <- 0;
+    t.node_find <- 0;
+    t.node_cache_length <- 0;
+    t.node_cache_find <- 0;
+    t.node_cache_miss <- 0;
+    t.node_val_v <- 0;
+    t.node_val_find <- 0;
+    t.node_val_list <- 0
+
+  let cnt = fresh_counters ()
+
+  module Path = P.Node.Path
+
+  module StepMap = struct
+    module X = struct
+      type t = Path.step
+
+      let t = Path.step_t
+
+      let compare = Type.compare Path.step_t
+    end
+
+    include Map.Make (X)
+    include Merge.Map (X)
+  end
+
+  module Metadata = P.Node.Metadata
+
+  type key = Path.t
+
+  type hash = P.Hash.t
+
+  type step = Path.step
+
+  type contents = P.Contents.value
+
+  type repo = P.Repo.t
+
+  let pp_hash = Type.pp P.Hash.t
+
+  let pp_path = Type.pp Path.t
+
+  module Hashes = Hashtbl.Make (struct
+    type t = hash
+
+    let hash = P.Hash.short_hash
+
+    let equal = Type.equal P.Hash.t
+  end)
+
+  module Contents = struct
+    type v = Hash of repo * hash | Value of contents
+
+    type info = {
+      mutable hash : hash option;
+      mutable value : contents option;
+      mutable color : [ `White | `Black ];
+    }
+
+    type t = { mutable v : v; mutable info : info }
+
+    module Hashes = Cache (P.Hash)
+    module Values = Cache (P.Contents.Val)
+
+    let info_is_empty i = i.hash = None && i.value = None
+
+    let values = Values.create ~is_empty:info_is_empty 1000
+
+    let hashes = Hashes.create ~is_empty:info_is_empty 1000
+
+    let iter_info f =
+      Values.iter (fun _ i -> f i) values;
+      Hashes.iter (fun _ i -> f i) hashes
+
+    let mark color i = i.color <- color
+
+    let v =
+      let open Type in
+      variant "Node.Contents.v" (fun hash value ->
+        function Hash (_, x) -> hash x | Value v -> value v)
+      |~ case1 "hash" P.Hash.t (fun _ -> assert false)
+      |~ case1 "value" P.Contents.Val.t (fun v -> Value v)
+      |> sealv
+
+    let clear_info i =
+      if not (info_is_empty i) then (
+        i.value <- None;
+        i.hash <- None )
+
+    let clear t = clear_info t.info
+
+    let merge_info ~into:x y =
+      let () =
+        match (x.hash, y.hash) with
+        | None, None | Some _, None -> ()
+        | Some _, Some _ -> ()
+        | None, Some _ -> x.hash <- y.hash
+      in
+      let () =
+        match (x.value, y.value) with
+        | None, None | Some _, None -> ()
+        | Some _, Some _ -> ()
+        | None, _ -> x.value <- y.value
+      in
+      ()
+
+    let of_v v =
+      let hash, value =
+        match v with Hash (_, k) -> (Some k, None) | Value v -> (None, Some v)
+      in
+      (* hashcons the info *)
+      let info =
+        match (hash, value) with
+        | Some _, Some _ -> assert false
+        | None, None -> { hash; value; color = `White }
+        | None, Some v -> (
+            cnt.contents_cache_find <- cnt.contents_cache_find + 1;
+            match Values.find values v with
+            | exception Not_found ->
+                cnt.contents_cache_miss <- cnt.contents_cache_miss + 1;
+                let i = { hash; value; color = `White } in
+                Values.add values v i;
+                i
+            | i -> i )
+        | Some k, None -> (
+            cnt.contents_cache_find <- cnt.contents_cache_find + 1;
+            match Hashes.find hashes k with
+            | exception Not_found ->
+                cnt.contents_cache_miss <- cnt.contents_cache_miss + 1;
+                let i = { hash; value; color = `White } in
+                Hashes.add hashes k i;
+                i
+            | i -> i )
+      in
+      (* hashcons for the contents (= leaf nodes) *)
+      let v =
+        match (v, info.value, info.hash) with
+        | Value _, Some v, _ -> Value v
+        | Hash (r, _), _, Some h -> Hash (r, h)
+        | _ -> v
+      in
+      let t = { v; info } in
+      t
+
+    let export ?clear:c repo t k =
+      let hash = t.info.hash in
+      if c = Some true then clear t;
+      match (t.v, hash) with
+      | Hash (_, k), _ -> t.v <- Hash (repo, k)
+      | Value _, None -> t.v <- Hash (repo, k)
+      | Value _, Some k -> t.v <- Hash (repo, k)
+
+    let t = Type.map v of_v (fun t -> t.v)
+
+    let of_value c = of_v (Value c)
+
+    let of_hash repo k = of_v (Hash (repo, k))
+
+    let hash t =
+      match (t.v, t.info.hash) with
+      | Hash (_, k), None ->
+          let h = Some k in
+          t.info.hash <- h;
+          h
+      | _, h -> h
+
+    let value t =
+      match (t.v, t.info.value) with
+      | Value v, None ->
+          let v = Some v in
+          t.info.value <- v;
+          v
+      | _, v -> v
+
+    let hashcons t =
+      match (t.v, t.info.hash, t.info.value) with
+      | Hash (r, h), Some h', _ -> if h != h' then t.v <- Hash (r, h')
+      | Value v, _, Some v' -> if v != v' then t.v <- Value v'
+      | _ -> ()
+
+    let hash_of_value c v =
+      cnt.contents_hash <- cnt.contents_hash + 1;
+      let k = P.Contents.Key.hash v in
+      c.info.hash <- Some k;
+      let () =
+        cnt.contents_cache_find <- cnt.contents_cache_find + 1;
+        match Hashes.find hashes k with
+        | i ->
+            let old = c.info in
+            c.info <- i;
+            merge_info ~into:i old;
+            hashcons c
+        | exception Not_found ->
+            cnt.contents_cache_miss <- cnt.contents_cache_miss + 1;
+            Hashes.add hashes k c.info
+      in
+      match c.info.hash with Some k -> k | None -> k
+
+    let to_hash c =
+      match hash c with
+      | Some k -> k
+      | None -> (
+          match value c with
+          | None -> assert false
+          | Some v -> hash_of_value c v )
+
+    let value_of_hash t repo k =
+      cnt.contents_find <- cnt.contents_find + 1;
+      P.Contents.find (P.Repo.contents_t repo) k >|= function
+      | None -> None
+      | Some v as vo ->
+          t.info.value <- vo;
+          let () =
+            cnt.contents_cache_find <- cnt.contents_cache_find + 1;
+            match Values.find values v with
+            | i ->
+                let old = t.info in
+                t.info <- i;
+                merge_info ~into:i old;
+                hashcons t
+            | exception Not_found ->
+                cnt.contents_cache_miss <- cnt.contents_cache_miss + 1;
+                Values.add values v t.info
+          in
+          t.info.value
+
+    let to_value t =
+      match value t with
+      | Some v -> Lwt.return_some v
+      | None -> (
+          match t.v with
+          | Value v -> Lwt.return_some v
+          | Hash (repo, k) -> value_of_hash t repo k )
+
+    let equal (x : t) (y : t) =
+      x == y
+      ||
+      match (x.v, y.v) with
+      | Hash (_, x), Hash (_, y) -> Type.equal P.Hash.t x y
+      | Value x, Value y -> Type.equal P.Contents.Val.t x y
+      | _ -> Type.equal P.Hash.t (to_hash x) (to_hash y)
+
+    let merge : t Merge.t =
+      let f ~old x y =
+        let old =
+          Merge.bind_promise old (fun old () ->
+              to_value old >|= fun c -> Ok (Some c))
+        in
+        to_value x >>= fun x ->
+        to_value y >>= fun y ->
+        Merge.(f P.Contents.Val.merge) ~old x y >|= function
+        | Ok (Some c) -> Ok (of_value c)
+        | Ok None -> Error (`Conflict "empty contents")
+        | Error _ as e -> e
+      in
+      Merge.v t f
+
+    let fold ~force ~path f t acc =
+      let aux = function None -> Lwt.return acc | Some c -> f path c acc in
+      match force with
+      | `True -> to_value t >>= aux
+      | `False skip -> (
+          match t.info.value with
+          | None -> skip path acc
+          | Some c -> aux (Some c) )
+  end
+
+  module Node = struct
+    type value = P.Node.Val.t
+
+    type elt = [ `Node of t | `Contents of Contents.t * Metadata.t ]
+
+    and map = elt StepMap.t
+
+    and info = {
+      mutable value : value option;
+      mutable map : map option;
+      mutable hash : hash option;
+      mutable color : [ `White | `Black ];
+      mutable findv_cache : map option;
+    }
+
+    and v =
+      | Map of map
+      | Hash of repo * hash
+      | Value of repo * value * map option
+
+    and t = { mutable v : v; mutable info : info }
+
+    let elt_t t : elt Type.t =
+      let open Type in
+      variant "Node.value" (fun node contents contents_m ->
+        function
+        | `Node x -> node x
+        | `Contents (c, m) ->
+            if Type.equal Metadata.t m Metadata.default then contents c
+            else contents_m (c, m))
+      |~ case1 "Node" t (fun x -> `Node x)
+      |~ case1 "Contents" Contents.t (fun x -> `Contents (x, Metadata.default))
+      |~ case1 "Contents-x" (pair Contents.t Metadata.t) (fun x -> `Contents x)
+      |> sealv
+
+    let map_t (elt : elt Type.t) : map Type.t =
+      let open Type in
+      let to_map x =
+        List.fold_left (fun acc (k, v) -> StepMap.add k v acc) StepMap.empty x
+      in
+      let of_map m = StepMap.fold (fun k v acc -> (k, v) :: acc) m [] in
+      map (list (pair Path.step_t elt)) to_map of_map
+
+    let v_t (m : map Type.t) : v Type.t =
+      let open Type in
+      variant "Node.node" (fun map hash value ->
+        function
+        | Map m -> map m
+        | Hash (_, y) -> hash y
+        | Value (_, v, m) -> value (v, m))
+      |~ case1 "map" m (fun m -> Map m)
+      |~ case1 "hash" P.Hash.t (fun _ -> assert false)
+      |~ case1 "value" (pair P.Node.Val.t (option m)) (fun _ -> assert false)
+      |> sealv
+
+    let rec merge_elt : type a. into:elt -> elt -> (unit -> a) -> a =
+     fun ~into:x y k ->
+      match (x, y) with
+      | `Contents (x, _), `Contents (y, _) ->
+          Contents.merge_info ~into:x.Contents.info y.Contents.info;
+          k ()
+      | `Node x, `Node y -> (merge_info [@tailcall]) ~into:x.info y.info k
+      | _ -> k ()
+
+    and merge_map : type a. into:map -> map -> (unit -> a) -> a =
+     fun ~into:x y k ->
+      List.iter2
+        (fun (_, x) (_, y) -> (merge_elt [@tailcall]) ~into:x y (fun () -> ()))
+        (StepMap.bindings x) (StepMap.bindings y);
+      k ()
+
+    and merge_info : type a. into:info -> info -> (unit -> a) -> a =
+     fun ~into:x y k ->
+      let () =
+        match (x.hash, y.hash) with
+        | None, None | Some _, None -> ()
+        | Some _, Some _ -> ()
+        | None, Some _ -> x.hash <- y.hash
+      in
+      let () =
+        match (x.value, y.value) with
+        | None, None | Some _, None -> ()
+        | Some _, Some _ -> ()
+        | None, _ -> x.value <- y.value
+      in
+      let () =
+        match (x.findv_cache, y.findv_cache) with
+        | None, None | Some _, None -> ()
+        | None, Some _ -> x.findv_cache <- y.findv_cache
+        | Some a, Some b ->
+            let m =
+              StepMap.union
+                (fun _ a b ->
+                  (merge_elt [@tailcall]) ~into:a b (fun () -> Some a))
+                a b
+            in
+            if m != a then x.findv_cache <- Some m
+      in
+      match (x.map, y.map) with
+      | None, None | Some _, None -> k ()
+      | None, Some _ ->
+          x.map <- y.map;
+          k ()
+      | Some x, Some y -> (merge_map [@tailcall]) ~into:x y k
+
+    let info_is_empty i =
+      i.map = None && i.value = None && i.findv_cache = None && i.hash = None
+
+    let depth i =
+      let rec map depth m k =
+        StepMap.fold
+          (fun _ v acc ->
+            match v with
+            | `Contents _ -> k (max acc (depth + 1))
+            | `Node t ->
+                (aux [@tailcall]) (depth + 1) t (fun d -> k (max acc d)))
+          m depth
+      and aux depth t k =
+        match (t.v, t.info.map) with
+        | (Hash _ | Value _), None -> k 0
+        | Map m, _ | _, Some m -> (map [@tailcall]) depth m k
+      in
+      match i.map with
+      | None -> 0
+      | Some m -> (map [@tailcall]) 0 m (fun x -> x)
+
+    let width i = match i.map with None -> 0 | Some m -> StepMap.cardinal m
+
+    let dump_info ppf i =
+      let value =
+        match i.value with
+        | None -> "<none>"
+        | Some v -> Type.to_string P.Node.Val.t v
+      in
+      let map = match i.map with None -> "<none>" | Some _ -> "<some>" in
+      let hash = match i.hash with None -> "<none>" | Some _ -> "<some>" in
+      let empty = if info_is_empty i then "*" else "" in
+      Fmt.pf ppf "[width=%d, depth=%d, value=%s, map=%s, hash=%s]%s" (width i)
+        (depth i) value map hash empty
+
+    module Cache = Cache (P.Hash)
+
+    let cache = Cache.create ~is_empty:info_is_empty 100
+
+    let iter_info f = Cache.iter (fun _ i -> f i) cache
+
+    let mark c t = t.color <- c
+
+    let hashcons t =
+      match (t.v, t.info.hash, t.info.map, t.info.value) with
+      | Hash (r, h), Some h', _, _ -> if h != h' then t.v <- Hash (r, h')
+      | Map v, _, Some v', _ ->
+          if v != v' then merge_map ~into:v' v (fun () -> t.v <- Map v')
+      | Value (r, v, None), _, _, Some v' ->
+          if v != v' then t.v <- Value (r, v', None)
+      | _ -> ()
+
+    let of_v v =
+      let hash, map, value =
+        match v with
+        | Map m -> (None, Some m, None)
+        | Hash (_, k) -> (Some k, None, None)
+        | Value (_, v, None) -> (None, None, Some v)
+        | Value _ -> (None, None, None)
+      in
+      let color = `White in
+      let findv_cache = None in
+      (* hashcons info *)
+      let info =
+        match hash with
+        | None -> { hash; map; value; color; findv_cache }
+        | Some k -> (
+            cnt.node_cache_find <- cnt.node_cache_find + 1;
+            match Cache.find cache k with
+            | exception Not_found ->
+                cnt.node_cache_miss <- cnt.node_cache_miss + 1;
+                let i = { hash; map; value; color; findv_cache } in
+                Cache.add cache k i;
+                i
+            | i -> i )
+      in
+      (* hashcons v *)
+      let t = { v; info } in
+      hashcons t;
+      t
+
+    let t node = Type.map node of_v (fun t -> t.v)
+
+    let _, t =
+      Type.mu2 (fun _ y ->
+          let elt = elt_t y in
+          let v = v_t (map_t elt) in
+          let t = t v in
+          (v, t))
+
+    let elt_t = elt_t t
+
+    let rec clear_map ~max_depth depth m =
+      List.iter
+        (fun (_, v) ->
+          match v with
+          | `Contents (c, _) ->
+              Contents.mark `Black c.Contents.info;
+              if depth + 1 > max_depth then Contents.clear c
+          | `Node t -> (clear [@tailcall]) ~max_depth (depth + 1) t)
+        m
+
+    and clear_info ~max_depth ?v depth i =
+      if i.color = `White then (
+        let added =
+          match v with
+          | Some (Value (_, _, Some m)) -> StepMap.bindings m
+          | _ -> []
+        in
+        let map =
+          match (v, i.map) with
+          | Some (Map m), _ | _, Some m -> StepMap.bindings m
+          | _ -> []
+        in
+        let findv =
+          match i.findv_cache with Some m -> StepMap.bindings m | None -> []
+        in
+        if depth >= max_depth && not (info_is_empty i) then (
+          i.color <- `Black;
+          i.value <- None;
+          i.map <- None;
+          i.hash <- None;
+          i.findv_cache <- None );
+        (clear_map [@tailcall]) ~max_depth depth (map @ added @ findv) )
+
+    and clear ~max_depth depth t = clear_info ~v:t.v ~max_depth depth t.info
+
+    let clear_info ?depth:d i =
+      let max_depth = match d with None -> 0 | Some max_depth -> max_depth in
+      clear_info ~max_depth 0 i
+
+    let clear ?depth:d n =
+      let max_depth = match d with None -> 0 | Some max_depth -> max_depth in
+      clear ~max_depth 0 n
+
+    (* export t to the given repo and clear the cache *)
+    let export ?clear:c repo t k =
+      let hash = t.info.hash in
+      if c = Some true then clear t;
+      match t.v with
+      | Hash (_, k) -> t.v <- Hash (repo, k)
+      | Value (_, v, None) when P.Node.Val.is_empty v -> ()
+      | Map m when StepMap.is_empty m ->
+          t.v <- Value (repo, P.Node.Val.empty, None)
+      | _ -> (
+          match hash with
+          | None -> t.v <- Hash (repo, k)
+          | Some k -> t.v <- Hash (repo, k) )
+
+    let dump = Type.pp_json ~minify:false t
+
+    let of_map m = of_v (Map m)
+
+    let of_hash repo k = of_v (Hash (repo, k))
+
+    let of_value ?added repo v = of_v (Value (repo, v, added))
+
+    let empty = function
+      | { v = Hash (repo, _) | Value (repo, _, _); _ } ->
+          of_value repo P.Node.Val.empty
+      | _ -> of_map StepMap.empty
+
+    let map_of_value repo (n : value) : map =
+      cnt.node_val_list <- cnt.node_val_list + 1;
+      let entries = P.Node.Val.list n in
+      let aux = function
+        | `Node h -> `Node (of_hash repo h)
+        | `Contents (c, m) -> `Contents (Contents.of_hash repo c, m)
+      in
+      List.fold_left
+        (fun acc (k, v) -> StepMap.add k (aux v) acc)
+        StepMap.empty entries
+
+    let hash t =
+      match (t.v, t.info.hash) with
+      | Hash (_, h), None ->
+          let h = Some h in
+          t.info.hash <- h;
+          h
+      | _, h -> h
+
+    let map t =
+      match (t.v, t.info.map) with
+      | Map m, None ->
+          let m = Some m in
+          t.info.map <- m;
+          m
+      | _, m -> m
+
+    let value t =
+      match (t.v, t.info.value) with
+      | Value (_, v, None), None ->
+          let v = Some v in
+          t.info.value <- v;
+          v
+      | _, v -> v
+
+    let hash_of_value t v =
+      cnt.node_hash <- cnt.node_hash + 1;
+      let k = P.Node.Key.hash v in
+      t.info.hash <- Some k;
+      let () =
+        cnt.node_cache_find <- cnt.node_cache_find + 1;
+        match Cache.find cache k with
+        | i ->
+            let old = t.info in
+            t.info <- i;
+            merge_info ~into:i old (fun () -> hashcons t)
+        | exception Not_found ->
+            cnt.node_cache_miss <- cnt.node_cache_miss + 1;
+            Cache.add cache k t.info
+      in
+      match t.info.hash with Some k -> k | None -> k
+
+    let to_hash ~value_of_adds ~value_of_map t =
+      match hash t with
+      | Some h -> h
+      | None -> (
+          let of_value v = hash_of_value t v in
+          match value t with
+          | Some v -> of_value v
+          | None -> (
+              match t.v with
+              | Hash (_, h) -> h
+              | Value (_, v, None) -> of_value v
+              | Value (_, v, Some a) -> of_value (value_of_adds t v a)
+              | Map m -> of_value (value_of_map t m) ) )
+
+    let rec value_of_map t ~value_of_adds map =
+      if StepMap.is_empty map then (
+        t.info.value <- Some P.Node.Val.empty;
+        P.Node.Val.empty )
+      else
+        let alist = StepMap.bindings map in
+        let rec aux acc = function
+          | [] ->
+              let alist = List.rev acc in
+              cnt.node_val_v <- cnt.node_val_v + 1;
+              P.Node.Val.v alist
+          | (step, v) :: rest -> (
+              match v with
+              | `Contents (c, m) ->
+                  let v = `Contents (Contents.to_hash c, m) in
+                  (aux [@tailcall]) ((step, v) :: acc) rest
+              | `Node n ->
+                  let n =
+                    to_hash ~value_of_adds
+                      ~value_of_map:(value_of_map ~value_of_adds)
+                      n
+                  in
+                  let v = `Node n in
+                  (aux [@tailcall]) ((step, v) :: acc) rest )
+        in
+        let v = aux [] alist in
+        t.info.value <- Some v;
+        v
+
+    let value_of_elt ~value_of_adds e =
+      match e with
+      | `Contents (c, m) -> `Contents (Contents.to_hash c, m)
+      | `Node n ->
+          let h =
+            to_hash
+              ~value_of_map:(value_of_map ~value_of_adds)
+              ~value_of_adds n
+          in
+          `Node h
+
+    let rec value_of_adds t v added =
+      let added = StepMap.bindings added in
+      let v =
+        List.fold_left
+          (fun v (k, e) ->
+            let e = value_of_elt ~value_of_adds e in
+            P.Node.Val.add v k e)
+          v added
+      in
+      t.info.value <- Some v;
+      v
+
+    let value_of_map = value_of_map ~value_of_adds
+
+    let to_hash = to_hash ~value_of_adds ~value_of_map
+
+    let value_of_hash t repo k =
+      match t.info.value with
+      | Some _ as v -> Lwt.return v
+      | None -> (
+          cnt.node_find <- cnt.node_find + 1;
+          P.Node.find (P.Repo.node_t repo) k >|= function
+          | None -> None
+          | Some _ as v ->
+              t.info.value <- v;
+              v )
+
+    let to_value t =
+      match value t with
+      | Some v -> Lwt.return_some v
+      | None -> (
+          match t.v with
+          | Value (_, v, None) -> Lwt.return_some v
+          | Value (_, v, Some m) ->
+              let v = value_of_adds t v m in
+              Lwt.return_some v
+          | Map m -> Lwt.return_some (value_of_map t m)
+          | Hash (repo, h) -> value_of_hash t repo h )
+
+    let to_map t =
+      match map t with
+      | Some m -> Lwt.return_some m
+      | None -> (
+          let of_value repo v added =
+            let m = map_of_value repo v in
+            let m =
+              match added with
+              | None -> m
+              | Some added -> StepMap.union (fun _ _ a -> Some a) m added
+            in
+            t.info.map <- Some m;
+            Some m
+          in
+          match t.v with
+          | Map m -> Lwt.return_some m
+          | Value (repo, v, m) -> Lwt.return (of_value repo v m)
+          | Hash (repo, k) -> (
+              value_of_hash t repo k >|= function
+              | None -> None
+              | Some v -> of_value repo v None ) )
+
+    let hash_equal x y = x == y || Type.equal P.Hash.t x y
+
+    let contents_equal ((c1, m1) as x1) ((c2, m2) as x2) =
+      x1 == x2 || (Contents.equal c1 c2 && Type.equal Metadata.t m1 m2)
+
+    let rec elt_equal (x : elt) (y : elt) =
+      x == y
+      ||
+      match (x, y) with
+      | `Contents x, `Contents y -> contents_equal x y
+      | `Node x, `Node y -> equal x y
+      | _ -> false
+
+    and map_equal (x : map) (y : map) = StepMap.equal elt_equal x y
+
+    and equal (x : t) (y : t) =
+      x == y
+      ||
+      match (x.v, y.v) with
+      | Hash (_, x), Hash (_, y) -> hash_equal x y
+      | Value (_, x, None), Value (_, y, None) -> Type.equal P.Node.Val.t x y
+      | Map x, Map y -> map_equal x y
+      | Value (_, x, Some a), Value (_, y, Some b) ->
+          Type.equal P.Node.Val.t x y && map_equal a b
+      | _ -> (
+          match (value x, value y) with
+          | Some x, Some y -> Type.equal P.Node.Val.t x y
+          | _ -> (
+              match (map x, map y) with
+              | Some x, Some y -> map_equal x y
+              | _ -> hash_equal (to_hash x) (to_hash y) ) )
+
+    let is_empty t =
+      match map t with
+      | Some m -> Lwt.return (StepMap.is_empty m)
+      | None -> (
+          match t.v with
+          | Value (_, _, Some _) -> Lwt.return_false
+          | _ -> (
+              to_value t >|= function
+              | None -> false
+              | Some n -> P.Node.Val.is_empty n ) )
+
+    let list t =
+      let trim l =
+        List.rev_map
+          (fun (s, v) ->
+            (s, match v with `Contents _ -> `Contents | `Node _ -> `Node))
+          l
+        |> List.rev
+      in
+      match map t with
+      | Some m -> Lwt.return (trim (StepMap.bindings m))
+      | None -> (
+          to_value t >|= function
+          | None -> []
+          | Some v ->
+              cnt.node_val_list <- cnt.node_val_list + 1;
+              trim (P.Node.Val.list v) )
+
+    let listv t =
+      to_map t >|= function None -> [] | Some m -> StepMap.bindings m
+
+    let add_to_findv_cache t step v =
+      match t.info.findv_cache with
+      | None -> t.info.findv_cache <- Some (StepMap.singleton step v)
+      | Some m -> t.info.findv_cache <- Some (StepMap.add step v m)
+
+    let findv t step =
+      let of_map m =
+        match StepMap.find step m with
+        | exception Not_found -> Lwt.return_none
+        | `Node n -> Lwt.return_some (`Node n)
+        | `Contents (c, m) -> (
+            Contents.to_value c >|= function
+            | None -> None
+            | Some c -> Some (`Contents (c, m)) )
+      in
+      let of_value repo v =
+        match P.Node.Val.find v step with
+        | None -> Lwt.return_none
+        | Some (`Contents (c, m)) -> (
+            let c = Contents.of_hash repo c in
+            let (v : elt) = `Contents (c, m) in
+            add_to_findv_cache t step v;
+            Contents.to_value c >|= function
+            | None -> None
+            | Some c -> Some (`Contents (c, m)) )
+        | Some (`Node n) ->
+            let n = of_hash repo n in
+            let v = `Node n in
+            add_to_findv_cache t step v;
+            Lwt.return_some v
+      in
+      let of_t () =
+        match t.v with
+        | Map m -> of_map m
+        | Value (repo, v, None) -> of_value repo v
+        | Value (repo, v, Some m) -> (
+            of_map m >>= function
+            | Some _ as v -> Lwt.return v
+            | None -> of_value repo v )
+        | Hash (repo, h) -> (
+            match value t with
+            | Some v -> of_value repo v
+            | None -> (
+                value_of_hash t repo h >>= function
+                | None -> Lwt.return_none
+                | Some v -> of_value repo v ) )
+      in
+      match map t with
+      | Some m -> of_map m
+      | None -> (
+          match t.info.findv_cache with
+          | None -> of_t ()
+          | Some m -> (
+              of_map m >>= function
+              | None -> of_t ()
+              | Some _ as r -> Lwt.return r ) )
+
+    let dummy_marks = Hashes.create 0
+
+    type marks = unit Hashes.t
+
+    let empty_marks () = Hashes.create 39
+
+    let fold ~force ~uniq ~pre ~post ~path f t acc =
+      let marks =
+        match uniq with
+        | `False -> dummy_marks
+        | `True -> empty_marks ()
+        | `Marks n -> n
+      in
+      let rec aux ~path acc t k =
+        match force with
+        | `True -> to_map t >>= fun m -> (map [@tailcall]) ~path acc m k
+        | `False skip -> (
+            match t.info.map with
+            | Some n -> (map [@tailcall]) ~path acc (Some n) k
+            | _ -> skip path acc )
+      and aux_uniq ~path acc t k =
+        if uniq = `False then (aux [@tailcall]) ~path acc t k
+        else
+          let h = to_hash t in
+          if Hashes.mem marks h then k acc
+          else (
+            Hashes.add marks h ();
+            (aux [@tailcall]) ~path acc t k )
+      and step ~path acc (s, v) k =
+        let path = Path.rcons path s in
+        match v with
+        | `Contents c -> Contents.fold ~force ~path f (fst c) acc >>= k
+        | `Node n -> (aux_uniq [@tailcall]) ~path acc n k
+      and steps ~path acc s k =
+        match s with
+        | [] -> k acc
+        | h :: t ->
+            (step [@tailcall]) ~path acc h @@ fun acc ->
+            (steps [@tailcall]) ~path acc t k
+      and map ~path acc m k =
+        match m with
+        | None -> k acc
+        | Some m ->
+            let bindings = StepMap.bindings m in
+            let s = List.rev_map fst bindings in
+            pre path s acc >>= fun acc ->
+            (steps [@tailcall]) ~path acc bindings @@ fun acc ->
+            post path s acc >>= k
+      in
+      aux_uniq ~path acc t Lwt.return
+
+    let remove t step =
+      to_map t >|= function
+      | None -> t
+      | Some n ->
+          if not (StepMap.mem step n) then t
+          else of_map (StepMap.remove step n)
+
+    let add t step v =
+      let v =
+        match v with
+        | `Node _ as n -> n
+        | `Contents (c, m) -> `Contents (Contents.of_value c, m)
+      in
+      let of_map m =
+        let m' = StepMap.add step v m in
+        if m == m' then t else of_map m'
+      in
+      let of_value repo n added =
+        let added' = StepMap.add step v added in
+        if added == added' then t else of_value repo n ~added:added'
+      in
+      match t.v with
+      | Map m -> Lwt.return (of_map m)
+      | Value (repo, n, None) -> Lwt.return (of_value repo n StepMap.empty)
+      | Value (repo, n, Some m) -> Lwt.return (of_value repo n m)
+      | Hash (repo, h) -> (
+          match (value t, map t) with
+          | Some v, _ -> Lwt.return (of_value repo v StepMap.empty)
+          | _, Some m -> Lwt.return (of_map m)
+          | None, None ->
+              (value_of_hash t repo h >|= function
+               | Some v -> v
+               | None -> P.Node.Val.empty)
+              >|= fun v -> of_value repo v StepMap.empty )
+
+    let rec merge : type a. (t Merge.t -> a) -> a =
+     fun k ->
+      let f ~old x y =
+        let old =
+          Merge.bind_promise old (fun old () ->
+              to_map old >|= fun m -> Ok (Some m))
+        in
+        to_map x >>= fun x ->
+        to_map y >>= fun y ->
+        let m =
+          StepMap.merge elt_t (fun _step ->
+              (merge_elt [@tailcall]) Merge.option)
+        in
+        Merge.(f @@ option m) ~old x y >|= function
+        | Ok (Some map) -> Ok (of_map map)
+        | Ok None -> Error (`Conflict "empty map")
+        | Error _ as e -> e
+      in
+      k (Merge.v t f)
+
+    and merge_elt : type a. (elt Merge.t -> a) -> a =
+     fun k ->
+      let open Merge.Infix in
+      let f : elt Merge.f =
+       fun ~old x y ->
+        match (x, y) with
+        | `Contents (x, cx), `Contents (y, cy) ->
+            let mold =
+              Merge.bind_promise old (fun old () ->
+                  match old with
+                  | `Contents (_, m) -> Lwt.return_ok (Some m)
+                  | `Node _ -> Lwt.return_ok None)
+            in
+            Merge.(f Metadata.merge) ~old:mold cx cy >>=* fun m ->
+            let old =
+              Merge.bind_promise old (fun old () ->
+                  match old with
+                  | `Contents (c, _) -> Lwt.return_ok (Some c)
+                  | `Node _ -> Lwt.return_ok None)
+            in
+            Merge.(f Contents.merge) ~old x y >>=* fun c ->
+            Merge.ok (`Contents (c, m))
+        | `Node x, `Node y ->
+            (merge [@tailcall]) (fun m ->
+                let old =
+                  Merge.bind_promise old (fun old () ->
+                      match old with
+                      | `Contents _ -> Lwt.return_ok None
+                      | `Node n -> Lwt.return_ok (Some n))
+                in
+                Merge.(f m ~old x y) >>=* fun n -> Merge.ok (`Node n))
+        | _ -> Merge.conflict "add/add values"
+      in
+      k (Merge.seq [ Merge.default elt_t; Merge.v elt_t f ])
+
+    let merge_elt = merge_elt (fun x -> x)
+  end
+
+  type node = Node.t
+
+  type metadata = Metadata.t
+
+  type tree = [ `Node of node | `Contents of contents * metadata ]
+
+  let of_private_node repo n = Node.of_value repo n
+
+  let to_private_node = Node.to_value
+
+  let node_t = Node.t
+
+  let tree_t =
+    let open Type in
+    variant "tree" (fun node contents ->
+      function `Node n -> node n | `Contents c -> contents c)
+    |~ case1 "node" Node.t (fun n -> `Node n)
+    |~ case1 "contents" (pair P.Contents.Val.t Metadata.t) (fun c ->
+           `Contents c)
+    |> sealv
+
+  let dump ppf = function
+    | `Node n -> Fmt.pf ppf "node: %a" Node.dump n
+    | `Contents (c, _) ->
+        Fmt.pf ppf "contents: %a" (Type.pp P.Contents.Val.t) c
+
+  let contents_equal ((c1, m1) as x1) ((c2, m2) as x2) =
+    x1 == x2
+    || (c1 == c2 && m1 == m2)
+    || (Type.equal P.Contents.Val.t c1 c2 && Type.equal Metadata.t m1 m2)
+
+  let equal (x : tree) (y : tree) =
+    x == y
+    ||
+    match (x, y) with
+    | `Node x, `Node y -> Node.equal x y
+    | `Contents x, `Contents y -> contents_equal x y
+    | `Node _, `Contents _ | `Contents _, `Node _ -> false
+
+  let is_empty = function
+    | `Node n -> Node.is_empty n
+    | `Contents _ -> Lwt.return_false
+
+  let of_node n = `Node n
+
+  let of_contents ?(metadata = Metadata.default) c = `Contents (c, metadata)
+
+  let clear ?depth = function
+    | `Node n -> Node.clear ?depth n
+    | `Contents _ -> ()
+
+  let sub t path =
+    let rec aux node path =
+      match Path.decons path with
+      | None -> Lwt.return_some node
+      | Some (h, p) -> (
+          Node.findv node h >>= function
+          | None | Some (`Contents _) -> Lwt.return_none
+          | Some (`Node n) -> (aux [@tailcall]) n p )
+    in
+    match t with
+    | `Node n -> (aux [@tailcall]) n path
+    | `Contents _ -> Lwt.return_none
+
+  let find_tree (t : tree) path =
+    Log.debug (fun l -> l "Tree.find_tree %a" pp_path path);
+    match (t, Path.rdecons path) with
+    | v, None -> Lwt.return_some v
+    | _, Some (path, file) -> (
+        sub t path >>= function
+        | None -> Lwt.return_none
+        | Some n -> Node.findv n file )
+
+  type marks = Node.marks
+
+  let empty_marks = Node.empty_marks
+
+  type 'a force = [ `True | `False of key -> 'a -> 'a Lwt.t ]
+
+  type uniq = [ `False | `True | `Marks of marks ]
+
+  type 'a node_fn = key -> step list -> 'a -> 'a Lwt.t
+
+  let id _ _ acc = Lwt.return acc
+
+  let fold ?(force = `True) ?(uniq = `False) ?(pre = id) ?(post = id) f
+      (t : tree) acc =
+    match t with
+    | `Contents v -> f Path.empty (fst v) acc
+    | `Node n -> Node.fold ~force ~uniq ~pre ~post ~path:Path.empty f n acc
+
+  type stats = {
+    nodes : int;
+    leafs : int;
+    skips : int;
+    depth : int;
+    width : int;
+  }
+
+  let empty_stats = { nodes = 0; leafs = 0; skips = 0; depth = 0; width = 0 }
+
+  let pp_stats ppf { nodes; leafs; skips; depth; width } =
+    Fmt.pf ppf "{@[nodes=%d; leafs=%d; skips=%d; depth=%d; width=%d]}" nodes
+      leafs skips depth width
+
+  let incr_nodes s = { s with nodes = s.nodes + 1 }
+
+  let incr_leafs s = { s with leafs = s.leafs + 1 }
+
+  let incr_skips s = { s with skips = s.skips + 1 }
+
+  let set_depth p s =
+    let n_depth = List.length (Path.map p (fun _ -> ())) in
+    let depth = max n_depth s.depth in
+    { s with depth }
+
+  let set_width childs s =
+    let width = max s.width (List.length childs) in
+    { s with width }
+
+  let err_not_found n k =
+    Fmt.kstrf invalid_arg "Irmin.Tree.%s: %a not found" n pp_path k
+
+  let get_tree (t : tree) path =
+    find_tree t path >|= function
+    | None -> err_not_found "get_tree" path
+    | Some v -> v
+
+  let find_all t k =
+    find_tree t k >|= function
+    | None | Some (`Node _) -> None
+    | Some (`Contents c) -> Some c
+
+  let find t k =
+    find_all t k >|= function None -> None | Some (c, _) -> Some c
+
+  let get_all t k =
+    find_all t k >>= function
+    | None -> err_not_found "get" k
+    | Some v -> Lwt.return v
+
+  let get t k = get_all t k >|= fun (c, _) -> c
+
+  let mem t k = find t k >|= function None -> false | _ -> true
+
+  let mem_tree t k = find_tree t k >|= function None -> false | _ -> true
+
+  let kind t path =
+    Log.debug (fun l -> l "Tree.kind %a" pp_path path);
+    match (t, Path.rdecons path) with
+    | `Contents _, None -> Lwt.return_some `Contents
+    | _, None -> Lwt.return_none
+    | _, Some (dir, file) -> (
+        sub t dir >>= function
+        | None -> Lwt.return_none
+        | Some m -> (
+            Node.findv m file >>= function
+            | None -> Lwt.return_none
+            | Some (`Contents _) -> Lwt.return_some `Contents
+            | Some (`Node _) -> Lwt.return_some `Node ) )
+
+  let list t path =
+    Log.debug (fun l -> l "Tree.list %a" pp_path path);
+    sub t path >>= function None -> Lwt.return_nil | Some n -> Node.list n
+
+  let may_remove t k =
+    Node.findv t k >>= function
+    | None -> Lwt.return_none
+    | Some _ -> Node.remove t k >>= fun t -> Lwt.return_some t
+
+  let empty = `Node (Node.of_map StepMap.empty)
+
+  let empty_node = function
+    | `Node n -> Node.empty n
+    | `Contents _ -> Node.of_map StepMap.empty
+
+  let remove t k =
+    Log.debug (fun l -> l "Tree.remove %a" pp_path k);
+    let empty = empty_node t in
+    match Path.rdecons k with
+    | None ->
+        is_empty t >>= fun is_empty ->
+        if is_empty then Lwt.return t else Lwt.return (`Node empty)
+    | Some (path, file) -> (
+        let rec aux view path k =
+          let some n = k (Some n) in
+          match Path.decons path with
+          | None -> may_remove view file >>= k
+          | Some (h, p) -> (
+              Node.findv view h >>= function
+              | None | Some (`Contents _) -> k None
+              | Some (`Node child) ->
+                  (aux [@tailcall]) child p (function
+                    | None -> k None
+                    | Some child' -> (
+                        (* remove empty dirs *)
+                        Node.is_empty child'
+                        >>= function
+                        | true -> may_remove view h >>= k
+                        | false -> Node.add view h (`Node child') >>= some )) )
+        in
+        let n = match t with `Node n -> n | _ -> empty in
+        (aux [@tailcall]) n path @@ function
+        | None -> Lwt.return t
+        | Some n -> Lwt.return (`Node n) )
+
+  let add_tree t k v =
+    Log.debug (fun l -> l "Tree.add_tree %a" pp_path k);
+    let empty = empty_node t in
+    match Path.rdecons k with
+    | None -> Lwt.return v
+    | Some (path, file) -> (
+        let rec aux n path k =
+          let some n = k (Some n) in
+          match Path.decons path with
+          | None -> (
+              Node.findv n file >>= function
+              | None -> Node.add n file v >>= some
+              | Some old ->
+                  if equal old v then k None else Node.add n file v >>= some )
+          | Some (h, p) -> (
+              Node.findv n h >>= function
+              | None | Some (`Contents _) ->
+                  (aux [@tailcall]) empty p (function
+                    | None -> k None
+                    | Some child' -> Node.add n h (`Node child') >>= some)
+              | Some (`Node child) ->
+                  (aux [@tailcall]) child p (function
+                    | None -> k None
+                    | Some child' -> Node.add n h (`Node child') >>= some) )
+        in
+        let n = match t with `Node n -> n | _ -> empty in
+        (aux [@tailcall]) n path @@ function
+        | None -> Lwt.return t
+        | Some node -> Lwt.return (`Node node) )
+
+  let add t k ?(metadata = Metadata.default) c =
+    Log.debug (fun l -> l "Tree.add %a" pp_path k);
+    let empty = empty_node t in
+    match Path.rdecons k with
+    | None -> (
+        match t with
+        | `Contents c' when contents_equal c' (c, metadata) -> Lwt.return t
+        | _ -> Lwt.return (`Contents (c, metadata)) )
+    | Some (path, file) -> (
+        let rec aux n path k =
+          let some n = k (Some n) in
+          match Path.decons path with
+          | None -> (
+              Node.findv n file >>= function
+              | Some (`Node _) | None ->
+                  Node.add n file (`Contents (c, metadata)) >>= some
+              | Some (`Contents _ as old) ->
+                  if equal old (`Contents (c, metadata)) then k None
+                  else Node.add n file (`Contents (c, metadata)) >>= some )
+          | Some (h, p) -> (
+              Node.findv n h >>= function
+              | None | Some (`Contents _) ->
+                  (aux [@tailcall]) empty p (function
+                    | None -> assert false
+                    | Some child -> Node.add n h (`Node child) >>= some)
+              | Some (`Node child) ->
+                  (aux [@tailcall]) child p (function
+                    | None -> k None
+                    | Some child' -> Node.add n h (`Node child') >>= some) )
+        in
+        let n = match t with `Node n -> n | _ -> empty in
+        (aux [@tailcall]) n path @@ function
+        | None -> Lwt.return t
+        | Some n -> Lwt.return (`Node n) )
+
+  let import repo k =
+    cnt.node_mem <- cnt.node_mem + 1;
+    P.Node.mem (P.Repo.node_t repo) k >|= function
+    | true -> Some (Node.of_hash repo k)
+    | false -> None
+
+  let import_no_check repo k = Node.of_hash repo k
+
+  let export ?clear repo contents_t node_t n =
+    let seen = Hashes.create 127 in
+    let add_node n v () =
+      cnt.node_add <- cnt.node_add + 1;
+      P.Node.add node_t v >|= fun k ->
+      let k' = Node.to_hash n in
+      assert (Type.equal P.Hash.t k k');
+      Node.export ?clear repo n k
+    in
+    let add_contents c x () =
+      cnt.contents_add <- cnt.contents_add + 1;
+      P.Contents.add contents_t x >|= fun k ->
+      let k' = Contents.to_hash c in
+      assert (Type.equal P.Hash.t k k');
+      Contents.export ?clear repo c k
+    in
+    let add_node_map n x () = add_node n (Node.value_of_map n x) () in
+    let todo = Stack.create () in
+    let rec add_to_todo : type a. _ -> (unit -> a Lwt.t) -> a Lwt.t =
+     fun n k ->
+      let h = Node.to_hash n in
+      if Hashes.mem seen h then k ()
+      else (
+        Hashes.add seen h ();
+        match n.Node.v with
+        | Node.Hash _ ->
+            Node.export ?clear repo n h;
+            k ()
+        | Node.Value (_, x, None) ->
+            Stack.push (add_node n x) todo;
+            k ()
+        | Map _ | Value (_, _, Some _) -> (
+            cnt.node_mem <- cnt.node_mem + 1;
+            P.Node.mem node_t h >>= function
+            | true ->
+                Node.export ?clear repo n h;
+                k ()
+            | false -> (
+                match n.v with
+                | Hash _ | Value (_, _, None) ->
+                    (* might happen if the node has already been added
+                     (while the thread was block on P.Node.mem *)
+                    k ()
+                | Map children | Value (_, _, Some children) ->
+                    (* 1. convert partial values to total values *)
+                    ( match n.v with
+                    | Value (_, _, Some _) -> (
+                        Node.to_value n >|= function
+                        | None -> ()
+                        | Some v -> n.v <- Value (repo, v, None) )
+                    | _ -> Lwt.return_unit )
+                    >>= fun () ->
+                    (* 2. push the current node job on the stack. *)
+                    let () =
+                      match (n.v, Node.value n) with
+                      | _, Some v -> Stack.push (add_node n v) todo
+                      | Map x, None -> Stack.push (add_node_map n x) todo
+                      | _ -> assert false
+                    in
+                    let contents = ref [] in
+                    let nodes = ref [] in
+                    StepMap.iter
+                      (fun _ -> function
+                        | `Contents c -> contents := c :: !contents
+                        | `Node n -> nodes := n :: !nodes)
+                      children;
+
+                    (* 2. push the contents job on the stack. *)
+                    List.iter
+                      (fun (c, _) ->
+                        let h = Contents.to_hash c in
+                        if Hashes.mem seen h then ()
+                        else (
+                          Hashes.add seen h ();
+                          match c.Contents.v with
+                          | Contents.Hash _ -> ()
+                          | Contents.Value x ->
+                              Stack.push (add_contents c x) todo ))
+                      !contents;
+
+                    (* 3. push the children jobs on the stack. *)
+                    List.iter
+                      (fun n ->
+                        Stack.push
+                          (fun () -> (add_to_todo [@tailcall]) n Lwt.return)
+                          todo)
+                      !nodes;
+                    k () ) ) )
+    in
+    let rec loop () =
+      let task = try Some (Stack.pop todo) with Stack.Empty -> None in
+      match task with None -> Lwt.return_unit | Some t -> t () >>= loop
+    in
+    (add_to_todo [@tailcall]) n @@ fun () ->
+    loop () >|= fun () ->
+    let x = Node.to_hash n in
+    Log.debug (fun l -> l "Tree.export -> %a" pp_hash x);
+    x
+
+  let merge : tree Merge.t =
+    let f ~old (x : tree) y =
+      let to_node x =
+        match x with
+        | `Node _ as x -> x
+        | `Contents (c, m) -> `Contents (Contents.of_value c, m)
+      in
+      let x = to_node x in
+      let y = to_node y in
+      let old =
+        Merge.bind_promise old (fun old -> Merge.promise (to_node old))
+      in
+      Merge.(f Node.merge_elt) ~old x y >>= function
+      | Ok (`Contents (c, m)) -> (
+          Contents.to_value c >>= function
+          | None -> Merge.conflict "conflict: contents"
+          | Some c -> Merge.ok (`Contents (c, m)) )
+      | Ok (`Node _ as n) -> Merge.ok n
+      | Error e -> Lwt.return_error e
+    in
+    Merge.v tree_t f
+
+  let entries path tree =
+    let rec aux acc = function
+      | [] -> Lwt.return acc
+      | (path, h) :: todo ->
+          Node.listv h >>= fun childs ->
+          let acc, todo =
+            List.fold_left
+              (fun (acc, todo) (k, v) ->
+                let path = Path.rcons path k in
+                match v with
+                | `Node v -> (acc, (path, v) :: todo)
+                | `Contents c -> ((path, c) :: acc, todo))
+              (acc, todo) childs
+          in
+          (aux [@tailcall]) acc todo
+    in
+    (aux [@tailcall]) [] [ (path, tree) ]
+
+  let diff_node (x : node) (y : node) =
+    let bindings n =
+      Node.to_map n >|= function None -> [] | Some m -> StepMap.bindings m
+    in
+    let removed acc (k, (c, m)) =
+      Contents.to_value c >|= function
+      | None -> acc
+      | Some c -> (k, `Removed (c, m)) :: acc
+    in
+    let added acc (k, (c, m)) =
+      Contents.to_value c >|= function
+      | None -> acc
+      | Some c -> (k, `Added (c, m)) :: acc
+    in
+    let rec aux acc = function
+      | [] -> Lwt.return acc
+      | (path, x, y) :: todo ->
+          if Node.equal x y then (aux [@tailcall]) acc todo
+          else
+            bindings x >>= fun x ->
+            bindings y >>= fun y ->
+            let acc = ref acc in
+            let todo = ref todo in
+            alist_iter2_lwt
+              Type.(compare @@ Path.step_t)
+              (fun key v ->
+                let path = Path.rcons path key in
+                match v with
+                (* Left *)
+                | `Left (`Contents x) ->
+                    removed !acc (path, x) >|= fun x -> acc := x
+                | `Left (`Node x) ->
+                    entries path x >>= fun xs ->
+                    Lwt_list.fold_left_s removed !acc xs >|= fun xs ->
+                    acc := xs
+                (* Right *)
+                | `Right (`Contents y) ->
+                    added !acc (path, y) >|= fun y -> acc := y
+                | `Right (`Node y) ->
+                    entries path y >>= fun ys ->
+                    Lwt_list.fold_left_s added !acc ys >|= fun ys -> acc := ys
+                (* Both *)
+                | `Both (`Node x, `Node y) ->
+                    todo := (path, x, y) :: !todo;
+                    Lwt.return_unit
+                | `Both (`Contents x, `Node y) ->
+                    entries path y >>= fun ys ->
+                    removed !acc (path, x) >>= fun x ->
+                    Lwt_list.fold_left_s added x ys >|= fun ys -> acc := ys
+                | `Both (`Node x, `Contents y) ->
+                    entries path x >>= fun xs ->
+                    added !acc (path, y) >>= fun y ->
+                    Lwt_list.fold_left_s removed y xs >|= fun ys -> acc := ys
+                | `Both (`Contents x, `Contents y) -> (
+                    if Node.contents_equal x y then Lwt.return_unit
+                    else
+                      Contents.to_value (fst x) >>= fun cx ->
+                      Contents.to_value (fst y) >|= fun cy ->
+                      match (cx, cy) with
+                      | None, None -> ()
+                      | Some cx, None ->
+                          let x = (cx, snd x) in
+                          acc := (path, `Removed x) :: !acc
+                      | None, Some cy ->
+                          let y = (cy, snd y) in
+                          acc := (path, `Added y) :: !acc
+                      | Some cx, Some cy ->
+                          let x = (cx, snd x) in
+                          let y = (cy, snd y) in
+                          acc := (path, `Updated (x, y)) :: !acc ))
+              x y
+            >>= fun () -> (aux [@tailcall]) !acc !todo
+    in
+    (aux [@tailcall]) [] [ (Path.empty, x, y) ]
+
+  let diff (x : tree) (y : tree) =
+    match (x, y) with
+    | `Contents x, `Contents y ->
+        if contents_equal x y then Lwt.return_nil
+        else Lwt.return [ (Path.empty, `Updated (y, x)) ]
+    | `Node x, `Node y -> diff_node x y
+    | `Contents x, `Node y ->
+        let empty = Node.empty y in
+        diff_node empty y >|= fun diff -> (Path.empty, `Removed x) :: diff
+    | `Node x, `Contents y ->
+        let empty = Node.empty x in
+        diff_node x empty >|= fun diff -> (Path.empty, `Added y) :: diff
+
+  type concrete =
+    [ `Tree of (step * concrete) list | `Contents of contents * metadata ]
+
+  let of_concrete c =
+    let rec concrete k = function
+      | `Contents _ as v -> k v
+      | `Tree childs -> tree StepMap.empty (fun n -> k (`Node n)) childs
+    and contents k (c, m) = k (`Contents (Contents.of_value c, m))
+    and tree map k = function
+      | [] -> k (Node.of_map map)
+      | (s, n) :: t ->
+          (concrete [@tailcall])
+            (function
+              | `Contents c ->
+                  (contents [@tailcall])
+                    (fun v -> (tree [@tailcall]) (StepMap.add s v map) k t)
+                    c
+              | `Node _ as v -> (tree [@tailcall]) (StepMap.add s v map) k t)
+            n
+    in
+    (concrete [@tailcall]) (fun x -> x) c
+
+  let to_concrete t =
+    let rec tree k = function
+      | `Contents _ as v -> k v
+      | `Node n -> (
+          Node.to_map n >>= function
+          | None -> k (`Tree [])
+          | Some n ->
+              (node [@tailcall]) [] (fun n -> k (`Tree n)) (StepMap.bindings n)
+          )
+    and contents k (c, m) =
+      Contents.to_value c >>= function
+      | None -> k None
+      | Some c -> k @@ Some (`Contents (c, m))
+    and node childs k = function
+      | [] -> k childs
+      | (s, n) :: t -> (
+          match n with
+          | `Node _ as n ->
+              (tree [@tailcall]) (fun tree -> node ((s, tree) :: childs) k t) n
+          | `Contents c ->
+              (contents [@tailcall])
+                (function
+                  | None -> (node [@tailcall]) childs k t
+                  | Some c -> (node [@tailcall]) ((s, c) :: childs) k t)
+                c )
+    in
+    tree (fun x -> Lwt.return x) t
+
+  let hash (t : tree) =
+    Log.debug (fun l -> l "Tree.hash");
+    match t with
+    | `Node n -> `Node (Node.to_hash n)
+    | `Contents (c, m) ->
+        cnt.contents_hash <- cnt.contents_hash + 1;
+        `Contents (P.Contents.Key.hash c, m)
+
+  module Cache = struct
+    let length () =
+      ( `Contents Contents.(Hashes.length hashes),
+        `Nodes Node.(Cache.length cache) )
+
+    let clear ?depth () =
+      Log.info (fun l -> l "Tree.Cache.clear %a" Fmt.(option int) depth);
+      match depth with
+      | None ->
+          Contents.iter_info Contents.clear_info;
+          Node.iter_info (fun i -> Node.clear_info i)
+      | Some depth ->
+          Contents.iter_info (Contents.mark `White);
+          Node.iter_info (Node.mark `White);
+          Node.iter_info (fun i -> Node.clear_info ~depth i);
+          Contents.iter_info (fun i ->
+              if i.Contents.color = `White then Contents.clear_info i)
+
+    let dump ppf () =
+      let ppo t ppf = function
+        | None -> Fmt.pf ppf "<none>"
+        | Some y -> Type.pp t ppf y
+      in
+      Contents.Hashes.iter
+        (fun k v ->
+          Fmt.pf ppf "C|%a: %a@." pp_hash k (ppo P.Contents.Val.t)
+            v.Contents.value)
+        Contents.hashes;
+      Node.Cache.iter
+        (fun k v -> Fmt.pf ppf "N|%a: %a@." pp_hash k Node.dump_info v)
+        Node.cache
+  end
+
+  let stats ?(force = false) (t : tree) =
+    let force =
+      if force then `True
+      else `False (fun k s -> set_depth k s |> incr_skips |> Lwt.return)
+    in
+    let f k _ s = set_depth k s |> incr_leafs |> Lwt.return in
+    let pre k childs s =
+      if childs = [] then Lwt.return s
+      else set_depth k s |> set_width childs |> incr_nodes |> Lwt.return
+    in
+    let post _ _ acc = Lwt.return acc in
+    fold ~force ~pre ~post f t empty_stats
+
+  let counters () = cnt
+
+  let dump_counters ppf () =
+    let `Contents c, `Nodes n = Cache.length () in
+    cnt.contents_cache_length <- c;
+    cnt.node_cache_length <- n;
+    dump_counters ppf cnt
+
+  let reset_counters () = reset_counters cnt
+
+  let inspect = function
+    | `Contents _ -> `Contents
+    | `Node n ->
+        `Node
+          ( match n.Node.v with
+          | Map _ -> `Map
+          | Value _ -> `Value
+          | Hash _ -> `Hash )
+end
diff --git a/vendors/irmin/tree.mli b/vendors/irmin/tree.mli
new file mode 100644
index 0000000000000000000000000000000000000000..52652984501454709636402b5bdbba87d183e7b7
--- /dev/null
+++ b/vendors/irmin/tree.mli
@@ -0,0 +1,51 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ * Copyright (c) 2017 Grégoire Henry <gregoire.henry@ocamlpro.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module Make (P : S.PRIVATE) : sig
+  include
+    S.TREE
+      with type key = P.Node.Path.t
+       and type step = P.Node.Path.step
+       and type metadata = P.Node.Val.metadata
+       and type contents = P.Contents.value
+
+  val import : P.Repo.t -> P.Node.key -> node option Lwt.t
+
+  val import_no_check : P.Repo.t -> P.Node.key -> node
+
+  val export :
+    ?clear:bool ->
+    P.Repo.t ->
+    [> `Write ] P.Contents.t ->
+    [ `Read | `Write ] P.Node.t ->
+    node ->
+    P.Node.key Lwt.t
+
+  val dump : tree Fmt.t
+
+  val equal : tree -> tree -> bool
+
+  val node_t : node Type.t
+
+  val tree_t : tree Type.t
+
+  val hash : tree -> [ `Contents of P.Hash.t * metadata | `Node of P.Hash.t ]
+
+  val of_private_node : P.Repo.t -> P.Node.value -> node
+
+  val to_private_node : node -> P.Node.value option Lwt.t
+end
diff --git a/vendors/irmin/type.ml b/vendors/irmin/type.ml
new file mode 100644
index 0000000000000000000000000000000000000000..b8ecb1e97ac0ae4b298e4cc5e4a7a25ed28487ed
--- /dev/null
+++ b/vendors/irmin/type.ml
@@ -0,0 +1,1675 @@
+(*
+ * Copyright (c) 2016-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type (_, _) eq = Refl : ('a, 'a) eq
+
+module Witness : sig
+  type 'a t
+
+  val make : unit -> 'a t
+
+  val eq : 'a t -> 'b t -> ('a, 'b) eq option
+end = struct
+  type _ equality = ..
+
+  module type Inst = sig
+    type t
+
+    type _ equality += Eq : t equality
+  end
+
+  type 'a t = (module Inst with type t = 'a)
+
+  let make : type a. unit -> a t =
+   fun () ->
+    let module Inst = struct
+      type t = a
+
+      type _ equality += Eq : t equality
+    end in
+    (module Inst)
+
+  let eq : type a b. a t -> b t -> (a, b) eq option =
+   fun (module A) (module B) -> match A.Eq with B.Eq -> Some Refl | _ -> None
+end
+
+module Json = struct
+  type decoder = { mutable lexemes : Jsonm.lexeme list; d : Jsonm.decoder }
+
+  let decoder ?encoding src = { lexemes = []; d = Jsonm.decoder ?encoding src }
+
+  let decoder_of_lexemes lexemes = { lexemes; d = Jsonm.decoder (`String "") }
+
+  let rewind e l = e.lexemes <- l :: e.lexemes
+
+  let decode e =
+    match e.lexemes with
+    | h :: t ->
+        e.lexemes <- t;
+        `Lexeme h
+    | [] -> Jsonm.decode e.d
+end
+
+type len = [ `Int | `Int8 | `Int16 | `Int32 | `Int64 | `Fixed of int ]
+
+type 'a pp = 'a Fmt.t
+
+type 'a of_string = string -> ('a, [ `Msg of string ]) result
+
+type 'a to_string = 'a -> string
+
+type 'a encode_json = Jsonm.encoder -> 'a -> unit
+
+type 'a decode_json = Json.decoder -> ('a, [ `Msg of string ]) result
+
+type 'a bin_seq = 'a -> (string -> unit) -> unit
+
+type 'a encode_bin = ?headers:bool -> 'a bin_seq
+
+type 'a decode_bin = ?headers:bool -> string -> int -> int * 'a
+
+type 'a size_of = ?headers:bool -> 'a -> int option
+
+type 'a compare = 'a -> 'a -> int
+
+type 'a equal = 'a -> 'a -> bool
+
+type 'a short_hash = ?seed:int -> 'a -> int
+
+type 'a t =
+  | Self : 'a self -> 'a t
+  | Custom : 'a custom -> 'a t
+  | Map : ('a, 'b) map -> 'b t
+  | Prim : 'a prim -> 'a t
+  | List : 'a len_v -> 'a list t
+  | Array : 'a len_v -> 'a array t
+  | Tuple : 'a tuple -> 'a t
+  | Option : 'a t -> 'a option t
+  | Record : 'a record -> 'a t
+  | Variant : 'a variant -> 'a t
+
+and 'a len_v = { len : len; v : 'a t }
+
+and 'a custom = {
+  cwit : [ `Type of 'a t | `Witness of 'a Witness.t ];
+  pp : 'a pp;
+  of_string : 'a of_string;
+  encode_json : 'a encode_json;
+  decode_json : 'a decode_json;
+  encode_bin : 'a encode_bin;
+  decode_bin : 'a decode_bin;
+  short_hash : 'a short_hash;
+  pre_hash : 'a bin_seq;
+  size_of : 'a size_of;
+  compare : 'a compare;
+  equal : 'a equal;
+}
+
+and ('a, 'b) map = {
+  x : 'a t;
+  f : 'a -> 'b;
+  g : 'b -> 'a;
+  mwit : 'b Witness.t;
+}
+
+and 'a self = { mutable self : 'a t }
+
+and 'a prim =
+  | Unit : unit prim
+  | Bool : bool prim
+  | Char : char prim
+  | Int : int prim
+  | Int32 : int32 prim
+  | Int64 : int64 prim
+  | Float : float prim
+  | String : len -> string prim
+  | Bytes : len -> bytes prim
+
+and 'a tuple =
+  | Pair : 'a t * 'b t -> ('a * 'b) tuple
+  | Triple : 'a t * 'b t * 'c t -> ('a * 'b * 'c) tuple
+
+and 'a record = {
+  rwit : 'a Witness.t;
+  rname : string;
+  rfields : 'a fields_and_constr;
+}
+
+and 'a fields_and_constr =
+  | Fields : ('a, 'b) fields * 'b -> 'a fields_and_constr
+
+and ('a, 'b) fields =
+  | F0 : ('a, 'a) fields
+  | F1 : ('a, 'b) field * ('a, 'c) fields -> ('a, 'b -> 'c) fields
+
+and ('a, 'b) field = { fname : string; ftype : 'b t; fget : 'a -> 'b }
+
+and 'a variant = {
+  vwit : 'a Witness.t;
+  vname : string;
+  vcases : 'a a_case array;
+  vget : 'a -> 'a case_v;
+}
+
+and 'a a_case = C0 : 'a case0 -> 'a a_case | C1 : ('a, 'b) case1 -> 'a a_case
+
+and 'a case_v =
+  | CV0 : 'a case0 -> 'a case_v
+  | CV1 : ('a, 'b) case1 * 'b -> 'a case_v
+
+and 'a case0 = { ctag0 : int; cname0 : string; c0 : 'a }
+
+and ('a, 'b) case1 = {
+  ctag1 : int;
+  cname1 : string;
+  ctype1 : 'b t;
+  c1 : 'b -> 'a;
+}
+
+type _ a_field = Field : ('a, 'b) field -> 'a a_field
+
+let rec pp_ty : type a. a t Fmt.t =
+ fun ppf -> function
+  | Self s -> Fmt.pf ppf "@[Self (%a@)]" pp_ty s.self
+  | Custom c -> Fmt.pf ppf "@[Custom (%a)@]" pp_custom c
+  | Map m -> Fmt.pf ppf "@[Map (%a)]" pp_ty m.x
+  | Prim p -> Fmt.pf ppf "@[Prim %a@]" pp_prim p
+  | List l -> Fmt.pf ppf "@[List%a (%a)@]" pp_len l.len pp_ty l.v
+  | Array a -> Fmt.pf ppf "@[Array%a (%a)@]" pp_len a.len pp_ty a.v
+  | Tuple (Pair (a, b)) -> Fmt.pf ppf "@[Pair (%a, %a)@]" pp_ty a pp_ty b
+  | Tuple (Triple (a, b, c)) ->
+      Fmt.pf ppf "@[Triple (%a, %a, %a)@]" pp_ty a pp_ty b pp_ty c
+  | Option t -> Fmt.pf ppf "@[Option (%a)@]" pp_ty t
+  | Record _ -> Fmt.pf ppf "@[Record@]"
+  | Variant _ -> Fmt.pf ppf "@[Variant@]"
+
+and pp_custom : type a. a custom Fmt.t =
+ fun ppf c ->
+  match c.cwit with `Type t -> pp_ty ppf t | `Witness _ -> Fmt.string ppf "-"
+
+and pp_prim : type a. a prim Fmt.t =
+ fun ppf -> function
+  | Unit -> Fmt.string ppf "Unit"
+  | Bool -> Fmt.string ppf "Bool"
+  | Char -> Fmt.string ppf "Char"
+  | Int -> Fmt.string ppf "Int"
+  | Int32 -> Fmt.string ppf "Int32"
+  | Int64 -> Fmt.string ppf "Int64"
+  | Float -> Fmt.string ppf "Float"
+  | String n -> Fmt.pf ppf "String%a" pp_len n
+  | Bytes n -> Fmt.pf ppf "Bytes%a" pp_len n
+
+and pp_len : len Fmt.t =
+ fun ppf -> function
+  | `Int8 -> Fmt.string ppf ":8"
+  | `Int64 -> Fmt.string ppf ":64"
+  | `Int16 -> Fmt.string ppf ":16"
+  | `Fixed n -> Fmt.pf ppf ":<%d>" n
+  | `Int -> ()
+  | `Int32 -> Fmt.pf ppf ":32"
+
+module Refl = struct
+  let prim : type a b. a prim -> b prim -> (a, b) eq option =
+   fun a b ->
+    match (a, b) with
+    | Unit, Unit -> Some Refl
+    | Bool, Bool -> Some Refl
+    | Char, Char -> Some Refl
+    | Int, Int -> Some Refl
+    | Int32, Int32 -> Some Refl
+    | Int64, Int64 -> Some Refl
+    | Float, Float -> Some Refl
+    | String _, String _ -> Some Refl
+    | Bytes _, Bytes _ -> Some Refl
+    | _ -> None
+
+  let rec t : type a b. a t -> b t -> (a, b) eq option =
+   fun a b ->
+    match (a, b) with
+    | Self a, _ -> t a.self b
+    | _, Self b -> t a b.self
+    | Map a, Map b -> Witness.eq a.mwit b.mwit
+    | Custom a, Custom b -> custom a b
+    | Prim a, Prim b -> prim a b
+    | Array a, Array b -> (
+        match t a.v b.v with Some Refl -> Some Refl | None -> None )
+    | List a, List b -> (
+        match t a.v b.v with Some Refl -> Some Refl | None -> None )
+    | Tuple a, Tuple b -> tuple a b
+    | Option a, Option b -> (
+        match t a b with Some Refl -> Some Refl | None -> None )
+    | Record a, Record b -> Witness.eq a.rwit b.rwit
+    | Variant a, Variant b -> Witness.eq a.vwit b.vwit
+    | _ -> None
+
+  and custom : type a b. a custom -> b custom -> (a, b) eq option =
+   fun a b ->
+    match (a.cwit, b.cwit) with
+    | `Witness a, `Witness b -> Witness.eq a b
+    | `Type a, `Type b -> t a b
+    | _ -> None
+
+  and tuple : type a b. a tuple -> b tuple -> (a, b) eq option =
+   fun a b ->
+    match (a, b) with
+    | Pair (a0, a1), Pair (b0, b1) -> (
+        match (t a0 b0, t a1 b1) with
+        | Some Refl, Some Refl -> Some Refl
+        | _ -> None )
+    | Triple (a0, a1, a2), Triple (b0, b1, b2) -> (
+        match (t a0 b0, t a1 b1, t a2 b2) with
+        | Some Refl, Some Refl, Some Refl -> Some Refl
+        | _ -> None )
+    | _ -> None
+end
+
+let unit = Prim Unit
+
+let bool = Prim Bool
+
+let char = Prim Char
+
+let int = Prim Int
+
+let int32 = Prim Int32
+
+let int64 = Prim Int64
+
+let float = Prim Float
+
+let string = Prim (String `Int)
+
+let bytes = Prim (Bytes `Int)
+
+let string_of n = Prim (String n)
+
+let bytes_of n = Prim (Bytes n)
+
+let list ?(len = `Int) v = List { v; len }
+
+let array ?(len = `Int) v = Array { v; len }
+
+let pair a b = Tuple (Pair (a, b))
+
+let triple a b c = Tuple (Triple (a, b, c))
+
+let option a = Option a
+
+let v ~cli ~json ~bin ~equal ~compare ~short_hash ~pre_hash =
+  let pp, of_string = cli in
+  let encode_json, decode_json = json in
+  let encode_bin, decode_bin, size_of = bin in
+  Custom
+    {
+      cwit = `Witness (Witness.make ());
+      pp;
+      of_string;
+      pre_hash;
+      encode_json;
+      decode_json;
+      encode_bin;
+      decode_bin;
+      size_of;
+      compare;
+      equal;
+      short_hash;
+    }
+
+(* fix points *)
+
+let mu : type a. (a t -> a t) -> a t =
+ fun f ->
+  let rec fake_x = { self = Self fake_x } in
+  let real_x = f (Self fake_x) in
+  fake_x.self <- real_x;
+  real_x
+
+let mu2 : type a b. (a t -> b t -> a t * b t) -> a t * b t =
+ fun f ->
+  let rec fake_x = { self = Self fake_x } in
+  let rec fake_y = { self = Self fake_y } in
+  let real_x, real_y = f (Self fake_x) (Self fake_y) in
+  fake_x.self <- real_x;
+  fake_y.self <- real_y;
+  (real_x, real_y)
+
+(* records *)
+
+type ('a, 'b, 'c) open_record =
+  ('a, 'c) fields -> string * 'b * ('a, 'b) fields
+
+let field fname ftype fget = { fname; ftype; fget }
+
+let record : string -> 'b -> ('a, 'b, 'b) open_record = fun n c fs -> (n, c, fs)
+
+let app :
+    type a b c d.
+    (a, b, c -> d) open_record -> (a, c) field -> (a, b, d) open_record =
+ fun r f fs ->
+  let n, c, fs = r (F1 (f, fs)) in
+  (n, c, fs)
+
+let sealr : type a b. (a, b, a) open_record -> a t =
+ fun r ->
+  let rname, c, fs = r F0 in
+  let rwit = Witness.make () in
+  Record { rwit; rname; rfields = Fields (fs, c) }
+
+let ( |+ ) = app
+
+(* variants *)
+
+type 'a case_p = 'a case_v
+
+type ('a, 'b) case = int -> 'a a_case * 'b
+
+let case0 cname0 c0 ctag0 =
+  let c = { ctag0; cname0; c0 } in
+  (C0 c, CV0 c)
+
+let case1 cname1 ctype1 c1 ctag1 =
+  let c = { ctag1; cname1; ctype1; c1 } in
+  (C1 c, fun v -> CV1 (c, v))
+
+type ('a, 'b, 'c) open_variant = 'a a_case list -> string * 'c * 'a a_case list
+
+let variant n c vs = (n, c, vs)
+
+let app v c cs =
+  let n, fc, cs = v cs in
+  let c, f = c (List.length cs) in
+  (n, fc f, c :: cs)
+
+let sealv v =
+  let vname, vget, vcases = v [] in
+  let vwit = Witness.make () in
+  let vcases = Array.of_list (List.rev vcases) in
+  Variant { vwit; vname; vcases; vget }
+
+let ( |~ ) = app
+
+let enum vname l =
+  let vwit = Witness.make () in
+  let _, vcases, mk =
+    List.fold_left
+      (fun (ctag0, cases, mk) (n, v) ->
+        let c = { ctag0; cname0 = n; c0 = v } in
+        (ctag0 + 1, C0 c :: cases, (v, CV0 c) :: mk))
+      (0, [], []) l
+  in
+  let vcases = Array.of_list (List.rev vcases) in
+  Variant { vwit; vname; vcases; vget = (fun x -> List.assq x mk) }
+
+let rec fields_aux : type a b. (a, b) fields -> a a_field list = function
+  | F0 -> []
+  | F1 (h, t) -> Field h :: fields_aux t
+
+let fields r = match r.rfields with Fields (f, _) -> fields_aux f
+
+let result a b =
+  variant "result" (fun ok error ->
+    function Ok x -> ok x | Error x -> error x)
+  |~ case1 "ok" a (fun a -> Ok a)
+  |~ case1 "error" b (fun b -> Error b)
+  |> sealv
+
+module Equal = struct
+  let unit _ _ = true
+
+  let bool (x : bool) (y : bool) = x = y
+
+  let char (x : char) (y : char) = x = y
+
+  let int (x : int) (y : int) = x = y
+
+  let int32 (x : int32) (y : int32) = x = y
+
+  let int64 (x : int64) (y : int64) = x = y
+
+  let string x y = x == y || String.equal x y
+
+  let bytes x y = x == y || Bytes.equal x y
+
+  (* NOTE: equality is ill-defined on float *)
+  let float (x : float) (y : float) = x = y
+
+  let list e x y =
+    x == y || (List.length x = List.length y && List.for_all2 e x y)
+
+  let array e x y =
+    x == y
+    || Array.length x = Array.length y
+       &&
+       let rec aux = function
+         | -1 -> true
+         | i -> e x.(i) y.(i) && aux (i - 1)
+       in
+       aux (Array.length x - 1)
+
+  let pair ex ey ((x1, y1) as a) ((x2, y2) as b) =
+    a == b || (ex x1 x2 && ey y1 y2)
+
+  let triple ex ey ez ((x1, y1, z1) as a) ((x2, y2, z2) as b) =
+    a == b || (ex x1 x2 && ey y1 y2 && ez z1 z2)
+
+  let option e x y =
+    x == y
+    ||
+    match (x, y) with
+    | None, None -> true
+    | Some x, Some y -> e x y
+    | _ -> false
+
+  let rec t : type a. a t -> a equal =
+   fun ty a b ->
+    match ty with
+    | Self s -> t s.self a b
+    | Custom c -> c.equal a b
+    | Map m -> map m a b
+    | Prim p -> prim p a b
+    | List l -> list (t l.v) a b
+    | Array x -> array (t x.v) a b
+    | Tuple t -> tuple t a b
+    | Option x -> option (t x) a b
+    | Record r -> record r a b
+    | Variant v -> variant v a b
+
+  and tuple : type a. a tuple -> a equal = function
+    | Pair (a, b) -> pair (t a) (t b)
+    | Triple (a, b, c) -> triple (t a) (t b) (t c)
+
+  and map : type a b. (a, b) map -> b equal =
+   fun { x; g; _ } u v -> t x (g u) (g v)
+
+  and prim : type a. a prim -> a equal = function
+    | Unit -> unit
+    | Bool -> bool
+    | Char -> char
+    | Int -> int
+    | Int32 -> int32
+    | Int64 -> int64
+    | Float -> float
+    | String _ -> string
+    | Bytes _ -> bytes
+
+  and record : type a. a record -> a equal =
+   fun r x y -> List.for_all (function Field f -> field f x y) (fields r)
+
+  and field : type a b. (a, b) field -> a equal =
+   fun f x y -> t f.ftype (f.fget x) (f.fget y)
+
+  and variant : type a. a variant -> a equal =
+   fun v x y -> case_v (v.vget x) (v.vget y)
+
+  and case_v : type a. a case_v equal =
+   fun x y ->
+    match (x, y) with
+    | CV0 x, CV0 y -> int x.ctag0 y.ctag0
+    | CV1 (x, vx), CV1 (y, vy) ->
+        int x.ctag1 y.ctag1 && eq (x.ctype1, vx) (y.ctype1, vy)
+    | _ -> false
+
+  and eq : type a b. a t * a -> b t * b -> bool =
+   fun (tx, x) (ty, y) ->
+    match Refl.t tx ty with Some Refl -> t tx x y | None -> assert false
+
+  (* this should never happen *)
+end
+
+let equal = Equal.t
+
+module Compare = struct
+  let unit (_ : unit) (_ : unit) = 0 [@@inline always]
+
+  let bool (x : bool) (y : bool) = compare x y [@@inline always]
+
+  let char x y = Char.compare x y [@@inline always]
+
+  let int (x : int) (y : int) = compare x y [@@inline always]
+
+  let int32 x y = Int32.compare x y [@@inline always]
+
+  let int64 x y = Int64.compare x y [@@inline always]
+
+  let float (x : float) (y : float) = compare x y [@@inline always]
+
+  let string x y = if x == y then 0 else String.compare x y [@@inline always]
+
+  let bytes x y = if x == y then 0 else Bytes.compare x y [@@inline always]
+
+  let list c x y =
+    if x == y then 0
+    else
+      let rec aux x y =
+        match (x, y) with
+        | [], [] -> 0
+        | [], _ -> -1
+        | _, [] -> 1
+        | xx :: x, yy :: y -> ( match c xx yy with 0 -> aux x y | i -> i )
+      in
+      aux x y
+
+  let array c x y =
+    if x == y then 0
+    else
+      let lenx = Array.length x in
+      let leny = Array.length y in
+      if lenx > leny then 1
+      else if lenx < leny then -1
+      else
+        let rec aux i =
+          match c x.(i) y.(i) with
+          | 0 when i + 1 = lenx -> 0
+          | 0 -> aux (i + 1)
+          | i -> i
+        in
+        aux 0
+
+  let pair cx cy ((x1, y1) as a) ((x2, y2) as b) =
+    if a == b then 0 else match cx x1 x2 with 0 -> cy y1 y2 | i -> i
+
+  let triple cx cy cz ((x1, y1, z1) as a) ((x2, y2, z2) as b) =
+    if a == b then 0
+    else match cx x1 x2 with 0 -> pair cy cz (y1, z1) (y2, z2) | i -> i
+
+  let option c x y =
+    if x == y then 0
+    else
+      match (x, y) with
+      | None, None -> 0
+      | Some _, None -> 1
+      | None, Some _ -> -1
+      | Some x, Some y -> c x y
+
+  let prim : type a. a prim -> a compare =
+   fun ty a b ->
+    match ty with
+    | Unit -> (unit [@inlined]) a b
+    | Bool -> (bool [@inlined]) a b
+    | Char -> (char [@inlined]) a b
+    | Int -> (int [@inlined]) a b
+    | Int32 -> (int32 [@inlined]) a b
+    | Int64 -> (int64 [@inlined]) a b
+    | Float -> (float [@inlined]) a b
+    | String _ -> (string [@inlined]) a b
+    | Bytes _ -> (bytes [@inlined]) a b
+   [@@inline always]
+
+  let rec t : type a. a t -> a compare =
+   fun ty a b ->
+    match ty with
+    | Self s -> t s.self a b
+    | Custom c -> c.compare a b
+    | Map m -> map m a b
+    | Prim p -> (prim [@inlined]) p a b
+    | List l -> list (t l.v) a b
+    | Array x -> array (t x.v) a b
+    | Tuple t -> tuple t a b
+    | Option x -> option (t x) a b
+    | Record r -> record r a b
+    | Variant v -> variant v a b
+
+  and tuple : type a. a tuple -> a compare = function
+    | Pair (x, y) -> pair (t x) (t y)
+    | Triple (x, y, z) -> triple (t x) (t y) (t z)
+
+  and map : type a b. (a, b) map -> b compare =
+   fun { x; g; _ } u v -> t x (g u) (g v)
+
+  and record : type a. a record -> a compare =
+   fun r x y ->
+    let rec aux = function
+      | [] -> 0
+      | Field f :: t -> ( match field f x y with 0 -> aux t | i -> i )
+    in
+    aux (fields r)
+
+  and field : type a b. (a, b) field -> a compare =
+   fun f x y -> t f.ftype (f.fget x) (f.fget y)
+
+  and variant : type a. a variant -> a compare =
+   fun v x y -> case_v (v.vget x) (v.vget y)
+
+  and case_v : type a. a case_v compare =
+   fun x y ->
+    match (x, y) with
+    | CV0 x, CV0 y -> int x.ctag0 y.ctag0
+    | CV0 x, CV1 (y, _) -> int x.ctag0 y.ctag1
+    | CV1 (x, _), CV0 y -> int x.ctag1 y.ctag0
+    | CV1 (x, vx), CV1 (y, vy) -> (
+        match int x.ctag1 y.ctag1 with
+        | 0 -> compare (x.ctype1, vx) (y.ctype1, vy)
+        | i -> i )
+
+  and compare : type a b. a t * a -> b t * b -> int =
+   fun (tx, x) (ty, y) ->
+    match Refl.t tx ty with Some Refl -> t tx x y | None -> assert false
+
+  (* this should never happen *)
+end
+
+let compare t x y = Compare.t t x y
+
+exception Not_utf8
+
+let is_valid_utf8 str =
+  try
+    Uutf.String.fold_utf_8
+      (fun _ _ -> function `Malformed _ -> raise Not_utf8 | _ -> ())
+      () str;
+    true
+  with Not_utf8 -> false
+
+module Encode_json = struct
+  let lexeme e l = ignore (Jsonm.encode e (`Lexeme l))
+
+  let unit e () = lexeme e `Null
+
+  let base64 e s =
+    let x = Base64.encode_exn s in
+    lexeme e `Os;
+    lexeme e (`Name "base64");
+    lexeme e (`String x);
+    lexeme e `Oe
+
+  let string e s = if is_valid_utf8 s then lexeme e (`String s) else base64 e s
+
+  let bytes e b =
+    let s = Bytes.unsafe_to_string b in
+    string e s
+
+  let char e c =
+    let s = String.make 1 c in
+    string e s
+
+  let float e f = lexeme e (`Float f)
+
+  let int e i = float e (float_of_int i)
+
+  let int32 e i = float e (Int32.to_float i)
+
+  let int64 e i = float e (Int64.to_float i)
+
+  let bool e = function false -> float e 0. | _ -> float e 1.
+
+  let list l e x =
+    lexeme e `As;
+    List.iter (l e) x;
+    lexeme e `Ae
+
+  let array l e x =
+    lexeme e `As;
+    Array.iter (l e) x;
+    lexeme e `Ae
+
+  let pair a b e (x, y) =
+    lexeme e `As;
+    a e x;
+    b e y;
+    lexeme e `Ae
+
+  let triple a b c e (x, y, z) =
+    lexeme e `As;
+    a e x;
+    b e y;
+    c e z;
+    lexeme e `Ae
+
+  let option o e = function None -> lexeme e `Null | Some x -> o e x
+
+  let rec t : type a. a t -> a encode_json =
+   fun ty e ->
+    match ty with
+    | Self s -> t s.self e
+    | Custom c -> c.encode_json e
+    | Map b -> map b e
+    | Prim t -> prim t e
+    | List l -> list (t l.v) e
+    | Array a -> array (t a.v) e
+    | Tuple t -> tuple t e
+    | Option x -> option (t x) e
+    | Record r -> record r e
+    | Variant v -> variant v e
+
+  and tuple : type a. a tuple -> a encode_json = function
+    | Pair (x, y) -> pair (t x) (t y)
+    | Triple (x, y, z) -> triple (t x) (t y) (t z)
+
+  and map : type a b. (a, b) map -> b encode_json =
+   fun { x; g; _ } e u -> t x e (g u)
+
+  and prim : type a. a prim -> a encode_json = function
+    | Unit -> unit
+    | Bool -> bool
+    | Char -> char
+    | Int -> int
+    | Int32 -> int32
+    | Int64 -> int64
+    | Float -> float
+    | String _ -> string
+    | Bytes _ -> bytes
+
+  and record : type a. a record -> a encode_json =
+   fun r e x ->
+    let fields = fields r in
+    lexeme e `Os;
+    List.iter
+      (fun (Field f) ->
+        match (f.ftype, f.fget x) with
+        | Option _, None -> ()
+        | Option o, Some x ->
+            lexeme e (`Name f.fname);
+            t o e x
+        | List _, [] -> ()
+        | tx, x ->
+            lexeme e (`Name f.fname);
+            t tx e x)
+      fields;
+    lexeme e `Oe
+
+  and variant : type a. a variant -> a encode_json =
+   fun v e x -> case_v e (v.vget x)
+
+  and case_v : type a. a case_v encode_json =
+   fun e c ->
+    match c with
+    | CV0 c -> string e c.cname0
+    | CV1 (c, v) ->
+        lexeme e `Os;
+        lexeme e (`Name c.cname1);
+        t c.ctype1 e v;
+        lexeme e `Oe
+end
+
+let encode_json = Encode_json.t
+
+let pp_json ?minify t ppf x =
+  let buf = Buffer.create 42 in
+  let e = Jsonm.encoder ?minify (`Buffer buf) in
+  encode_json t e x;
+  ignore (Jsonm.encode e `End);
+  Fmt.string ppf (Buffer.contents buf)
+
+let pp t =
+  let rec aux : type a. a t -> a pp =
+   fun t ppf x ->
+    match t with
+    | Self s -> aux s.self ppf x
+    | Custom c -> c.pp ppf x
+    | Map m -> map m ppf x
+    | Prim p -> prim p ppf x
+    | _ -> pp_json t ppf x
+  and map : type a b. (a, b) map -> b pp = fun l ppf x -> aux l.x ppf (l.g x)
+  and prim : type a. a prim -> a pp =
+   fun t ppf x ->
+    match t with
+    | Unit -> ()
+    | Bool -> Fmt.bool ppf x
+    | Char -> Fmt.char ppf x
+    | Int -> Fmt.int ppf x
+    | Int32 -> Fmt.int32 ppf x
+    | Int64 -> Fmt.int64 ppf x
+    | Float -> Fmt.float ppf x
+    | String _ -> Fmt.string ppf x
+    | Bytes _ -> Fmt.string ppf (Bytes.unsafe_to_string x)
+  in
+  aux t
+
+let to_json_string ?minify t x = Fmt.to_to_string (pp_json ?minify t) x
+
+module Decode_json = struct
+  let lexeme e =
+    match Json.decode e with
+    | `Lexeme e -> Ok e
+    | `Error e -> Error (`Msg (Fmt.to_to_string Jsonm.pp_error e))
+    | `End | `Await -> assert false
+
+  let ( >>= ) l f = match l with Error _ as e -> e | Ok l -> f l
+
+  let ( >|= ) l f = match l with Ok l -> Ok (f l) | Error _ as e -> e
+
+  let join = function Error _ as e -> e | Ok x -> x
+
+  let error e got expected =
+    let _, (l, c) = Jsonm.decoded_range e.Json.d in
+    Error
+      (`Msg
+        (Fmt.strf
+           "line %d, character %d:\n\
+            Found lexeme %a, but lexeme %s was expected"
+           l c Jsonm.pp_lexeme got expected))
+
+  let expect_lexeme e expected =
+    lexeme e >>= fun got ->
+    if expected = got then Ok ()
+    else error e got (Fmt.to_to_string Jsonm.pp_lexeme expected)
+
+  (* read all lexemes until the end of the next well-formed value *)
+  let value e =
+    let lexemes = ref [] in
+    let objs = ref 0 in
+    let arrs = ref 0 in
+    let rec aux () =
+      lexeme e >>= fun l ->
+      lexemes := l :: !lexemes;
+      let () =
+        match l with
+        | `Os -> incr objs
+        | `As -> incr arrs
+        | `Oe -> decr objs
+        | `Ae -> decr arrs
+        | `Name _ | `Null | `Bool _ | `String _ | `Float _ -> ()
+      in
+      if !objs > 0 || !arrs > 0 then aux () else Ok ()
+    in
+    aux () >|= fun () -> List.rev !lexemes
+
+  let unit e = expect_lexeme e `Null
+
+  let get_base64_value e =
+    match lexeme e with
+    | Ok (`Name "base64") -> (
+        match lexeme e with
+        | Ok (`String b) -> (
+            match expect_lexeme e `Oe with
+            | Ok () -> Ok (Base64.decode_exn b)
+            | Error e -> Error e )
+        | Ok l -> error e l "Bad base64 encoded character"
+        | Error e -> Error e )
+    | Ok l -> error e l "Invalid base64 object"
+    | Error e -> Error e
+
+  let string e =
+    lexeme e >>= function
+    | `String s -> Ok s
+    | `Os -> get_base64_value e
+    | l -> error e l "`String"
+
+  let bytes e =
+    lexeme e >>= function
+    | `String s -> Ok (Bytes.unsafe_of_string s)
+    | `Os -> (
+        match get_base64_value e with
+        | Ok s -> Ok (Bytes.unsafe_of_string s)
+        | Error e -> Error e )
+    | l -> error e l "`String"
+
+  let float e =
+    lexeme e >>= function `Float f -> Ok f | l -> error e l "`Float"
+
+  let char e =
+    lexeme e >>= function
+    | `String s when String.length s = 1 -> Ok s.[0]
+    | `Os -> (
+        match get_base64_value e with Ok s -> Ok s.[0] | Error x -> Error x )
+    | l -> error e l "`String[0]"
+
+  let int32 e = float e >|= Int32.of_float
+
+  let int64 e = float e >|= Int64.of_float
+
+  let int e = float e >|= int_of_float
+
+  let bool e = int e >|= function 0 -> false | _ -> true
+
+  let list l e =
+    expect_lexeme e `As >>= fun () ->
+    let rec aux acc =
+      lexeme e >>= function
+      | `Ae -> Ok (List.rev acc)
+      | lex ->
+          Json.rewind e lex;
+          l e >>= fun v -> aux (v :: acc)
+    in
+    aux []
+
+  let array l e = list l e >|= Array.of_list
+
+  let pair a b e =
+    expect_lexeme e `As >>= fun () ->
+    a e >>= fun x ->
+    b e >>= fun y ->
+    expect_lexeme e `Ae >|= fun () -> (x, y)
+
+  let triple a b c e =
+    expect_lexeme e `As >>= fun () ->
+    a e >>= fun x ->
+    b e >>= fun y ->
+    c e >>= fun z ->
+    expect_lexeme e `Ae >|= fun () -> (x, y, z)
+
+  let option o e =
+    lexeme e >>= function
+    | `Null -> Ok None
+    | lex ->
+        Json.rewind e lex;
+        o e >|= fun v -> Some v
+
+  let rec t : type a. a t -> a decode_json =
+   fun ty d ->
+    match ty with
+    | Self s -> t s.self d
+    | Custom c -> c.decode_json d
+    | Map b -> map b d
+    | Prim t -> prim t d
+    | List l -> list (t l.v) d
+    | Array a -> array (t a.v) d
+    | Tuple t -> tuple t d
+    | Option x -> option (t x) d
+    | Record r -> record r d
+    | Variant v -> variant v d
+
+  and tuple : type a. a tuple -> a decode_json = function
+    | Pair (x, y) -> pair (t x) (t y)
+    | Triple (x, y, z) -> triple (t x) (t y) (t z)
+
+  and map : type a b. (a, b) map -> b decode_json =
+   fun { x; f; _ } e -> t x e >|= f
+
+  and prim : type a. a prim -> a decode_json = function
+    | Unit -> unit
+    | Bool -> bool
+    | Char -> char
+    | Int -> int
+    | Int32 -> int32
+    | Int64 -> int64
+    | Float -> float
+    | String _ -> string
+    | Bytes _ -> bytes
+
+  and record : type a. a record -> a decode_json =
+   fun r e ->
+    expect_lexeme e `Os >>= fun () ->
+    let rec soup acc =
+      lexeme e >>= function
+      | `Name n -> value e >>= fun s -> soup ((n, s) :: acc)
+      | `Oe -> Ok acc
+      | l -> error e l "`Record-contents"
+    in
+    soup [] >>= fun soup ->
+    let rec aux :
+        type a b. (a, b) fields -> b -> (a, [ `Msg of string ]) result =
+     fun f c ->
+      match f with
+      | F0 -> Ok c
+      | F1 (h, f) -> (
+          let v =
+            try
+              let s = List.assoc h.fname soup in
+              let e = Json.decoder_of_lexemes s in
+              t h.ftype e
+            with Not_found -> (
+              match h.ftype with
+              | Option _ -> Ok None
+              | List _ -> Ok []
+              | _ ->
+                  Error
+                    (`Msg (Fmt.strf "missing value for %s.%s" r.rname h.fname)) )
+          in
+          match v with Ok v -> aux f (c v) | Error _ as e -> e )
+    in
+    let (Fields (f, c)) = r.rfields in
+    aux f c
+
+  and variant : type a. a variant -> a decode_json =
+   fun v e ->
+    lexeme e >>= function
+    | `String s -> case0 s v e
+    | `Os -> case1 v e
+    | l -> error e l "(`String | `Os)"
+
+  and case0 : type a. string -> a variant -> a decode_json =
+   fun s v _e ->
+    let rec aux i =
+      match v.vcases.(i) with
+      | C0 c when String.compare c.cname0 s = 0 -> Ok c.c0
+      | _ ->
+          if i < Array.length v.vcases then aux (i + 1)
+          else Error (`Msg "variant")
+    in
+    aux 0
+
+  and case1 : type a. a variant -> a decode_json =
+   fun v e ->
+    lexeme e >>= function
+    | `Name s ->
+        let rec aux i =
+          match v.vcases.(i) with
+          | C1 c when String.compare c.cname1 s = 0 -> t c.ctype1 e >|= c.c1
+          | _ ->
+              if i < Array.length v.vcases then aux (i + 1)
+              else Error (`Msg "variant")
+        in
+        aux 0 >>= fun c ->
+        expect_lexeme e `Oe >|= fun () -> c
+    | l -> error e l "`Name"
+end
+
+let decode_json x d = Decode_json.(t x @@ { Json.d; lexemes = [] })
+
+let decode_json_lexemes x ls = Decode_json.(t x @@ Json.decoder_of_lexemes ls)
+
+let of_json_string x s = Decode_json.(t x @@ Json.decoder (`String s))
+
+module Size_of = struct
+  let ( >>= ) x f = match x with Some x -> f x | None -> None
+
+  let ( >|= ) x f = match x with Some x -> Some (f x) | None -> None
+
+  let int n =
+    let rec aux len n =
+      if n >= 0 && n < 128 then len else aux (len + 1) (n lsr 7)
+    in
+    aux 1 n
+
+  let len n = function
+    | `Int -> int n
+    | `Int8 -> 1
+    | `Int16 -> 2
+    | `Int32 -> 4
+    | `Int64 -> 8
+    | `Fixed _ -> 0
+
+  let unit () = 0
+
+  let char (_ : char) = 1
+
+  let int32 (_ : int32) = 4
+
+  let int64 (_ : int64) = 8
+
+  let bool (_ : bool) = 1
+
+  let float (_ : float) = 8 (* NOTE: we consider 'double' here *)
+
+  let string ?(headers = true) n s =
+    let s = String.length s in
+    if not headers then s else len s n + s
+
+  let bytes ?(headers = true) n s =
+    let s = Bytes.length s in
+    if not headers then s else len s n + s
+
+  let list l n x =
+    let init = len (List.length x) n in
+    List.fold_left
+      (fun acc x ->
+        acc >>= fun acc ->
+        l x >|= fun l -> acc + l)
+      (Some init) x
+
+  let array l n x =
+    let init = len (Array.length x) n in
+    Array.fold_left
+      (fun acc x ->
+        acc >>= fun acc ->
+        l x >|= fun l -> acc + l)
+      (Some init) x
+
+  let pair a b (x, y) =
+    a x >>= fun a ->
+    b y >|= fun b -> a + b
+
+  let triple a b c (x, y, z) =
+    a x >>= fun a ->
+    b y >>= fun b ->
+    c z >|= fun c -> a + b + c
+
+  let option o = function
+    | None -> Some (char '\000')
+    | Some x -> o x >|= fun o -> char '\000' + o
+
+  let rec t : type a. a t -> a size_of =
+   fun ty ?headers e ->
+    match ty with
+    | Self s -> t ?headers s.self e
+    | Custom c -> c.size_of ?headers e
+    | Map b -> map ?headers b e
+    | Prim t -> prim ?headers t e
+    | List l -> list (t l.v) l.len e
+    | Array a -> array (t a.v) a.len e
+    | Tuple t -> tuple ?headers t e
+    | Option x -> option (t x) e
+    | Record r -> record ?headers r e
+    | Variant v -> variant ?headers v e
+
+  and tuple : type a. a tuple -> a size_of =
+   fun ty ?headers:_ ->
+    match ty with
+    | Pair (x, y) -> pair (t x) (t y)
+    | Triple (x, y, z) -> triple (t x) (t y) (t z)
+
+  and map : type a b. (a, b) map -> b size_of =
+   fun { x; g; _ } ?headers u -> t ?headers x (g u)
+
+  and prim : type a. a prim -> a size_of =
+   fun p ?headers x ->
+    match p with
+    | Unit -> Some (unit x)
+    | Bool -> Some (bool x)
+    | Char -> Some (char x)
+    | Int -> Some (int x)
+    | Int32 -> Some (int32 x)
+    | Int64 -> Some (int64 x)
+    | Float -> Some (float x)
+    | String n -> Some (string ?headers n x)
+    | Bytes n -> Some (bytes ?headers n x)
+
+  and record : type a. a record -> a size_of =
+   fun r ?headers:_ x ->
+    let fields = fields r in
+    List.fold_left
+      (fun acc (Field f) ->
+        acc >>= fun acc ->
+        field f x >|= fun f -> acc + f)
+      (Some 0) fields
+
+  and field : type a b. (a, b) field -> a size_of =
+   fun f ?headers:_ x -> t f.ftype (f.fget x)
+
+  and variant : type a. a variant -> a size_of =
+   fun v ?headers:_ x ->
+    match v.vget x with
+    | CV0 v -> Some (int v.ctag0)
+    | CV1 (x, vx) -> t x.ctype1 vx >|= fun v -> int x.ctag1 + v
+end
+
+let size_of = Size_of.t
+
+module B = struct
+  external get_16 : string -> int -> int = "%caml_string_get16"
+
+  external get_32 : string -> int -> int32 = "%caml_string_get32"
+
+  external get_64 : string -> int -> int64 = "%caml_string_get64"
+
+  external set_16 : Bytes.t -> int -> int -> unit = "%caml_string_set16u"
+
+  external set_32 : Bytes.t -> int -> int32 -> unit = "%caml_string_set32u"
+
+  external set_64 : Bytes.t -> int -> int64 -> unit = "%caml_string_set64u"
+
+  external swap16 : int -> int = "%bswap16"
+
+  external swap32 : int32 -> int32 = "%bswap_int32"
+
+  external swap64 : int64 -> int64 = "%bswap_int64"
+
+  let get_uint16 s off =
+    if not Sys.big_endian then swap16 (get_16 s off) else get_16 s off
+
+  let get_uint32 s off =
+    if not Sys.big_endian then swap32 (get_32 s off) else get_32 s off
+
+  let get_uint64 s off =
+    if not Sys.big_endian then swap64 (get_64 s off) else get_64 s off
+
+  let set_uint16 s off v =
+    if not Sys.big_endian then set_16 s off (swap16 v) else set_16 s off v
+
+  let set_uint32 s off v =
+    if not Sys.big_endian then set_32 s off (swap32 v) else set_32 s off v
+
+  let set_uint64 s off v =
+    if not Sys.big_endian then set_64 s off (swap64 v) else set_64 s off v
+end
+
+module Encode_bin = struct
+  let unit () _k = ()
+
+  let add_bytes b k = k (Bytes.to_string b)
+
+  let add_string s k = k s
+
+  let char c = add_bytes (Bytes.make 1 c)
+
+  let int8 i = char (Char.chr i)
+
+  let int16 i =
+    let b = Bytes.create 2 in
+    B.set_uint16 b 0 i;
+    add_bytes b
+
+  let int32 i =
+    let b = Bytes.create 4 in
+    B.set_uint32 b 0 i;
+    add_bytes b
+
+  let int64 i =
+    let b = Bytes.create 8 in
+    B.set_uint64 b 0 i;
+    add_bytes b
+
+  let float f = int64 (Int64.bits_of_float f)
+
+  let bool b = char (if b then '\255' else '\000')
+
+  let int i k =
+    let rec aux n =
+      if n >= 0 && n < 128 then int8 n k
+      else
+        let out = 128 + (n land 127) in
+        int8 out k;
+        aux (n lsr 7)
+    in
+    aux i
+
+  let len n i =
+    match n with
+    | `Int -> int i
+    | `Int8 -> int8 i
+    | `Int16 -> int16 i
+    | `Int32 -> int32 (Int32.of_int i)
+    | `Int64 -> int64 (Int64.of_int i)
+    | `Fixed _ -> unit ()
+
+  let string ?(headers = true) n s k =
+    if not headers then add_string s k
+    else
+      let i = String.length s in
+      len n i k;
+      add_string s k
+
+  let bytes ?(headers = true) n s k =
+    if not headers then add_bytes s k
+    else
+      let i = Bytes.length s in
+      len n i k;
+      add_bytes s k
+
+  let list l n x k =
+    len n (List.length x) k;
+    List.iter (fun e -> l e k) x
+
+  let array l n x k =
+    len n (Array.length x) k;
+    Array.iter (fun e -> l e k) x
+
+  let pair a b (x, y) k =
+    a x k;
+    b y k
+
+  let triple a b c (x, y, z) k =
+    a x k;
+    b y k;
+    c z k
+
+  let option o v k =
+    match v with
+    | None -> char '\000' k
+    | Some x ->
+        char '\255' k;
+        o x k
+
+  let rec t : type a. a t -> a encode_bin =
+   fun ty ?headers e k ->
+    match ty with
+    | Self s -> t ?headers s.self e k
+    | Custom c -> c.encode_bin ?headers e k
+    | Map b -> map ?headers b e k
+    | Prim t -> prim ?headers t e k
+    | List l -> list (t l.v) l.len e k
+    | Array a -> array (t a.v) a.len e k
+    | Tuple t -> tuple ?headers t e k
+    | Option x -> option (t x) e k
+    | Record r -> record ?headers r e k
+    | Variant v -> variant ?headers v e k
+
+  and tuple : type a. a tuple -> a encode_bin =
+   fun ty ?headers:_ ->
+    match ty with
+    | Pair (x, y) -> pair (t x) (t y)
+    | Triple (x, y, z) -> triple (t x) (t y) (t z)
+
+  and map : type a b. (a, b) map -> b encode_bin =
+   fun { x; g; _ } ?headers u k -> t ?headers x (g u) k
+
+  and prim : type a. a prim -> a encode_bin =
+   fun ty ?headers ->
+    match ty with
+    | Unit -> unit
+    | Bool -> bool
+    | Char -> char
+    | Int -> int
+    | Int32 -> int32
+    | Int64 -> int64
+    | Float -> float
+    | String n -> string ?headers n
+    | Bytes n -> bytes ?headers n
+
+  and record : type a. a record -> a encode_bin =
+   fun r ?headers:_ x k ->
+    let fields = fields r in
+    List.iter (fun (Field f) -> t f.ftype (f.fget x) k) fields
+
+  and variant : type a. a variant -> a encode_bin =
+   fun v ?headers:_ x k -> case_v (v.vget x) k
+
+  and case_v : type a. a case_v encode_bin =
+   fun ?headers:_ c k ->
+    match c with
+    | CV0 c -> int c.ctag0 k
+    | CV1 (c, v) ->
+        int c.ctag1 k;
+        t c.ctype1 v k
+end
+
+let encode_bin = Encode_bin.t
+
+let to_bin size_of encode_bin x =
+  let seq = encode_bin ?headers:(Some false) x in
+  let len =
+    match size_of ?headers:(Some false) x with None -> 1024 | Some n -> n
+  in
+  let buf = Buffer.create len in
+  seq (Buffer.add_string buf);
+  Buffer.contents buf
+
+let to_bin_string t x =
+  let rec aux : type a. a t -> a -> string =
+   fun t x ->
+    match t with
+    | Self s -> aux s.self x
+    | Map m -> aux m.x (m.g x)
+    | Prim (String _) -> x
+    | Prim (Bytes _) -> Bytes.to_string x
+    | Custom c -> to_bin c.size_of c.encode_bin x
+    | _ -> to_bin (size_of t) (encode_bin t) x
+  in
+  aux t x
+
+let pre_hash t x =
+  let rec aux : type a. a t -> a bin_seq =
+   fun t v k ->
+    match t with
+    | Self s -> aux s.self v k
+    | Map m -> aux m.x (m.g v) k
+    | Custom c -> c.pre_hash v k
+    | _ -> encode_bin ?headers:(Some false) t v k
+  in
+  aux t x
+
+module Decode_bin = struct
+  let ( >|= ) (ofs, x) f = (ofs, f x)
+
+  let ( >>= ) (ofs, x) f = f (ofs, x)
+
+  let ok ofs x = (ofs, x)
+
+  type 'a res = int * 'a
+
+  let unit _ ofs = ok ofs ()
+
+  let char buf ofs = ok (ofs + 1) buf.[ofs]
+
+  let int8 buf ofs = char buf ofs >|= Char.code
+
+  let int16 buf ofs = ok (ofs + 2) (B.get_uint16 buf ofs)
+
+  let int32 buf ofs = ok (ofs + 4) (B.get_uint32 buf ofs)
+
+  let int64 buf ofs = ok (ofs + 8) (B.get_uint64 buf ofs)
+
+  let bool buf ofs = char buf ofs >|= function '\000' -> false | _ -> true
+
+  let float buf ofs = int64 buf ofs >|= Int64.float_of_bits
+
+  let int buf ofs =
+    let rec aux n p ofs =
+      int8 buf ofs >>= fun (ofs, i) ->
+      let n = n + ((i land 127) lsl (p * 7)) in
+      if i >= 0 && i < 128 then (ofs, n) else aux n (p + 1) ofs
+    in
+    aux 0 0 ofs
+
+  let len buf ofs = function
+    | `Int -> int buf ofs
+    | `Int8 -> int8 buf ofs
+    | `Int16 -> int16 buf ofs
+    | `Int32 -> int32 buf ofs >|= Int32.to_int
+    | `Int64 -> int64 buf ofs >|= Int64.to_int
+    | `Fixed n -> ok ofs n
+
+  let has_fixed_size = function `Fixed _ -> true | _ -> false
+
+  let string ?(headers = true) n buf ofs =
+    if (not headers) && not (has_fixed_size n) then ok (String.length buf) buf
+    else
+      len buf ofs n >>= fun (ofs, len) ->
+      let str = Bytes.create len in
+      String.blit buf ofs str 0 len;
+      ok (ofs + len) (Bytes.unsafe_to_string str)
+
+  let bytes ?(headers = true) n buf ofs =
+    if (not headers) && not (has_fixed_size n) then
+      ok (String.length buf) (Bytes.of_string buf)
+    else
+      len buf ofs n >>= fun (ofs, len) ->
+      let str = Bytes.create len in
+      String.blit buf ofs str 0 len;
+      ok (ofs + len) str
+
+  let list l n buf ofs =
+    len buf ofs n >>= fun (ofs, len) ->
+    let rec aux acc ofs = function
+      | 0 -> ok ofs (List.rev acc)
+      | n -> l buf ofs >>= fun (ofs, x) -> aux (x :: acc) ofs (n - 1)
+    in
+    aux [] ofs len
+
+  let array l len buf ofs = list l len buf ofs >|= Array.of_list
+
+  let pair a b buf ofs =
+    a buf ofs >>= fun (ofs, a) ->
+    b buf ofs >|= fun b -> (a, b)
+
+  let triple a b c buf ofs =
+    a buf ofs >>= fun (ofs, a) ->
+    b buf ofs >>= fun (ofs, b) ->
+    c buf ofs >|= fun c -> (a, b, c)
+
+  let option : type a. a decode_bin -> a option decode_bin =
+   fun o ?headers:_ buf ofs ->
+    char buf ofs >>= function
+    | ofs, '\000' -> ok ofs None
+    | ofs, _ -> o buf ofs >|= fun x -> Some x
+
+  let rec t : type a. a t -> a decode_bin =
+   fun ty ?headers buf ofs ->
+    match ty with
+    | Self s -> t ?headers s.self buf ofs
+    | Custom c -> c.decode_bin ?headers buf ofs
+    | Map b -> map ?headers b buf ofs
+    | Prim t -> prim ?headers t buf ofs
+    | List l -> list (t l.v) l.len buf ofs
+    | Array a -> array (t a.v) a.len buf ofs
+    | Tuple t -> tuple ?headers t buf ofs
+    | Option x -> option ?headers (t x) buf ofs
+    | Record r -> record ?headers r buf ofs
+    | Variant v -> variant ?headers v buf ofs
+
+  and tuple : type a. a tuple -> a decode_bin =
+   fun ty ?headers:_ ->
+    match ty with
+    | Pair (x, y) -> pair (t x) (t y)
+    | Triple (x, y, z) -> triple (t x) (t y) (t z)
+
+  and map : type a b. (a, b) map -> b decode_bin =
+   fun { x; f; _ } ?headers buf ofs -> t ?headers x buf ofs >|= f
+
+  and prim : type a. a prim -> a decode_bin =
+   fun ty ?headers ->
+    match ty with
+    | Unit -> unit
+    | Bool -> bool
+    | Char -> char
+    | Int -> int
+    | Int32 -> int32
+    | Int64 -> int64
+    | Float -> float
+    | String n -> string ?headers n
+    | Bytes n -> bytes ?headers n
+
+  and record : type a. a record -> a decode_bin =
+   fun r ?headers:_ buf ofs ->
+    match r.rfields with
+    | Fields (fs, c) ->
+        let rec aux : type b. int -> b -> (a, b) fields -> a res =
+         fun ofs f -> function
+          | F0 -> ok ofs f
+          | F1 (h, t) -> field h buf ofs >>= fun (ofs, x) -> aux ofs (f x) t
+        in
+        aux ofs c fs
+
+  and field : type a b. (a, b) field -> b decode_bin = fun f -> t f.ftype
+
+  and variant : type a. a variant -> a decode_bin =
+   fun v ?headers:_ buf ofs ->
+    int buf ofs >>= fun (ofs, i) -> case v.vcases.(i) buf ofs
+
+  and case : type a. a a_case -> a decode_bin =
+   fun c ?headers:_ buf ofs ->
+    match c with C0 c -> ok ofs c.c0 | C1 c -> t c.ctype1 buf ofs >|= c.c1
+end
+
+let map_result f = function Ok x -> Ok (f x) | Error _ as e -> e
+
+let decode_bin = Decode_bin.t
+
+let of_bin decode_bin x =
+  let last, v = decode_bin ?headers:(Some false) x 0 in
+  assert (last = String.length x);
+  Ok v
+
+let of_bin_string t x =
+  let rec aux : type a. a t -> string -> (a, [ `Msg of string ]) result =
+   fun t x ->
+    match t with
+    | Self s -> aux s.self x
+    | Map l -> aux l.x x |> map_result l.f
+    | Prim (String _) -> Ok x
+    | Prim (Bytes _) -> Ok (Bytes.of_string x)
+    | Custom c -> of_bin c.decode_bin x
+    | _ -> of_bin (decode_bin t) x
+  in
+  try aux t x with Invalid_argument e -> Error (`Msg e)
+
+let to_string t = Fmt.to_to_string (pp t)
+
+let of_string t =
+  let v f x = try Ok (f x) with Invalid_argument e -> Error (`Msg e) in
+  let rec aux : type a a. a t -> a of_string =
+   fun t x ->
+    match t with
+    | Self s -> aux s.self x
+    | Custom c -> c.of_string x
+    | Map m -> aux m.x x |> map_result m.f
+    | Prim p -> prim p x
+    | _ -> of_json_string t x
+  and prim : type a. a prim -> a of_string =
+   fun t x ->
+    match t with
+    | Unit -> Ok ()
+    | Bool -> v bool_of_string x
+    | Char -> v (fun x -> x.[1]) x
+    | Int -> v int_of_string x
+    | Int32 -> v Int32.of_string x
+    | Int64 -> v Int64.of_string x
+    | Float -> v float_of_string x
+    | String _ -> Ok x
+    | Bytes _ -> Ok (Bytes.unsafe_of_string x)
+  in
+  aux t
+
+type 'a ty = 'a t
+
+let short_hash t ?seed x =
+  match t with
+  | Custom c -> c.short_hash ?seed x
+  | _ ->
+      let seed = match seed with None -> 0 | Some t -> t in
+      let h = ref seed in
+      pre_hash t x (fun s -> h := Hashtbl.seeded_hash !h s);
+      !h
+
+let like ?cli ?json ?bin ?equal ?compare ?short_hash:h ?pre_hash:p t =
+  let encode_json, decode_json =
+    match json with
+    | Some (x, y) -> (x, y)
+    | None -> (
+        let rec is_prim : type a. a t -> bool = function
+          | Self s -> is_prim s.self
+          | Map m -> is_prim m.x
+          | Prim _ -> true
+          | _ -> false
+        in
+        match (t, cli) with
+        | ty, Some (pp, of_string) when is_prim ty ->
+            let ty = string in
+            ( (fun ppf u -> Encode_json.t ty ppf (Fmt.to_to_string pp u)),
+              fun buf -> Decode_json.(t ty buf >|= of_string |> join) )
+        | _ -> (Encode_json.t t, Decode_json.t t) )
+  in
+  let pp, of_string =
+    match cli with Some (x, y) -> (x, y) | None -> (pp t, of_string t)
+  in
+  let encode_bin, decode_bin, size_of =
+    match bin with
+    | Some (x, y, z) -> (x, y, z)
+    | None -> (encode_bin t, decode_bin t, size_of t)
+  in
+  let equal =
+    match equal with
+    | Some x -> x
+    | None -> (
+        match compare with Some f -> fun x y -> f x y = 0 | None -> Equal.t t )
+  in
+  let compare = match compare with Some x -> x | None -> Compare.t t in
+  let short_hash ?seed =
+    match h with Some x -> x | None -> short_hash ?seed t
+  in
+  let pre_hash =
+    match p with Some x -> x | None -> encode_bin ?headers:(Some false)
+  in
+  Custom
+    {
+      cwit = `Type t;
+      pp;
+      of_string;
+      encode_json;
+      decode_json;
+      encode_bin;
+      decode_bin;
+      size_of;
+      compare;
+      equal;
+      short_hash;
+      pre_hash;
+    }
+
+let map ?cli ?json ?bin ?equal ?compare ?short_hash ?pre_hash x f g =
+  match (cli, json, bin, equal, compare, short_hash, pre_hash) with
+  | None, None, None, None, None, None, None ->
+      Map { x; f; g; mwit = Witness.make () }
+  | _ ->
+      let x = Map { x; f; g; mwit = Witness.make () } in
+      like ?cli ?json ?bin ?equal ?compare ?short_hash ?pre_hash x
+
+module type S = sig
+  type t
+
+  val t : t ty
+end
diff --git a/vendors/irmin/type.mli b/vendors/irmin/type.mli
new file mode 100644
index 0000000000000000000000000000000000000000..2b102932a60e147cb670fc2c203858a9d5232656
--- /dev/null
+++ b/vendors/irmin/type.mli
@@ -0,0 +1,212 @@
+(*
+ * Copyright (c) 2016-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type len = [ `Int | `Int8 | `Int16 | `Int32 | `Int64 | `Fixed of int ]
+
+type 'a t
+
+val unit : unit t
+
+val bool : bool t
+
+val char : char t
+
+val int : int t
+
+val int32 : int32 t
+
+val int64 : int64 t
+
+val float : float t
+
+val string : string t
+
+val bytes : bytes t
+
+val list : ?len:len -> 'a t -> 'a list t
+
+val array : ?len:len -> 'a t -> 'a array t
+
+val option : 'a t -> 'a option t
+
+val pair : 'a t -> 'b t -> ('a * 'b) t
+
+val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+
+val result : 'a t -> 'b t -> ('a, 'b) result t
+
+val string_of : len -> string t
+
+val bytes_of : len -> bytes t
+
+type ('a, 'b) field
+
+type ('a, 'b, 'c) open_record
+
+val field : string -> 'a t -> ('b -> 'a) -> ('b, 'a) field
+
+val sealr : ('a, 'b, 'a) open_record -> 'a t
+
+val ( |+ ) :
+  ('a, 'b, 'c -> 'd) open_record -> ('a, 'c) field -> ('a, 'b, 'd) open_record
+
+val record : string -> 'b -> ('a, 'b, 'b) open_record
+
+type ('a, 'b) case
+
+type 'a case_p
+
+type ('a, 'b, 'c) open_variant
+
+val case0 : string -> 'a -> ('a, 'a case_p) case
+
+val case1 : string -> 'b t -> ('b -> 'a) -> ('a, 'b -> 'a case_p) case
+
+val sealv : ('a, 'b, 'a -> 'a case_p) open_variant -> 'a t
+
+val variant : string -> 'b -> ('a, 'b, 'b) open_variant
+
+val ( |~ ) :
+  ('a, 'b, 'c -> 'd) open_variant -> ('a, 'c) case -> ('a, 'b, 'd) open_variant
+
+val enum : string -> (string * 'a) list -> 'a t
+
+val mu : ('a t -> 'a t) -> 'a t
+
+val mu2 : ('a t -> 'b t -> 'a t * 'b t) -> 'a t * 'b t
+
+(* generics *)
+
+val equal : 'a t -> 'a -> 'a -> bool
+
+val compare : 'a t -> 'a -> 'a -> int
+
+val short_hash : 'a t -> ?seed:int -> 'a -> int
+
+(* CLI *)
+
+type 'a pp = 'a Fmt.t
+
+type 'a to_string = 'a -> string
+
+type 'a of_string = string -> ('a, [ `Msg of string ]) result
+
+val pp : 'a t -> 'a Fmt.t
+
+val of_string : 'a t -> 'a of_string
+
+(* JSON (wire) *)
+
+module Json : sig
+  type decoder
+
+  val decoder : ?encoding:[< Jsonm.encoding ] -> [< Jsonm.src ] -> decoder
+
+  val decode :
+    decoder ->
+    [> `Await | `End | `Error of Jsonm.error | `Lexeme of Jsonm.lexeme ]
+
+  val rewind : decoder -> Jsonm.lexeme -> unit
+end
+
+type 'a encode_json = Jsonm.encoder -> 'a -> unit
+
+type 'a decode_json = Json.decoder -> ('a, [ `Msg of string ]) result
+
+(* Raw (disk) *)
+
+type 'a bin_seq = 'a -> (string -> unit) -> unit
+
+type 'a encode_bin = ?headers:bool -> 'a bin_seq
+
+type 'a decode_bin = ?headers:bool -> string -> int -> int * 'a
+
+type 'a size_of = ?headers:bool -> 'a -> int option
+
+val size_of : 'a t -> 'a size_of
+
+(* like *)
+
+val v :
+  cli:'a pp * 'a of_string ->
+  json:'a encode_json * 'a decode_json ->
+  bin:'a encode_bin * 'a decode_bin * 'a size_of ->
+  equal:('a -> 'a -> bool) ->
+  compare:('a -> 'a -> int) ->
+  short_hash:(?seed:int -> 'a -> int) ->
+  pre_hash:'a bin_seq ->
+  'a t
+
+val like :
+  ?cli:'a pp * 'a of_string ->
+  ?json:'a encode_json * 'a decode_json ->
+  ?bin:'a encode_bin * 'a decode_bin * 'a size_of ->
+  ?equal:('a -> 'a -> bool) ->
+  ?compare:('a -> 'a -> int) ->
+  ?short_hash:('a -> int) ->
+  ?pre_hash:'a bin_seq ->
+  'a t ->
+  'a t
+
+val map :
+  ?cli:'b pp * 'b of_string ->
+  ?json:'b encode_json * 'b decode_json ->
+  ?bin:'b encode_bin * 'b decode_bin * 'b size_of ->
+  ?equal:('b -> 'b -> bool) ->
+  ?compare:('b -> 'b -> int) ->
+  ?short_hash:('b -> int) ->
+  ?pre_hash:'b bin_seq ->
+  'a t ->
+  ('a -> 'b) ->
+  ('b -> 'a) ->
+  'b t
+
+(* convenient functions. *)
+
+val to_string : 'a t -> 'a -> string
+
+val pp_json : ?minify:bool -> 'a t -> 'a Fmt.t
+
+val pre_hash : 'a t -> 'a bin_seq
+
+val encode_json : 'a t -> Jsonm.encoder -> 'a -> unit
+
+val decode_json : 'a t -> Jsonm.decoder -> ('a, [ `Msg of string ]) result
+
+val decode_json_lexemes :
+  'a t -> Jsonm.lexeme list -> ('a, [ `Msg of string ]) result
+
+val to_json_string : ?minify:bool -> 'a t -> 'a to_string
+
+val of_json_string : 'a t -> 'a of_string
+
+val encode_bin : 'a t -> 'a encode_bin
+
+val to_bin_string : 'a t -> 'a to_string
+
+val decode_bin : 'a t -> 'a decode_bin
+
+val of_bin_string : 'a t -> 'a of_string
+
+type 'a ty = 'a t
+
+val pp_ty : 'a t Fmt.t
+
+module type S = sig
+  type t
+
+  val t : t ty
+end
diff --git a/vendors/irmin/version.ml b/vendors/irmin/version.ml
new file mode 100644
index 0000000000000000000000000000000000000000..3274b52a91db18c5bd4ac12428e294e5dce5fef3
--- /dev/null
+++ b/vendors/irmin/version.ml
@@ -0,0 +1 @@
+let current = "%%VERSION%%"
diff --git a/vendors/irmin/watch.ml b/vendors/irmin/watch.ml
new file mode 100644
index 0000000000000000000000000000000000000000..779440e068080a94db748b16a10cab712ca25c09
--- /dev/null
+++ b/vendors/irmin/watch.ml
@@ -0,0 +1,342 @@
+(*
+ * Copyright (c) 2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+
+let src = Logs.Src.create "irmin.watch" ~doc:"Irmin watch notifications"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+module type S = sig
+  type key
+
+  type value
+
+  type watch
+
+  type t
+
+  val stats : t -> int * int
+
+  val notify : t -> key -> value option -> unit Lwt.t
+
+  val v : unit -> t
+
+  val clear : t -> unit Lwt.t
+
+  val watch_key :
+    t -> key -> ?init:value -> (value Diff.t -> unit Lwt.t) -> watch Lwt.t
+
+  val watch :
+    t ->
+    ?init:(key * value) list ->
+    (key -> value Diff.t -> unit Lwt.t) ->
+    watch Lwt.t
+
+  val unwatch : t -> watch -> unit Lwt.t
+
+  val listen_dir :
+    t ->
+    string ->
+    key:(string -> key option) ->
+    value:(key -> value option Lwt.t) ->
+    (unit -> unit Lwt.t) Lwt.t
+end
+
+let none _ _ =
+  Printf.eprintf "Listen hook not set!\n%!";
+  assert false
+
+let listen_dir_hook = ref none
+
+type hook =
+  int -> string -> (string -> unit Lwt.t) -> (unit -> unit Lwt.t) Lwt.t
+
+let set_listen_dir_hook (h : hook) = listen_dir_hook := h
+
+let id () =
+  let c = ref 0 in
+  fun () ->
+    incr c;
+    !c
+
+let global = id ()
+
+let workers_r = ref 0
+
+let workers () = !workers_r
+
+let scheduler () =
+  let p = ref None in
+  let niet () = () in
+  let c = ref niet in
+  let push elt =
+    match !p with
+    | Some p -> p elt
+    | None ->
+        let stream, push = Lwt_stream.create () in
+        incr workers_r;
+        Lwt.async (fun () ->
+            (* FIXME: we would like to skip some updates if more recent ones
+             are at the back of the queue. *)
+            Lwt_stream.iter_s (fun f -> f ()) stream);
+        p := Some push;
+        (c := fun () -> push None);
+        push elt
+  in
+  let clean () =
+    !c ();
+    decr workers_r;
+    c := niet;
+    p := None
+  in
+  let enqueue v = push (Some v) in
+  (clean, enqueue)
+
+module Make (K : sig
+  type t
+
+  val t : t Type.t
+end) (V : sig
+  type t
+
+  val t : t Type.t
+end) =
+struct
+  type key = K.t
+
+  type value = V.t
+
+  type watch = int
+
+  module KMap = Map.Make (struct
+    type t = K.t
+
+    let compare = Type.compare K.t
+  end)
+
+  module IMap = Map.Make (struct
+    type t = int
+
+    let compare (x : int) (y : int) = compare x y
+  end)
+
+  type key_handler = value Diff.t -> unit Lwt.t
+
+  type all_handler = key -> value Diff.t -> unit Lwt.t
+
+  let pp_value = Type.pp V.t
+
+  let equal_opt_values = Type.(equal (option V.t))
+
+  let equal_keys = Type.equal K.t
+
+  type t = {
+    id : int;
+    (* unique watch manager id. *)
+    lock : Lwt_mutex.t;
+    (* protect [keys] and [glb]. *)
+    mutable next : int;
+    (* next id, to identify watch handlers. *)
+    mutable keys : (key * value option * key_handler) IMap.t;
+    (* key handlers. *)
+    mutable glob : (value KMap.t * all_handler) IMap.t;
+    (* global handlers. *)
+    enqueue : (unit -> unit Lwt.t) -> unit;
+    (* enqueue notifications. *)
+    clean : unit -> unit;
+    (* destroy the notification thread. *)
+    mutable listeners : int;
+    (* number of listeners. *)
+    mutable stop_listening : unit -> unit Lwt.t;
+        (* clean-up listen resources. *)
+  }
+
+  let stats t = (IMap.cardinal t.keys, IMap.cardinal t.glob)
+
+  let to_string t =
+    let k, a = stats t in
+    Printf.sprintf "[%d: %dk/%dg|%d]" t.id k a t.listeners
+
+  let next t =
+    let id = t.next in
+    t.next <- id + 1;
+    id
+
+  let is_empty t = IMap.is_empty t.keys && IMap.is_empty t.glob
+
+  let clear_unsafe t =
+    t.keys <- IMap.empty;
+    t.glob <- IMap.empty;
+    t.next <- 0
+
+  let clear t =
+    Lwt_mutex.with_lock t.lock (fun () ->
+        clear_unsafe t;
+        Lwt.return_unit)
+
+  let v () =
+    let lock = Lwt_mutex.create () in
+    let clean, enqueue = scheduler () in
+    {
+      lock;
+      clean;
+      enqueue;
+      id = global ();
+      next = 0;
+      keys = IMap.empty;
+      glob = IMap.empty;
+      listeners = 0;
+      stop_listening = (fun () -> Lwt.return_unit);
+    }
+
+  let unwatch_unsafe t id =
+    Log.debug (fun f -> f "unwatch %s: id=%d" (to_string t) id);
+    let glob = IMap.remove id t.glob in
+    let keys = IMap.remove id t.keys in
+    t.glob <- glob;
+    t.keys <- keys
+
+  let unwatch t id =
+    Lwt_mutex.with_lock t.lock (fun () ->
+        unwatch_unsafe t id;
+        if is_empty t then t.clean ();
+        Lwt.return_unit)
+
+  let mk old value =
+    match (old, value) with
+    | None, None -> assert false
+    | Some v, None -> `Removed v
+    | None, Some v -> `Added v
+    | Some x, Some y -> `Updated (x, y)
+
+  let protect f () =
+    Lwt.catch f (fun e ->
+        Log.err (fun l ->
+            l "watch callback got: %a\n%s" Fmt.exn e
+              (Printexc.get_backtrace ()));
+        Lwt.return_unit)
+
+  let notify_all_unsafe t key value =
+    let todo = ref [] in
+    let glob =
+      IMap.fold
+        (fun id ((init, f) as arg) acc ->
+          let fire old_value =
+            Log.debug (fun f ->
+                f "notify-all[%d.%d]: firing! (v=%a)" t.id id
+                  Fmt.(Dump.option pp_value)
+                  old_value);
+            todo := protect (fun () -> f key (mk old_value value)) :: !todo;
+            let init =
+              match value with
+              | None -> KMap.remove key init
+              | Some v -> KMap.add key v init
+            in
+            IMap.add id (init, f) acc
+          in
+          let old_value =
+            try Some (KMap.find key init) with Not_found -> None
+          in
+          if equal_opt_values old_value value then (
+            Log.debug (fun f ->
+                f "notify-all[%d:%d]: same value, skipping." t.id id);
+            IMap.add id arg acc )
+          else fire old_value)
+        t.glob IMap.empty
+    in
+    t.glob <- glob;
+    match !todo with
+    | [] -> ()
+    | ts -> t.enqueue (fun () -> Lwt_list.iter_p (fun x -> x ()) ts)
+
+  let notify_key_unsafe t key value =
+    let todo = ref [] in
+    let keys =
+      IMap.fold
+        (fun id ((k, old_value, f) as arg) acc ->
+          if not (equal_keys key k) then IMap.add id arg acc
+          else if equal_opt_values value old_value then (
+            Log.debug (fun f ->
+                f "notify-key[%d.%d]: same value, skipping." t.id id);
+            IMap.add id arg acc )
+          else (
+            Log.debug (fun f -> f "notify-key[%d:%d] firing!" t.id id);
+            todo := protect (fun () -> f (mk old_value value)) :: !todo;
+            IMap.add id (k, value, f) acc ))
+        t.keys IMap.empty
+    in
+    t.keys <- keys;
+    match !todo with
+    | [] -> ()
+    | ts -> t.enqueue (fun () -> Lwt_list.iter_p (fun x -> x ()) ts)
+
+  let notify t key value =
+    Lwt_mutex.with_lock t.lock (fun () ->
+        if is_empty t then Lwt.return_unit
+        else (
+          notify_all_unsafe t key value;
+          notify_key_unsafe t key value;
+          Lwt.return_unit ))
+
+  let watch_key_unsafe t key ?init f =
+    let id = next t in
+    Log.debug (fun f -> f "watch-key %s: id=%d" (to_string t) id);
+    t.keys <- IMap.add id (key, init, f) t.keys;
+    id
+
+  let watch_key t key ?init f =
+    Lwt_mutex.with_lock t.lock (fun () ->
+        let id = watch_key_unsafe t ?init key f in
+        Lwt.return id)
+
+  let kmap_of_alist l =
+    List.fold_left (fun map (k, v) -> KMap.add k v map) KMap.empty l
+
+  let watch_unsafe t ?(init = []) f =
+    let id = next t in
+    Log.debug (fun f -> f "watch %s: id=%d" (to_string t) id);
+    t.glob <- IMap.add id (kmap_of_alist init, f) t.glob;
+    id
+
+  let watch t ?init f =
+    Lwt_mutex.with_lock t.lock (fun () ->
+        let id = watch_unsafe t ?init f in
+        Lwt.return id)
+
+  let listen_dir t dir ~key ~value =
+    let init () =
+      if t.listeners = 0 then (
+        Log.debug (fun f -> f "%s: start listening to %s" (to_string t) dir);
+        !listen_dir_hook t.id dir (fun file ->
+            match key file with
+            | None -> Lwt.return_unit
+            | Some key -> value key >>= notify t key)
+        >|= fun f -> t.stop_listening <- f )
+      else (
+        Log.debug (fun f -> f "%s: already listening on %s" (to_string t) dir);
+        Lwt.return_unit )
+    in
+    init () >|= fun () ->
+    t.listeners <- t.listeners + 1;
+    function
+    | () ->
+        if t.listeners > 0 then t.listeners <- t.listeners - 1;
+        if t.listeners <> 0 then Lwt.return_unit
+        else (
+          Log.debug (fun f -> f "%s: stop listening to %s" (to_string t) dir);
+          t.stop_listening () )
+end
diff --git a/vendors/irmin/watch.mli b/vendors/irmin/watch.mli
new file mode 100644
index 0000000000000000000000000000000000000000..0fbd3a081218b38c678ef81d24b901880280f254
--- /dev/null
+++ b/vendors/irmin/watch.mli
@@ -0,0 +1,72 @@
+(*
+ * Copyright (c) 2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Watches *)
+
+module type S = sig
+  type key
+
+  type value
+
+  type watch
+
+  type t
+
+  val stats : t -> int * int
+
+  val notify : t -> key -> value option -> unit Lwt.t
+
+  val v : unit -> t
+
+  val clear : t -> unit Lwt.t
+
+  val watch_key :
+    t -> key -> ?init:value -> (value Diff.t -> unit Lwt.t) -> watch Lwt.t
+
+  val watch :
+    t ->
+    ?init:(key * value) list ->
+    (key -> value Diff.t -> unit Lwt.t) ->
+    watch Lwt.t
+
+  val unwatch : t -> watch -> unit Lwt.t
+
+  val listen_dir :
+    t ->
+    string ->
+    key:(string -> key option) ->
+    value:(key -> value option Lwt.t) ->
+    (unit -> unit Lwt.t) Lwt.t
+end
+
+module Make (K : sig
+  type t
+
+  val t : t Type.t
+end) (V : sig
+  type t
+
+  val t : t Type.t
+end) : S with type key = K.t and type value = V.t
+
+type hook =
+  int -> string -> (string -> unit Lwt.t) -> (unit -> unit Lwt.t) Lwt.t
+
+val set_listen_dir_hook : hook -> unit
+
+val none : hook
+
+val workers : unit -> int