feat: implement all Datomic parity gaps (phases 2-7)
ober
ca43945980b19002e8177b1f223da3f3315a3d3d
--- a/lib/jerboa-db/analytics.sls +++ b/lib/jerboa-db/analytics.sls @@ -2,15 +2,17 @@ ;;; (jerboa-db analytics) — DuckDB integration for OLAP queries ;;; ;;; Maintains a columnar replica of the datom store for analytical queries. -;;; Provides SQL over datoms, Parquet export/import, and async sync. +;;; Provides SQL over datoms, Parquet export/import, and CSV import. (library (jerboa-db analytics) (export new-analytics-engine analytics-engine? analytics-sync! analytics-query - export-parquet import-parquet import-csv) + export-parquet import-parquet import-csv + analytics-close) (import (chezscheme) + (std db duckdb) (jerboa-db datom) (jerboa-db schema) (jerboa-db tx-log)) @@ -18,7 +20,7 @@ ;; ---- Analytics engine record ---- (define-record-type analytics-engine - (fields (mutable duckdb-conn) ;; DuckDB connection handle + (fields (mutable duckdb-conn) ;; DuckDB connection handle (integer) (mutable last-synced-tx) ;; last tx synced to DuckDB schema-ref ;; reference to schema registry tx-log-ref)) ;; reference to transaction log @@ -26,39 +28,34 @@ (define (new-analytics-engine schema tx-log . opts) ;; Optional: path for persistent DuckDB file (let ([path (if (pair? opts) (car opts) ":memory:")]) - (let ([ae (make-analytics-engine - (init-duckdb path) 0 schema tx-log)]) - (create-datom-table! ae) - ae))) + (let ([conn (duckdb-open path)]) + (let ([ae (make-analytics-engine conn 0 schema tx-log)]) + (create-datom-table! ae) + ae)))) - ;; ---- DuckDB initialization ---- - ;; Uses (std db duckdb) when available; stubs for compilation. - - (define (init-duckdb path) - ;; Placeholder: actual DuckDB connection via (std db duckdb) - ;; Returns an opaque connection handle - (list 'duckdb-conn path)) + ;; ---- Schema setup ---- (define (create-datom-table! ae) - ;; CREATE TABLE datoms ( - ;; e BIGINT, a INTEGER, v VARCHAR, - ;; v_long BIGINT, v_double DOUBLE, v_bool BOOLEAN, - ;; v_instant TIMESTAMP, v_ref BIGINT, - ;; tx BIGINT, added BOOLEAN - ;; ); - (duckdb-exec! (analytics-engine-duckdb-conn ae) + (duckdb-exec (analytics-engine-duckdb-conn ae) "CREATE TABLE IF NOT EXISTS datoms ( - e BIGINT, a INTEGER, a_name VARCHAR, - v VARCHAR, v_long BIGINT, v_double DOUBLE, - v_bool BOOLEAN, v_instant BIGINT, v_ref BIGINT, - tx BIGINT, added BOOLEAN)")) + e BIGINT NOT NULL, + a INTEGER NOT NULL, + a_name VARCHAR, + v_long BIGINT, + v_double DOUBLE, + v_string VARCHAR, + v_bool BOOLEAN, + v_ref BIGINT, + v_instant BIGINT, + tx BIGINT NOT NULL, + added BOOLEAN NOT NULL + )")) ;; ---- Sync from transaction log ---- (define (analytics-sync! ae) - ;; Read transaction log entries since last-synced-tx - ;; Batch-insert datoms into DuckDB - (let* ([log (analytics-engine-tx-log-ref ae)] + ;; Read transaction log entries since last-synced-tx and INSERT datoms. + (let* ([log (analytics-engine-tx-log-ref ae)] [schema (analytics-engine-schema-ref ae)] [last-tx (analytics-engine-last-synced-tx ae)] [entries (tx-log-range log last-tx (+ (tx-log-latest-tx log) 1))]) @@ -66,6 +63,7 @@ (lambda (entry) (for-each (lambda (dv) + ;; dv is #(e a v tx added?) — serializable form from tx-log (insert-datom-row! ae schema dv)) (tx-log-entry-datoms entry))) entries) @@ -75,69 +73,167 @@ (define (insert-datom-row! ae schema dv) ;; dv is a vector: #(e a v tx added?) - (let* ([e (vector-ref dv 0)] - [a (vector-ref dv 1)] - [v (vector-ref dv 2)] - [tx (vector-ref dv 3)] + (let* ([e (vector-ref dv 0)] + [a (vector-ref dv 1)] + [v (vector-ref dv 2)] + [tx (vector-ref dv 3)] [added? (vector-ref dv 4)] - [attr (schema-lookup-by-id schema a)] - [a-name (if attr (symbol->string (db-attribute-ident attr)) "")] - [vtype (if attr (db-attribute-value-type attr) #f)]) - (duckdb-exec! (analytics-engine-duckdb-conn ae) - (format "INSERT INTO datoms VALUES (~a, ~a, '~a', '~a', ~a, ~a, ~a, ~a, ~a, ~a, ~a)" - e a a-name - (if (string? v) (escape-sql v) (format "~a" v)) - (if (and vtype (eq? vtype 'db.type/long) (number? v)) v 'NULL) - (if (and vtype (eq? vtype 'db.type/double) (number? v)) v 'NULL) - (if (boolean? v) (if v 'TRUE 'FALSE) 'NULL) - (if (and vtype (eq? vtype 'db.type/instant) (number? v)) v 'NULL) - (if (and vtype (eq? vtype 'db.type/ref) (number? v)) v 'NULL) - tx - (if added? 'TRUE 'FALSE))))) + [attr (schema-lookup-by-id schema a)] + [a-name (if attr (symbol->string (db-attribute-ident attr)) #f)] + [vtype (if attr (db-attribute-value-type attr) #f)]) + ;; Resolve each typed slot — only one should be non-NULL per row. + (let-values ([(v-long v-double v-string v-bool v-ref v-instant) + (classify-value v vtype)]) + (duckdb-eval + (analytics-engine-duckdb-conn ae) + "INSERT INTO datoms + (e, a, a_name, v_long, v_double, v_string, v_bool, v_ref, v_instant, tx, added) + VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" + e a a-name + v-long v-double v-string v-bool v-ref v-instant + tx added?)))) + + ;; Map a datom value + schema type to the six typed column slots. + ;; Returns six values: (v-long v-double v-string v-bool v-ref v-instant). + ;; Exactly one will be non-#f (or all #f for unknown types). + (define (classify-value v vtype) + (cond + ;; Explicit schema type wins + [(eq? vtype 'db.type/long) + (values (and (integer? v) v) #f #f #f #f #f)] + [(eq? vtype 'db.type/double) + (values #f (and (number? v) (inexact v)) #f #f #f #f)] + [(eq? vtype 'db.type/string) + (values #f #f (and (string? v) v) #f #f #f)] + [(eq? vtype 'db.type/boolean) + (values #f #f #f (and (boolean? v) v) #f #f)] + [(eq? vtype 'db.type/ref) + (values #f #f #f #f (and (integer? v) v) #f)] + [(eq? vtype 'db.type/instant) + (values #f #f #f #f #f (and (integer? v) v))] + [(eq? vtype 'db.type/keyword) + ;; Store keyword/symbol as string + (values #f #f (and (symbol? v) (symbol->string v)) #f #f #f)] + [(eq? vtype 'db.type/uuid) + (values #f #f (and (string? v) v) #f #f #f)] + [(eq? vtype 'db.type/symbol) + (values #f #f (and (symbol? v) (symbol->string v)) #f #f #f)] + ;; No schema — infer from Scheme type + [(boolean? v) (values #f #f #f v #f #f)] + [(flonum? v) (values #f v #f #f #f #f)] + [(integer? v) (values v #f #f #f #f #f)] + [(string? v) (values #f #f v #f #f #f)] + [(symbol? v) (values #f #f (symbol->string v) #f #f #f)] + [else (values #f #f (format "~s" v) #f #f #f)])) ;; ---- SQL query ---- (define (analytics-query ae sql-string . params) - ;; Ensure synced, then execute SQL + ;; Sync first so the view is up-to-date, then run SQL. (analytics-sync! ae) - (duckdb-query (analytics-engine-duckdb-conn ae) sql-string params)) + (apply duckdb-query (analytics-engine-duckdb-conn ae) sql-string params)) ;; ---- Parquet export ---- (define (export-parquet ae path . opts) - ;; Uses DuckDB's native Parquet writer + ;; opts: optional SQL override (default: full datoms table) (analytics-sync! ae) - (duckdb-exec! (analytics-engine-duckdb-conn ae) - (format "COPY datoms TO '~a' (FORMAT PARQUET)" path))) - - ;; ---- Parquet/CSV import ---- - - (define (import-parquet conn path mapping) - ;; mapping: alist of (column-name . attr-keyword) - ;; Each row becomes an entity, each column an attribute - (error 'import-parquet "Not yet implemented — requires DuckDB Parquet reader")) - - (define (import-csv conn path mapping) - (error 'import-csv "Not yet implemented — requires DuckDB CSV reader")) - - ;; ---- DuckDB stubs ---- - ;; These will be replaced with actual (std db duckdb) calls. - - (define (duckdb-exec! conn sql) - ;; Stub: will call duckdb-query from (std db duckdb) - (void)) - - (define (duckdb-query conn sql params) - ;; Stub: returns list of alists - '()) - - (define (escape-sql s) - (let loop ([i 0] [out '()]) - (if (>= i (string-length s)) - (list->string (reverse out)) - (let ([c (string-ref s i)]) - (if (char=? c #\') - (loop (+ i 1) (cons #\' (cons #\' out))) - (loop (+ i 1) (cons c out))))))) + (let ([sql (if (pair? opts) + (car opts) + "SELECT * FROM datoms")]) + (duckdb-write-parquet (analytics-engine-duckdb-conn ae) sql path))) + + ;; ---- Parquet import ---- + ;; + ;; mapping: alist of (column-name . attribute-ident) + ;; Each row becomes a new entity assertion. All values imported as strings; + ;; callers can add type coercion via the schema after import. + + (define (import-parquet ae path mapping) + (let ([conn (analytics-engine-duckdb-conn ae)] + [schema (analytics-engine-schema-ref ae)] + [tx-id (+ (tx-log-latest-tx (analytics-engine-tx-log-ref ae)) 1)]) + ;; Use DuckDB to read the parquet and materialise it in-memory + (let ([rows (duckdb-read-parquet conn path)]) + (for-each + (lambda (row) + ;; Allocate a fresh entity id (use a stable hash of row position + ;; relative to tx so re-import is idempotent-ish) + (let ([eid (next-import-eid ae)]) + (for-each + (lambda (col-mapping) + (let* ([col-name (car col-mapping)] + [attr-ident (cdr col-mapping)] + [raw-val (cdr (or (assoc col-name row) '(#f . #f)))] + [attr (schema-lookup-by-ident schema attr-ident)] + [a-id (if attr (db-attribute-id attr) #f)]) + (when (and raw-val a-id) + (let ([vtype (if attr (db-attribute-value-type attr) #f)]) + (let-values ([(v-long v-double v-string v-bool v-ref v-instant) + (classify-value raw-val vtype)]) + (duckdb-eval conn + "INSERT INTO datoms + (e, a, a_name, v_long, v_double, v_string, + v_bool, v_ref, v_instant, tx, added) + VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" + eid a-id + (if attr (symbol->string (db-attribute-ident attr)) #f) + v-long v-double v-string v-bool v-ref v-instant + tx-id #t)))))) + mapping))) + rows)))) + + ;; ---- CSV import ---- + ;; + ;; Same semantics as import-parquet — reads CSV via DuckDB's auto-detect, + ;; then maps columns to attributes. + + (define (import-csv ae path mapping) + (let ([conn (analytics-engine-duckdb-conn ae)] + [schema (analytics-engine-schema-ref ae)] + [tx-id (+ (tx-log-latest-tx (analytics-engine-tx-log-ref ae)) 1)]) + (let ([rows (duckdb-read-csv conn path)]) + (for-each + (lambda (row) + (let ([eid (next-import-eid ae)]) + (for-each + (lambda (col-mapping) + (let* ([col-name (car col-mapping)] + [attr-ident (cdr col-mapping)] + [raw-val (cdr (or (assoc col-name row) '(#f . #f)))] + [attr (schema-lookup-by-ident schema attr-ident)] + [a-id (if attr (db-attribute-id attr) #f)]) + (when (and raw-val a-id) + (let ([vtype (if attr (db-attribute-value-type attr) #f)]) + (let-values ([(v-long v-double v-string v-bool v-ref v-instant) + (classify-value raw-val vtype)]) + (duckdb-eval conn + "INSERT INTO datoms + (e, a, a_name, v_long, v_double, v_string, + v_bool, v_ref, v_instant, tx, added) + VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" + eid a-id + (if attr (symbol->string (db-attribute-ident attr)) #f) + v-long v-double v-string v-bool v-ref v-instant + tx-id #t)))))) + mapping))) + rows)))) + + ;; ---- Close ---- + + (define (analytics-close ae) + (duckdb-close (analytics-engine-duckdb-conn ae)) + (analytics-engine-duckdb-conn-set! ae #f)) + + ;; ---- Internal helpers ---- + + ;; Simple monotonic counter for import entity IDs. + ;; Starts well above any normal entity range so imports don't collide. + (define *import-eid-counter* (expt 2 48)) + + (define (next-import-eid ae) + (let ([eid *import-eid-counter*]) + (set! *import-eid-counter* (+ *import-eid-counter* 1)) + eid)) ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/backup.sls @@ -0,0 +1,198 @@ +#!chezscheme +;;; (jerboa-db backup) — Backup & Restore +;;; +;;; Snapshots the entire database (all four indices + schema + metadata) +;;; to a file using FASL encoding with optional gzip compression. +;;; Restoration creates a fresh in-memory connection and replays all datoms. + +(library (jerboa-db backup) + (export backup! restore!) + + (import (chezscheme) + (jerboa-db datom) + (jerboa-db schema) + (jerboa-db index protocol) + (jerboa-db index memory) + (jerboa-db history) + (jerboa-db core)) + + ;; ---- Magic header ---- + ;; First 8 bytes of every backup file. + (define +backup-magic+ #vu8(74 68 66 75 49 48 48 48)) ;; "JDBU1000" + + ;; ---- Lazy zlib loader ---- + ;; Mirrors the LevelDB lazy loader pattern in core.sls. + ;; The backup format works with or without zlib: + ;; byte 8 = 1 → gzip compressed, 0 → uncompressed + (define zlib-loaded? #f) + (define zlib-gzip #f) + (define zlib-gunzip #f) + + (define (try-load-zlib!) + (unless zlib-loaded? + (guard (exn [#t #f]) + (eval '(import (std compress zlib))) + (set! zlib-gzip (eval 'gzip-bytevector)) + (set! zlib-gunzip (eval 'gunzip-bytevector)) + (set! zlib-loaded? #t)))) + + ;; ---- Schema serialization ---- + ;; Convert schema registry to a plain list for FASL portability. + + (define (schema->plist schema) + ;; Returns a list of (ident id vtype card unique index? comp? doc no-hist?) + (map (lambda (attr) + (list (db-attribute-ident attr) + (db-attribute-id attr) + (db-attribute-value-type attr) + (db-attribute-cardinality attr) + (db-attribute-unique attr) + (db-attribute-index? attr) + (db-attribute-is-component? attr) + (db-attribute-doc attr) + (db-attribute-no-history? attr))) + (schema-all-attributes schema))) + + (define (plist->schema plist) + ;; new-schema-registry bootstraps system attributes (IDs 0..19). + ;; We then install user attributes from the plist on top of that. + (let ([reg (new-schema-registry)]) + (for-each + (lambda (entry) + (let ([ident (list-ref entry 0)] + [id (list-ref entry 1)] + [vtype (list-ref entry 2)] + [card (list-ref entry 3)] + [unique (list-ref entry 4)] + [idx? (list-ref entry 5)] + [comp? (list-ref entry 6)] + [doc (list-ref entry 7)] + [no-hist (list-ref entry 8)]) + ;; Only install user attributes; system ones are already bootstrapped + (when (>= id +first-user-attr-id+) + (let ([attr (make-db-attribute + ident id vtype card unique idx? comp? doc no-hist)]) + (schema-install-attribute! reg attr))))) + plist) + reg)) + + ;; ---- backup! ---- + ;; Serialize connection snapshot to output-path. + ;; Format: + ;; [8 bytes magic] [1 byte: 0=raw, 1=gzip] [FASL payload] + ;; FASL payload is a vector: #(basis-tx next-eid schema-plist datoms-list) + ;; where datoms-list is a list of (e a v tx added?) 5-tuples. + + (define (backup! conn output-path) + ;; Try to load zlib but proceed without it on failure + (try-load-zlib!) + (let* ([current-db (db conn)] + [indices (db-value-indices current-db)] + [schema (db-value-schema current-db)] + [basis-tx (db-value-basis-tx current-db)] + ;; Read next-eid from connection (it's a list cell: (next-eid)) + ;; We reconstruct it by reading all datoms and taking max eid + 1 + [eavt (index-set-eavt indices)] + [all-datoms (dbi-datoms eavt)] + ;; Serialize datoms as plain lists for FASL + [datom-list (map datom->list all-datoms)] + [schema-pl (schema->plist schema)] + ;; Compute next-eid from connection internals via db-stats + [stats (db-stats conn)] + [payload (vector basis-tx + ;; Store eavt-count as a marker; restore computes next-eid + datom-list + schema-pl)]) + ;; FASL-serialize payload to bytevector + (let-values ([(port get-bv) (open-bytevector-output-port)]) + (fasl-write payload port) + (let* ([raw-bv (get-bv)] + [use-gzip (and zlib-gzip #t)] + [data-bv (if use-gzip (zlib-gzip raw-bv) raw-bv)]) + ;; Write binary data: magic + compression flag + payload + (let ([out (open-file-output-port output-path + (file-options no-fail) + (buffer-mode block))]) + (put-bytevector out +backup-magic+) + (put-u8 out (if use-gzip 1 0)) + (put-bytevector out data-bv) + (close-port out)))))) + + ;; ---- restore! ---- + ;; Read a backup file and return a new in-memory connection with all + ;; data replayed. Does NOT call transact! — datoms are inserted directly + ;; into the indices to avoid schema validation overhead and to preserve + ;; original transaction IDs. + + (define (restore! backup-path) + (try-load-zlib!) + ;; Read the file + (let* ([in (open-file-input-port backup-path + (file-options) + (buffer-mode block))] + [magic (get-bytevector-n in 8)] + [flag (get-u8 in)] + [rest (get-bytevector-all in)]) + (close-port in) + ;; Validate magic + (unless (equal? magic +backup-magic+) + (error 'restore! "Not a valid jerboa-db backup file" backup-path)) + ;; Decompress if needed + (let* ([raw-bv (if (= flag 1) + (if zlib-gunzip + (zlib-gunzip rest) + (error 'restore! "Backup is gzip-compressed but zlib is unavailable")) + rest)] + ;; Deserialize FASL + [port (open-bytevector-input-port raw-bv)] + [payload (fasl-read port)]) + (close-port port) + (let* ([basis-tx (vector-ref payload 0)] + [datom-list (vector-ref payload 1)] + [schema-pl (vector-ref payload 2)] + ;; Rebuild schema + [schema (plist->schema schema-pl)] + ;; Create fresh in-memory index set + [indices (make-mem-index-set)] + ;; Replay all datoms directly into indices + [eavt (index-set-eavt indices)] + [aevt (index-set-aevt indices)] + [avet (index-set-avet indices)] + [vaet (index-set-vaet indices)]) + ;; Insert each datom into appropriate indices + (for-each + (lambda (entry) + (let* ([e (list-ref entry 0)] + [a (list-ref entry 1)] + [v (list-ref entry 2)] + [tx (list-ref entry 3)] + [added (list-ref entry 4)] + [d (make-datom e a v tx added)]) + ;; Always insert into EAVT and AEVT + (dbi-add! eavt d) + (dbi-add! aevt d) + ;; Insert into AVET if attribute is indexed + (let ([attr (schema-lookup-by-id schema a)]) + (when (and attr (indexed-attr? attr)) + (dbi-add! avet d)) + ;; Insert into VAET if ref type + (when (and attr (ref-type? attr)) + (dbi-add! vaet d))))) + datom-list) + ;; Compute next-eid = max entity id + 1 + (let ([max-eid (fold-left + (lambda (acc entry) (max acc (list-ref entry 0))) + +first-user-attr-id+ + datom-list)]) + ;; Build the initial db-value + (let* ([initial-db (make-db-value basis-tx indices schema #f #f #f)] + [conn (make-connection + initial-db + (list (+ max-eid 1)) + '() + (new-db-cache 10000) + ":memory:" + #f)]) + conn)))))) + +) ;; end library --- a/lib/jerboa-db/core.sls +++ b/lib/jerboa-db/core.sls @@ -7,7 +7,7 @@ (library (jerboa-db core) (export ;; Connection - connect connection? db + connect close connection? db ;; Transactions transact! tempid tempid? @@ -15,7 +15,7 @@ tx-report-tx-data tx-report-tempids ;; Query - q + q explain-query ;; Pull API pull pull-many @@ -30,7 +30,12 @@ tx-range ;; Utilities - db-stats schema-for) + db-stats schema-for + + ;; Internal constructors (used by backup/restore) + make-connection new-db-cache + connection-current-db-set! + connection-next-eid connection-next-eid-set!) (import (chezscheme) (jerboa-db datom) @@ -53,21 +58,55 @@ (mutable next-eid) ;; next entity ID to assign (mutable cell) (mutable tx-log) ;; list of tx-reports (most recent first) (mutable db-cache) ;; LRU cache - path)) ;; storage path (":memory:" for in-memory) + path ;; storage path (":memory:" for in-memory) + (mutable db-handles))) ;; LevelDB handles for cleanup (#f for in-memory) ;; ---- connect ---- + ;; path = ":memory:" → in-memory RB-tree indices + ;; path = anything else → LevelDB-backed persistent indices + + ;; Lazy loader for LevelDB backend — avoids loading the shared library + ;; until a persistent connection is actually requested. + (define leveldb-loaded? #f) + (define leveldb-make-index-set #f) + (define leveldb-close-index-set #f) + + (define (ensure-leveldb!) + (unless leveldb-loaded? + (eval '(import (jerboa-db index leveldb))) + (set! leveldb-make-index-set + (eval 'make-leveldb-index-set)) + (set! leveldb-close-index-set + (eval 'close-leveldb-index-set)) + (set! leveldb-loaded? #t))) (define (connect path) - (let* ([schema (new-schema-registry)] - [indices (make-mem-index-set)] - [initial-db (make-db-value 0 indices schema #f #f #f)] - [conn (make-connection - initial-db - (list +first-user-attr-id+) ;; next-eid cell (mutable pair) - '() - (new-db-cache 10000) - path)]) - conn)) + (let-values ([(indices handles) + (if (string=? path ":memory:") + (values (make-mem-index-set) #f) + (begin + (ensure-leveldb!) + (leveldb-make-index-set path)))]) + (let* ([schema (new-schema-registry)] + [initial-db (make-db-value 0 indices schema #f #f #f)] + [conn (make-connection + initial-db + (list +first-user-attr-id+) + '() + (new-db-cache 10000) + path + handles)]) + conn))) + + ;; ---- close ---- + ;; Close a persistent connection. No-op for in-memory. + + (define (close conn) + (let ([handles (connection-db-handles conn)]) + (when handles + (when leveldb-close-index-set + (leveldb-close-index-set handles)) + (connection-db-handles-set! conn #f)))) ;; ---- db: get current database value ---- new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/excision.sls @@ -0,0 +1,92 @@ +#!chezscheme +;;; (jerboa-db excision) — GDPR Excision +;;; +;;; Permanently removes datoms from ALL indices. +;;; Unlike retraction (which adds a retraction datom), excision physically +;;; deletes matching datoms so they cannot be retrieved even via history queries. +;;; +;;; WARNING: This is a destructive, irreversible operation. +;;; Use only for GDPR/legal compliance requirements. + +(library (jerboa-db excision) + (export + excise! + excise-entity! + excise-attribute!) + + (import (chezscheme) + (jerboa-db datom) + (jerboa-db schema) + (jerboa-db index protocol) + (jerboa-db history) + (jerboa-db core)) + + ;; ---- Internal: remove datom from all four indices ---- + + (define (remove-from-all-indices! indices datom) + (dbi-remove! (index-set-eavt indices) datom) + (dbi-remove! (index-set-aevt indices) datom) + ;; AVET and VAET only contain datoms for indexed/ref attributes, + ;; but calling remove! on a non-existent datom is safe (no-op). + (dbi-remove! (index-set-avet indices) datom) + (dbi-remove! (index-set-vaet indices) datom)) + + ;; ---- Internal: find all datoms matching a predicate in EAVT ---- + + (define (scan-eavt-matching indices pred) + ;; Scan all datoms in EAVT and collect those matching pred. + ;; Returns a list of datoms (both assertions and retractions). + (filter pred (dbi-datoms (index-set-eavt indices)))) + + ;; ---- excise! ---- + ;; spec: alist with optional keys: + ;; (entity . eid) — match this entity only + ;; (attribute . attr-ident) — match this attribute only + ;; (before-tx . tx-id) — match datoms with tx < tx-id only + ;; + ;; All matching datoms are physically removed from ALL indices. + + (define (excise! conn excision-spec) + (let* ([current-db (db conn)] + [indices (db-value-indices current-db)] + [schema (db-value-schema current-db)] + [eid-filter (let ([p (assq 'entity excision-spec)]) + (and p (cdr p)))] + [attr-filter (let ([p (assq 'attribute excision-spec)]) + (and p (cdr p)))] + [tx-filter (let ([p (assq 'before-tx excision-spec)]) + (and p (cdr p)))] + ;; Resolve attribute ident to id if provided + [aid-filter (and attr-filter + (let ([attr (schema-lookup-by-ident schema attr-filter)]) + (and attr (db-attribute-id attr))))]) + ;; Validate attribute ident + (when (and attr-filter (not aid-filter)) + (error 'excise! "Unknown attribute in excision spec" attr-filter)) + ;; Build predicate and collect matching datoms from EAVT scan + (let ([victims (scan-eavt-matching + indices + (lambda (d) + (and (or (not eid-filter) (= (datom-e d) eid-filter)) + (or (not aid-filter) (= (datom-a d) aid-filter)) + (or (not tx-filter) (< (datom-tx d) tx-filter)))))]) + ;; Remove each from all four indices + (for-each + (lambda (d) (remove-from-all-indices! indices d)) + victims) + ;; Return count of excised datoms + (length victims)))) + + ;; ---- excise-entity! ---- + ;; Remove all datoms for eid from all indices. + + (define (excise-entity! conn eid) + (excise! conn `((entity . ,eid)))) + + ;; ---- excise-attribute! ---- + ;; Remove all datoms for (eid, attr-ident) from all indices. + + (define (excise-attribute! conn eid attr-ident) + (excise! conn `((entity . ,eid) (attribute . ,attr-ident)))) + +) ;; end library new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/index/leveldb.sls @@ -0,0 +1,188 @@ +#!chezscheme +;;; (jerboa-db index leveldb) — LevelDB-backed persistent index +;;; +;;; Each covering index (EAVT, AEVT, AVET, VAET) is stored in a +;;; separate LevelDB database directory. Keys are 28-byte encoded +;;; datom keys (from encoding.sls) that sort correctly via bytewise +;;; comparison. Values are FASL-encoded datom records. + +(library (jerboa-db index leveldb) + (export make-leveldb-index-set close-leveldb-index-set) + + (import (chezscheme) + (jerboa-db datom) + (jerboa-db encoding) + (jerboa-db index protocol) + (std db leveldb)) + + ;; ---- FASL encoding for datom values ---- + ;; We store the full datom as the LevelDB value so we can + ;; reconstruct it without a separate value store. + + (define (datom->fasl-bytevector d) + (let-values ([(port extract) (open-bytevector-output-port)]) + (fasl-write (datom->list d) port) + (extract))) + + (define (fasl-bytevector->datom bv) + (let* ([port (open-bytevector-input-port bv)] + [lst (fasl-read port)]) + (apply make-datom lst))) + + ;; ---- Key encoding per index ---- + + (define (datom-value-hash d) + (content-hash-bytes (datom-v d))) + + (define (encode-key-for index-name d) + (let ([vh (datom-value-hash d)]) + (case index-name + [(eavt) (encode-eavt-key (datom-e d) (datom-a d) vh + (datom-tx d) (datom-added? d))] + [(aevt) (encode-aevt-key (datom-a d) (datom-e d) vh + (datom-tx d) (datom-added? d))] + [(avet) (encode-avet-key (datom-a d) vh (datom-e d) + (datom-tx d) (datom-added? d))] + [(vaet) (encode-vaet-key vh (datom-a d) (datom-e d) + (datom-tx d) (datom-added? d))]))) + + ;; ---- Boundary keys for range scans ---- + ;; Build min/max 28-byte keys from partial datom components. + + (define (make-zero-8) (make-bytevector 8 0)) + (define (make-max-8) (make-bytevector 8 #xFF)) + (define (make-zero-4) (make-bytevector 4 0)) + (define (make-max-4) (make-bytevector 4 #xFF)) + + (define (range-lo-key index-name d) + (let ([e (datom-e d)] + [a (datom-a d)] + [v (datom-v d)] + [tx (datom-tx d)]) + (let ([e-bv (encode-eid e)] + [a-bv (encode-aid a)] + [vh (if (sentinel? v) (if (sentinel-min? v) (make-zero-8) (make-max-8)) + (content-hash-bytes v))] + [tx-bv (encode-tx+op tx #t)]) + (case index-name + [(eavt) (bv-concat e-bv a-bv vh tx-bv)] + [(aevt) (bv-concat a-bv e-bv vh tx-bv)] + [(avet) (bv-concat a-bv vh e-bv tx-bv)] + [(vaet) (bv-concat vh a-bv e-bv tx-bv)])))) + + (define (range-hi-key index-name d) + (let ([e (datom-e d)] + [a (datom-a d)] + [v (datom-v d)] + [tx (datom-tx d)]) + (let ([e-bv (encode-eid e)] + [a-bv (encode-aid a)] + [vh (if (sentinel? v) (if (sentinel-min? v) (make-zero-8) (make-max-8)) + (content-hash-bytes v))] + [tx-bv (encode-tx+op tx #t)]) + (case index-name + [(eavt) (bv-concat e-bv a-bv vh tx-bv)] + [(aevt) (bv-concat a-bv e-bv vh tx-bv)] + [(avet) (bv-concat a-bv vh e-bv tx-bv)] + [(vaet) (bv-concat vh a-bv e-bv tx-bv)])))) + + (define (bv-concat . bvs) + (let* ([total (apply + (map bytevector-length bvs))] + [out (make-bytevector total 0)]) + (let loop ([bvs bvs] [off 0]) + (if (null? bvs) + out + (let ([bv (car bvs)] [len (bytevector-length (car bvs))]) + (bytevector-copy! bv 0 out off len) + (loop (cdr bvs) (+ off len))))))) + + ;; Bytevector comparison (for range termination) + (define (bytevector<=? a b) + (let ([alen (bytevector-length a)] + [blen (bytevector-length b)]) + (let loop ([i 0]) + (cond + [(and (= i alen) (= i blen)) #t] ;; equal + [(= i alen) #t] ;; a shorter = a < b + [(= i blen) #f] ;; b shorter = a > b + [(< (bytevector-u8-ref a i) (bytevector-u8-ref b i)) #t] + [(> (bytevector-u8-ref a i) (bytevector-u8-ref b i)) #f] + [else (loop (+ i 1))])))) + + ;; ---- Single LevelDB index ---- + + (define (make-leveldb-index name db-handle) + ;; db-handle: an open leveldb instance for this specific index + + (define (add! datom) + (let ([key (encode-key-for name datom)] + [val (datom->fasl-bytevector datom)]) + (leveldb-put db-handle key val))) + + (define (remove! datom) + (let ([key (encode-key-for name datom)]) + (leveldb-delete db-handle key))) + + (define (range-query start end) + ;; Scan from lo-key to hi-key using iterator + (let ([lo (range-lo-key name start)] + [hi (range-hi-key name end)]) + (leveldb-fold db-handle + (lambda (key val acc) + (cons (fasl-bytevector->datom val) acc)) + '() + lo hi))) + + (define (seek . components) + ;; Prefix-scan with given components + ;; For now, delegate to range-query + (error 'leveldb-index-seek "use range-query instead")) + + (define (count-range start end) + (let ([lo (range-lo-key name start)] + [hi (range-hi-key name end)]) + (leveldb-fold-keys db-handle + (lambda (key acc) (+ acc 1)) + 0 + lo hi))) + + (define (snapshot) + (leveldb-snapshot db-handle)) + + (define (all-datoms) + ;; Full table scan — expensive, use sparingly + (reverse + (leveldb-fold db-handle + (lambda (key val acc) + (cons (fasl-bytevector->datom val) acc)) + '()))) + + (make-dbi name add! remove! range-query seek count-range snapshot all-datoms)) + + ;; ---- Create the four covering indices ---- + + ;; Returns: (values index-set db-handles-list) + ;; Caller must pass db-handles-list to close-leveldb-index-set on shutdown. + (define (make-leveldb-index-set data-path) + (let ([opts (leveldb-options 'create-if-missing #t + 'compression #t + 'lru-cache-capacity (* 64 1024 1024) + 'bloom-filter-bits 10)]) + (let ([eavt-db (leveldb-open (string-append data-path "/eavt") opts)] + [aevt-db (leveldb-open (string-append data-path "/aevt") opts)] + [avet-db (leveldb-open (string-append data-path "/avet") opts)] + [vaet-db (leveldb-open (string-append data-path "/vaet") opts)]) + (values + (make-index-set + (make-leveldb-index 'eavt eavt-db) + (make-leveldb-index 'aevt aevt-db) + (make-leveldb-index 'avet avet-db) + (make-leveldb-index 'vaet vaet-db)) + (list eavt-db aevt-db avet-db vaet-db))))) + + ;; Close all four LevelDB databases. + ;; Accepts the list of db-handles returned as second value from make-leveldb-index-set. + (define (close-leveldb-index-set handles) + (for-each leveldb-close handles)) + +) ;; end library deleted file mode 100644 --- a/lib/jerboa-db/index/lmdb.sls +++ /dev/null @@ -1,201 +0,0 @@ -#!chezscheme -;;; (jerboa-db index lmdb) — LMDB-backed index backend -;;; -;;; Implements the index protocol using LMDB for persistent, crash-safe storage. -;;; Keys are 28-byte bytevectors with bytewise comparison = datom order. -;;; Values are full datom data encoded with FASL. - -(library (jerboa-db index lmdb) - (export make-lmdb-index-set close-lmdb-index-set) - - (import (chezscheme) - (jerboa-db datom) - (jerboa-db encoding) - (jerboa-db index protocol) - (thunderchez lmdb)) - - ;; ---- LMDB environment setup ---- - - (define +map-size+ (* 1024 1024 1024)) ;; 1 GB default - (define +max-dbs+ 10) - - (define (open-lmdb-env path) - (mdb-library-init) - (unless (file-exists? path) (mkdir path)) - (let ([env* (mdb-alloc-env*)]) - (let ([env (mdb-env-create env*)]) - (when (not (= env MDB_SUCCESS)) - (error 'open-lmdb-env "Failed to create LMDB env" (mdb-strerror env))) - (let ([env (foreign-ref 'void* env* 0)]) - (mdb-env-set-mapsize env +map-size+) - (mdb-env-set-maxdbs env +max-dbs+) - (let ([rc (mdb-env-open env path 0 #o664)]) - (when (not (= rc MDB_SUCCESS)) - (error 'open-lmdb-env "Failed to open LMDB env" (mdb-strerror rc)))) - env)))) - - ;; ---- Open a named database ---- - - (define (open-named-db env name) - (let ([txn* (mdb-alloc-txn*)] - [dbi (mdb-alloc-dbi)]) - (let ([rc (mdb-txn-begin env (mdb-null-txn) 0 txn*)]) - (when (not (= rc MDB_SUCCESS)) - (error 'open-named-db "Failed to begin txn" (mdb-strerror rc))) - (let ([txn (foreign-ref 'void* txn* 0)]) - (let ([rc2 (mdb-dbi-open txn name MDB_CREATE dbi)]) - (when (not (= rc2 MDB_SUCCESS)) - (mdb-txn-abort txn) - (error 'open-named-db "Failed to open dbi" (mdb-strerror rc2))) - (let ([db-handle (foreign-ref 'unsigned-32 dbi 0)]) - (mdb-txn-commit txn) - db-handle)))))) - - ;; ---- Create a single LMDB-backed index ---- - - (define (make-lmdb-index env dbi-handle name encode-key-fn decode-key-fn) - - (define (add! datom) - (let ([key-bv (encode-key-fn datom)] - [val-bv (datom->bytevector datom)]) - (let ([txn* (mdb-alloc-txn*)]) - (let ([rc (mdb-txn-begin env (mdb-null-txn) 0 txn*)]) - (when (= rc MDB_SUCCESS) - (let ([txn (foreign-ref 'void* txn* 0)] - [k (make-mdb-val key-bv)] - [v (make-mdb-val val-bv)]) - (let ([rc2 (mdb-put txn dbi-handle k v 0)]) - (if (= rc2 MDB_SUCCESS) - (mdb-txn-commit txn) - (mdb-txn-abort txn))))))))) - - (define (remove! datom) - (let ([key-bv (encode-key-fn datom)]) - (let ([txn* (mdb-alloc-txn*)]) - (let ([rc (mdb-txn-begin env (mdb-null-txn) 0 txn*)]) - (when (= rc MDB_SUCCESS) - (let ([txn (foreign-ref 'void* txn* 0)] - [k (make-mdb-val key-bv)]) - (mdb-del txn dbi-handle k (mdb-null-val)) - (mdb-txn-commit txn))))))) - - (define (range-query start end) - (let ([start-key (encode-key-fn start)] - [end-key (encode-key-fn end)] - [results '()]) - (let ([txn* (mdb-alloc-txn*)]) - (let ([rc (mdb-txn-begin env (mdb-null-txn) MDB_RDONLY txn*)]) - (when (= rc MDB_SUCCESS) - (let ([txn (foreign-ref 'void* txn* 0)]) - (let ([cursor* (foreign-alloc (foreign-sizeof 'void*))]) - (let ([rc2 (mdb-cursor-open txn dbi-handle cursor*)]) - (when (= rc2 MDB_SUCCESS) - (let ([cursor (foreign-ref 'void* cursor* 0)] - [k (make-mdb-val start-key)]