-
Notifications
You must be signed in to change notification settings - Fork 0
/
indirect.ml
109 lines (92 loc) · 3.07 KB
/
indirect.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
(* Indirect block management. *)
open Batteries
type t = {
pool: Pool.writable;
limit: int;
prefix: string;
buffers: Buffer.t Stack.t }
let make_indirect pool prefix limit =
let limit = (limit / 20) * 20 in
let core = Buffer.create limit in
let buffers = Stack.create () in
Stack.push core buffers;
{ pool = (pool :> Pool.writable); prefix = prefix; limit = limit;
buffers = buffers }
(* Push a new buffer level, containing the initial hash. *)
let push ind hash =
let buf = Buffer.create ind.limit in
Buffer.add_string buf (Hash.get_raw hash);
Stack.push buf ind.buffers
(* Summarize the buffer at the given level, returning the hash of the summary. *)
let summarize ind buffer level =
if Buffer.length buffer = 0 then begin
if level > 0 then
Log.fail "Empty has at non-zero level";
(* An empty chunk is allowed, but only at level 0. *)
let chunk = Chunk.chunk_of_string "null" "" in
ind.pool#add chunk;
chunk#hash
end else if Buffer.length buffer = 20 then begin
(* If there is a single hash, just use it instead of making an indirect block of one element. *)
Hash.of_raw (Buffer.contents buffer)
end else begin
(* Otherwise make a new chunk out of the data. *)
let kind = Printf.sprintf "%s%d" ind.prefix level in
let chunk = Chunk.chunk_of_string kind (Buffer.contents buffer) in
ind.pool#add chunk;
chunk#hash
end
let rec append ind hash level =
if Stack.is_empty ind.buffers then
push ind hash
else if Buffer.length (Stack.top ind.buffers) >= ind.limit then begin
let summary_hash = summarize ind (Stack.pop ind.buffers) (level+1) in
append ind summary_hash (level+1);
push ind hash
end else
Buffer.add_string (Stack.top ind.buffers) (Hash.get_raw hash)
let add ind hash = append ind hash 0
let finish ind =
(* Collapse the buffers. *)
let level = ref 0 in (* Note this is occasionally wrong *)
while Stack.length ind.buffers > 1 do
let tmp = Stack.pop ind.buffers in
let summary = summarize ind tmp (!level + 1) in
append ind summary (!level + 1);
level := !level + 1;
done;
let top = Stack.pop ind.buffers in
summarize ind top 0
(* Builder for directories. *)
module Dir = struct
let ind_add = add
let ind_finish = finish
type ind_t = t
module SM = Maps.StringMap
type t = { pool: Pool.writable;
limit: int;
mutable buffer: Hash.t SM.t;
mutable length: int;
ind: ind_t }
let make pool limit = { pool = (pool :> Pool.writable);
limit = limit;
buffer = SM.empty;
length = 0;
ind = make_indirect pool "dir" limit }
let ship dir =
if not (SM.is_empty dir.buffer) then begin
let node = Nodes.DirNode dir.buffer in
let hash = Nodes.try_put dir.pool node in
ind_add dir.ind hash;
dir.buffer <- SM.empty;
dir.length <- 0
end
let add dir name hash =
let len = 22 + String.length name in
if dir.length + len > dir.limit then ship dir;
dir.length <- dir.length + len;
dir.buffer <- SM.add name hash dir.buffer
let finish dir =
ship dir;
ind_finish dir.ind
end