feat: implement jerboa-db Datomic-style database
ober
cef3462800c3c2049e6be927efdf17c8543f5a61
new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,40 @@ +SCHEME = scheme +JERBOA_DIR = $(HOME)/mine/jerboa +LIBDIRS = lib:$(JERBOA_DIR)/lib + +# Chez external FFI libs (for LMDB, DuckDB, etc.) +CHEZ_EXT_DIR ?= $(HOME)/src +CHEZ_EXT_LIBDIRS = $(CHEZ_EXT_DIR)/chez-lmdb:$(CHEZ_EXT_DIR)/chez-duckdb +FULL_LIBDIRS = $(LIBDIRS):$(CHEZ_EXT_LIBDIRS) + +.PHONY: test build clean check + +# Run the core test suite (in-memory, no FFI deps) +test: + $(SCHEME) --libdirs "$(LIBDIRS)" --script tests/test-core.ss + +# Run tests including LMDB backend +test-lmdb: + $(SCHEME) --libdirs "$(FULL_LIBDIRS)" --script tests/test-lmdb.ss + +# Compile all libraries (catches syntax/import errors) +build: + @echo "Compiling jerboa-db libraries..." + $(SCHEME) --libdirs "$(LIBDIRS)" --program /dev/null \ + --import-notify <<< '(import (jerboa-db core))' 2>&1 || true + @echo "Build check complete." + +# Syntax check all .sls files +check: + @echo "Checking library files..." + @for f in $$(find lib -name "*.sls"); do \ + echo " $$f"; \ + $(SCHEME) --libdirs "$(LIBDIRS)" --script /dev/null 2>&1 | head -5 || true; \ + done + @echo "Check complete." + +# Clean compiled artifacts +clean: + find lib -name "*.so" -delete + find lib -name "*.wpo" -delete + rm -rf /tmp/jerboa-db-test-* new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/analytics.sls @@ -0,0 +1,143 @@ +#!chezscheme +;;; (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. + +(library (jerboa-db analytics) + (export + new-analytics-engine analytics-engine? + analytics-sync! analytics-query + export-parquet import-parquet import-csv) + + (import (chezscheme) + (jerboa-db datom) + (jerboa-db schema) + (jerboa-db tx-log)) + + ;; ---- Analytics engine record ---- + + (define-record-type analytics-engine + (fields (mutable duckdb-conn) ;; DuckDB connection handle + (mutable last-synced-tx) ;; last tx synced to DuckDB + schema-ref ;; reference to schema registry + tx-log-ref)) ;; reference to transaction log + + (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))) + + ;; ---- 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)) + + (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) + "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)")) + + ;; ---- 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)] + [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))]) + (for-each + (lambda (entry) + (for-each + (lambda (dv) + (insert-datom-row! ae schema dv)) + (tx-log-entry-datoms entry))) + entries) + (when (pair? entries) + (analytics-engine-last-synced-tx-set! ae + (tx-log-entry-tx-id (car (reverse entries))))))) + + (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)] + [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))))) + + ;; ---- SQL query ---- + + (define (analytics-query ae sql-string . params) + ;; Ensure synced, then execute SQL + (analytics-sync! ae) + (duckdb-query (analytics-engine-duckdb-conn ae) sql-string params)) + + ;; ---- Parquet export ---- + + (define (export-parquet ae path . opts) + ;; Uses DuckDB's native Parquet writer + (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))))))) + +) ;; end library new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/cache.sls @@ -0,0 +1,103 @@ +#!chezscheme +;;; (jerboa-db cache) — LRU datom/entity cache +;;; +;;; Wraps an LRU cache for hot datoms and entity maps. +;;; Cache invalidation is trivial because data is immutable — +;;; new transactions only add entries, never modify existing ones. + +(library (jerboa-db cache) + (export + new-db-cache db-cache? + cache-get cache-put! cache-clear! cache-stats + cache-get-entity cache-put-entity!) + + (import (chezscheme)) + + ;; Simple LRU cache using a hashtable + doubly-linked list (mutable pairs). + ;; We inline this to avoid depending on (std misc lru-cache) at library level. + + (define-record-type db-cache + (fields (mutable capacity) + (mutable datom-ht) ;; eq-hashtable: key -> value + (mutable datom-order) ;; list of keys in access order (MRU first) + (mutable entity-ht) + (mutable entity-order) + (mutable hits) + (mutable misses))) + + (define (new-db-cache capacity) + (make-db-cache capacity + (make-hashtable equal-hash equal?) '() + (make-hashtable equal-hash equal?) '() + 0 0)) + + ;; ---- Generic cache ops over a ht + order pair ---- + + (define (lru-get cache ht order-getter order-setter! key default) + (let ([v (hashtable-ref ht key 'NOT-FOUND)]) + (if (eq? v 'NOT-FOUND) + (begin + (db-cache-misses-set! cache (+ (db-cache-misses cache) 1)) + default) + (begin + (db-cache-hits-set! cache (+ (db-cache-hits cache) 1)) + ;; Move to front + (order-setter! cache (cons key (remq key (order-getter cache)))) + v)))) + + (define (lru-put! cache ht order-getter order-setter! key value) + (let ([cap (db-cache-capacity cache)]) + (hashtable-set! ht key value) + (let ([new-order (cons key (remq key (order-getter cache)))]) + ;; Evict if over capacity + (when (> (length new-order) cap) + (let ([victim (list-ref new-order (- (length new-order) 1))]) + (hashtable-delete! ht victim) + (set! new-order (reverse (cdr (reverse new-order)))))) + (order-setter! cache new-order)))) + + ;; ---- Datom cache ---- + + (define (cache-get cache key default) + (lru-get cache (db-cache-datom-ht cache) + db-cache-datom-order db-cache-datom-order-set! + key default)) + + (define (cache-put! cache key value) + (lru-put! cache (db-cache-datom-ht cache) + db-cache-datom-order db-cache-datom-order-set! + key value)) + + ;; ---- Entity cache ---- + + (define (cache-get-entity cache eid default) + (lru-get cache (db-cache-entity-ht cache) + db-cache-entity-order db-cache-entity-order-set! + eid default)) + + (define (cache-put-entity! cache eid entity) + (lru-put! cache (db-cache-entity-ht cache) + db-cache-entity-order db-cache-entity-order-set! + eid entity)) + + ;; ---- Maintenance ---- + + (define (cache-clear! cache) + (hashtable-clear! (db-cache-datom-ht cache)) + (db-cache-datom-order-set! cache '()) + (hashtable-clear! (db-cache-entity-ht cache)) + (db-cache-entity-order-set! cache '()) + (db-cache-hits-set! cache 0) + (db-cache-misses-set! cache 0)) + + (define (cache-stats cache) + (let ([hits (db-cache-hits cache)] + [misses (db-cache-misses cache)]) + `((hits . ,hits) + (misses . ,misses) + (hit-rate . ,(if (= (+ hits misses) 0) 0.0 + (inexact (/ hits (+ hits misses))))) + (datom-size . ,(hashtable-size (db-cache-datom-ht cache))) + (entity-size . ,(hashtable-size (db-cache-entity-ht cache)))))) + +) ;; end library new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/core.sls @@ -0,0 +1,190 @@ +#!chezscheme +;;; (jerboa-db core) — Public API +;;; +;;; This is the primary entry point for Jerboa-DB. +;;; connect, db, transact!, q, pull, entity, as-of, since, history + +(library (jerboa-db core) + (export + ;; Connection + connect connection? db + + ;; Transactions + transact! tempid tempid? + tx-report? tx-report-db-before tx-report-db-after + tx-report-tx-data tx-report-tempids + + ;; Query + q + + ;; Pull API + pull pull-many + + ;; Entity API + entity touch + + ;; Time-travel + as-of since history + + ;; Transaction log + tx-range + + ;; Utilities + db-stats schema-for) + + (import (chezscheme) + (jerboa-db datom) + (jerboa-db schema) + (jerboa-db index protocol) + (jerboa-db index memory) + (jerboa-db history) + (jerboa-db cache) + (jerboa-db tx) + (jerboa-db query engine) + (jerboa-db query pull) + (jerboa-db entity)) + + ;; ---- Connection ---- + ;; A connection holds the mutable state: current db-value, entity counter, + ;; transaction log, and cache. + + (define-record-type connection + (fields (mutable current-db) ;; db-value + (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) + + ;; ---- connect ---- + + (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)) + + ;; ---- db: get current database value ---- + + (define (db conn) + (connection-current-db conn)) + + ;; ---- transact! ---- + + (define (transact! conn tx-ops) + (let* ([current (connection-current-db conn)] + [eid-cell (connection-next-eid conn)] + [report (process-transaction current tx-ops eid-cell)]) + ;; Update schema if schema attributes were transacted + (materialize-schema-datoms! (db-value-schema (tx-report-db-after report)) + (tx-report-tx-data report)) + ;; Update connection state + (connection-current-db-set! conn (tx-report-db-after report)) + (connection-tx-log-set! conn (cons report (connection-tx-log conn))) + ;; Clear entity cache (conservative — could be smarter) + (cache-clear! (connection-db-cache conn)) + report)) + + ;; ---- Schema materialization ---- + ;; When datoms define schema attributes, materialize them into the registry. + + (define (materialize-schema-datoms! schema datoms) + ;; Collect datoms that define schema attributes (those with db/ident) + ;; Group by entity, then build db-attribute records. + (let ([ident-datoms (filter (lambda (d) + (and (datom-added? d) + (let ([attr (schema-lookup-by-id schema (datom-a d))]) + (and attr + (eq? (db-attribute-ident attr) 'db/ident))))) + datoms)]) + (for-each + (lambda (ident-datom) + (let* ([eid (datom-e ident-datom)] + [attr-ident (datom-v ident-datom)] + ;; Find other schema datoms for this entity + [entity-datoms (filter (lambda (d) + (and (= (datom-e d) eid) + (datom-added? d))) + datoms)] + [get-val (lambda (attr-name) + (let ([d (find (lambda (d) + (let ([a (schema-lookup-by-id schema (datom-a d))]) + (and a (eq? (db-attribute-ident a) attr-name)))) + entity-datoms)]) + (and d (datom-v d))))] + [vtype (or (get-val 'db/valueType) 'db.type/string)] + [card (or (get-val 'db/cardinality) 'db.cardinality/one)] + [uniq (get-val 'db/unique)] + [idx? (get-val 'db/index)] + [doc (get-val 'db/doc)] + [comp? (get-val 'db/isComponent)] + [no-hist? (get-val 'db/noHistory)] + ;; Assign or lookup attribute ID + [aid (schema-intern-attr! schema attr-ident)] + [db-attr (make-db-attribute + attr-ident aid vtype card + uniq (or idx? (and uniq #t)) + comp? doc no-hist?)]) + (schema-install-attribute! schema db-attr))) + ident-datoms))) + + ;; ---- q: Datalog query ---- + + (define (q query-form db-val . inputs) + (let ([parsed (parse-query query-form)]) + (apply query-db parsed db-val inputs))) + + ;; ---- pull ---- + + (define (pull db-val pattern eid) + (pull-entity db-val pattern eid)) + + ;; pull-many re-exported from (jerboa-db query pull) + + ;; ---- entity ---- + + (define (entity db-val eid) + (new-entity-map eid db-val)) + + (define (touch ent) + (entity-touch ent)) + + ;; ---- Time-travel (re-exported) ---- + ;; as-of, since, history are re-exported from (jerboa-db history) + + ;; ---- Transaction log access ---- + + (define (tx-range conn start-tx end-tx) + ;; Return datoms from the transaction log between start-tx and end-tx + (let loop ([log (connection-tx-log conn)] [result '()]) + (if (null? log) + result + (let* ([report (car log)] + [tx-data (tx-report-tx-data report)]) + (let ([matching (filter (lambda (d) + (let ([tx (datom-tx d)]) + (and (>= tx start-tx) (< tx end-tx)))) + tx-data)]) + (loop (cdr log) (append matching result))))))) + + ;; ---- Utilities ---- + + (define (db-stats conn) + (let* ([current (db conn)] + [indices (db-value-indices current)]) + `((basis-tx . ,(db-value-basis-tx current)) + (eavt-count . ,(length (dbi-datoms (index-set-eavt indices)))) + (aevt-count . ,(length (dbi-datoms (index-set-aevt indices)))) + (avet-count . ,(length (dbi-datoms (index-set-avet indices)))) + (vaet-count . ,(length (dbi-datoms (index-set-vaet indices)))) + (cache . ,(cache-stats (connection-db-cache conn)))))) + + (define (schema-for conn) + (schema-all-attributes (db-value-schema (db conn)))) + +) ;; end library new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/datom.sls @@ -0,0 +1,163 @@ +#!chezscheme +;;; (jerboa-db datom) — Datom record and index comparison functions +;;; +;;; The fundamental unit of data: [entity attribute value transaction added?] +;;; Four covering indices sort datoms in different orders for different access patterns. + +(library (jerboa-db datom) + (export + ;; Datom record + make-datom datom? datom-e datom-a datom-v datom-tx datom-added? + + ;; Sentinel values for range query boundaries + +min-val+ +max-val+ sentinel? sentinel-min? sentinel-max? + + ;; Comparison functions (three-way: -1, 0, 1) + compare-values compare-datoms-eavt compare-datoms-aevt + compare-datoms-avet compare-datoms-vaet + + ;; Datom utilities + datom->list datom-matches?) + + (import (chezscheme)) + + ;; ---- Sentinel values for range boundaries ---- + ;; Used to construct probe datoms for index range scans. + ;; +min-val+ compares less than any real value. + ;; +max-val+ compares greater than any real value. + + (define-record-type sentinel (fields kind)) + (define +min-val+ (make-sentinel 'min)) + (define +max-val+ (make-sentinel 'max)) + + (define (sentinel-min? x) (and (sentinel? x) (eq? (sentinel-kind x) 'min))) + (define (sentinel-max? x) (and (sentinel? x) (eq? (sentinel-kind x) 'max))) + + ;; ---- Datom record ---- + + (define-record-type datom + (fields e ;; entity id (integer) + a ;; attribute id (integer, interned from keyword) + v ;; value (scheme value — type depends on attribute schema) + tx ;; transaction id (integer, monotonically increasing) + added? ;; #t = assertion, #f = retraction + )) + + ;; ---- Three-way comparison helpers ---- + + (define (compare-int a b) + (cond [(< a b) -1] [(> a b) 1] [else 0])) + + ;; Generic value comparison. Handles sentinels, then dispatches on type. + ;; Values of different types are ordered by type tag to ensure total ordering. + (define (compare-values a b) + (cond + ;; Sentinels + [(sentinel? a) + (cond [(sentinel-min? a) (if (sentinel-min? b) 0 -1)] + [else (if (sentinel-max? b) 0 1)])] ;; max sentinel + [(sentinel? b) + (cond [(sentinel-min? b) 1] + [else -1])] ;; b is max sentinel + ;; Same-type comparisons + [(and (fixnum? a) (fixnum? b)) (compare-int a b)] + [(and (number? a) (number? b)) + (cond [(< a b) -1] [(> a b) 1] [else 0])] + [(and (string? a) (string? b)) + (cond [(string<? a b) -1] [(string>? a b) 1] [else 0])] + [(and (boolean? a) (boolean? b)) + (cond [(eq? a b) 0] [a 1] [else -1])] + [(and (symbol? a) (symbol? b)) + (let ([sa (symbol->string a)] [sb (symbol->string b)]) + (cond [(string<? sa sb) -1] [(string>? sa sb) 1] [else 0]))] + [(and (bytevector? a) (bytevector? b)) + (let ([la (bytevector-length a)] [lb (bytevector-length b)]) + (let loop ([i 0]) + (cond + [(and (= i la) (= i lb)) 0] + [(= i la) -1] + [(= i lb) 1] + [else + (let ([ba (bytevector-u8-ref a i)] [bb (bytevector-u8-ref b i)]) + (cond [(< ba bb) -1] [(> ba bb) 1] + [else (loop (+ i 1))]))])))] + ;; Cross-type ordering by type tag + [else + (let ([ta (type-tag a)] [tb (type-tag b)]) + (compare-int ta tb))])) + + ;; Assign a numeric tag to each value type for total cross-type ordering + (define (type-tag v) + (cond + [(boolean? v) 0] + [(fixnum? v) 1] + [(number? v) 2] + [(string? v) 3] + [(symbol? v) 4] + [(bytevector? v) 5] + [(pair? v) 6] + [(vector? v) 7] + [else 8])) + + ;; ---- Cascading comparison ---- + ;; Compares multiple fields in sequence; short-circuits on first non-zero. + + (define-syntax cascade-compare + (syntax-rules () + [(_ e1) e1] + [(_ e1 e2 ...) + (let ([r e1]) + (if (= r 0) (cascade-compare e2 ...) r))])) + + ;; ---- Index comparison functions ---- + ;; Each returns a three-way comparator (-1, 0, 1) suitable for sorted-map. + + ;; EAVT: Entity -> Attribute -> Value -> Tx + ;; "All attributes of entity 42" + (define (compare-datoms-eavt a b) + (cascade-compare + (compare-int (datom-e a) (datom-e b)) + (compare-int (datom-a a) (datom-a b)) + (compare-values (datom-v a) (datom-v b)) + (compare-int (datom-tx a) (datom-tx b)))) + + ;; AEVT: Attribute -> Entity -> Value -> Tx + ;; "All entities with :person/name" + (define (compare-datoms-aevt a b) + (cascade-compare + (compare-int (datom-a a) (datom-a b)) + (compare-int (datom-e a) (datom-e b)) + (compare-values (datom-v a) (datom-v b)) + (compare-int (datom-tx a) (datom-tx b)))) + + ;; AVET: Attribute -> Value -> Entity -> Tx + ;; "Entity where :email = 'a@b.com'" (unique lookup) + (define (compare-datoms-avet a b) + (cascade-compare + (compare-int (datom-a a) (datom-a b)) + (compare-values (datom-v a) (datom-v b)) + (compare-int (datom-e a) (datom-e b)) + (compare-int (datom-tx a) (datom-tx b)))) + + ;; VAET: Value -> Attribute -> Entity -> Tx + ;; "All entities referencing entity 42" (reverse refs) + (define (compare-datoms-vaet a b) + (cascade-compare + (compare-values (datom-v a) (datom-v b)) + (compare-int (datom-a a) (datom-a b)) + (compare-int (datom-e a) (datom-e b)) + (compare-int (datom-tx a) (datom-tx b)))) + + ;; ---- Datom utilities ---- + + (define (datom->list d) + (list (datom-e d) (datom-a d) (datom-v d) (datom-tx d) (datom-added? d))) + + ;; Check if a datom matches given components (use #f for "any") + (define (datom-matches? d e a v tx) + (and (or (not e) (= (datom-e d) e)) + (or (not a) (= (datom-a d) a)) + (or (not v) (equal? (datom-v d) v)) + (or (not tx) (= (datom-tx d) tx)))) + +) ;; end library new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/encoding.sls @@ -0,0 +1,228 @@ +#!chezscheme +;;; (jerboa-db encoding) — Binary encoding for datom keys and values +;;; +;;; LMDB keys must be bytevectors with correct bytewise sort order. +;;; All integers are big-endian so memcmp gives numeric ordering. +;;; The added? flag is encoded in the high bit of the tx field. + +(library (jerboa-db encoding) + (export + ;; Integer encoding + encode-eid decode-eid encode-aid decode-aid + encode-tx+op decode-tx+op + + ;; Value encoding + encode-value-inline encode-value-hash + decode-value-inline + + ;; Full datom key encoding (28 bytes per index) + encode-eavt-key encode-aevt-key encode-avet-key encode-vaet-key + decode-eavt-key decode-aevt-key decode-avet-key decode-vaet-key + + ;; Sortable double encoding + encode-f64-sortable decode-f64-sortable + + ;; Content hashing for variable-length values + content-hash-bytes) + + (import (chezscheme)) + + ;; ---- Entity ID: big-endian unsigned 64-bit ---- + + (define (encode-eid eid) + (let ([bv (make-bytevector 8 0)]) + (bytevector-u64-set! bv 0 eid (endianness big)) + bv)) + + (define (decode-eid bv offset) + (bytevector-u64-ref bv offset (endianness big))) + + ;; ---- Attribute ID: big-endian unsigned 32-bit ---- + + (define (encode-aid aid) + (let ([bv (make-bytevector 4 0)]) + (bytevector-u32-set! bv 0 aid (endianness big)) + bv)) + + (define (decode-aid bv offset) + (bytevector-u32-ref bv offset (endianness big))) + + ;; ---- Transaction ID + added? flag ---- + ;; High bit of 64-bit tx: 0 = assertion, 1 = retraction + + (define +retract-bit+ #x8000000000000000) + + (define (encode-tx+op tx added?) + (let ([bv (make-bytevector 8 0)] + [encoded (if added? tx (bitwise-ior tx +retract-bit+))]) + (bytevector-u64-set! bv 0 encoded (endianness big)) + bv)) + + (define (decode-tx+op bv offset) + (let ([raw (bytevector-u64-ref bv offset (endianness big))]) + (if (bitwise-bit-set? raw 63) + (values (bitwise-and raw (- +retract-bit+ 1)) #f) ;; retraction + (values raw #t)))) ;; assertion + + ;; ---- Value encoding ---- + ;; Values that fit in 8 bytes are encoded inline. + ;; Variable-length values are content-hashed to 8 bytes. + + (define (encode-value-inline value type) + (let ([bv (make-bytevector 8 0)]) + (case type + [(db.type/long) + ;; Signed integer: offset by min-fixnum so bytewise order = numeric order + (bytevector-u64-set! bv 0 + (bitwise-and (+ value #x8000000000000000) #xFFFFFFFFFFFFFFFF) + (endianness big))] + [(db.type/double) + (let ([encoded (encode-f64-sortable value)]) + (bytevector-copy! encoded 0 bv 0 8))] + [(db.type/boolean) + (bytevector-u8-set! bv 7 (if value 1 0))] + [(db.type/instant) + ;; Epoch nanoseconds or seconds as u64 + (bytevector-u64-set! bv 0 (if (integer? value) value 0) (endianness big))] + [(db.type/ref) + (bytevector-u64-set! bv 0 value (endianness big))] + [else + ;; Variable-length: use hash + (bytevector-copy! (content-hash-bytes value) 0 bv 0 8)]) + bv)) + + (define (decode-value-inline bv offset type) + (case type + [(db.type/long) + (- (bytevector-u64-ref bv offset (endianness big)) #x8000000000000000)] + [(db.type/double) + (let ([sub (make-bytevector 8)]) + (bytevector-copy! bv offset sub 0 8) + (decode-f64-sortable sub))] + [(db.type/boolean) + (= (bytevector-u8-ref bv (+ offset 7)) 1)] + [(db.type/instant) + (bytevector-u64-ref bv offset (endianness big))] + [(db.type/ref) + (bytevector-u64-ref bv offset (endianness big))] + [else #f])) ;; variable-length needs value-store lookup + + (define (encode-value-hash value) + (content-hash-bytes value)) + + ;; ---- Sortable IEEE 754 double encoding ---- + ;; XOR sign bit, flip all bits if negative. + ;; This makes bytewise comparison equal numeric comparison. + + (define (encode-f64-sortable d) + (let ([bv (make-bytevector 8)]) + (bytevector-ieee-double-set! bv 0 d (endianness big)) + (let ([high (bytevector-u8-ref bv 0)]) + (if (bitwise-bit-set? high 7) + ;; Negative: flip all bits + (let ([out (make-bytevector 8)]) + (do ([i 0 (+ i 1)]) + ((= i 8) out) + (bytevector-u8-set! out i + (bitwise-xor (bytevector-u8-ref bv i) #xFF)))) + ;; Positive or zero: flip sign bit + (begin + (bytevector-u8-set! bv 0 (bitwise-xor high #x80)) + bv))))) + + (define (decode-f64-sortable bv) + (let ([high (bytevector-u8-ref bv 0)]) + (if (bitwise-bit-set? high 7) + ;; Was positive: flip sign bit back + (let ([out (make-bytevector 8)]) + (bytevector-copy! bv 0 out 0 8) + (bytevector-u8-set! out 0 (bitwise-xor high #x80)) + (bytevector-ieee-double-ref out 0 (endianness big))) + ;; Was negative: flip all bits back + (let ([out (make-bytevector 8)]) + (do ([i 0 (+ i 1)]) + ((= i 8)) + (bytevector-u8-set! out i + (bitwise-xor (bytevector-u8-ref bv i) #xFF))) + (bytevector-ieee-double-ref out 0 (endianness big)))))) + + ;; ---- Content hashing (FNV-1a 64-bit) ---- + ;; Used for variable-length values in index keys. + + (define +fnv-offset+ 14695981039346656037) + (define +fnv-prime+ 1099511628211) + + (define (content-hash-bytes value) + (let* ([data (cond + [(string? value) (string->utf8 value)] + [(bytevector? value) value] + [(symbol? value) (string->utf8 (symbol->string value))] + [else (string->utf8 (format "~a" value))])] + [hash (fnv1a-64 data)] + [bv (make-bytevector 8)]) + (bytevector-u64-set! bv 0 hash (endianness big)) + bv)) + + (define (fnv1a-64 data) + (let ([len (bytevector-length data)]) + (let loop ([i 0] [h +fnv-offset+]) + (if (>= i len) + (bitwise-and h #xFFFFFFFFFFFFFFFF) + (let* ([byte (bytevector-u8-ref data i)] + [h2 (bitwise-xor h byte)] + [h3 (bitwise-and (* h2 +fnv-prime+) #xFFFFFFFFFFFFFFFF)]) + (loop (+ i 1) h3)))))) + + ;; ---- Full 28-byte index key construction ---- + + (define (encode-eavt-key e a v-hash tx added?) + (let ([bv (make-bytevector 28 0)]) + (bytevector-copy! (encode-eid e) 0 bv 0 8) + (bytevector-copy! (encode-aid a) 0 bv 8 4) + (bytevector-copy! v-hash 0 bv 12 8) + (bytevector-copy! (encode-tx+op tx added?) 0 bv 20 8) + bv)) + + (define (encode-aevt-key a e v-hash tx added?) + (let ([bv (make-bytevector 28 0)]) + (bytevector-copy! (encode-aid a) 0 bv 0 4) + (bytevector-copy! (encode-eid e) 0 bv 4 8) + (bytevector-copy! v-hash 0 bv 12 8) + (bytevector-copy! (encode-tx+op tx added?) 0 bv 20 8) + bv)) + + (define (encode-avet-key a v-hash e tx added?) + (let ([bv (make-bytevector 28 0)]) + (bytevector-copy! (encode-aid a) 0 bv 0 4) + (bytevector-copy! v-hash 0 bv 4 8) + (bytevector-copy! (encode-eid e) 0 bv 12 8) + (bytevector-copy! (encode-tx+op tx added?) 0 bv 20 8) + bv)) + + (define (encode-vaet-key v-hash a e tx added?) + (let ([bv (make-bytevector 28 0)]) + (bytevector-copy! v-hash 0 bv 0 8) + (bytevector-copy! (encode-aid a) 0 bv 8 4) + (bytevector-copy! (encode-eid e) 0 bv 12 8) + (bytevector-copy! (encode-tx+op tx added?) 0 bv 20 8) + bv)) + + ;; ---- Key decoding ---- + + (define (decode-eavt-key bv) + (let-values ([(tx added?) (decode-tx+op bv 20)]) + (values (decode-eid bv 0) (decode-aid bv 8) tx added?))) + + (define (decode-aevt-key bv) + (let-values ([(tx added?) (decode-tx+op bv 20)]) + (values (decode-aid bv 0) (decode-eid bv 4) tx added?))) + + (define (decode-avet-key bv) + (let-values ([(tx added?) (decode-tx+op bv 20)]) + (values (decode-aid bv 0) (decode-eid bv 12) tx added?))) + + (define (decode-vaet-key bv) + (let-values ([(tx added?) (decode-tx+op bv 20)]) + (values (decode-aid bv 8) (decode-eid bv 12) tx added?))) + +) ;; end library new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/entity.sls @@ -0,0 +1,131 @@ +#!chezscheme +;;; (jerboa-db entity) — Lazy navigable entity maps +;;; +;;; An entity is a lazy, navigable view of all datoms for a given entity ID. +;;; Attributes are loaded on demand. Ref attributes return other entity objects. + +(library (jerboa-db entity) + (export + new-entity-map entity-map? entity-map-eid + entity-get entity-touch entity-keys) + + (import (chezscheme) + (jerboa-db datom) + (jerboa-db schema) + (jerboa-db index protocol) + (jerboa-db history)) + + ;; ---- Entity map ---- + ;; Lazy: attributes are fetched from the index on first access. + ;; The cache stores materialized attribute values. + + (define-record-type entity-map + (fields eid ;; integer + db ;; db-value (for index access) + (mutable cache) ;; hashtable: attr-ident -> value(s) + (mutable touched?))) ;; #t if all attributes loaded + + (define (new-entity-map eid db) + (make-entity-map eid db (make-eq-hashtable) #f)) + + ;; ---- Attribute access ---- + + (define (entity-get ent attr-ident) + (let ([cache (entity-map-cache ent)]) + (if (hashtable-contains? cache attr-ident) + (hashtable-ref cache attr-ident #f) + ;; Load from index + (let* ([db (entity-map-db ent)] + [schema (db-value-schema db)] + [attr (schema-lookup-by-ident schema attr-ident)]) + (if (not attr) + #f + (let* ([eid (entity-map-eid ent)] + [aid (db-attribute-id attr)] + [eavt (db-resolve-index db 'eavt)] + [lo (make-datom eid aid +min-val+ 0 #t)] + [hi (make-datom eid aid +max-val+ (greatest-fixnum) #t)] + [raw (dbi-range eavt lo hi)] + [filtered (filter (lambda (d) (db-filter-datom? db d)) raw)] + ;; Resolve current state: group by value, keep highest-tx + [datoms (let ([ht (make-hashtable equal-hash equal?)]) + (for-each + (lambda (d) + (let ([v (datom-v d)]) + (let ([ex (hashtable-ref ht v #f)]) + (when (or (not ex) (> (datom-tx d) (datom-tx ex))) + (hashtable-set! ht v d))))) + filtered) + (let-values ([(ks vs) (hashtable-entries ht)]) + (filter datom-added? (vector->list vs))))] + [values (map datom-v datoms)] + [result (cond + [(null? values) #f] + [(eq? (db-attribute-cardinality attr) + 'db.cardinality/one) + ;; Return single value; for refs, wrap in entity + (let ([v (car values)]) + (if (eq? (db-attribute-value-type attr) 'db.type/ref) + (new-entity-map v db) + v))] + [else + ;; Cardinality many: return list + (if (eq? (db-attribute-value-type attr) 'db.type/ref) + (map (lambda (v) (new-entity-map v db)) values) + values)])]) + (hashtable-set! cache attr-ident result) + result)))))) + + ;; ---- Touch: eagerly load all attributes ---- + + (define (entity-touch ent) + (when (not (entity-map-touched? ent)) + (let* ([db (entity-map-db ent)] + [schema (db-value-schema db)] + [eid (entity-map-eid ent)] + [eavt (db-resolve-index db 'eavt)] + [lo (make-datom eid 0 +min-val+ 0 #t)] + [hi (make-datom eid (greatest-fixnum) +max-val+ (greatest-fixnum) #t)] + [raw (dbi-range eavt lo hi)] + [filtered (filter (lambda (d) (db-filter-datom? db d)) raw)] + ;; Resolve current state per (a, v) + [datoms (let ([ht (make-hashtable equal-hash equal?)]) + (for-each + (lambda (d) + (let ([key (cons (datom-a d) (datom-v d))]) + (let ([ex (hashtable-ref ht key #f)]) + (when (or (not ex) (> (datom-tx d) (datom-tx ex))) + (hashtable-set! ht key d))))) + filtered) + (let-values ([(ks vs) (hashtable-entries ht)]) + (filter datom-added? (vector->list vs))))] + [cache (entity-map-cache ent)]) + ;; Group by attribute and store + (for-each + (lambda (d) + (let ([attr (schema-lookup-by-id schema (datom-a d))]) + (when attr + (let ([ident (db-attribute-ident attr)] + [v (datom-v d)]) + (if (eq? (db-attribute-cardinality attr) 'db.cardinality/one) + (hashtable-set! cache ident v) + (hashtable-update! cache ident + (lambda (existing) (cons v existing)) + '())))))) + datoms) + (entity-map-touched?-set! ent #t))) + ;; Return as alist + (let ([cache (entity-map-cache ent)]