Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
Clean up Backend naming: Memory_of functor, Memory.sha1/sha256/cid
- Backend.Memory_of(H : HASH) is the functor for custom hash types
- Backend.Memory.sha1/sha256/cid are convenience constructors
- Backend.Disk.sha1/sha256/cid replace create_sha1/create_sha256/create_cid
- Backend.HASH module type extracted (was inline sig)
- Memory_of exposes val empty for creating initial state
- proof.ml and subtree.ml use top-level module definitions instead
of let module
+34
-12
+7
-9
lib/backend.ml
+7
-9
lib/backend.ml
···
168
168
mutable refs : 'hash String_map.t;
169
169
}
170
170
171
-
module Memory_of (H : HASH) :
172
-
S with type hash = H.t and type t = H.t mem_state = struct
171
+
module Memory_of (H : HASH) = struct
173
172
type hash = H.t
174
173
type t = hash mem_state
175
174
···
203
202
204
203
let flush _ = ()
205
204
let close _ = ()
205
+
let empty () : t = { objects = String_map.empty; refs = String_map.empty }
206
206
end
207
207
208
-
let empty_mem_state () = { objects = String_map.empty; refs = String_map.empty }
209
-
210
-
let pack_memory (type h) (to_hex : h -> string) (equal : h -> h -> bool) : h t =
208
+
let memory (type h) (to_hex : h -> string) (equal : h -> h -> bool) : h t =
211
209
let module H = struct
212
210
type t = h
213
211
···
216
214
end in
217
215
let module B = Memory_of (H) in
218
216
let module P = Make (B) in
219
-
P.v (empty_mem_state ())
217
+
P.v (B.empty ())
220
218
221
219
module Memory = struct
222
-
let sha1 () = pack_memory Hash.to_hex Hash.equal
223
-
let sha256 () = pack_memory Hash.to_hex Hash.equal
224
-
let cid () = pack_memory Atp.Cid.to_string Atp.Cid.equal
220
+
let sha1 () = memory Hash.to_hex Hash.equal
221
+
let sha256 () = memory Hash.to_hex Hash.equal
222
+
let cid () = memory Atp.Cid.to_string Atp.Cid.equal
225
223
end
226
224
227
225
(* ===== Disk backend ===== *)
+5
-1
lib/backend.mli
+5
-1
lib/backend.mli
+11
-1
lib/proof.ml
+11
-1
lib/proof.ml
···
183
183
type hash = C.hash
184
184
type contents = string
185
185
186
+
module Replay_hash : Backend.HASH with type t = C.hash = struct
187
+
type t = C.hash
188
+
189
+
let to_hex = C.hash_to_hex
190
+
let equal = C.hash_equal
191
+
end
192
+
193
+
module Replay_mem = Backend.Memory_of (Replay_hash)
194
+
module Replay_packed = Backend.Make (Replay_mem)
195
+
186
196
(* Hash-keyed tables for recording backend reads. *)
187
197
module Htbl = Hashtbl.Make (struct
188
198
type t = hash
···
231
241
232
242
(* A replay backend is a Memory backend pre-populated from the env. *)
233
243
let replay_backend env =
234
-
let b = Backend.Memory.create_with_hash C.hash_to_hex C.hash_equal in
244
+
let b = Replay_packed.v (Replay_mem.empty ()) in
235
245
Htbl.iter (fun h data -> Backend.write b h data) env.nodes;
236
246
Htbl.iter (fun h data -> Backend.write b h data) env.contents;
237
247
b
+11
-1
lib/subtree.ml
+11
-1
lib/subtree.ml
···
5
5
module Tree = Store.Tree
6
6
module Commit = Store.Commit
7
7
8
+
module Mem_hash : Backend.HASH with type t = F.hash = struct
9
+
type t = F.hash
10
+
11
+
let to_hex = F.hash_to_hex
12
+
let equal = F.hash_equal
13
+
end
14
+
15
+
module Mem = Backend.Memory_of (Mem_hash)
16
+
module Mem_packed = Backend.Make (Mem)
17
+
8
18
type status =
9
19
[ `In_sync
10
20
| `Local_ahead of int
···
22
32
23
33
(* Split: Extract subtree history into a new store *)
24
34
let split store ~prefix =
25
-
let backend = Backend.Memory.create_with_hash F.hash_to_hex F.hash_equal in
35
+
let backend = Mem_packed.v (Mem.empty ()) in
26
36
let new_store = Store.create ~backend in
27
37
28
38
(* Walk commits and rewrite those touching prefix *)