Merge commit '837a470995369419f7d48edfe1135f38ae5a1e2d' as 'ocaml-btree'

.gitignore

···
+# OCaml build artifacts
+_build/
+*.install
+*.merlin
+
+# Dune package management
+dune.lock/
+
+# Editor and OS files
+.DS_Store
+*.swp
+*~
+.vscode/
+.idea/
+
+# Opam local switch
+_opam/

.ocamlformat

···
+version=0.27.0

LICENSE.md

···
+MIT License
+
+Copyright (c) 2025 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.

README.md

···
+# btree
+
+Pure OCaml B-tree implementation for persistent storage.
+
+## Overview
+
+A B-tree implementation supporting SQLite-compatible page-based storage:
+
+- **Table B-trees**: 64-bit integer keys with data in leaves
+- **Index B-trees**: Arbitrary keys, no data (for secondary indexes)
+- **Page-based**: Interior and leaf pages with configurable size
+- **Overflow support**: Large records span multiple pages
+
+## Installation
+
+```
+opam install btree
+```
+
+## Usage
+
+```ocaml
+(* Create a pager backed by a file *)
+let pager = Btree.Pager.create ~page_size:4096 file in
+
+(* Create a table B-tree *)
+let tree = Btree.Table.create pager in
+
+(* Insert records *)
+Btree.Table.insert tree ~rowid:1L "Hello";
+Btree.Table.insert tree ~rowid:2L "World";
+
+(* Lookup *)
+let data = Btree.Table.find tree 1L in  (* Some "Hello" *)
+
+(* Iterate *)
+Btree.Table.iter tree (fun rowid data ->
+  Printf.printf "%Ld: %s\n" rowid data)
+```
+
+## API
+
+### Pager
+
+The pager manages page I/O and caching:
+
+- `Pager.create ~page_size file` - Create pager with given page size
+- `Pager.read pager page_num` - Read a page
+- `Pager.write pager page_num data` - Write a page
+- `Pager.allocate pager` - Allocate a new page
+- `Pager.free pager page_num` - Free a page
+- `Pager.sync pager` - Sync to disk
+
+### Table B-tree
+
+For rowid-keyed tables (like SQLite tables):
+
+- `Table.create pager` - Create a new table B-tree
+- `Table.open_ pager root_page` - Open existing table
+- `Table.insert tree ~rowid data` - Insert a record
+- `Table.find tree rowid` - Find by rowid
+- `Table.delete tree rowid` - Delete by rowid
+- `Table.iter tree f` - Iterate all records
+
+### Index B-tree
+
+For arbitrary keys (like SQLite indexes):
+
+- `Index.create pager` - Create a new index B-tree
+- `Index.insert tree key` - Insert a key
+- `Index.mem tree key` - Check if key exists
+- `Index.delete tree key` - Delete a key
+- `Index.iter tree f` - Iterate all keys
+
+## Page Format
+
+Following SQLite's B-tree page format:
+
+### Page Header
+
+| Offset | Size | Description |
+|--------|------|-------------|
+| 0 | 1 | Page type (0x02, 0x05, 0x0a, 0x0d) |
+| 1 | 2 | First freeblock offset |
+| 3 | 2 | Number of cells |
+| 5 | 2 | Cell content area start |
+| 7 | 1 | Fragmented free bytes |
+| 8 | 4 | Right-most child (interior only) |
+
+### Page Types
+
+- `0x02` - Interior index page
+- `0x05` - Interior table page
+- `0x0a` - Leaf index page
+- `0x0d` - Leaf table page
+
+## Related Work
+
+- [SQLite](https://www.sqlite.org/fileformat.html) - Reference B-tree implementation
+- [Limbo](https://github.com/tursodatabase/limbo) - Rust SQLite implementation
+- [ocaml-btree (ctk21)](https://github.com/ctk21/ocaml-btree) - In-memory B-tree
+
+## License
+
+MIT License. See [LICENSE.md](LICENSE.md) for details.

dune-project

···
+(lang dune 3.0)
+
+(name btree)
+
+(generate_opam_files true)
+
+(license MIT)
+(authors "Thomas Gazagnaire")
+(maintainers "Thomas Gazagnaire")
+(source (uri https://tangled.org/gazagnaire.org/ocaml-btree))
+
+(package
+ (name btree)
+ (synopsis "Pure OCaml B-tree implementation for persistent storage")
+ (description
+  "A B-tree implementation supporting both table B-trees (integer keys with data) and index B-trees (arbitrary keys). Designed for SQLite-compatible persistent storage with page-based I/O.")
+ (depends
+  (ocaml (>= 5.1))
+  (eio (>= 1.0))
+  cstruct
+  (alcotest :with-test)
+  (eio_main :with-test)))

lib/btree.ml

···
+(*---------------------------------------------------------------------------
+   Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
+   SPDX-License-Identifier: MIT
+  ---------------------------------------------------------------------------*)
+
+(* Varint encoding - SQLite style *)
+module Varint = struct
+  let decode buf off =
+    let rec loop acc shift i =
+      if i >= String.length buf then (acc, i - off)
+      else
+        let byte = Char.code buf.[i] in
+        let value = Int64.of_int (byte land 0x7f) in
+        let acc = Int64.logor acc (Int64.shift_left value shift) in
+        if byte land 0x80 = 0 then (acc, i - off + 1)
+        else if shift >= 56 then
+          (* 9th byte - use all 8 bits *)
+          let byte9 = Char.code buf.[i + 1] in
+          let acc = Int64.logor acc (Int64.shift_left (Int64.of_int byte9) 56) in
+          (acc, i - off + 2)
+        else loop acc (shift + 7) (i + 1)
+    in
+    loop 0L 0 off
+
+  let size n =
+    if n < 0L then 9
+    else if n < 128L then 1
+    else if n < 16384L then 2
+    else if n < 2097152L then 3
+    else if n < 268435456L then 4
+    else if n < 34359738368L then 5
+    else if n < 4398046511104L then 6
+    else if n < 562949953421312L then 7
+    else if n < 72057594037927936L then 8
+    else 9
+
+  let encode n =
+    let sz = size n in
+    let buf = Bytes.create sz in
+    let rec loop n i =
+      if i = sz - 1 then Bytes.set_uint8 buf i (Int64.to_int n land 0x7f)
+      else begin
+        Bytes.set_uint8 buf i (Int64.to_int n land 0x7f lor 0x80);
+        loop (Int64.shift_right_logical n 7) (i + 1)
+      end
+    in
+    loop n 0;
+    Bytes.unsafe_to_string buf
+end
+
+(* Page types *)
+type page_type =
+  | Interior_index
+  | Interior_table
+  | Leaf_index
+  | Leaf_table
+
+let pp_page_type ppf = function
+  | Interior_index -> Format.pp_print_string ppf "interior_index"
+  | Interior_table -> Format.pp_print_string ppf "interior_table"
+  | Leaf_index -> Format.pp_print_string ppf "leaf_index"
+  | Leaf_table -> Format.pp_print_string ppf "leaf_table"
+
+let page_type_of_byte = function
+  | 0x02 -> Interior_index
+  | 0x05 -> Interior_table
+  | 0x0a -> Leaf_index
+  | 0x0d -> Leaf_table
+  | b -> failwith (Printf.sprintf "Invalid page type: 0x%02x" b)
+
+let byte_of_page_type = function
+  | Interior_index -> 0x02
+  | Interior_table -> 0x05
+  | Leaf_index -> 0x0a
+  | Leaf_table -> 0x0d
+
+let page_header_size = function
+  | Interior_index | Interior_table -> 12
+  | Leaf_index | Leaf_table -> 8
+
+let is_interior = function
+  | Interior_index | Interior_table -> true
+  | Leaf_index | Leaf_table -> false
+
+(* Page header *)
+type page_header = {
+  page_type : page_type;
+  first_freeblock : int;
+  cell_count : int;
+  cell_content_start : int;
+  fragmented_bytes : int;
+  right_child : int option;
+}
+
+let get_u16_be buf off =
+  (Char.code buf.[off] lsl 8) lor Char.code buf.[off + 1]
+
+let get_u32_be buf off =
+  (Char.code buf.[off] lsl 24)
+  lor (Char.code buf.[off + 1] lsl 16)
+  lor (Char.code buf.[off + 2] lsl 8)
+  lor Char.code buf.[off + 3]
+
+let set_u16_be buf off v =
+  Bytes.set_uint8 buf off (v lsr 8);
+  Bytes.set_uint8 buf (off + 1) (v land 0xff)
+
+let set_u32_be buf off v =
+  Bytes.set_uint8 buf off (v lsr 24);
+  Bytes.set_uint8 buf (off + 1) ((v lsr 16) land 0xff);
+  Bytes.set_uint8 buf (off + 2) ((v lsr 8) land 0xff);
+  Bytes.set_uint8 buf (off + 3) (v land 0xff)
+
+let parse_page_header buf off =
+  let page_type = page_type_of_byte (Char.code buf.[off]) in
+  let first_freeblock = get_u16_be buf (off + 1) in
+  let cell_count = get_u16_be buf (off + 3) in
+  let cell_content_start =
+    let v = get_u16_be buf (off + 5) in
+    if v = 0 then 65536 else v
+  in
+  let fragmented_bytes = Char.code buf.[off + 7] in
+  let right_child =
+    if is_interior page_type then Some (get_u32_be buf (off + 8)) else None
+  in
+  {
+    page_type;
+    first_freeblock;
+    cell_count;
+    cell_content_start;
+    fragmented_bytes;
+    right_child;
+  }
+
+(* Cells *)
+module Cell = struct
+  type table_leaf = {
+    rowid : int64;
+    payload : string;
+    overflow_page : int option;
+  }
+
+  type table_interior = { left_child : int; rowid : int64 }
+
+  type index_leaf = { payload : string; overflow_page : int option }
+
+  type index_interior = {
+    left_child : int;
+    payload : string;
+    overflow_page : int option;
+  }
+
+  (* Calculate max payload on page - simplified *)
+  let max_local ~usable_size ~is_table =
+    if is_table then usable_size - 35 else ((usable_size - 12) * 64 / 255) - 23
+
+  let min_local ~usable_size =
+    ((usable_size - 12) * 32 / 255) - 23
+
+  let parse_table_leaf buf off ~usable_size =
+    let payload_size, consumed1 = Varint.decode buf off in
+    let rowid, consumed2 = Varint.decode buf (off + consumed1) in
+    let header_len = consumed1 + consumed2 in
+    let payload_size = Int64.to_int payload_size in
+    let max_local = max_local ~usable_size ~is_table:true in
+    let min_local = min_local ~usable_size in
+    let local_size, overflow_page =
+      if payload_size <= max_local then (payload_size, None)
+      else
+        let k = min_local + ((payload_size - min_local) mod (usable_size - 4)) in
+        let local = if k <= max_local then k else min_local in
+        let overflow = get_u32_be buf (off + header_len + local) in
+        (local, Some overflow)
+    in
+    let payload = String.sub buf (off + header_len) local_size in
+    let total_consumed =
+      header_len + local_size + (if overflow_page = None then 0 else 4)
+    in
+    ({ rowid; payload; overflow_page }, total_consumed)
+
+  let parse_table_interior buf off =
+    let left_child = get_u32_be buf off in
+    let rowid, consumed = Varint.decode buf (off + 4) in
+    ({ left_child; rowid }, 4 + consumed)
+
+  let parse_index_leaf buf off ~usable_size =
+    let payload_size, consumed = Varint.decode buf off in
+    let payload_size = Int64.to_int payload_size in
+    let max_local = max_local ~usable_size ~is_table:false in
+    let min_local = min_local ~usable_size in
+    let local_size, overflow_page =
+      if payload_size <= max_local then (payload_size, None)
+      else
+        let k = min_local + ((payload_size - min_local) mod (usable_size - 4)) in
+        let local = if k <= max_local then k else min_local in
+        let overflow = get_u32_be buf (off + consumed + local) in
+        (local, Some overflow)
+    in
+    let payload = String.sub buf (off + consumed) local_size in
+    let total = consumed + local_size + (if overflow_page = None then 0 else 4) in
+    ({ payload; overflow_page }, total)
+
+  let parse_index_interior buf off ~usable_size =
+    let left_child = get_u32_be buf off in
+    let payload_size, consumed = Varint.decode buf (off + 4) in
+    let payload_size = Int64.to_int payload_size in
+    let max_local = max_local ~usable_size ~is_table:false in
+    let min_local = min_local ~usable_size in
+    let local_size, overflow_page =
+      if payload_size <= max_local then (payload_size, None)
+      else
+        let k = min_local + ((payload_size - min_local) mod (usable_size - 4)) in
+        let local = if k <= max_local then k else min_local in
+        let overflow = get_u32_be buf (off + 4 + consumed + local) in
+        (local, Some overflow)
+    in
+    let payload = String.sub buf (off + 4 + consumed) local_size in
+    let total =
+      4 + consumed + local_size + (if overflow_page = None then 0 else 4)
+    in
+    ({ left_child; payload; overflow_page }, total)
+end
+
+(* Record format *)
+module Record = struct
+  type serial_type =
+    | Null
+    | Int8
+    | Int16
+    | Int24
+    | Int32
+    | Int48
+    | Int64
+    | Float64
+    | Zero
+    | One
+    | Blob of int
+    | Text of int
+
+  type value = Vnull | Vint of int64 | Vfloat of float | Vblob of string | Vtext of string
+
+  let serial_type_of_int = function
+    | 0 -> Null
+    | 1 -> Int8
+    | 2 -> Int16
+    | 3 -> Int24
+    | 4 -> Int32
+    | 5 -> Int48
+    | 6 -> Int64
+    | 7 -> Float64
+    | 8 -> Zero
+    | 9 -> One
+    | n when n >= 12 && n mod 2 = 0 -> Blob ((n - 12) / 2)
+    | n when n >= 13 -> Text ((n - 13) / 2)
+    | n -> failwith (Printf.sprintf "Invalid serial type: %d" n)
+
+  let serial_type_size = function
+    | Null | Zero | One -> 0
+    | Int8 -> 1
+    | Int16 -> 2
+    | Int24 -> 3
+    | Int32 -> 4
+    | Int48 -> 6
+    | Int64 | Float64 -> 8
+    | Blob n | Text n -> n
+
+  let decode_int buf off len =
+    let rec loop acc i =
+      if i >= len then acc
+      else
+        let b = Char.code buf.[off + i] in
+        let acc = Int64.logor (Int64.shift_left acc 8) (Int64.of_int b) in
+        loop acc (i + 1)
+    in
+    (* Sign extend for negative values *)
+    let v = loop 0L 0 in
+    if len > 0 && Char.code buf.[off] land 0x80 <> 0 then
+      let mask = Int64.shift_left (-1L) (len * 8) in
+      Int64.logor v mask
+    else v
+
+  let decode payload =
+    let header_size, consumed = Varint.decode payload 0 in
+    let header_size = Int64.to_int header_size in
+    (* Parse serial types *)
+    let rec parse_types off acc =
+      if off >= header_size then List.rev acc
+      else
+        let st, consumed = Varint.decode payload off in
+        let st = serial_type_of_int (Int64.to_int st) in
+        parse_types (off + consumed) (st :: acc)
+    in
+    let types = parse_types consumed [] in
+    (* Parse values *)
+    let rec parse_values types off acc =
+      match types with
+      | [] -> List.rev acc
+      | st :: rest ->
+          let value, sz =
+            match st with
+            | Null -> (Vnull, 0)
+            | Zero -> (Vint 0L, 0)
+            | One -> (Vint 1L, 0)
+            | Int8 -> (Vint (decode_int payload off 1), 1)
+            | Int16 -> (Vint (decode_int payload off 2), 2)
+            | Int24 -> (Vint (decode_int payload off 3), 3)
+            | Int32 -> (Vint (decode_int payload off 4), 4)
+            | Int48 -> (Vint (decode_int payload off 6), 6)
+            | Int64 -> (Vint (decode_int payload off 8), 8)
+            | Float64 ->
+                let bits = decode_int payload off 8 in
+                (Vfloat (Int64.float_of_bits bits), 8)
+            | Blob n -> (Vblob (String.sub payload off n), n)
+            | Text n -> (Vtext (String.sub payload off n), n)
+          in
+          parse_values rest (off + sz) (value :: acc)
+    in
+    parse_values types header_size []
+
+  let serial_type_of_value = function
+    | Vnull -> (0, 0)
+    | Vint 0L -> (8, 0)
+    | Vint 1L -> (9, 0)
+    | Vint n ->
+        if n >= -128L && n <= 127L then (1, 1)
+        else if n >= -32768L && n <= 32767L then (2, 2)
+        else if n >= -8388608L && n <= 8388607L then (3, 3)
+        else if n >= -2147483648L && n <= 2147483647L then (4, 4)
+        else if n >= -140737488355328L && n <= 140737488355327L then (5, 6)
+        else (6, 8)
+    | Vfloat _ -> (7, 8)
+    | Vblob s -> (12 + String.length s * 2, String.length s)
+    | Vtext s -> (13 + String.length s * 2, String.length s)
+
+  let encode_int buf off n len =
+    for i = 0 to len - 1 do
+      let shift = (len - 1 - i) * 8 in
+      Bytes.set_uint8 buf (off + i)
+        (Int64.to_int (Int64.shift_right n shift) land 0xff)
+    done
+
+  let encode values =
+    (* Calculate header *)
+    let types_and_sizes = List.map serial_type_of_value values in
+    let header_types =
+      List.map (fun (st, _) -> Varint.encode (Int64.of_int st)) types_and_sizes
+    in
+    let header_body = String.concat "" header_types in
+    let header_size = 1 + String.length header_body in
+    (* header size varint + types *)
+    let body_size = List.fold_left (fun acc (_, sz) -> acc + sz) 0 types_and_sizes in
+    let total = header_size + body_size in
+    let buf = Bytes.create total in
+    (* Write header size *)
+    Bytes.set_uint8 buf 0 header_size;
+    (* Write serial types *)
+    let _ =
+      List.fold_left
+        (fun off s ->
+          Bytes.blit_string s 0 buf off (String.length s);
+          off + String.length s)
+        1 header_types
+    in
+    (* Write values *)
+    let _ =
+      List.fold_left2
+        (fun off value (_, sz) ->
+          (match value with
+          | Vnull | Vint 0L | Vint 1L -> ()
+          | Vint n -> encode_int buf off n sz
+          | Vfloat f -> encode_int buf off (Int64.bits_of_float f) 8
+          | Vblob s | Vtext s -> Bytes.blit_string s 0 buf off sz);
+          off + sz)
+        header_size values types_and_sizes
+    in
+    Bytes.unsafe_to_string buf
+
+  let pp_value ppf = function
+    | Vnull -> Format.pp_print_string ppf "NULL"
+    | Vint n -> Format.fprintf ppf "%Ld" n
+    | Vfloat f -> Format.fprintf ppf "%f" f
+    | Vblob s -> Format.fprintf ppf "BLOB(%d)" (String.length s)
+    | Vtext s -> Format.fprintf ppf "%S" s
+end
+
+(* Pager *)
+module Pager = struct
+  type t = {
+    file : Eio.File.rw_ty Eio.Resource.t;
+    page_size : int;
+    mutable page_count : int;
+    cache : (int, string) Hashtbl.t;
+    dirty : (int, string) Hashtbl.t;
+  }
+
+  let create ~page_size file =
+    let stat = Eio.File.stat file in
+    let file_size = Optint.Int63.to_int stat.size in
+    let page_count = if file_size = 0 then 0 else file_size / page_size in
+    {
+      file;
+      page_size;
+      page_count;
+      cache = Hashtbl.create 64;
+      dirty = Hashtbl.create 16;
+    }
+
+  let page_size t = t.page_size
+  let page_count t = t.page_count
+
+  let read t page_num =
+    if page_num < 1 || page_num > t.page_count then
+      failwith (Printf.sprintf "Invalid page number: %d" page_num);
+    match Hashtbl.find_opt t.dirty page_num with
+    | Some data -> data
+    | None -> (
+        match Hashtbl.find_opt t.cache page_num with
+        | Some data -> data
+        | None ->
+            let offset = Optint.Int63.of_int ((page_num - 1) * t.page_size) in
+            let buf = Cstruct.create t.page_size in
+            Eio.File.pread_exact t.file ~file_offset:offset [ buf ];
+            let data = Cstruct.to_string buf in
+            Hashtbl.replace t.cache page_num data;
+            data)
+
+  let write t page_num data =
+    if String.length data <> t.page_size then
+      failwith "Invalid page size";
+    Hashtbl.replace t.dirty page_num data;
+    Hashtbl.replace t.cache page_num data
+
+  let allocate t =
+    t.page_count <- t.page_count + 1;
+    let data = String.make t.page_size '\x00' in
+    Hashtbl.replace t.dirty t.page_count data;
+    Hashtbl.replace t.cache t.page_count data;
+    t.page_count
+
+  let sync t =
+    Hashtbl.iter
+      (fun page_num data ->
+        let offset = Optint.Int63.of_int ((page_num - 1) * t.page_size) in
+        let buf = Cstruct.of_string data in
+        Eio.File.pwrite_all t.file ~file_offset:offset [ buf ])
+      t.dirty;
+    Hashtbl.clear t.dirty
+end
+
+(* Table B-tree *)
+module Table = struct
+  type t = { pager : Pager.t; mutable root_page : int }
+
+  let create pager =
+    let root = Pager.allocate pager in
+    (* Initialize as empty leaf page *)
+    let page_size = Pager.page_size pager in
+    let buf = Bytes.create page_size in
+    Bytes.set_uint8 buf 0 (byte_of_page_type Leaf_table);
+    set_u16_be buf 1 0;
+    (* first freeblock *)
+    set_u16_be buf 3 0;
+    (* cell count *)
+    set_u16_be buf 5 page_size;
+    (* cell content start *)
+    Bytes.set_uint8 buf 7 0;
+    (* fragmented bytes *)
+    Pager.write pager root (Bytes.unsafe_to_string buf);
+    { pager; root_page = root }
+
+  let open_ pager ~root_page = { pager; root_page }
+  let root_page t = t.root_page
+
+  let usable_size t = Pager.page_size t.pager
+
+  (* Find cell pointers in a page *)
+  let cell_pointers page header_offset header =
+    let ptrs = Array.make header.cell_count 0 in
+    let ptr_start = header_offset + page_header_size header.page_type in
+    for i = 0 to header.cell_count - 1 do
+      ptrs.(i) <- get_u16_be page (ptr_start + i * 2)
+    done;
+    ptrs
+
+  (* Binary search for rowid in leaf page *)
+  let search_leaf t page header rowid =
+    let ptrs = cell_pointers page 0 header in
+    let usable = usable_size t in
+    let rec loop lo hi =
+      if lo > hi then None
+      else
+        let mid = (lo + hi) / 2 in
+        let cell, _ = Cell.parse_table_leaf page ptrs.(mid) ~usable_size:usable in
+        if cell.rowid = rowid then Some cell.payload
+        else if cell.rowid < rowid then loop (mid + 1) hi
+        else loop lo (mid - 1)
+    in
+    loop 0 (header.cell_count - 1)
+
+  (* Find child page for rowid in interior page *)
+  let find_child t page header rowid =
+    let ptrs = cell_pointers page 0 header in
+    let rec loop i =
+      if i >= header.cell_count then Option.get header.right_child
+      else
+        let cell, _ = Cell.parse_table_interior page ptrs.(i) in
+        if rowid <= cell.rowid then cell.left_child else loop (i + 1)
+    in
+    loop 0
+
+  let rec find_in_page t page_num rowid =
+    let page = Pager.read t.pager page_num in
+    let header = parse_page_header page 0 in
+    match header.page_type with
+    | Leaf_table -> search_leaf t page header rowid
+    | Interior_table ->
+        let child = find_child t page header rowid in
+        find_in_page t child rowid
+    | _ -> failwith "Invalid page type in table B-tree"
+
+  let find t rowid = find_in_page t t.root_page rowid
+
+  (* Insert - simplified, doesn't handle page splits *)
+  let insert t ~rowid data =
+    let page = Pager.read t.pager t.root_page in
+    let header = parse_page_header page 0 in
+    match header.page_type with
+    | Leaf_table ->
+        let page_size = Pager.page_size t.pager in
+        let buf = Bytes.of_string page in
+        (* Create cell *)
+        let rowid_varint = Varint.encode rowid in
+        let payload_size_varint = Varint.encode (Int64.of_int (String.length data)) in
+        let cell_size =
+          String.length payload_size_varint + String.length rowid_varint + String.length data
+        in
+        (* Find insertion point *)
+        let ptrs = cell_pointers page 0 header in
+        let usable = usable_size t in
+        let insert_idx =
+          let rec find i =
+            if i >= header.cell_count then i
+            else
+              let cell, _ = Cell.parse_table_leaf page ptrs.(i) ~usable_size:usable in
+              if rowid < cell.rowid then i else find (i + 1)
+          in
+          find 0
+        in
+        (* Write cell at end of cell content area *)
+        let cell_start = header.cell_content_start - cell_size in
+        Bytes.blit_string payload_size_varint 0 buf cell_start
+          (String.length payload_size_varint);
+        let off = cell_start + String.length payload_size_varint in
+        Bytes.blit_string rowid_varint 0 buf off (String.length rowid_varint);
+        let off = off + String.length rowid_varint in
+        Bytes.blit_string data 0 buf off (String.length data);
+        (* Update cell content start *)
+        set_u16_be buf 5 cell_start;
+        (* Insert cell pointer *)
+        let ptr_area_start = page_header_size Leaf_table in
+        (* Shift existing pointers *)
+        for i = header.cell_count - 1 downto insert_idx do
+          set_u16_be buf (ptr_area_start + (i + 1) * 2) (get_u16_be page (ptr_area_start + i * 2))
+        done;
+        set_u16_be buf (ptr_area_start + insert_idx * 2) cell_start;
+        (* Update cell count *)
+        set_u16_be buf 3 (header.cell_count + 1);
+        Pager.write t.pager t.root_page (Bytes.unsafe_to_string buf)
+    | _ -> failwith "Insert into interior page not yet implemented"
+
+  let delete _t _rowid = failwith "Delete not yet implemented"
+
+  let iter t f =
+    let rec iter_page page_num =
+      let page = Pager.read t.pager page_num in
+      let header = parse_page_header page 0 in
+      let ptrs = cell_pointers page 0 header in
+      let usable = usable_size t in
+      match header.page_type with
+      | Leaf_table ->
+          for i = 0 to header.cell_count - 1 do
+            let cell, _ = Cell.parse_table_leaf page ptrs.(i) ~usable_size:usable in
+            f cell.rowid cell.payload
+          done
+      | Interior_table ->
+          for i = 0 to header.cell_count - 1 do
+            let cell, _ = Cell.parse_table_interior page ptrs.(i) in
+            iter_page cell.left_child
+          done;
+          Option.iter iter_page header.right_child
+      | _ -> failwith "Invalid page type"
+    in
+    iter_page t.root_page
+
+  let fold t ~init ~f =
+    let acc = ref init in
+    iter t (fun rowid data -> acc := f rowid data !acc);
+    !acc
+end
+
+(* Index B-tree *)
+module Index = struct
+  type t = { pager : Pager.t; mutable root_page : int }
+
+  let create pager =
+    let root = Pager.allocate pager in
+    let page_size = Pager.page_size pager in
+    let buf = Bytes.create page_size in
+    Bytes.set_uint8 buf 0 (byte_of_page_type Leaf_index);
+    set_u16_be buf 1 0;
+    set_u16_be buf 3 0;
+    set_u16_be buf 5 page_size;
+    Bytes.set_uint8 buf 7 0;
+    Pager.write pager root (Bytes.unsafe_to_string buf);
+    { pager; root_page = root }
+
+  let open_ pager ~root_page = { pager; root_page }
+  let root_page t = t.root_page
+
+  let usable_size t = Pager.page_size t.pager
+
+  let cell_pointers page header =
+    let ptrs = Array.make header.cell_count 0 in
+    let ptr_start = page_header_size header.page_type in
+    for i = 0 to header.cell_count - 1 do
+      ptrs.(i) <- get_u16_be page (ptr_start + i * 2)
+    done;
+    ptrs
+
+  let rec mem_in_page t page_num key =
+    let page = Pager.read t.pager page_num in
+    let header = parse_page_header page 0 in
+    let ptrs = cell_pointers page header in
+    let usable = usable_size t in
+    match header.page_type with
+    | Leaf_index ->
+        let rec search i =
+          if i >= header.cell_count then false
+          else
+            let cell, _ = Cell.parse_index_leaf page ptrs.(i) ~usable_size:usable in
+            if cell.payload = key then true
+            else if cell.payload > key then false
+            else search (i + 1)
+        in
+        search 0
+    | Interior_index ->
+        let rec find_child i =
+          if i >= header.cell_count then Option.get header.right_child
+          else
+            let cell, _ = Cell.parse_index_interior page ptrs.(i) ~usable_size:usable in
+            if key <= cell.payload then cell.left_child else find_child (i + 1)
+        in
+        mem_in_page t (find_child 0) key
+    | _ -> failwith "Invalid page type in index B-tree"
+
+  let mem t key = mem_in_page t t.root_page key
+
+  let insert _t _key = failwith "Index insert not yet implemented"
+  let delete _t _key = failwith "Index delete not yet implemented"
+
+  let iter t f =
+    let rec iter_page page_num =
+      let page = Pager.read t.pager page_num in
+      let header = parse_page_header page 0 in
+      let ptrs = cell_pointers page header in
+      let usable = usable_size t in
+      match header.page_type with
+      | Leaf_index ->
+          for i = 0 to header.cell_count - 1 do
+            let cell, _ = Cell.parse_index_leaf page ptrs.(i) ~usable_size:usable in
+            f cell.payload
+          done
+      | Interior_index ->
+          for i = 0 to header.cell_count - 1 do
+            let cell, _ = Cell.parse_index_interior page ptrs.(i) ~usable_size:usable in
+            iter_page cell.left_child
+          done;
+          Option.iter iter_page header.right_child
+      | _ -> failwith "Invalid page type"
+    in
+    iter_page t.root_page
+end

lib/btree.mli

···
+(*---------------------------------------------------------------------------
+   Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
+   SPDX-License-Identifier: MIT
+  ---------------------------------------------------------------------------*)
+
+(** Pure OCaml B-tree for persistent storage.
+
+    Implements SQLite-compatible B-tree pages for table and index storage. *)
+
+(** {1 Varint Encoding}
+
+    Variable-length integers as used in SQLite. *)
+
+module Varint : sig
+  val decode : string -> int -> int64 * int
+  (** [decode buf off] decodes a varint starting at [off] in [buf].
+      Returns [(value, bytes_consumed)]. *)
+
+  val encode : int64 -> string
+  (** [encode n] encodes [n] as a varint. *)
+
+  val size : int64 -> int
+  (** [size n] returns the number of bytes needed to encode [n]. *)
+end
+
+(** {1 Page Types} *)
+
+type page_type =
+  | Interior_index  (** 0x02 *)
+  | Interior_table  (** 0x05 *)
+  | Leaf_index      (** 0x0a *)
+  | Leaf_table      (** 0x0d *)
+
+val pp_page_type : Format.formatter -> page_type -> unit
+
+(** {1 Page Header} *)
+
+type page_header = {
+  page_type : page_type;
+  first_freeblock : int;
+  cell_count : int;
+  cell_content_start : int;
+  fragmented_bytes : int;
+  right_child : int option;  (** Interior pages only *)
+}
+
+val parse_page_header : string -> int -> page_header
+(** [parse_page_header buf off] parses a page header starting at [off].
+    For page 1, [off] should be 100 (after database header). *)
+
+val page_header_size : page_type -> int
+(** [page_header_size typ] is 8 for leaf pages, 12 for interior pages. *)
+
+(** {1 Cells}
+
+    Cells contain the actual data in B-tree pages. *)
+
+module Cell : sig
+  (** Table leaf cell: rowid + payload *)
+  type table_leaf = {
+    rowid : int64;
+    payload : string;
+    overflow_page : int option;
+  }
+
+  (** Table interior cell: child page + rowid *)
+  type table_interior = {
+    left_child : int;
+    rowid : int64;
+  }
+
+  (** Index leaf cell: payload only *)
+  type index_leaf = {
+    payload : string;
+    overflow_page : int option;
+  }
+
+  (** Index interior cell: child page + payload *)
+  type index_interior = {
+    left_child : int;
+    payload : string;
+    overflow_page : int option;
+  }
+
+  val parse_table_leaf : string -> int -> usable_size:int -> table_leaf * int
+  (** [parse_table_leaf buf off ~usable_size] parses a table leaf cell.
+      Returns [(cell, bytes_consumed)]. *)
+
+  val parse_table_interior : string -> int -> table_interior * int
+  (** [parse_table_interior buf off] parses a table interior cell. *)
+
+  val parse_index_leaf : string -> int -> usable_size:int -> index_leaf * int
+  (** [parse_index_leaf buf off ~usable_size] parses an index leaf cell. *)
+
+  val parse_index_interior : string -> int -> usable_size:int -> index_interior * int
+  (** [parse_index_interior buf off ~usable_size] parses an index interior cell. *)
+end
+
+(** {1 Record Format}
+
+    SQLite record format for storing column values. *)
+
+module Record : sig
+  (** Serial types determine how column values are stored. *)
+  type serial_type =
+    | Null
+    | Int8
+    | Int16
+    | Int24
+    | Int32
+    | Int48
+    | Int64
+    | Float64
+    | Zero
+    | One
+    | Blob of int
+    | Text of int
+
+  (** Column values *)
+  type value =
+    | Vnull
+    | Vint of int64
+    | Vfloat of float
+    | Vblob of string
+    | Vtext of string
+
+  val decode : string -> value list
+  (** [decode payload] decodes a record from its payload bytes. *)
+
+  val encode : value list -> string
+  (** [encode values] encodes values as a record. *)
+
+  val pp_value : Format.formatter -> value -> unit
+end
+
+(** {1 Pager}
+
+    Page I/O and caching layer. *)
+
+module Pager : sig
+  type t
+
+  val create : page_size:int -> Eio.File.rw_ty Eio.Resource.t -> t
+  (** [create ~page_size file] creates a pager with the given page size. *)
+
+  val page_size : t -> int
+  (** [page_size t] returns the page size. *)
+
+  val page_count : t -> int
+  (** [page_count t] returns the number of pages in the file. *)
+
+  val read : t -> int -> string
+  (** [read t page_num] reads page [page_num] (1-indexed). *)
+
+  val write : t -> int -> string -> unit
+  (** [write t page_num data] writes [data] to page [page_num]. *)
+
+  val allocate : t -> int
+  (** [allocate t] allocates a new page and returns its number. *)
+
+  val sync : t -> unit
+  (** [sync t] syncs all dirty pages to disk. *)
+end
+
+(** {1 Table B-tree}
+
+    B-tree for rowid-keyed tables (like SQLite tables). *)
+
+module Table : sig
+  type t
+
+  val create : Pager.t -> t
+  (** [create pager] creates a new empty table B-tree. *)
+
+  val open_ : Pager.t -> root_page:int -> t
+  (** [open_ pager ~root_page] opens an existing table B-tree. *)
+
+  val root_page : t -> int
+  (** [root_page t] returns the root page number. *)
+
+  val find : t -> int64 -> string option
+  (** [find t rowid] finds the record with the given rowid. *)
+
+  val insert : t -> rowid:int64 -> string -> unit
+  (** [insert t ~rowid data] inserts or updates a record. *)
+
+  val delete : t -> int64 -> unit
+  (** [delete t rowid] deletes the record with the given rowid. *)
+
+  val iter : t -> (int64 -> string -> unit) -> unit
+  (** [iter t f] calls [f rowid data] for each record in order. *)
+
+  val fold : t -> init:'a -> f:(int64 -> string -> 'a -> 'a) -> 'a
+  (** [fold t ~init ~f] folds over all records in order. *)
+end
+
+(** {1 Index B-tree}
+
+    B-tree for arbitrary keys (like SQLite indexes). *)
+
+module Index : sig
+  type t
+
+  val create : Pager.t -> t
+  (** [create pager] creates a new empty index B-tree. *)
+
+  val open_ : Pager.t -> root_page:int -> t
+  (** [open_ pager ~root_page] opens an existing index B-tree. *)
+
+  val root_page : t -> int
+  (** [root_page t] returns the root page number. *)
+
+  val mem : t -> string -> bool
+  (** [mem t key] returns true if [key] exists in the index. *)
+
+  val insert : t -> string -> unit
+  (** [insert t key] inserts a key. *)
+
+  val delete : t -> string -> unit
+  (** [delete t key] deletes a key. *)
+
+  val iter : t -> (string -> unit) -> unit
+  (** [iter t f] calls [f key] for each key in order. *)
+end

lib/dune

···
+(library
+ (name btree)
+ (public_name btree)
+ (libraries eio cstruct))

test/dune

···
+(test
+ (name test)
+ (libraries btree alcotest eio_main))

test/test.ml

···
+let () = Alcotest.run "btree" Test_btree.suite

test/test_btree.ml

···
+(*---------------------------------------------------------------------------
+   Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
+   SPDX-License-Identifier: MIT
+  ---------------------------------------------------------------------------*)
+
+(* Varint tests *)
+
+let test_varint_roundtrip () =
+  let test n =
+    let encoded = Btree.Varint.encode n in
+    let decoded, _ = Btree.Varint.decode encoded 0 in
+    Alcotest.(check int64) (Printf.sprintf "roundtrip %Ld" n) n decoded
+  in
+  test 0L;
+  test 1L;
+  test 127L;
+  test 128L;
+  test 255L;
+  test 16383L;
+  test 16384L;
+  test 1000000L;
+  test Int64.max_int
+
+let test_varint_size () =
+  Alcotest.(check int) "size 0" 1 (Btree.Varint.size 0L);
+  Alcotest.(check int) "size 127" 1 (Btree.Varint.size 127L);
+  Alcotest.(check int) "size 128" 2 (Btree.Varint.size 128L);
+  Alcotest.(check int) "size 16383" 2 (Btree.Varint.size 16383L);
+  Alcotest.(check int) "size 16384" 3 (Btree.Varint.size 16384L)
+
+(* Record format tests *)
+
+let test_record_null () =
+  let values = [ Btree.Record.Vnull ] in
+  let encoded = Btree.Record.encode values in
+  let decoded = Btree.Record.decode encoded in
+  Alcotest.(check int) "length" 1 (List.length decoded);
+  match List.hd decoded with
+  | Btree.Record.Vnull -> ()
+  | _ -> Alcotest.fail "expected Vnull"
+
+let test_record_integers () =
+  let values =
+    [
+      Btree.Record.Vint 0L;
+      Btree.Record.Vint 1L;
+      Btree.Record.Vint 42L;
+      Btree.Record.Vint (-1L);
+      Btree.Record.Vint 1000000L;
+    ]
+  in
+  let encoded = Btree.Record.encode values in
+  let decoded = Btree.Record.decode encoded in
+  Alcotest.(check int) "length" 5 (List.length decoded);
+  let check_int expected actual =
+    match actual with
+    | Btree.Record.Vint n -> Alcotest.(check int64) "int" expected n
+    | _ -> Alcotest.fail "expected Vint"
+  in
+  check_int 0L (List.nth decoded 0);
+  check_int 1L (List.nth decoded 1);
+  check_int 42L (List.nth decoded 2);
+  check_int (-1L) (List.nth decoded 3);
+  check_int 1000000L (List.nth decoded 4)
+
+let test_record_text () =
+  let values = [ Btree.Record.Vtext "Hello, World!" ] in
+  let encoded = Btree.Record.encode values in
+  let decoded = Btree.Record.decode encoded in
+  match List.hd decoded with
+  | Btree.Record.Vtext s -> Alcotest.(check string) "text" "Hello, World!" s
+  | _ -> Alcotest.fail "expected Vtext"
+
+let test_record_blob () =
+  let data = "\x00\x01\x02\xff" in
+  let values = [ Btree.Record.Vblob data ] in
+  let encoded = Btree.Record.encode values in
+  let decoded = Btree.Record.decode encoded in
+  match List.hd decoded with
+  | Btree.Record.Vblob s -> Alcotest.(check string) "blob" data s
+  | _ -> Alcotest.fail "expected Vblob"
+
+let test_record_mixed () =
+  let values =
+    [
+      Btree.Record.Vnull;
+      Btree.Record.Vint 42L;
+      Btree.Record.Vtext "test";
+      Btree.Record.Vblob "\xff\xfe";
+    ]
+  in
+  let encoded = Btree.Record.encode values in
+  let decoded = Btree.Record.decode encoded in
+  Alcotest.(check int) "length" 4 (List.length decoded)
+
+(* Page header tests *)
+
+let test_page_header_leaf () =
+  let page = Bytes.create 4096 in
+  Bytes.set_uint8 page 0 0x0d; (* Leaf table *)
+  Bytes.set_uint8 page 1 0;
+  Bytes.set_uint8 page 2 0; (* first freeblock = 0 *)
+  Bytes.set_uint8 page 3 0;
+  Bytes.set_uint8 page 4 5; (* cell count = 5 *)
+  Bytes.set_uint8 page 5 0x0f;
+  Bytes.set_uint8 page 6 0x00; (* cell content start = 0x0f00 *)
+  Bytes.set_uint8 page 7 0; (* fragmented = 0 *)
+  let header = Btree.parse_page_header (Bytes.unsafe_to_string page) 0 in
+  Alcotest.(check int) "cell_count" 5 header.cell_count;
+  Alcotest.(check int) "cell_content_start" 0x0f00 header.cell_content_start;
+  Alcotest.(check bool) "no right_child" true (Option.is_none header.right_child)
+
+let test_page_header_interior () =
+  let page = Bytes.create 4096 in
+  Bytes.set_uint8 page 0 0x05; (* Interior table *)
+  Bytes.set_uint8 page 1 0;
+  Bytes.set_uint8 page 2 0;
+  Bytes.set_uint8 page 3 0;
+  Bytes.set_uint8 page 4 3;
+  Bytes.set_uint8 page 5 0x10;
+  Bytes.set_uint8 page 6 0x00;
+  Bytes.set_uint8 page 7 0;
+  (* Right child at offset 8-11 *)
+  Bytes.set_uint8 page 8 0;
+  Bytes.set_uint8 page 9 0;
+  Bytes.set_uint8 page 10 0;
+  Bytes.set_uint8 page 11 42;
+  let header = Btree.parse_page_header (Bytes.unsafe_to_string page) 0 in
+  Alcotest.(check int) "cell_count" 3 header.cell_count;
+  match header.right_child with
+  | Some n -> Alcotest.(check int) "right_child" 42 n
+  | None -> Alcotest.fail "expected right_child"
+
+(* Table B-tree tests with file *)
+
+let with_temp_file f =
+  Eio_main.run @@ fun env ->
+  let cwd = Eio.Stdenv.cwd env in
+  let tmp_dir = Eio.Path.(cwd / "_build" / "test_btree") in
+  (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with _ -> ());
+  let path =
+    Eio.Path.(tmp_dir / Printf.sprintf "test_%d.db" (Random.int 1_000_000))
+  in
+  Eio.Path.with_open_out ~create:(`Or_truncate 0o644) path (fun file ->
+      f (file :> Eio.File.rw_ty Eio.Resource.t))
+
+let test_table_create () =
+  with_temp_file @@ fun file ->
+  let pager = Btree.Pager.create ~page_size:4096 file in
+  let tree = Btree.Table.create pager in
+  Alcotest.(check int) "root page" 1 (Btree.Table.root_page tree)
+
+let test_table_insert_find () =
+  with_temp_file @@ fun file ->
+  let pager = Btree.Pager.create ~page_size:4096 file in
+  let tree = Btree.Table.create pager in
+  Btree.Table.insert tree ~rowid:1L "Hello";
+  let result = Btree.Table.find tree 1L in
+  Alcotest.(check (option string)) "found" (Some "Hello") result
+
+let test_table_multiple_inserts () =
+  with_temp_file @@ fun file ->
+  let pager = Btree.Pager.create ~page_size:4096 file in
+  let tree = Btree.Table.create pager in
+  Btree.Table.insert tree ~rowid:3L "Three";
+  Btree.Table.insert tree ~rowid:1L "One";
+  Btree.Table.insert tree ~rowid:2L "Two";
+  Alcotest.(check (option string)) "find 1" (Some "One") (Btree.Table.find tree 1L);
+  Alcotest.(check (option string)) "find 2" (Some "Two") (Btree.Table.find tree 2L);
+  Alcotest.(check (option string)) "find 3" (Some "Three") (Btree.Table.find tree 3L);
+  Alcotest.(check (option string)) "find 4" None (Btree.Table.find tree 4L)
+
+let test_table_iter () =
+  with_temp_file @@ fun file ->
+  let pager = Btree.Pager.create ~page_size:4096 file in
+  let tree = Btree.Table.create pager in
+  Btree.Table.insert tree ~rowid:1L "A";
+  Btree.Table.insert tree ~rowid:2L "B";
+  Btree.Table.insert tree ~rowid:3L "C";
+  let items = ref [] in
+  Btree.Table.iter tree (fun rowid data -> items := (rowid, data) :: !items);
+  let sorted = List.sort compare !items in
+  Alcotest.(check (list (pair int64 string)))
+    "iter order"
+    [ (1L, "A"); (2L, "B"); (3L, "C") ]
+    sorted
+
+let suite =
+  [
+    ( "varint",
+      [
+        Alcotest.test_case "roundtrip" `Quick test_varint_roundtrip;
+        Alcotest.test_case "size" `Quick test_varint_size;
+      ] );
+    ( "record",
+      [
+        Alcotest.test_case "null" `Quick test_record_null;
+        Alcotest.test_case "integers" `Quick test_record_integers;
+        Alcotest.test_case "text" `Quick test_record_text;
+        Alcotest.test_case "blob" `Quick test_record_blob;
+        Alcotest.test_case "mixed" `Quick test_record_mixed;
+      ] );
+    ( "page_header",
+      [
+        Alcotest.test_case "leaf" `Quick test_page_header_leaf;
+        Alcotest.test_case "interior" `Quick test_page_header_interior;
+      ] );
+    ( "table",
+      [
+        Alcotest.test_case "create" `Quick test_table_create;
+        Alcotest.test_case "insert/find" `Quick test_table_insert_find;
+        Alcotest.test_case "multiple inserts" `Quick test_table_multiple_inserts;
+        Alcotest.test_case "iter" `Quick test_table_iter;
+      ] );
+  ]