perf: 5 query/write optimisations (50x exact-match, 63% mixed workload)
ober
ca6ae0384cc01b9cccb562809476ffd0202908af
--- a/lib/jerboa-db/query/engine.sls +++ b/lib/jerboa-db/query/engine.sls @@ -26,16 +26,19 @@ (char=? (string-ref (symbol->string x) 0) #\?))) ;; ---- Binding environment ---- - ;; A binding is an alist: ((var . value) ...) + ;; A binding is an eq? hashtable: var-symbol → value. + ;; O(1) lookup vs O(n) for alists. Copy-on-extend preserves immutability + ;; across the binding-set list used during clause evaluation. - (define empty-bindings '()) + (define (make-empty-bindings) (make-hashtable symbol-hash eq?)) (define (binding-ref bindings var) - (let ([found (assq var bindings)]) - (and found (cdr found)))) + (hashtable-ref bindings var #f)) (define (binding-set bindings var val) - (cons (cons var val) bindings)) + (let ([new-ht (hashtable-copy bindings #t)]) + (hashtable-set! new-ht var val) + new-ht)) (define (resolve-in-bindings bindings x) (if (logic-var? x) @@ -78,22 +81,23 @@ ;; assertion, the value is live; if a retraction, the value is gone. (define (resolve-current-datoms datoms) - ;; datoms come sorted from an index with tx as last key, so within each - ;; (e,a,v) group, later entries have higher tx. Walk the list, tracking - ;; the latest datom per (e,a,v). - (let ([ht (make-hashtable equal-hash equal?)]) - (for-each - (lambda (d) - (let ([key (list (datom-e d) (datom-a d) (datom-v d))]) - (let ([existing (hashtable-ref ht key #f)]) - (when (or (not existing) - (> (datom-tx d) (datom-tx existing))) - (hashtable-set! ht key d))))) - datoms) - ;; Keep only triples whose latest datom is an assertion - (let-values ([(keys vals) (hashtable-entries ht)]) - (let ([vlist (vector->list vals)]) - (filter datom-added? vlist))))) + ;; Fast path: if no retractions in the scanned range, every datom is a current + ;; assertion — skip the hashtable entirely. This is the common case for + ;; freshly-written or lightly-updated databases. + (if (for-all datom-added? datoms) + datoms + ;; Slow path: build (e,a,v) → latest-datom map and filter for assertions. + (let ([ht (make-hashtable equal-hash equal?)]) + (for-each + (lambda (d) + (let ([key (list (datom-e d) (datom-a d) (datom-v d))]) + (let ([existing (hashtable-ref ht key #f)]) + (when (or (not existing) + (> (datom-tx d) (datom-tx existing))) + (hashtable-set! ht key d))))) + datoms) + (let-values ([(keys vals) (hashtable-entries ht)]) + (filter datom-added? (vector->list vals)))))) ;; ---- Data pattern evaluation ---- ;; A data pattern like (?e person/name ?name) is matched against an index. @@ -118,7 +122,8 @@ [index-name (cond [e-val 'eavt] [(and v-val (ref-type? attr)) 'vaet] - [(and v-val (indexed-attr? attr)) 'avet] + ;; Use AVET for all scalar attrs — tx.sls now indexes them all + [(and v-val (avet-eligible? attr)) 'avet] [else 'aevt])] [idx (db-resolve-index db index-name)] ;; Build range boundaries @@ -331,9 +336,16 @@ (exists (lambda (v) (and (pair? v) (aggregate? (car v)))) find-vars)) (define (apply-aggregates find-vars bindings-list) - ;; Group non-aggregate vars, then aggregate within each group. - (let* ([grouping-vars (filter (lambda (v) (not (and (pair? v) (aggregate? (car v))))) - find-vars)] + ;; Fast path: single (count ?x) with no grouping vars — just count rows. + ;; Skips group-bindings hashtable construction and per-row value extraction. + (if (and (= 1 (length find-vars)) + (pair? (car find-vars)) + (eq? 'count (caar find-vars)) + (logic-var? (cadar find-vars))) + (list (list (length bindings-list))) + ;; General path: group non-aggregate vars, then aggregate within each group. + (let* ([grouping-vars (filter (lambda (v) (not (and (pair? v) (aggregate? (car v))))) + find-vars)] [agg-specs (filter (lambda (v) (and (pair? v) (aggregate? (car v)))) find-vars)] ;; Group bindings by grouping vars @@ -355,7 +367,7 @@ (binding-ref sample-binding fv) fv))) find-vars))) - groups))) + groups)))) (define (group-bindings grouping-vars bindings-list) ;; Group bindings by the values of grouping-vars. @@ -403,7 +415,7 @@ ;; [[?x ?y]]— relation: input is a list of tuples [input-bindings (let loop ([ivs in-vars] [inps inputs] - [bindings-list (list empty-bindings)]) + [bindings-list (list (make-empty-bindings))]) (cond [(null? ivs) bindings-list] [(eq? (car ivs) '$) (loop (cdr ivs) inps bindings-list)] @@ -468,7 +480,7 @@ ;; Reorder clauses for optimal execution ;; input-bindings is now a list of binding-sets [bound-at-start (if (null? input-bindings) '() - (map car (car input-bindings)))] + (vector->list (hashtable-keys (car input-bindings))))] [ordered-clauses (reorder-clauses where-clauses bound-at-start schema)] ;; Execute [result-bindings --- a/lib/jerboa-db/query/planner.sls +++ b/lib/jerboa-db/query/planner.sls @@ -90,10 +90,11 @@ (let ([attr (and a-bound? (schema-lookup-by-ident schema a-pos))]) (+ (if e-bound? 100 0) ;; entity bound: very selective - (if (and attr (db-attribute-unique attr)) 90 0) ;; unique attr - (if v-bound? 50 0) ;; value bound - (if a-bound? 20 0) ;; attribute bound (always true for valid queries) - (if (and attr (indexed-attr? attr)) 10 0))))] ;; indexed + (if (and attr (db-attribute-unique attr)) 90 0) ;; unique attr: point lookup + ;; V-bound + scalar attr: AVET range scan (fast). + ;; V-bound + ref attr: VAET reverse lookup (also fast). + (if v-bound? (if (and attr (avet-eligible? attr)) 60 50) 0) + (if a-bound? 20 0))))] ;; attribute bound (always true for valid queries) ;; Predicate/function clauses: score by how many vars are already bound [(and (pair? clause) (pair? (car clause))) (let ([used (clause-used-vars clause)]) @@ -136,8 +137,8 @@ [e-bound? 'eavt] ;; Value known + ref type -> VAET (reverse ref lookup) [(and v-bound? attr (ref-type? attr)) 'vaet] - ;; Value known + indexed -> AVET (value lookup) - [(and v-bound? attr (indexed-attr? attr)) 'avet] + ;; Value known + scalar attr -> AVET (all scalar attrs now indexed) + [(and v-bound? attr (avet-eligible? attr)) 'avet] ;; Default: scan by attribute -> AEVT [else 'aevt]))) --- a/lib/jerboa-db/schema.sls +++ b/lib/jerboa-db/schema.sls @@ -30,7 +30,7 @@ ;; Value type predicates valid-value-type? value-matches-type? coerce-value - cardinality-one? cardinality-many? ref-type? indexed-attr? + cardinality-one? cardinality-many? ref-type? indexed-attr? avet-eligible? ;; Bootstrap bootstrap-schema!) @@ -206,4 +206,12 @@ (or (db-attribute-index? attr) (db-attribute-unique attr))) + ;; avet-eligible?: should this attribute be stored in the AVET index? + ;; True for all scalar (non-ref, non-tuple) attributes. + ;; Ref types use VAET for reverse lookups; tuple/any values are not AVET-indexable. + (define (avet-eligible? attr) + (and attr + (not (memq (db-attribute-value-type attr) + '(db.type/ref db.type/tuple db.type/any))))) + ) ;; end library --- a/lib/jerboa-db/tx.sls +++ b/lib/jerboa-db/tx.sls @@ -59,6 +59,15 @@ [tempid-map '()] [produced-datoms '()]) + ;; --- Schema lookup cache --- + ;; Avoids repeated registry scans for the same attribute within one transaction. + (define schema-cache (make-hashtable symbol-hash eq?)) + (define (lookup-attr ident) + (or (hashtable-ref schema-cache ident #f) + (let ([attr (schema-lookup-by-ident schema ident)]) + (when attr (hashtable-set! schema-cache ident attr)) + attr))) + ;; --- Helpers --- (define (resolve-eid raw-eid) @@ -71,7 +80,7 @@ ;; Lookup ref: (attr-ident value) (let* ([attr-ident (car raw-eid)] [val (cadr raw-eid)] - [attr (schema-lookup-by-ident schema attr-ident)]) + [attr (lookup-attr attr-ident)]) (unless attr (error 'transact! "Unknown attribute in lookup ref" attr-ident)) (unless (db-attribute-unique attr) @@ -106,7 +115,7 @@ (let* ([pair (car pairs)] [attr-ident (car pair)] [val (cdr pair)] - [attr (schema-lookup-by-ident schema attr-ident)]) + [attr (lookup-attr attr-ident)]) (if (and attr (eq? (db-attribute-unique attr) 'db.unique/identity)) (let ([existing (find-entity-by-unique attr val)]) (or existing (loop (cdr pairs)))) @@ -204,7 +213,7 @@ (lambda (pair) (let* ([attr-ident (car pair)] [val (cdr pair)] - [attr (schema-lookup-by-ident schema attr-ident)]) + [attr (lookup-attr attr-ident)]) (unless attr ;; Auto-intern unknown attributes as schema if they look like schema ;; For now, error on unknown attributes @@ -257,7 +266,7 @@ (define (process-add! eid-raw attr-ident val) (let* ([eid (resolve-eid eid-raw)] - [attr (schema-lookup-by-ident schema attr-ident)]) + [attr (lookup-attr attr-ident)]) (unless attr (error 'transact! "Unknown attribute" attr-ident)) (let* ([aid (db-attribute-id attr)] [cval (coerce-value (db-attribute-value-type attr) val)] @@ -277,7 +286,7 @@ (emit-datom! eid aid final-val #t)))) (define (process-retract! eid attr-ident val) - (let ([attr (schema-lookup-by-ident schema attr-ident)]) + (let ([attr (lookup-attr attr-ident)]) (unless attr (error 'transact! "Unknown attribute" attr-ident)) (emit-datom! eid (db-attribute-id attr) val #f))) @@ -308,7 +317,7 @@ vals))))) (define (process-cas! eid attr-ident old-val new-val) - (let* ([attr (schema-lookup-by-ident schema attr-ident)] + (let* ([attr (lookup-attr attr-ident)] [aid (db-attribute-id attr)] [cur (current-value eid aid)]) (unless (and cur (equal? (datom-v cur) old-val)) @@ -322,7 +331,7 @@ ;; Effective value for composite tuple generation: ;; checks pending produced-datoms first, then falls back to current index value. (define (effective-value-for-entity eid attr-ident) - (let ([attr (schema-lookup-by-ident schema attr-ident)]) + (let ([attr (lookup-attr attr-ident)]) (and attr (let* ([aid (db-attribute-id attr)] [pending (filter (lambda (d) @@ -360,7 +369,7 @@ tx-ops) ;; Add transaction metadata: :db/txInstant - (let ([tx-instant-attr (schema-lookup-by-ident schema +db/txInstant+)]) + (let ([tx-instant-attr (lookup-attr +db/txInstant+)]) (when tx-instant-attr (emit-datom! tx-id (db-attribute-id tx-instant-attr) (time-second (current-time)) #t))) @@ -388,7 +397,7 @@ [comp-aids (let loop ([l components] [acc '()]) (if (null? l) (reverse acc) - (let ([ca (schema-lookup-by-ident schema (car l))]) + (let ([ca (lookup-attr (car l))]) (loop (cdr l) (if ca (cons (db-attribute-id ca) acc) acc)))))] ;; Check if any component was changed for this entity @@ -421,9 +430,9 @@ ;; Always write to EAVT and AEVT (dbi-add! (index-set-eavt indices) d) (dbi-add! (index-set-aevt indices) d) - ;; Write to AVET if attribute is indexed or unique + ;; Write to AVET for all scalar attributes (enables fast value lookups) (let ([attr (schema-lookup-by-id schema (datom-a d))]) - (when (and attr (indexed-attr? attr)) + (when (avet-eligible? attr) (dbi-add! (index-set-avet indices) d)) ;; Write to VAET if attribute is ref type (when (and attr (ref-type? attr))