diff --git a/private/lru-cache.rkt b/private/lru-cache.rkt index d88c0d5..99cb99d 100644 --- a/private/lru-cache.rkt +++ b/private/lru-cache.rkt @@ -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 diff --git a/scribblings/lru-cache.scrbl b/scribblings/lru-cache.scrbl index e037ce0..0fc938c 100644 --- a/scribblings/lru-cache.scrbl +++ b/scribblings/lru-cache.scrbl @@ -74,6 +74,15 @@ If capacity is reached, the least recently used item is removed. 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?]{ Returns @racket[#t] if @racket[item] is currently present (and not expired), otherwise @racket[#f]. This call also performs lazy cleanup of expired items.