Pure OCaml B-tree implementation for persistent storage
fix(E606/E620): consolidate test stanzas, remove ounit2, fix testlib conflict
- tls/tests: merge → single test.ml runner, remove ounit2, convert to alcotest
- tls/eio/tests: add crypto-rng dep (E606), add test_rng.mli
- tls/test: move testlib to test/helpers/ (named test_helpers) to fix naming
conflict; merge 10 stanzas → single test_core stanza without (modules)
- tls/test/eio: merge 2 stanzas → 1
- tomlt/test: merge 2 stanzas → single test.ml; expose suite in .mli files
- tcf/test: merge 2 stanzas → single test.ml; convert runners to suite values
+75
-24
+13
-5
lib/record.ml
+13
-5
lib/record.ml
···
123
123
List.map (fun (st, _) -> Varint.encode (Int64.of_int st)) types_and_sizes
124
124
in
125
125
let header_body = String.concat "" header_types in
126
-
let header_size = 1 + String.length header_body in
127
-
(* header size varint + types *)
126
+
let header_body_len = String.length header_body in
127
+
(* header_size includes itself; iterate to find stable size *)
128
+
let rec find_header_size tentative =
129
+
let varint_len = Varint.size (Int64.of_int tentative) in
130
+
let actual = varint_len + header_body_len in
131
+
if actual = tentative then tentative else find_header_size actual
132
+
in
133
+
let header_size = find_header_size (1 + header_body_len) in
134
+
let header_size_varint = Varint.encode (Int64.of_int header_size) in
135
+
let header_varint_len = String.length header_size_varint in
128
136
let body_size =
129
137
List.fold_left (fun acc (_, sz) -> acc + sz) 0 types_and_sizes
130
138
in
131
139
let total = header_size + body_size in
132
140
let buf = Bytes.create total in
133
-
(* Write header size *)
134
-
Bytes.set_uint8 buf 0 header_size;
141
+
(* Write header size as varint *)
142
+
Bytes.blit_string header_size_varint 0 buf 0 header_varint_len;
135
143
(* Write serial types *)
136
144
let _ =
137
145
List.fold_left
138
146
(fun off s ->
139
147
Bytes.blit_string s 0 buf off (String.length s);
140
148
off + String.length s)
141
-
1 header_types
149
+
header_varint_len header_types
142
150
in
143
151
(* Write values *)
144
152
let _ =
+38
-1
lib/table.ml
+38
-1
lib/table.ml
···
387
387
in
388
388
traverse t.root_page []
389
389
390
-
let delete _t _rowid = failwith "Delete not yet implemented"
390
+
let delete t rowid =
391
+
let rec traverse page_num =
392
+
let page = Pager.read t.pager page_num in
393
+
let header = Page.parse_header page 0 in
394
+
match header.Page.kind with
395
+
| Page.Leaf_table ->
396
+
let ptrs = Page.cell_pointers page 0 header in
397
+
let usable = usable_size t in
398
+
let rec search lo hi =
399
+
if lo > hi then ()
400
+
else
401
+
let mid = (lo + hi) / 2 in
402
+
let cell, _ =
403
+
Cell.parse_table_leaf page ptrs.(mid) ~usable_size:usable
404
+
in
405
+
if cell.Cell.rowid = rowid then begin
406
+
let buf = Bytes.of_string page in
407
+
let ptr_start = Page.header_size Page.Leaf_table in
408
+
for i = mid to header.Page.cell_count - 2 do
409
+
let next_ptr = Page.u16_be page (ptr_start + ((i + 1) * 2)) in
410
+
Page.set_u16_be buf (ptr_start + (i * 2)) next_ptr
411
+
done;
412
+
let new_count = header.Page.cell_count - 1 in
413
+
Page.set_u16_be buf 3 new_count;
414
+
if new_count = 0 then
415
+
Page.set_u16_be buf 5 (Pager.page_size t.pager);
416
+
Pager.write t.pager page_num (Bytes.unsafe_to_string buf)
417
+
end
418
+
else if cell.Cell.rowid < rowid then search (mid + 1) hi
419
+
else search lo (mid - 1)
420
+
in
421
+
search 0 (header.Page.cell_count - 1)
422
+
| Page.Interior_table ->
423
+
let c = child t page header rowid in
424
+
traverse c
425
+
| _ -> failwith "Invalid page type in table B-tree"
426
+
in
427
+
traverse t.root_page
391
428
392
429
let iter t f =
393
430
let rec iter_page page_num =
+22
-16
lib/varint.ml
+22
-16
lib/varint.ml
···
6
6
(** SQLite-style variable-length integer encoding. *)
7
7
8
8
let decode buf off =
9
-
let rec loop acc shift i =
9
+
let rec loop acc i =
10
10
if i >= String.length buf then (acc, i - off)
11
11
else
12
12
let byte = Char.code buf.[i] in
13
-
let value = Int64.of_int (byte land 0x7f) in
14
-
let acc = Int64.logor acc (Int64.shift_left value shift) in
15
-
if byte land 0x80 = 0 then (acc, i - off + 1)
16
-
else if shift >= 56 then
13
+
if i - off >= 8 then
17
14
(* 9th byte - use all 8 bits *)
18
-
let byte9 = Char.code buf.[i + 1] in
19
-
let acc = Int64.logor acc (Int64.shift_left (Int64.of_int byte9) 56) in
20
-
(acc, i - off + 2)
21
-
else loop acc (shift + 7) (i + 1)
15
+
let acc = Int64.logor (Int64.shift_left acc 8) (Int64.of_int byte) in
16
+
(acc, i - off + 1)
17
+
else
18
+
let value = Int64.of_int (byte land 0x7f) in
19
+
let acc = Int64.logor (Int64.shift_left acc 7) value in
20
+
if byte land 0x80 = 0 then (acc, i - off + 1) else loop acc (i + 1)
22
21
in
23
-
loop 0L 0 off
22
+
loop 0L off
24
23
25
24
let size n =
26
25
if n < 0L then 9
···
37
36
let encode n =
38
37
let sz = size n in
39
38
let buf = Bytes.create sz in
40
-
let rec loop n i =
41
-
if i = sz - 1 then Bytes.set_uint8 buf i (Int64.to_int n land 0x7f)
39
+
let n = ref n in
40
+
for i = sz - 1 downto 0 do
41
+
if i = sz - 1 && sz = 9 then begin
42
+
Bytes.set_uint8 buf i (Int64.to_int !n land 0xff);
43
+
n := Int64.shift_right_logical !n 8
44
+
end
45
+
else if i = sz - 1 then begin
46
+
Bytes.set_uint8 buf i (Int64.to_int !n land 0x7f);
47
+
n := Int64.shift_right_logical !n 7
48
+
end
42
49
else begin
43
-
Bytes.set_uint8 buf i (Int64.to_int n land 0x7f lor 0x80);
44
-
loop (Int64.shift_right_logical n 7) (i + 1)
50
+
Bytes.set_uint8 buf i (Int64.to_int !n land 0x7f lor 0x80);
51
+
n := Int64.shift_right_logical !n 7
45
52
end
46
-
in
47
-
loop n 0;
53
+
done;
48
54
Bytes.unsafe_to_string buf
+2
-2
test/test_btree.ml
+2
-2
test/test_btree.ml
···
318
318
test_encode 1L [ 0x01 ];
319
319
test_encode 127L [ 0x7f ];
320
320
(* Two bytes: 128-16383 *)
321
-
test_encode 128L [ 0x80; 0x01 ];
322
-
test_encode 255L [ 0xff; 0x01 ];
321
+
test_encode 128L [ 0x81; 0x00 ];
322
+
test_encode 255L [ 0x81; 0x7f ];
323
323
test_encode 16383L [ 0xff; 0x7f ]
324
324
325
325
let test_varint_boundaries () =