Added lru-use function
This commit is contained in:
+42
-12
@@ -11,6 +11,7 @@
|
|||||||
lru-expire
|
lru-expire
|
||||||
set-lru-expire!
|
set-lru-expire!
|
||||||
lru-has?
|
lru-has?
|
||||||
|
lru-use
|
||||||
lru-add!
|
lru-add!
|
||||||
lru-count
|
lru-count
|
||||||
lru-empty?
|
lru-empty?
|
||||||
@@ -47,19 +48,19 @@
|
|||||||
(define (expire? e)
|
(define (expire? e)
|
||||||
(or (eq? e #f) (max-count? e)))
|
(or (eq? e #f) (max-count? e)))
|
||||||
|
|
||||||
(define (find-and-bubble count max-count e cache cmp expire-s current-s el)
|
(define (find-and-bubble count max-count e cache cmp expire-s current-s el el-found-cb)
|
||||||
(if (or (null? cache)
|
(if (or (null? cache) (>= count max-count))
|
||||||
(>= count max-count))
|
|
||||||
'()
|
'()
|
||||||
(let ((front (car cache)))
|
(let ((front (car cache)))
|
||||||
(if (and (not (eq? expire-s #f))
|
(if (and (not (eq? expire-s #f)) (< (cadr front) expire-s))
|
||||||
(< (cadr front) expire-s))
|
(find-and-bubble count max-count e (cdr cache) cmp expire-s current-s el el-found-cb)
|
||||||
(find-and-bubble count max-count e (cdr cache) cmp expire-s current-s el)
|
|
||||||
(if (cmp e (car front))
|
(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
|
(cons front
|
||||||
(find-and-bubble (+ count 1) max-count
|
(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)))
|
'cleaned)))
|
||||||
|
|
||||||
(define (find-and/or-add lru el)
|
(define (find-and/or-add lru el)
|
||||||
(let ((ncache (find-and-bubble
|
(let ((ncache (find-and-bubble 1 (lru*-max-count lru) el
|
||||||
1 (lru*-max-count lru)
|
(unbox (lru*-cache lru))
|
||||||
el (unbox (lru*-cache lru))
|
|
||||||
(lru*-compare lru)
|
(lru*-compare lru)
|
||||||
(if (eq? (lru*-expire-in-seconds lru) #f)
|
(if (eq? (lru*-expire-in-seconds lru) #f)
|
||||||
#f
|
#f
|
||||||
(- (current-seconds) (lru*-expire-in-seconds lru)))
|
(- (current-seconds) (lru*-expire-in-seconds lru)))
|
||||||
(current-seconds)
|
(current-seconds)
|
||||||
#f)))
|
#f
|
||||||
|
(λ (el) #t)
|
||||||
|
)))
|
||||||
(set-box! (lru*-cache lru) (cons (list el (current-seconds)) ncache)))
|
(set-box! (lru*-cache lru) (cons (list el (current-seconds)) ncache)))
|
||||||
lru)
|
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
|
(define-syntax with-lock
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((_ lru code ...)
|
((_ 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)
|
(define/contract (lru-add! lru el)
|
||||||
(-> lru*? any/c lru*?)
|
(-> lru*? any/c lru*?)
|
||||||
(with-lock lru
|
(with-lock lru
|
||||||
|
|||||||
@@ -74,6 +74,15 @@ If capacity is reached, the least recently used item is removed.
|
|||||||
Returns @racket[l].
|
Returns @racket[l].
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@defproc[(lry-use [l lru?] [key any/c] [default any/c]) any/c]{
|
||||||
|
Finds the given @racket[item] by @racket[key] (this must be accomodated
|
||||||
|
in the compare function (see @tt{#:cmp}). When the item is found
|
||||||
|
using the key, it will not only return the item, but also move the
|
||||||
|
item to the front of the cache and update the expiry parameter.
|
||||||
|
|
||||||
|
When the item is not found, it will return @racket{default}.
|
||||||
|
}
|
||||||
|
|
||||||
@defproc[(lru-has? [l lru?] [item any/c]) boolean?]{
|
@defproc[(lru-has? [l lru?] [item any/c]) boolean?]{
|
||||||
Returns @racket[#t] if @racket[item] is currently present (and not expired),
|
Returns @racket[#t] if @racket[item] is currently present (and not expired),
|
||||||
otherwise @racket[#f]. This call also performs lazy cleanup of expired items.
|
otherwise @racket[#f]. This call also performs lazy cleanup of expired items.
|
||||||
|
|||||||
Reference in New Issue
Block a user