Minimal SQLite key-value store for OCaml
Use persistent Btree.Index for UNIQUE constraints instead of in-memory Hashtbl
Indexes are now stored as Btree.Index B-trees in the database file and
registered in sqlite_master as type "index" (sqlite_autoindex_<tbl>_<n>),
matching real SQLite behavior. No more full table scan on reopen.
+131
-40
+131
-40
lib/sqlite.ml
+131
-40
lib/sqlite.ml
···
43
43
44
44
exception Unique_violation of string
45
45
46
-
(* A unique index maps composite key values to the rowid that owns them *)
46
+
(* A persistent unique index backed by Btree.Index *)
47
47
type unique_index = {
48
48
ui_columns : int list; (* column indices *)
49
-
ui_name : string; (* for error messages *)
50
-
ui_keys : (value list, int64) Hashtbl.t;
49
+
ui_name : string; (* for error messages, e.g. "provider, uid" *)
50
+
ui_index_name : string; (* sqlite_master name, e.g. "sqlite_autoindex_t_1" *)
51
+
ui_tbl_name : string; (* owning table name *)
52
+
ui_btree : Btree.Index.t; (* persistent B-tree index *)
51
53
}
52
54
53
55
type generic_table = {
···
369
371
else v)
370
372
values
371
373
372
-
(* Build empty unique indexes from parsed constraints *)
373
-
let make_unique_indexes constraints =
374
-
List.map
375
-
(fun (indices, name) ->
376
-
{ ui_columns = indices; ui_name = name; ui_keys = Hashtbl.create 64 })
374
+
(* Encode the indexed column values as a Record string for Btree.Index *)
375
+
let encode_index_key ui values =
376
+
let key_values =
377
+
List.map
378
+
(fun idx ->
379
+
if idx < List.length values then List.nth values idx
380
+
else Btree.Record.Vnull)
381
+
ui.ui_columns
382
+
in
383
+
Btree.Record.encode key_values
384
+
385
+
(* Create persistent unique indexes for a table *)
386
+
let make_unique_indexes pager ~tbl_name constraints =
387
+
List.mapi
388
+
(fun i (indices, col_name) ->
389
+
let idx_name = Fmt.str "sqlite_autoindex_%s_%d" tbl_name (i + 1) in
390
+
{
391
+
ui_columns = indices;
392
+
ui_name = col_name;
393
+
ui_index_name = idx_name;
394
+
ui_tbl_name = tbl_name;
395
+
ui_btree = Btree.Index.v pager;
396
+
})
377
397
constraints
378
398
379
-
(* Extract composite key values for a unique index from a row *)
380
-
let extract_key ui values =
381
-
List.map
382
-
(fun idx -> if idx < List.length values then List.nth values idx else Vnull)
383
-
ui.ui_columns
384
-
385
-
(* Populate unique indexes by scanning existing rows *)
399
+
(* Populate persistent indexes from existing table data (used on migration) *)
386
400
let populate_unique_indexes btree schema indexes =
387
401
if indexes <> [] then
388
402
Btree.Table.iter btree (fun rowid payload ->
···
390
404
let values = fixup_values ~schema ~rowid values in
391
405
List.iter
392
406
(fun ui ->
393
-
let key = extract_key ui values in
394
-
Hashtbl.replace ui.ui_keys key rowid)
407
+
let key = encode_index_key ui values in
408
+
Btree.Index.insert ui.ui_btree key)
395
409
indexes)
396
410
397
411
(* Standard kv table schema *)
···
453
467
Btree.Page.set_u32_be buf 96 3046000
454
468
455
469
(* Build a sqlite_master table leaf cell *)
456
-
let master_cell ~rowid ~name ~root_page ~sql =
470
+
let master_cell ~rowid ~type_ ~name ~tbl_name ~root_page ~sql =
457
471
let record =
458
472
Btree.Record.encode
459
473
[
460
-
Btree.Record.Vtext "table";
461
-
Btree.Record.Vtext name;
474
+
Btree.Record.Vtext type_;
462
475
Btree.Record.Vtext name;
476
+
Btree.Record.Vtext tbl_name;
463
477
Btree.Record.Vint (Int64.of_int root_page);
464
-
Btree.Record.Vtext sql;
478
+
sql;
465
479
]
466
480
in
467
481
let payload_varint =
···
469
483
in
470
484
let rowid_varint = Btree.Varint.encode rowid in
471
485
payload_varint ^ rowid_varint ^ record
486
+
487
+
(* Collect all sqlite_master entries: tables then indexes *)
488
+
let master_entries t =
489
+
let entries = ref [] in
490
+
let rowid = ref 1 in
491
+
List.iter
492
+
(fun gt ->
493
+
entries :=
494
+
( !rowid,
495
+
gt.g_schema.tbl_name,
496
+
gt.g_schema.tbl_name,
497
+
Btree.Table.root_page gt.g_btree,
498
+
Btree.Record.Vtext gt.g_schema.sql,
499
+
"table" )
500
+
:: !entries;
501
+
incr rowid;
502
+
List.iter
503
+
(fun ui ->
504
+
entries :=
505
+
( !rowid,
506
+
ui.ui_index_name,
507
+
ui.ui_tbl_name,
508
+
Btree.Index.root_page ui.ui_btree,
509
+
Btree.Record.Vnull,
510
+
"index" )
511
+
:: !entries;
512
+
incr rowid)
513
+
gt.g_unique_indexes)
514
+
t.all_tables;
515
+
List.rev !entries
472
516
473
517
(* Write page 1: db header + sqlite_master leaf table *)
474
518
let rebuild_page1 t =
···
478
522
Bytes.set_uint8 buf 100 0x0d;
479
523
Btree.Page.set_u16_be buf 101 0;
480
524
Bytes.set_uint8 buf 107 0;
481
-
(* Collect all tables from all_tables *)
482
-
let tables =
483
-
List.map
484
-
(fun gt ->
485
-
(gt.g_schema.tbl_name, Btree.Table.root_page gt.g_btree, gt.g_schema.sql))
486
-
t.all_tables
487
-
in
488
-
let n = List.length tables in
525
+
let entries = master_entries t in
526
+
let n = List.length entries in
489
527
Btree.Page.set_u16_be buf 103 n;
490
528
(* Build cells from end of page *)
491
529
let cell_content_start = ref page_size in
492
530
let cell_ptrs = Array.make n 0 in
493
531
List.iteri
494
-
(fun i (name, root_page, sql) ->
532
+
(fun i (rowid, name, tbl_name, root_page, sql, type_) ->
495
533
let cell =
496
-
master_cell ~rowid:(Int64.of_int (i + 1)) ~name ~root_page ~sql
534
+
master_cell ~rowid:(Int64.of_int rowid) ~type_ ~name ~tbl_name
535
+
~root_page ~sql
497
536
in
498
537
let cell_len = String.length cell in
499
538
cell_content_start := !cell_content_start - cell_len;
500
539
Bytes.blit_string cell 0 buf !cell_content_start cell_len;
501
540
cell_ptrs.(i) <- !cell_content_start)
502
-
tables;
541
+
entries;
503
542
Btree.Page.set_u16_be buf 105 !cell_content_start;
504
543
(* Cell pointer array at offset 108 (100 + 8 byte leaf header) *)
505
544
Array.iteri
···
602
641
let header = Btree.Page.parse_header page1 100 in
603
642
let ptrs = Btree.Page.cell_pointers page1 100 header in
604
643
let raw_tables = ref [] in
644
+
let raw_indexes = ref [] in
605
645
for i = 0 to header.Btree.Page.cell_count - 1 do
606
646
let cell, _ =
607
647
Btree.Cell.parse_table_leaf page1 ptrs.(i) ~usable_size:page_size
···
615
655
Btree.Record.Vtext sql;
616
656
] ->
617
657
raw_tables := (name, Int64.to_int root, sql) :: !raw_tables
658
+
| [
659
+
Btree.Record.Vtext "index";
660
+
Btree.Record.Vtext idx_name;
661
+
Btree.Record.Vtext tbl_name;
662
+
Btree.Record.Vint root;
663
+
_;
664
+
] ->
665
+
raw_indexes := (idx_name, tbl_name, Int64.to_int root) :: !raw_indexes
618
666
| _ -> ()
619
667
done;
620
668
let raw_tables = List.rev !raw_tables in
669
+
let raw_indexes = List.rev !raw_indexes in
621
670
(* Build generic_table for every table *)
622
671
let all_tables =
623
672
List.map
···
626
675
let columns = parse_create_table sql in
627
676
let schema = { tbl_name = name; columns; sql } in
628
677
let constraints = parse_unique_constraints sql columns in
629
-
let indexes = make_unique_indexes constraints in
630
-
populate_unique_indexes btree schema indexes;
678
+
(* Reconnect persistent indexes from sqlite_master *)
679
+
let tbl_indexes =
680
+
List.filter (fun (_, tbl, _) -> tbl = name) raw_indexes
681
+
in
682
+
let indexes =
683
+
List.mapi
684
+
(fun i (indices, col_name) ->
685
+
let expected_name =
686
+
Fmt.str "sqlite_autoindex_%s_%d" name (i + 1)
687
+
in
688
+
match
689
+
List.find_opt
690
+
(fun (idx_name, _, _) -> idx_name = expected_name)
691
+
tbl_indexes
692
+
with
693
+
| Some (idx_name, _, idx_root) ->
694
+
(* Reopen existing persistent index *)
695
+
{
696
+
ui_columns = indices;
697
+
ui_name = col_name;
698
+
ui_index_name = idx_name;
699
+
ui_tbl_name = name;
700
+
ui_btree = Btree.Index.open_ pager ~root_page:idx_root;
701
+
}
702
+
| None ->
703
+
(* No persisted index yet — create and populate *)
704
+
let ui =
705
+
{
706
+
ui_columns = indices;
707
+
ui_name = col_name;
708
+
ui_index_name = expected_name;
709
+
ui_tbl_name = name;
710
+
ui_btree = Btree.Index.v pager;
711
+
}
712
+
in
713
+
Btree.Table.iter btree (fun rowid payload ->
714
+
let values = Btree.Record.decode payload in
715
+
let values = fixup_values ~schema ~rowid values in
716
+
let key = encode_index_key ui values in
717
+
Btree.Index.insert ui.ui_btree key);
718
+
ui)
719
+
constraints
720
+
in
631
721
{ g_btree = btree; g_schema = schema; g_unique_indexes = indexes })
632
722
raw_tables
633
723
in
···
785
875
let btree = Btree.Table.v t.pager in
786
876
let schema = { tbl_name = name; columns; sql } in
787
877
let constraints = parse_unique_constraints sql columns in
788
-
let indexes = make_unique_indexes constraints in
878
+
let indexes = make_unique_indexes t.pager ~tbl_name:name constraints in
789
879
let gt = { g_btree = btree; g_schema = schema; g_unique_indexes = indexes } in
790
880
t.all_tables <- t.all_tables @ [ gt ]
791
881
···
836
926
let full_values = fixup_values ~schema:gt.g_schema ~rowid values in
837
927
List.iter
838
928
(fun ui ->
839
-
let key = extract_key ui full_values in
840
-
if Hashtbl.mem ui.ui_keys key then raise (Unique_violation ui.ui_name))
929
+
let key = encode_index_key ui full_values in
930
+
if Btree.Index.mem ui.ui_btree key then
931
+
raise (Unique_violation ui.ui_name))
841
932
gt.g_unique_indexes;
842
933
let record = Btree.Record.encode record_values in
843
934
Btree.Table.insert gt.g_btree ~rowid record;
844
-
(* Update unique indexes *)
935
+
(* Update persistent unique indexes *)
845
936
List.iter
846
937
(fun ui ->
847
-
let key = extract_key ui full_values in
848
-
Hashtbl.replace ui.ui_keys key rowid)
938
+
let key = encode_index_key ui full_values in
939
+
Btree.Index.insert ui.ui_btree key)
849
940
gt.g_unique_indexes;
850
941
rowid
851
942