Pure OCaml B-tree implementation for persistent storage
fix(lint): resolve E205, E331, E340 redundant prefixes and error patterns
Remove redundant function prefixes (get_, find_, make_, create_, bundle_)
across bpsec, btree, bundle, cbort, cfdp, cgr, claudeio, and dependent
packages. Replace Printf.sprintf with Fmt.failwith, add err_eio/err_msg
helpers in skills.ml.
+166
-168
+16
-16
lib/btree.mli
+16
-16
lib/btree.mli
···
37
37
(** {1 Page Types and Headers} *)
38
38
39
39
module Page : sig
40
-
type page_type =
40
+
type kind =
41
41
| Interior_index (** 0x02 *)
42
42
| Interior_table (** 0x05 *)
43
43
| Leaf_index (** 0x0a *)
44
44
| Leaf_table (** 0x0d *)
45
45
46
-
val pp_page_type : Format.formatter -> page_type -> unit
46
+
val pp_kind : Format.formatter -> kind -> unit
47
47
48
48
type header = {
49
-
page_type : page_type;
49
+
kind : kind;
50
50
first_freeblock : int;
51
51
cell_count : int;
52
52
cell_content_start : int;
···
58
58
(** [parse_header buf off] parses a page header starting at [off]. For page 1,
59
59
[off] should be 100 (after database header). *)
60
60
61
-
val header_size : page_type -> int
61
+
val header_size : kind -> int
62
62
(** [header_size typ] is 8 for leaf pages, 12 for interior pages. *)
63
63
64
-
val init : page_size:int -> page_type:page_type -> bytes
65
-
(** [init ~page_size ~page_type] creates a new empty page buffer. *)
64
+
val init : page_size:int -> kind:kind -> bytes
65
+
(** [init ~page_size ~kind] creates a new empty page buffer. *)
66
66
67
67
val cell_pointers : string -> int -> header -> int array
68
68
(** [cell_pointers page header_offset header] returns cell pointer array. *)
69
69
70
-
val get_u16_be : string -> int -> int
70
+
val u16_be : string -> int -> int
71
71
72
-
val get_u32_be : string -> int -> int
72
+
val u32_be : string -> int -> int
73
73
(** Read unsigned 32-bit big-endian integer. *)
74
74
75
75
val set_u16_be : bytes -> int -> int -> unit
···
181
181
module Pager : sig
182
182
type t
183
183
184
-
val create : page_size:int -> Eio.File.rw_ty Eio.Resource.t -> t
185
-
(** [create ~page_size file] creates a pager with the given page size. *)
184
+
val v : page_size:int -> Eio.File.rw_ty Eio.Resource.t -> t
185
+
(** [v ~page_size file] creates a pager with the given page size. *)
186
186
187
187
val page_size : t -> int
188
188
(** [page_size t] returns the page size. *)
···
210
210
module Table : sig
211
211
type t
212
212
213
-
val create : Pager.t -> t
214
-
(** [create pager] creates a new empty table B-tree. *)
213
+
val v : Pager.t -> t
214
+
(** [v pager] creates a new empty table B-tree. *)
215
215
216
216
val open_ : Pager.t -> root_page:int -> t
217
217
(** [open_ pager ~root_page] opens an existing table B-tree. *)
···
243
243
type t
244
244
(** An index B-tree for string keys. *)
245
245
246
-
val create : Pager.t -> t
247
-
(** [create pager] creates a new empty index B-tree. *)
246
+
val v : Pager.t -> t
247
+
(** [v pager] creates a new empty index B-tree. *)
248
248
249
249
val open_ : Pager.t -> root_page:int -> t
250
250
(** [open_ pager ~root_page] opens an existing index B-tree. *)
···
267
267
Note: This is a simplified implementation that doesn't rebalance the tree.
268
268
*)
269
269
270
-
val find_by_prefix : t -> string -> string option
271
-
(** [find_by_prefix t prefix] finds the first entry starting with [prefix]. *)
270
+
val by_prefix : t -> string -> string option
271
+
(** [by_prefix t prefix] finds the first entry starting with [prefix]. *)
272
272
273
273
val delete_by_prefix : t -> string -> unit
274
274
(** [delete_by_prefix t prefix] deletes the first entry starting with
+5
-5
lib/cell.ml
+5
-5
lib/cell.ml
···
38
38
else
39
39
let k = min_local + ((payload_size - min_local) mod (usable_size - 4)) in
40
40
let local = if k <= max_local then k else min_local in
41
-
let overflow = Page.get_u32_be buf (off + header_len + local) in
41
+
let overflow = Page.u32_be buf (off + header_len + local) in
42
42
(local, Some overflow)
43
43
in
44
44
let payload = String.sub buf (off + header_len) local_size in
···
48
48
({ rowid; payload; overflow_page }, total_consumed)
49
49
50
50
let parse_table_interior buf off =
51
-
let left_child = Page.get_u32_be buf off in
51
+
let left_child = Page.u32_be buf off in
52
52
let rowid, consumed = Varint.decode buf (off + 4) in
53
53
({ left_child; rowid }, 4 + consumed)
54
54
···
63
63
else
64
64
let k = min_local + ((payload_size - min_local) mod (usable_size - 4)) in
65
65
let local = if k <= max_local then k else min_local in
66
-
let overflow = Page.get_u32_be buf (off + consumed + local) in
66
+
let overflow = Page.u32_be buf (off + consumed + local) in
67
67
(local, Some overflow)
68
68
in
69
69
let local_payload = String.sub buf (off + consumed) local_size in
···
79
79
80
80
(* Parse index interior cell - returns local payload and overflow pointer *)
81
81
let parse_index_interior_raw buf off ~usable_size =
82
-
let left_child = Page.get_u32_be buf off in
82
+
let left_child = Page.u32_be buf off in
83
83
let payload_size, consumed = Varint.decode buf (off + 4) in
84
84
let payload_size = Int64.to_int payload_size in
85
85
let max_local = max_local ~usable_size ~is_table:false in
···
89
89
else
90
90
let k = min_local + ((payload_size - min_local) mod (usable_size - 4)) in
91
91
let local = if k <= max_local then k else min_local in
92
-
let overflow = Page.get_u32_be buf (off + 4 + consumed + local) in
92
+
let overflow = Page.u32_be buf (off + 4 + consumed + local) in
93
93
(local, Some overflow)
94
94
in
95
95
let local_payload = String.sub buf (off + 4 + consumed) local_size in
+47
-47
lib/index.ml
+47
-47
lib/index.ml
···
7
7
8
8
type t = { pager : Pager.t; mutable root_page : int }
9
9
10
-
let create pager =
10
+
let v pager =
11
11
let root = Pager.allocate pager in
12
12
let page_size = Pager.page_size pager in
13
-
let buf = Page.init ~page_size ~page_type:Page.Leaf_index in
13
+
let buf = Page.init ~page_size ~kind:Page.Leaf_index in
14
14
Pager.write pager root (Bytes.unsafe_to_string buf);
15
15
{ pager; root_page = root }
16
16
···
27
27
if remaining <= 0 || page_num = 0 then ()
28
28
else begin
29
29
let page = Pager.read pager page_num in
30
-
let next_page = Page.get_u32_be page 0 in
30
+
let next_page = Page.u32_be page 0 in
31
31
let to_read = min remaining overflow_content_size in
32
32
Buffer.add_substring buf page 4 to_read;
33
33
read next_page (remaining - to_read)
···
102
102
103
103
let cell_pointers page header =
104
104
let ptrs = Array.make header.Page.cell_count 0 in
105
-
let ptr_start = Page.header_size header.Page.page_type in
105
+
let ptr_start = Page.header_size header.Page.kind in
106
106
for i = 0 to header.Page.cell_count - 1 do
107
-
ptrs.(i) <- Page.get_u16_be page (ptr_start + (i * 2))
107
+
ptrs.(i) <- Page.u16_be page (ptr_start + (i * 2))
108
108
done;
109
109
ptrs
110
110
111
111
(* Calculate free space in a page *)
112
-
let free_space header ~page_type =
113
-
let header_size = Page.header_size page_type in
112
+
let free_space header ~kind =
113
+
let header_size = Page.header_size kind in
114
114
let ptr_area_end = header_size + (header.Page.cell_count * 2) in
115
115
header.Page.cell_content_start - ptr_area_end - header.Page.fragmented_bytes
116
116
···
169
169
new_start
170
170
171
171
(* Insert a cell pointer at index, shifting others *)
172
-
let insert_cell_pointer buf ~header_offset ~page_type ~cell_count ~index ~ptr =
173
-
let ptr_start = header_offset + Page.header_size page_type in
172
+
let insert_cell_pointer buf ~header_offset ~kind ~cell_count ~index ~ptr =
173
+
let ptr_start = header_offset + Page.header_size kind in
174
174
(* Shift existing pointers right *)
175
175
for i = cell_count - 1 downto index do
176
176
let old_ptr =
177
-
Page.get_u16_be (Bytes.unsafe_to_string buf) (ptr_start + (i * 2))
177
+
Page.u16_be (Bytes.unsafe_to_string buf) (ptr_start + (i * 2))
178
178
in
179
179
Page.set_u16_be buf (ptr_start + ((i + 1) * 2)) old_ptr
180
180
done;
···
200
200
let header = Page.parse_header page 0 in
201
201
let ptrs = cell_pointers page header in
202
202
let usable = usable_size t in
203
-
match header.Page.page_type with
203
+
match header.Page.kind with
204
204
| Page.Leaf_index ->
205
205
let rec search lo hi =
206
206
if lo > hi then false
···
231
231
let mem t key = mem_in_page t t.root_page key
232
232
233
233
(* Find exact key, returns payload *)
234
-
let rec find_in_page t page_num key =
234
+
let rec search_page t page_num key =
235
235
let page = Pager.read t.pager page_num in
236
236
let header = Page.parse_header page 0 in
237
237
let ptrs = cell_pointers page header in
238
238
let usable = usable_size t in
239
-
match header.Page.page_type with
239
+
match header.Page.kind with
240
240
| Page.Leaf_index ->
241
241
let rec search lo hi =
242
242
if lo > hi then None
···
267
267
cell.Cell.left_child
268
268
else find_child_rec (i + 1)
269
269
in
270
-
find_in_page t (find_child_rec 0) key
270
+
search_page t (find_child_rec 0) key
271
271
| _ -> failwith "Invalid page type in index B-tree"
272
272
273
-
let find t key = find_in_page t t.root_page key
273
+
let find t key = search_page t t.root_page key
274
274
275
275
(* Find a key in leaf page, returns (payload, index) if found *)
276
-
let find_in_leaf t page header key =
276
+
let search_leaf t page header key =
277
277
let ptrs = cell_pointers page header in
278
278
let usable = usable_size t in
279
279
let rec search lo hi =
···
291
291
search 0 (header.Page.cell_count - 1)
292
292
293
293
(* Find insertion index for key in leaf page *)
294
-
let find_insert_idx t page header key =
294
+
let insert_idx t page header key =
295
295
let ptrs = cell_pointers page header in
296
296
let usable = usable_size t in
297
297
let rec find i =
···
305
305
find 0
306
306
307
307
(* Find child page for key in interior page *)
308
-
let find_child t page header key =
308
+
let child t page header key =
309
309
let ptrs = cell_pointers page header in
310
310
let usable = usable_size t in
311
311
let rec loop i =
···
324
324
loop 0
325
325
326
326
(* Find child index for key in interior page *)
327
-
let find_child_idx t page header key =
327
+
let child_idx t page header key =
328
328
let ptrs = cell_pointers page header in
329
329
let usable = usable_size t in
330
330
let rec loop i =
···
358
358
359
359
(* Create new right page *)
360
360
let new_page_num = Pager.allocate t.pager in
361
-
let new_buf = Page.init ~page_size ~page_type:Page.Leaf_index in
361
+
let new_buf = Page.init ~page_size ~kind:Page.Leaf_index in
362
362
363
363
(* Copy cells [split_idx..cell_count-1] to new page *)
364
364
let new_cell_content_start = ref page_size in
···
413
413
414
414
(* Create new right page *)
415
415
let new_page_num = Pager.allocate t.pager in
416
-
let new_buf = Page.init ~page_size ~page_type:Page.Interior_index in
416
+
let new_buf = Page.init ~page_size ~kind:Page.Interior_index in
417
417
418
418
(* Cells [split_idx+1..cell_count-1] go to new page *)
419
419
let new_cell_content_start = ref page_size in
···
464
464
let space_needed = cell_len + 2 in
465
465
(* cell + pointer *)
466
466
467
-
if free_space header ~page_type:Page.Interior_index >= space_needed then begin
467
+
if free_space header ~kind:Page.Interior_index >= space_needed then begin
468
468
(* Fits - insert directly *)
469
469
let buf = Bytes.of_string page in
470
470
let ptrs = cell_pointers page header in
···
490
490
Page.set_u16_be buf 5 cell_start;
491
491
492
492
(* Insert pointer *)
493
-
insert_cell_pointer buf ~header_offset:0 ~page_type:Page.Interior_index
493
+
insert_cell_pointer buf ~header_offset:0 ~kind:Page.Interior_index
494
494
~cell_count:header.Page.cell_count ~index:insert_idx ~ptr:cell_start;
495
495
496
496
(* Update cell count *)
···
500
500
if insert_idx < header.Page.cell_count then begin
501
501
let ptr_start = Page.header_size Page.Interior_index in
502
502
let displaced_ptr =
503
-
Page.get_u16_be
503
+
Page.u16_be
504
504
(Bytes.unsafe_to_string buf)
505
505
(ptr_start + ((insert_idx + 1) * 2))
506
506
in
···
538
538
let space_needed = cell_len + 2 in
539
539
(* cell + pointer *)
540
540
541
-
if free_space header ~page_type:Page.Leaf_index >= space_needed then begin
541
+
if free_space header ~kind:Page.Leaf_index >= space_needed then begin
542
542
(* Fits - insert directly *)
543
543
let buf = Bytes.of_string page in
544
-
let insert_idx = find_insert_idx t page header key in
544
+
let insert_idx = insert_idx t page header key in
545
545
546
546
(* Write cell *)
547
547
let cell_start =
···
550
550
Page.set_u16_be buf 5 cell_start;
551
551
552
552
(* Insert pointer *)
553
-
insert_cell_pointer buf ~header_offset:0 ~page_type:Page.Leaf_index
553
+
insert_cell_pointer buf ~header_offset:0 ~kind:Page.Leaf_index
554
554
~cell_count:header.Page.cell_count ~index:insert_idx ~ptr:cell_start;
555
555
556
556
(* Update cell count *)
···
569
569
let target = Pager.read t.pager target_page in
570
570
let target_header = Page.parse_header target 0 in
571
571
let target_buf = Bytes.of_string target in
572
-
let insert_idx = find_insert_idx t target target_header key in
572
+
let insert_idx = insert_idx t target target_header key in
573
573
let cell_start =
574
574
write_cell target_buf
575
575
~cell_content_start:target_header.Page.cell_content_start ~cell
576
576
in
577
577
Page.set_u16_be target_buf 5 cell_start;
578
-
insert_cell_pointer target_buf ~header_offset:0 ~page_type:Page.Leaf_index
578
+
insert_cell_pointer target_buf ~header_offset:0 ~kind:Page.Leaf_index
579
579
~cell_count:target_header.Page.cell_count ~index:insert_idx
580
580
~ptr:cell_start;
581
581
Page.set_u16_be target_buf 3 (target_header.Page.cell_count + 1);
···
592
592
(* Splitting root - create new root *)
593
593
let page_size = Pager.page_size t.pager in
594
594
let new_root = Pager.allocate t.pager in
595
-
let buf = Page.init ~page_size ~page_type:Page.Interior_index in
595
+
let buf = Page.init ~page_size ~kind:Page.Interior_index in
596
596
597
597
(* Single cell pointing to left page *)
598
598
let cell =
···
622
622
let rec traverse page_num parent_stack =
623
623
let page = Pager.read t.pager page_num in
624
624
let header = Page.parse_header page 0 in
625
-
match header.Page.page_type with
625
+
match header.Page.kind with
626
626
| Page.Leaf_index -> (
627
627
(* Check if key already exists *)
628
-
match find_in_leaf t page header key with
628
+
match search_leaf t page header key with
629
629
| Some _ -> () (* Key exists, do nothing (set semantics) *)
630
630
| None -> insert_into_leaf t page_num ~key ~parent_stack)
631
631
| Page.Interior_index ->
632
-
let child_idx = find_child_idx t page header key in
632
+
let child_idx = child_idx t page header key in
633
633
let child_page =
634
634
if child_idx >= header.Page.cell_count then
635
635
Option.get header.Page.right_child
···
658
658
659
659
(* Shift pointers left to remove the entry at index *)
660
660
for i = index to header.Page.cell_count - 2 do
661
-
let next_ptr = Page.get_u16_be page (ptr_start + ((i + 1) * 2)) in
661
+
let next_ptr = Page.u16_be page (ptr_start + ((i + 1) * 2)) in
662
662
Page.set_u16_be buf (ptr_start + (i * 2)) next_ptr
663
663
done;
664
664
···
675
675
let rec traverse page_num =
676
676
let page = Pager.read t.pager page_num in
677
677
let header = Page.parse_header page 0 in
678
-
match header.Page.page_type with
678
+
match header.Page.kind with
679
679
| Page.Leaf_index -> (
680
-
match find_in_leaf t page header key with
680
+
match search_leaf t page header key with
681
681
| Some (_, idx) -> delete_from_leaf t page_num ~index:idx
682
682
| None -> () (* Key not found, nothing to do *))
683
683
| Page.Interior_index ->
684
-
let child = find_child t page header key in
685
-
traverse child
684
+
let c = child t page header key in
685
+
traverse c
686
686
| _ -> failwith "Invalid page type in index B-tree"
687
687
in
688
688
traverse t.root_page
689
689
690
690
(* Find by prefix - returns first entry starting with prefix *)
691
-
let rec find_by_prefix_in_page t page_num prefix =
691
+
let rec prefix_search_page t page_num prefix =
692
692
let page = Pager.read t.pager page_num in
693
693
let header = Page.parse_header page 0 in
694
694
let ptrs = cell_pointers page header in
···
698
698
String.length payload >= prefix_len
699
699
&& String.sub payload 0 prefix_len = prefix
700
700
in
701
-
match header.Page.page_type with
701
+
match header.Page.kind with
702
702
| Page.Leaf_index ->
703
703
(* Linear search for first entry with prefix *)
704
704
let rec find_first i =
···
713
713
in
714
714
find_first 0
715
715
| Page.Interior_index ->
716
-
let child = find_child t page header prefix in
717
-
find_by_prefix_in_page t child prefix
716
+
let c = child t page header prefix in
717
+
prefix_search_page t c prefix
718
718
| _ -> failwith "Invalid page type in index B-tree"
719
719
720
-
let find_by_prefix t prefix = find_by_prefix_in_page t t.root_page prefix
720
+
let by_prefix t prefix = prefix_search_page t t.root_page prefix
721
721
722
722
(* Delete by prefix - deletes first entry starting with prefix *)
723
723
let rec delete_by_prefix_in_page t page_num prefix =
···
730
730
String.length payload >= prefix_len
731
731
&& String.sub payload 0 prefix_len = prefix
732
732
in
733
-
match header.Page.page_type with
733
+
match header.Page.kind with
734
734
| Page.Leaf_index -> (
735
735
(* Find first entry with prefix *)
736
736
let rec find_idx i =
···
747
747
| Some idx -> delete_from_leaf t page_num ~index:idx
748
748
| None -> ())
749
749
| Page.Interior_index ->
750
-
let child = find_child t page header prefix in
751
-
delete_by_prefix_in_page t child prefix
750
+
let c = child t page header prefix in
751
+
delete_by_prefix_in_page t c prefix
752
752
| _ -> failwith "Invalid page type in index B-tree"
753
753
754
754
let delete_by_prefix t prefix = delete_by_prefix_in_page t t.root_page prefix
···
759
759
let header = Page.parse_header page 0 in
760
760
let ptrs = cell_pointers page header in
761
761
let usable = usable_size t in
762
-
match header.Page.page_type with
762
+
match header.Page.kind with
763
763
| Page.Leaf_index ->
764
764
for i = 0 to header.Page.cell_count - 1 do
765
765
let full_payload =
+4
-4
lib/index.mli
+4
-4
lib/index.mli
···
8
8
type t
9
9
(** An index B-tree for string keys. *)
10
10
11
-
val create : Pager.t -> t
12
-
(** [create pager] creates a new empty index B-tree. *)
11
+
val v : Pager.t -> t
12
+
(** [v pager] creates a new empty index B-tree. *)
13
13
14
14
val open_ : Pager.t -> root_page:int -> t
15
15
(** [open_ pager ~root_page] opens an existing index B-tree. *)
···
30
30
val delete : t -> string -> unit
31
31
(** [delete t key] removes a key. *)
32
32
33
-
val find_by_prefix : t -> string -> string option
34
-
(** [find_by_prefix t prefix] finds the first entry starting with [prefix]. *)
33
+
val by_prefix : t -> string -> string option
34
+
(** [by_prefix t prefix] finds the first entry starting with [prefix]. *)
35
35
36
36
val delete_by_prefix : t -> string -> unit
37
37
(** [delete_by_prefix t prefix] deletes the first entry starting with [prefix].
+24
-26
lib/page.ml
+24
-26
lib/page.ml
···
5
5
6
6
(** B-tree page types and header parsing. *)
7
7
8
-
type page_type = Interior_index | Interior_table | Leaf_index | Leaf_table
8
+
type kind = Interior_index | Interior_table | Leaf_index | Leaf_table
9
9
10
-
let pp_page_type ppf = function
10
+
let pp_kind ppf = function
11
11
| Interior_index -> Format.pp_print_string ppf "interior_index"
12
12
| Interior_table -> Format.pp_print_string ppf "interior_table"
13
13
| Leaf_index -> Format.pp_print_string ppf "leaf_index"
14
14
| Leaf_table -> Format.pp_print_string ppf "leaf_table"
15
15
16
-
let page_type_of_byte = function
16
+
let kind_of_byte = function
17
17
| 0x02 -> Interior_index
18
18
| 0x05 -> Interior_table
19
19
| 0x0a -> Leaf_index
20
20
| 0x0d -> Leaf_table
21
-
| b -> failwith (Printf.sprintf "Invalid page type: 0x%02x" b)
21
+
| b -> Fmt.failwith "Invalid page type: 0x%02x" b
22
22
23
-
let byte_of_page_type = function
23
+
let byte_of_kind = function
24
24
| Interior_index -> 0x02
25
25
| Interior_table -> 0x05
26
26
| Leaf_index -> 0x0a
···
35
35
| Leaf_index | Leaf_table -> false
36
36
37
37
type header = {
38
-
page_type : page_type;
38
+
kind : kind;
39
39
first_freeblock : int;
40
40
cell_count : int;
41
41
cell_content_start : int;
···
46
46
47
47
(* Binary helpers *)
48
48
49
-
let get_u16_be buf off = (Char.code buf.[off] lsl 8) lor Char.code buf.[off + 1]
49
+
let u16_be buf off = (Char.code buf.[off] lsl 8) lor Char.code buf.[off + 1]
50
50
51
-
let get_u32_be buf off =
51
+
let u32_be buf off =
52
52
(Char.code buf.[off] lsl 24)
53
53
lor (Char.code buf.[off + 1] lsl 16)
54
54
lor (Char.code buf.[off + 2] lsl 8)
···
65
65
Bytes.set_uint8 buf (off + 3) (v land 0xff)
66
66
67
67
let parse_header buf off =
68
-
let page_type = page_type_of_byte (Char.code buf.[off]) in
69
-
let first_freeblock = get_u16_be buf (off + 1) in
70
-
let cell_count = get_u16_be buf (off + 3) in
68
+
let kind = kind_of_byte (Char.code buf.[off]) in
69
+
let first_freeblock = u16_be buf (off + 1) in
70
+
let cell_count = u16_be buf (off + 3) in
71
71
let cell_content_start =
72
-
let v = get_u16_be buf (off + 5) in
72
+
let v = u16_be buf (off + 5) in
73
73
if v = 0 then 65536 else v
74
74
in
75
75
let fragmented_bytes = Char.code buf.[off + 7] in
76
76
let right_child =
77
-
if is_interior page_type then Some (get_u32_be buf (off + 8)) else None
77
+
if is_interior kind then Some (u32_be buf (off + 8)) else None
78
78
in
79
79
{
80
-
page_type;
80
+
kind;
81
81
first_freeblock;
82
82
cell_count;
83
83
cell_content_start;
···
85
85
right_child;
86
86
}
87
87
88
-
let free_space header ~page_type =
89
-
let hdr_size = header_size page_type in
88
+
let free_space header ~kind =
89
+
let hdr_size = header_size kind in
90
90
let ptr_area_end = hdr_size + (header.cell_count * 2) in
91
91
header.cell_content_start - ptr_area_end - header.fragmented_bytes
92
92
93
-
let init ~page_size ~page_type =
93
+
let init ~page_size ~kind =
94
94
let buf = Bytes.create page_size in
95
-
Bytes.set_uint8 buf 0 (byte_of_page_type page_type);
95
+
Bytes.set_uint8 buf 0 (byte_of_kind kind);
96
96
set_u16_be buf 1 0;
97
97
(* first freeblock *)
98
98
set_u16_be buf 3 0;
···
101
101
(* cell content start *)
102
102
Bytes.set_uint8 buf 7 0;
103
103
(* fragmented bytes *)
104
-
if is_interior page_type then set_u32_be buf 8 0;
104
+
if is_interior kind then set_u32_be buf 8 0;
105
105
(* right child *)
106
106
buf
107
107
···
113
113
114
114
let cell_pointers page header_offset header =
115
115
let ptrs = Array.make header.cell_count 0 in
116
-
let ptr_start = header_offset + header_size header.page_type in
116
+
let ptr_start = header_offset + header_size header.kind in
117
117
for i = 0 to header.cell_count - 1 do
118
-
ptrs.(i) <- get_u16_be page (ptr_start + (i * 2))
118
+
ptrs.(i) <- u16_be page (ptr_start + (i * 2))
119
119
done;
120
120
ptrs
121
121
122
-
let insert_cell_pointer buf ~header_offset ~page_type ~cell_count ~index ~ptr =
123
-
let ptr_start = header_offset + header_size page_type in
122
+
let insert_cell_pointer buf ~header_offset ~kind ~cell_count ~index ~ptr =
123
+
let ptr_start = header_offset + header_size kind in
124
124
(* Shift existing pointers right *)
125
125
for i = cell_count - 1 downto index do
126
-
let old_ptr =
127
-
get_u16_be (Bytes.unsafe_to_string buf) (ptr_start + (i * 2))
128
-
in
126
+
let old_ptr = u16_be (Bytes.unsafe_to_string buf) (ptr_start + (i * 2)) in
129
127
set_u16_be buf (ptr_start + ((i + 1) * 2)) old_ptr
130
128
done;
131
129
set_u16_be buf (ptr_start + (index * 2)) ptr
+15
-15
lib/page.mli
+15
-15
lib/page.mli
···
5
5
6
6
(** B-tree page types and header parsing. *)
7
7
8
-
type page_type =
8
+
type kind =
9
9
| Interior_index (** 0x02 *)
10
10
| Interior_table (** 0x05 *)
11
11
| Leaf_index (** 0x0a *)
12
12
| Leaf_table (** 0x0d *)
13
13
14
-
val pp_page_type : Format.formatter -> page_type -> unit
14
+
val pp_kind : Format.formatter -> kind -> unit
15
15
16
-
val page_type_of_byte : int -> page_type
16
+
val kind_of_byte : int -> kind
17
17
(** Convert byte to page type. *)
18
18
19
-
val byte_of_page_type : page_type -> int
19
+
val byte_of_kind : kind -> int
20
20
(** Convert page type to byte. *)
21
21
22
-
val is_interior : page_type -> bool
22
+
val is_interior : kind -> bool
23
23
(** Check if page type is interior. *)
24
24
25
-
val header_size : page_type -> int
25
+
val header_size : kind -> int
26
26
(** [header_size typ] is 8 for leaf pages, 12 for interior pages. *)
27
27
28
28
type header = {
29
-
page_type : page_type;
29
+
kind : kind;
30
30
first_freeblock : int;
31
31
cell_count : int;
32
32
cell_content_start : int;
···
38
38
val parse_header : string -> int -> header
39
39
(** [parse_header buf off] parses a page header starting at [off]. *)
40
40
41
-
val free_space : header -> page_type:page_type -> int
42
-
(** [free_space header ~page_type] returns the free space in the page. *)
41
+
val free_space : header -> kind:kind -> int
42
+
(** [free_space header ~kind] returns the free space in the page. *)
43
43
44
-
val init : page_size:int -> page_type:page_type -> bytes
45
-
(** [init ~page_size ~page_type] creates a new empty page buffer. *)
44
+
val init : page_size:int -> kind:kind -> bytes
45
+
(** [init ~page_size ~kind] creates a new empty page buffer. *)
46
46
47
47
(** {1 Binary helpers} *)
48
48
49
-
val get_u16_be : string -> int -> int
49
+
val u16_be : string -> int -> int
50
50
51
-
val get_u32_be : string -> int -> int
51
+
val u32_be : string -> int -> int
52
52
(** Read unsigned 32-bit big-endian integer. *)
53
53
54
54
val set_u16_be : bytes -> int -> int -> unit
···
69
69
val insert_cell_pointer :
70
70
bytes ->
71
71
header_offset:int ->
72
-
page_type:page_type ->
72
+
kind:kind ->
73
73
cell_count:int ->
74
74
index:int ->
75
75
ptr:int ->
76
76
unit
77
-
(** [insert_cell_pointer buf ~header_offset ~page_type ~cell_count ~index ~ptr]
77
+
(** [insert_cell_pointer buf ~header_offset ~kind ~cell_count ~index ~ptr]
78
78
inserts a cell pointer at [index], shifting others right. *)
+1
-1
lib/pager.ml
+1
-1
lib/pager.ml
+2
-2
lib/pager.mli
+2
-2
lib/pager.mli
···
8
8
type t
9
9
(** A pager manages page-level I/O with caching. *)
10
10
11
-
val create : page_size:int -> Eio.File.rw_ty Eio.Resource.t -> t
12
-
(** [create ~page_size file] creates a pager with the given page size. *)
11
+
val v : page_size:int -> Eio.File.rw_ty Eio.Resource.t -> t
12
+
(** [v ~page_size file] creates a pager with the given page size. *)
13
13
14
14
val page_size : t -> int
15
15
(** [page_size t] returns the page size. *)
+29
-29
lib/table.ml
+29
-29
lib/table.ml
···
7
7
8
8
type t = { pager : Pager.t; mutable root_page : int }
9
9
10
-
let create pager =
10
+
let v pager =
11
11
let root = Pager.allocate pager in
12
12
let page_size = Pager.page_size pager in
13
-
let buf = Page.init ~page_size ~page_type:Page.Leaf_table in
13
+
let buf = Page.init ~page_size ~kind:Page.Leaf_table in
14
14
Pager.write pager root (Bytes.unsafe_to_string buf);
15
15
{ pager; root_page = root }
16
16
···
19
19
let usable_size t = Pager.page_size t.pager
20
20
21
21
(* Calculate free space in a page *)
22
-
let free_space header ~page_type =
23
-
let header_size = Page.header_size page_type in
22
+
let free_space header ~kind =
23
+
let header_size = Page.header_size kind in
24
24
let ptr_area_end = header_size + (header.Page.cell_count * 2) in
25
25
header.Page.cell_content_start - ptr_area_end - header.Page.fragmented_bytes
26
26
···
59
59
new_start
60
60
61
61
(* Insert a cell pointer at index, shifting others *)
62
-
let insert_cell_pointer buf ~header_offset ~page_type ~cell_count ~index ~ptr =
63
-
let ptr_start = header_offset + Page.header_size page_type in
62
+
let insert_cell_pointer buf ~header_offset ~kind ~cell_count ~index ~ptr =
63
+
let ptr_start = header_offset + Page.header_size kind in
64
64
(* Shift existing pointers right *)
65
65
for i = cell_count - 1 downto index do
66
66
let old_ptr =
67
-
Page.get_u16_be (Bytes.unsafe_to_string buf) (ptr_start + (i * 2))
67
+
Page.u16_be (Bytes.unsafe_to_string buf) (ptr_start + (i * 2))
68
68
in
69
69
Page.set_u16_be buf (ptr_start + ((i + 1) * 2)) old_ptr
70
70
done;
···
86
86
loop 0 (header.Page.cell_count - 1)
87
87
88
88
(* Find insertion index for rowid in leaf page *)
89
-
let find_insert_idx t page header rowid =
89
+
let insert_idx t page header rowid =
90
90
let ptrs = Page.cell_pointers page 0 header in
91
91
let usable = usable_size t in
92
92
let rec find i =
···
99
99
100
100
(* Find child page for rowid in interior page.
101
101
SQLite B-tree: keys < separator go left, keys >= separator go right. *)
102
-
let find_child _t page header rowid =
102
+
let child _t page header rowid =
103
103
let ptrs = Page.cell_pointers page 0 header in
104
104
let rec loop i =
105
105
if i >= header.Page.cell_count then Option.get header.Page.right_child
···
110
110
loop 0
111
111
112
112
(* Find child index for rowid in interior page *)
113
-
let find_child_idx page header rowid =
113
+
let child_idx page header rowid =
114
114
let ptrs = Page.cell_pointers page 0 header in
115
115
let rec loop i =
116
116
if i >= header.Page.cell_count then i (* right child *)
···
120
120
in
121
121
loop 0
122
122
123
-
let rec find_in_page t page_num rowid =
123
+
let rec search_page t page_num rowid =
124
124
let page = Pager.read t.pager page_num in
125
125
let header = Page.parse_header page 0 in
126
-
match header.Page.page_type with
126
+
match header.Page.kind with
127
127
| Page.Leaf_table -> search_leaf t page header rowid
128
128
| Page.Interior_table ->
129
-
let child = find_child t page header rowid in
130
-
find_in_page t child rowid
129
+
let child = child t page header rowid in
130
+
search_page t child rowid
131
131
| _ -> failwith "Invalid page type in table B-tree"
132
132
133
-
let find t rowid = find_in_page t t.root_page rowid
133
+
let find t rowid = search_page t t.root_page rowid
134
134
135
135
(* Split result: new page number and separator rowid *)
136
136
type split_result = { new_page : int; separator_rowid : int64 }
···
154
154
155
155
(* Create new right page *)
156
156
let new_page_num = Pager.allocate t.pager in
157
-
let new_buf = Page.init ~page_size ~page_type:Page.Leaf_table in
157
+
let new_buf = Page.init ~page_size ~kind:Page.Leaf_table in
158
158
159
159
(* Copy cells [split_idx..cell_count-1] to new page *)
160
160
let new_cell_content_start = ref page_size in
···
209
209
210
210
(* Create new right page *)
211
211
let new_page_num = Pager.allocate t.pager in
212
-
let new_buf = Page.init ~page_size ~page_type:Page.Interior_table in
212
+
let new_buf = Page.init ~page_size ~kind:Page.Interior_table in
213
213
214
214
(* The right child of split cell becomes the left-most child of new page *)
215
215
(* Cells [split_idx+1..cell_count-1] go to new page *)
···
261
261
let space_needed = cell_len + 2 in
262
262
(* cell + pointer *)
263
263
264
-
if free_space header ~page_type:Page.Interior_table >= space_needed then begin
264
+
if free_space header ~kind:Page.Interior_table >= space_needed then begin
265
265
(* Fits - insert directly *)
266
266
let buf = Bytes.of_string page in
267
267
let ptrs = Page.cell_pointers page 0 header in
···
284
284
Page.set_u16_be buf 5 cell_start;
285
285
286
286
(* Insert pointer *)
287
-
insert_cell_pointer buf ~header_offset:0 ~page_type:Page.Interior_table
287
+
insert_cell_pointer buf ~header_offset:0 ~kind:Page.Interior_table
288
288
~cell_count:header.Page.cell_count ~index:insert_idx ~ptr:cell_start;
289
289
290
290
(* Update cell count *)
···
297
297
(* Update the displaced cell's left_child to right_child *)
298
298
let ptr_start = Page.header_size Page.Interior_table in
299
299
let displaced_ptr =
300
-
Page.get_u16_be
300
+
Page.u16_be
301
301
(Bytes.unsafe_to_string buf)
302
302
(ptr_start + ((insert_idx + 1) * 2))
303
303
in
···
339
339
let space_needed = cell_len + 2 in
340
340
(* cell + pointer *)
341
341
342
-
if free_space header ~page_type:Page.Leaf_table >= space_needed then begin
342
+
if free_space header ~kind:Page.Leaf_table >= space_needed then begin
343
343
(* Fits - insert directly *)
344
344
let buf = Bytes.of_string page in
345
-
let insert_idx = find_insert_idx t page header rowid in
345
+
let insert_idx = insert_idx t page header rowid in
346
346
347
347
(* Write cell *)
348
348
let cell_start =
···
351
351
Page.set_u16_be buf 5 cell_start;
352
352
353
353
(* Insert pointer *)
354
-
insert_cell_pointer buf ~header_offset:0 ~page_type:Page.Leaf_table
354
+
insert_cell_pointer buf ~header_offset:0 ~kind:Page.Leaf_table
355
355
~cell_count:header.Page.cell_count ~index:insert_idx ~ptr:cell_start;
356
356
357
357
(* Update cell count *)
···
371
371
let target = Pager.read t.pager target_page in
372
372
let target_header = Page.parse_header target 0 in
373
373
let target_buf = Bytes.of_string target in
374
-
let insert_idx = find_insert_idx t target target_header rowid in
374
+
let insert_idx = insert_idx t target target_header rowid in
375
375
let cell_start =
376
376
write_cell target_buf
377
377
~cell_content_start:target_header.Page.cell_content_start ~cell
378
378
in
379
379
Page.set_u16_be target_buf 5 cell_start;
380
-
insert_cell_pointer target_buf ~header_offset:0 ~page_type:Page.Leaf_table
380
+
insert_cell_pointer target_buf ~header_offset:0 ~kind:Page.Leaf_table
381
381
~cell_count:target_header.Page.cell_count ~index:insert_idx
382
382
~ptr:cell_start;
383
383
Page.set_u16_be target_buf 3 (target_header.Page.cell_count + 1);
···
394
394
(* Splitting root - create new root *)
395
395
let page_size = Pager.page_size t.pager in
396
396
let new_root = Pager.allocate t.pager in
397
-
let buf = Page.init ~page_size ~page_type:Page.Interior_table in
397
+
let buf = Page.init ~page_size ~kind:Page.Interior_table in
398
398
399
399
(* Single cell pointing to left page *)
400
400
let cell =
···
424
424
let rec traverse page_num parent_stack =
425
425
let page = Pager.read t.pager page_num in
426
426
let header = Page.parse_header page 0 in
427
-
match header.Page.page_type with
427
+
match header.Page.kind with
428
428
| Page.Leaf_table -> insert_into_leaf t page_num ~rowid ~data ~parent_stack
429
429
| Page.Interior_table ->
430
-
let child_idx = find_child_idx page header rowid in
430
+
let child_idx = child_idx page header rowid in
431
431
let child_page =
432
432
if child_idx >= header.Page.cell_count then
433
433
Option.get header.Page.right_child
···
449
449
let header = Page.parse_header page 0 in
450
450
let ptrs = Page.cell_pointers page 0 header in
451
451
let usable = usable_size t in
452
-
match header.Page.page_type with
452
+
match header.Page.kind with
453
453
| Page.Leaf_table ->
454
454
for i = 0 to header.Page.cell_count - 1 do
455
455
let cell, _ =
+2
-2
lib/table.mli
+2
-2
lib/table.mli
···
8
8
type t
9
9
(** A table B-tree keyed by rowid. *)
10
10
11
-
val create : Pager.t -> t
12
-
(** [create pager] creates a new empty table B-tree. *)
11
+
val v : Pager.t -> t
12
+
(** [v pager] creates a new empty table B-tree. *)
13
13
14
14
val open_ : Pager.t -> root_page:int -> t
15
15
(** [open_ pager ~root_page] opens an existing table B-tree. *)
+21
-21
test/test_btree.ml
+21
-21
test/test_btree.ml
···
146
146
Eio_main.run @@ fun env ->
147
147
let cwd = Eio.Stdenv.cwd env in
148
148
let tmp_dir = Eio.Path.(cwd / "_build" / "test_btree") in
149
-
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with _ -> ());
149
+
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ());
150
150
let path =
151
151
Eio.Path.(tmp_dir / Printf.sprintf "test_%d.db" (Random.int 1_000_000))
152
152
in
···
155
155
156
156
let test_table_create () =
157
157
with_temp_file @@ fun file ->
158
-
let pager = Btree.Pager.create ~page_size:4096 file in
159
-
let tree = Btree.Table.create pager in
158
+
let pager = Btree.Pager.v ~page_size:4096 file in
159
+
let tree = Btree.Table.v pager in
160
160
Alcotest.(check int) "root page" 1 (Btree.Table.root_page tree)
161
161
162
162
let test_table_insert_find () =
163
163
with_temp_file @@ fun file ->
164
-
let pager = Btree.Pager.create ~page_size:4096 file in
165
-
let tree = Btree.Table.create pager in
164
+
let pager = Btree.Pager.v ~page_size:4096 file in
165
+
let tree = Btree.Table.v pager in
166
166
Btree.Table.insert tree ~rowid:1L "Hello";
167
167
let result = Btree.Table.find tree 1L in
168
168
Alcotest.(check (option string)) "found" (Some "Hello") result
169
169
170
170
let test_table_multiple_inserts () =
171
171
with_temp_file @@ fun file ->
172
-
let pager = Btree.Pager.create ~page_size:4096 file in
173
-
let tree = Btree.Table.create pager in
172
+
let pager = Btree.Pager.v ~page_size:4096 file in
173
+
let tree = Btree.Table.v pager in
174
174
Btree.Table.insert tree ~rowid:3L "Three";
175
175
Btree.Table.insert tree ~rowid:1L "One";
176
176
Btree.Table.insert tree ~rowid:2L "Two";
···
184
184
185
185
let test_table_iter () =
186
186
with_temp_file @@ fun file ->
187
-
let pager = Btree.Pager.create ~page_size:4096 file in
188
-
let tree = Btree.Table.create pager in
187
+
let pager = Btree.Pager.v ~page_size:4096 file in
188
+
let tree = Btree.Table.v pager in
189
189
Btree.Table.insert tree ~rowid:1L "A";
190
190
Btree.Table.insert tree ~rowid:2L "B";
191
191
Btree.Table.insert tree ~rowid:3L "C";
···
202
202
let test_leaf_split () =
203
203
(* Use small page size to trigger splits quickly *)
204
204
with_temp_file @@ fun file ->
205
-
let pager = Btree.Pager.create ~page_size:512 file in
206
-
let tree = Btree.Table.create pager in
205
+
let pager = Btree.Pager.v ~page_size:512 file in
206
+
let tree = Btree.Table.v pager in
207
207
(* Insert enough records to trigger a split *)
208
208
(* With 512 byte pages, ~20-30 small records should trigger a split *)
209
209
for i = 1 to 50 do
···
226
226
let test_multi_level_tree () =
227
227
(* Force multiple levels by inserting many records *)
228
228
with_temp_file @@ fun file ->
229
-
let pager = Btree.Pager.create ~page_size:512 file in
230
-
let tree = Btree.Table.create pager in
229
+
let pager = Btree.Pager.v ~page_size:512 file in
230
+
let tree = Btree.Table.v pager in
231
231
let n = 200 in
232
232
for i = 1 to n do
233
233
Btree.Table.insert tree ~rowid:(Int64.of_int i) (Printf.sprintf "v%d" i)
···
247
247
let test_reverse_insert_order () =
248
248
(* Insert in reverse order to stress different split patterns *)
249
249
with_temp_file @@ fun file ->
250
-
let pager = Btree.Pager.create ~page_size:512 file in
251
-
let tree = Btree.Table.create pager in
250
+
let pager = Btree.Pager.v ~page_size:512 file in
251
+
let tree = Btree.Table.v pager in
252
252
for i = 100 downto 1 do
253
253
Btree.Table.insert tree ~rowid:(Int64.of_int i) (Printf.sprintf "r%d" i)
254
254
done;
···
263
263
let test_random_insert_order () =
264
264
(* Pseudo-random insertion order *)
265
265
with_temp_file @@ fun file ->
266
-
let pager = Btree.Pager.create ~page_size:512 file in
267
-
let tree = Btree.Table.create pager in
266
+
let pager = Btree.Pager.v ~page_size:512 file in
267
+
let tree = Btree.Table.v pager in
268
268
(* LCG for deterministic "random" order *)
269
269
let shuffle n =
270
270
let a = Array.init n (fun i -> i + 1) in
···
294
294
let test_large_values () =
295
295
(* Test with larger values that take more space *)
296
296
with_temp_file @@ fun file ->
297
-
let pager = Btree.Pager.create ~page_size:1024 file in
298
-
let tree = Btree.Table.create pager in
297
+
let pager = Btree.Pager.v ~page_size:1024 file in
298
+
let tree = Btree.Table.v pager in
299
299
for i = 1 to 30 do
300
300
let data = String.make 50 (Char.chr (65 + (i mod 26))) in
301
301
Btree.Table.insert tree ~rowid:(Int64.of_int i) data
···
382
382
let test_iter_order_after_splits () =
383
383
(* Verify iteration order is correct after splits *)
384
384
with_temp_file @@ fun file ->
385
-
let pager = Btree.Pager.create ~page_size:512 file in
386
-
let tree = Btree.Table.create pager in
385
+
let pager = Btree.Pager.v ~page_size:512 file in
386
+
let tree = Btree.Table.v pager in
387
387
let n = 100 in
388
388
for i = 1 to n do
389
389
Btree.Table.insert tree ~rowid:(Int64.of_int i) (string_of_int i)