hans/lru-cache
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added lru-use function

Browse Source
This commit is contained in:
Hans Dijkema
2026-05-17 21:55:50 +02:00
parent 8e1752c7ad
commit d8d50515f6
2 changed files with 56 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/lru-cache.rkt
+47 -17
View File
@@ -11,6 +11,7 @@
lru-expire
set-lru-expire!
lru-has?
lru-use
lru-add!
lru-count
lru-empty?
@@ -47,19 +48,19 @@
(define (expire? e)
(or (eq? e #f) (max-count? e)))
(define (find-and-bubble count max-count e cache cmp expire-s current-s el)
(if (or (null? cache)
(>= count max-count))
(define (find-and-bubble count max-count e cache cmp expire-s current-s el el-found-cb)
(if (or (null? cache) (>= count max-count))
'()
(let ((front (car cache)))
(if (and (not (eq? expire-s #f))
(< (cadr front) expire-s))
(find-and-bubble count max-count e (cdr cache) cmp expire-s current-s el)
(if (and (not (eq? expire-s #f)) (< (cadr front) expire-s))
(find-and-bubble count max-count e (cdr cache) cmp expire-s current-s el el-found-cb)
(if (cmp e (car front))
(find-and-bubble count max-count e (cdr cache) cmp expire-s current-s (car front))
(begin
(el-found-cb (car front))
(find-and-bubble count max-count e (cdr cache) cmp expire-s current-s (car front) el-found-cb))
(cons front
(find-and-bubble (+ count 1) max-count
e (cdr cache) cmp expire-s current-s el))
e (cdr cache) cmp expire-s current-s el el-found-cb))
)
)
)
@@ -91,18 +92,38 @@
'cleaned)))
(define (find-and/or-add lru el)
(let ((ncache (find-and-bubble
1 (lru*-max-count lru)
el (unbox (lru*-cache lru))
(lru*-compare lru)
(if (eq? (lru*-expire-in-seconds lru) #f)
#f
(- (current-seconds) (lru*-expire-in-seconds lru)))
(current-seconds)
#f)))
(let ((ncache (find-and-bubble 1 (lru*-max-count lru) el
(unbox (lru*-cache lru))
(lru*-compare lru)
(if (eq? (lru*-expire-in-seconds lru) #f)
#f
(- (current-seconds) (lru*-expire-in-seconds lru)))
(current-seconds)
#f
(λ (el) #t)
)))
(set-box! (lru*-cache lru) (cons (list el (current-seconds)) ncache)))
lru)
(define (find-and-get lru key)
(let* ((el #f)
(found #f))
(let ((ncache (find-and-bubble 1 (lru*-max-count lru) key
(unbox (lru*-cache lru))
(lru*-compare lru)
(if (eq? (lru*-expire-in-seconds lru) #f)
#f
(- (current-seconds) (lru*-expire-in-seconds lru)))
(current-seconds)
#f
(λ (e)
(set! found #t)
(set! el e)))))
(set-box! (lru*-cache lru) (if found
(cons (list el (current-seconds)) ncache)
ncache)))
(values found el)))
(define-syntax with-lock
(syntax-rules ()
((_ lru code ...)
@@ -132,6 +153,15 @@
)
)
(define/contract (lru-use lru key def-el)
(-> lru*? any/c any/c any/c)
(with-lock lru
(let-values (((found el) (find-and-get lru key)))
(if found
el
def-el))))
(define/contract (lru-add! lru el)
(-> lru*? any/c lru*?)
(with-lock lru