perf: env-regex LRU uses hashtable+timestamp (O(1) cache hit, was O(cache) list reorder per regex op)
ober
57db9bcf48d64fe04f02cba8caee77de61204db6
--- a/lib/jerboa-awk/runtime.sls +++ b/lib/jerboa-awk/runtime.sls @@ -194,19 +194,11 @@ (hashtable-set! cache pattern compiled) (values compiled #f))))) - (define (remove-pattern pattern patterns) - (cond - ((null? patterns) '()) - ((string=? pattern (car patterns)) (cdr patterns)) - (else (cons (car patterns) (remove-pattern pattern (cdr patterns)))))) - - (define (drop-last patterns) - (cond - ((or (null? patterns) (null? (cdr patterns))) '()) - (else (cons (car patterns) (drop-last (cdr patterns)))))) - - (define (last-pattern patterns) - (if (null? (cdr patterns)) (car patterns) (last-pattern (cdr patterns)))) + ;; Monotonic clock stamping each regex-cache access. env-regex stores + ;; (vector stamp compiled) per pattern, so a cache hit is O(1) (just bump the + ;; stamp) instead of reordering a recency list; eviction scans the bounded + ;; cache for the smallest stamp, but only runs on a miss when the cache is full. + (define regex-clock 0) ;;; ---- Execution state ---- @@ -286,20 +278,23 @@ (define (env-regex env pattern) (env-assert-owner! 'env-regex env) (let* ((cache (awk-env-regex-cache env)) - (cached (hashtable-ref cache pattern #f))) - (if cached + (entry (hashtable-ref cache pattern #f))) + (set! regex-clock (+ regex-clock 1)) + (if entry (begin - (awk-env-regex-order-set! - env (cons pattern (remove-pattern pattern (awk-env-regex-order env)))) - cached) - (let ((compiled (pregexp pattern)) - (order (awk-env-regex-order env))) + (vector-set! entry 0 regex-clock) + (vector-ref entry 1)) + (let ((compiled (pregexp pattern))) (when (>= (hashtable-size cache) max-regex-cache-entries) - (let ((oldest (last-pattern order))) - (hashtable-delete! cache oldest) - (set! order (drop-last order)))) - (hashtable-set! cache pattern compiled) - (awk-env-regex-order-set! env (cons pattern order)) + (let ((oldest-stamp #f) (oldest-key #f)) + (hash-for-each + (lambda (k v) + (when (or (not oldest-stamp) (< (vector-ref v 0) oldest-stamp)) + (set! oldest-stamp (vector-ref v 0)) + (set! oldest-key k))) + cache) + (when oldest-key (hashtable-delete! cache oldest-key)))) + (hashtable-set! cache pattern (vector regex-clock compiled)) compiled)))) (define (make-initial-env)