index: wire columnar segment tree as a live durable backend
ober
7f4c08797a115889538aba249d341e5394caeca1
--- a/lib/jerboa-db/core.ss +++ b/lib/jerboa-db/core.ss @@ -83,6 +83,7 @@ (jerboa-db schema) (jerboa-db index protocol) (jerboa-db index memory) + (jerboa-db index segtree-backend) (jerboa-db history) (jerboa-db cache) (jerboa-db tx) @@ -131,11 +132,11 @@ (def (connect path) (let-values ([(indices handles) - (if (string=? path ":memory:") - (values (make-mem-index-set) #f) - (begin - (ensure-leveldb!) - (leveldb-make-index-set path)))]) + (cond + [(string=? path ":memory:") (values (make-mem-index-set) #f)] + ;; durable two-layer columnar segment-tree backend (in-memory store) + [(string=? path ":segtree:") (values (make-segtree-index-set) #f)] + [else (ensure-leveldb!) (leveldb-make-index-set path)])]) (let* ([schema (new-schema-registry)] [stats (make-db-stats)] [initial-db (make-db-value 0 indices schema #f #f #f stats)] --- a/lib/jerboa-db/index/memory.ss +++ b/lib/jerboa-db/index/memory.ss @@ -15,7 +15,7 @@ ;;; rank) rather than O(range). (library (jerboa-db index memory) - (export make-mem-index-set) + (export make-mem-index-set make-mem-index) (import (except (chezscheme) make-hash-table hash-table? new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/index/segtree-backend.ss @@ -0,0 +1,119 @@ +#!chezscheme +;;; (jerboa-db index segtree-backend) — durable two-layer index backend +;;; +;;; Wires the columnar segment tree (jerboa-db index segtree) in as a live `dbi`, +;;; in Datomic's two-layer shape: a small in-memory index (the B+-tree backend) +;;; absorbs writes, and a durable immutable segment tree holds flushed datoms. +;;; Reads MERGE both layers with the k-way `merge-streams` from the cursor work; +;;; once the memory layer crosses a threshold it is flushed into the durable tree +;;; (structural sharing — only touched leaves are rewritten). +;;; +;;; Physical removal (dbi-remove!, used only by gc/excision/migrate — normal +;;; retractions are appended as datoms) is recorded as a tombstone and filtered +;;; at read; a compaction pass would rebuild the durable tree dropping them. +;;; +;;; Append-only + tombstones matches jerboa-db's existing model: db-value +;;; snapshots are tx-filtered views over a shared mutable index-set, so the +;;; engine's db-filter-datom? + resolve-current still provide as-of/current. +;;; +;;; This uses an in-memory segment store; a disk/value-store-backed store is a +;;; drop-in (the store is just id->bytes). + +(library (jerboa-db index segtree-backend) + (export make-segtree-index-set make-segtree-index) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time + atom? meta) + (jerboa prelude) + (jerboa-db datom) + (jerboa-db index protocol) + (jerboa-db index memory) + (jerboa-db index segtree)) + + (def +flush-threshold+ 8192) + + ;; One index (e.g. eavt) = in-memory dbi layer + durable segtree + tombstones, + ;; all sharing the segment store `ss`. + (def (make-segtree-index name comparator ss) + (let ([mem-cell (list (make-mem-index name comparator))] + [root-cell (list (segtree-build ss '() comparator +segtree-default-seg-size+))] + [tomb (make-hashtable equal-hash equal?)] + [memcount (list 0)]) + + (define (get-mem) (car mem-cell)) + (define (get-root) (car root-cell)) + (define (tombed? d) (hashtable-ref tomb (datom->list d) #f)) + + (define (flush!) + (let ([ds (dbi-datoms (get-mem))]) + (unless (null? ds) + (set-car! root-cell + (segtree-add (get-root) ss ds comparator +segtree-default-seg-size+)) + (set-car! mem-cell (make-mem-index name comparator)) + (set-car! memcount 0)))) + + (define (add! d) + (hashtable-delete! tomb (datom->list d)) ;; re-asserting un-tombstones + (dbi-add! (get-mem) d) + (set-car! memcount (+ (car memcount) 1)) + (when (>= (car memcount) +flush-threshold+) (flush!))) + + (define (remove! d) + (dbi-remove! (get-mem) d) + (hashtable-set! tomb (datom->list d) #t)) + + ;; Lazily drop tombstoned datoms from a stream. + (define (filter-live s) + (cond + [(stream-null? s) '()] + [(tombed? (stream-car s)) (filter-live (stream-cdr s))] + [else (cons (stream-car s) (delay (filter-live (stream-cdr s))))])) + + ;; Merged, current cursor: memory layer + durable tree, tombstones removed. + ;; Both inputs are lazy, so an early-exit consumer (e.g. :limit) only forces + ;; the prefix it needs. + (define (cursor lo hi) + (let ([merged (merge-streams comparator + (list (dbi-cursor (get-mem) lo hi) + (segtree-range (get-root) ss lo hi)))]) + (if (= 0 (hashtable-size tomb)) merged (filter-live merged)))) + + (define (range-query lo hi) (stream->list (cursor lo hi))) + + (define (seek . components) + (let-values ([(e a v tx) (apply values components)]) + (range-query + (make-datom (or e 0) (or a 0) (if v v +min-val+) (or tx 0) #t) + (make-datom (or e (greatest-fixnum)) (or a (greatest-fixnum)) + (if v v +max-val+) (or tx (greatest-fixnum)) #t)))) + + (define (count-range lo hi) (length (range-query lo hi))) + + (define (all-datoms) + (range-query (make-datom 0 0 +min-val+ 0 #t) + (make-datom (greatest-fixnum) (greatest-fixnum) +max-val+ + (greatest-fixnum) #t))) + + ;; Immutable handle: flushed memory btset + durable root + tombstone copy. + (define (snapshot) (list (dbi-snapshot (get-mem)) (get-root) (hashtable-copy tomb))) + + (make-dbi name add! remove! range-query seek count-range snapshot all-datoms cursor))) + + ;; The four covering indices, sharing one segment store. + (def (make-segtree-index-set) + (let ([ss (make-mem-segstore)]) + (make-index-set + (make-segtree-index 'eavt compare-datoms-eavt ss) + (make-segtree-index 'aevt compare-datoms-aevt ss) + (make-segtree-index 'avet compare-datoms-avet ss) + (make-segtree-index 'vaet compare-datoms-vaet ss)))) + +) ;; end library --- a/tests/test-core.ss +++ b/tests/test-core.ss @@ -917,6 +917,34 @@ (assert-equal (segtree-total t1) 52) (assert-true (memv 101 (map datom-e (segtree->list t1 ss)))))))) +(test "durable segtree backend: full DB lifecycle across merged layers" + (let ([conn (connect ":segtree:")]) + (transact! conn + (list '((db/ident . p/name) (db/valueType . db.type/string) (db/cardinality . db.cardinality/one) (db/index . #t)) + '((db/ident . p/age) (db/valueType . db.type/long) (db/cardinality . db.cardinality/one)))) + ;; load > flush threshold (8192) so data lands in the durable tree, and reads + ;; must merge the durable layer with the in-memory remainder + (transact! conn + (for/collect ([i (in-range 10000)]) + `((p/name . ,(str "P" i)) (p/age . ,(modulo i 100))))) + (let ([d (db conn)]) + ;; full scan across both layers + (assert-equal (length (q '((find ?e) (where (?e p/age ?a))) d)) 10000) + ;; indexed value point lookup (AVET) across layers + (assert-equal (length (q '((find ?e) (where (?e p/name "P500"))) d)) 1) + ;; group-by aggregate across layers: 100 ages, summing to 10000 entities + (let ([rows (q '((find ?a (count ?e)) (where (?e p/age ?a))) d)]) + (assert-equal (length rows) 100) + (assert-equal (fold-left + 0 (map cadr rows)) 10000)) + ;; :limit streams through the merged cursor + (assert-equal (length (q '((find ?e) (where (?e p/age ?a)) (limit 7)) d)) 7)) + ;; update + retract round-trip through the backend + (let ([eid (caar (q '((find ?e) (where (?e p/name "P500"))) (db conn)))]) + (transact! conn (list `(db/add ,eid p/age 999))) + (assert-equal (caar (q '((find ?a) (in $ ?e) (where (?e p/age ?a))) (db conn) eid)) 999) + (transact! conn (list `(db/retract ,eid p/age 999))) + (assert-equal (q '((find ?a) (in $ ?e) (where (?e p/age ?a))) (db conn) eid) '())))) + ;; ============================================================ ;; Report ;; ============================================================