LRU Cache
This module gives an implementation of a thread safe Least Recently Used Cache. It is setup using a cyclic vector, i.e. a vector that is assigned in a cyclic way. Each new element in the cache is considered the least recently used element. If the full cache of elements is in use, each new element will overwrite the oldest (i.e. least used) element.
The LRU Cache is searched lineairly for elements in the cache. Older elements will be reached slower, because the search is larger. A full search on a fully used cache vector, will go exactly two times through the vector of cached elements. The search is done recusivly. If an element is found, it will bubble up to the front of the cache. If it is needed again soon, next time it is needed, it will be in one of the first positions of the cache.
Supportive macros and functions
This section provides some simple macros. No explanation is given.
(define-struct %lru-cache (type size sem vect index inuse))
(define-syntax lru-cache-type
(syntax-rules ()
((_ cache)
(%lru-cache-type cache))))
(define-syntax lru-cache-eq-type?
(syntax-rules ()
((_ cache)
(eq? (lru-cache-type cache) 'eq))))
(define-syntax lru-cache-size
(syntax-rules ()
((_ cache)
(%lru-cache-size cache))))
(define-syntax protect
(syntax-rules ()
((_ cache body)
(begin
(semaphore-wait (%lru-cache-sem cache))
(let ((r body))
(semaphore-post (%lru-cache-sem cache))
r)))))
Interface
(lru-cache size ['equal]) : lru-cache
Returns a new lru-cache of size size elements.
If 'equal is provided as an arguments, comparisions
on the keys of the cache will be done using equal? instead
of eq?.
(define (lru-cache size . args)
(let ((type (if (null? args)
'eq
(if (eq? (car args) 'eq)
'eq
(if (eq? (car args) 'equal)
'equal
(error "lru-cache: invalid argument"))))))
(make-%lru-cache type size (make-semaphore 1) (make-vector size) (- size 1) 0)))
(lru-cache? obj) : boolean
Returns #t, if obj is a lru cache.
(define (lru-cache? obj) (%lru-cache? obj))
(empty-lru-cache! cache) : lru-cache
Clears cache and returns cache. This function is thread safe.
(define (empty-lru-cache! cache)
(protect cache
(let ((sem (%lru-cache-sem cache))) ;;;(vector-ref cache 2)))
(let ((c (lru-cache (lru-cache-size cache) (lru-cache-type cache))))
(set-%lru-cache-vect! cache (%lru-cache-vect c))
(set-%lru-cache-index! cache (%lru-cache-index c))
(set-%lru-cache-inuse! cache (%lru-cache-inuse c))
cache))))
(lru-cache-empty? cache) : boolean
Returns #t, if the cache has no elements, #f otherwise. This function is not thread safe. This is however not important, as it returns a snapshot in time of the state of the lru-cache, that will only be of value in a context where concurrent access is not of importance.
(define (lru-cache-empty? cache) (= (%lru-cache-inuse cache) 0))
(lru-cache+ cache key element) : cache
Adds element to the cache under key key. This
function is thread safe. The cache is protected
using a critical section.
(define (lru-cache+ cache key element)
(protect cache
(let ((index (%lru-cache-index cache))
(vect (%lru-cache-vect cache))
(size (lru-cache-size cache))
(inuse (%lru-cache-inuse cache)))
(set! index (if (= index 0)
(- size 1)
(- index 1)))
(set! inuse (if (= inuse size)
size
(+ inuse 1)))
(vector-set! vect index (cons key element))
(set-%lru-cache-index! cache index)
(set-%lru-cache-inuse! cache inuse)
cache)))
(lru-cache-find cache key) : #f | found element
This function will search key in cache. If it finds key, it will return the associated element. If it doesn't find key, it will return #f.
(define (lru-cache-find cache key)
(protect cache
(let ((index (%lru-cache-index cache))
(inuse (%lru-cache-inuse cache))
(size (- (lru-cache-size cache) 1))
(vect (%lru-cache-vect cache))
(found #f)
(cmp (if (lru-cache-eq-type? cache)
eq?
equal?)))
(define (find-and-bubble i previous-i N)
(if (<= N 0)
#f
(if (cmp (car (vector-ref vect i)) key)
(let ((elem (vector-ref vect i)))
(if (= previous-i -1)
elem
(begin
(vector-set! vect i (vector-ref vect previous-i))
elem)))
(let ((r (find-and-bubble (if (= i size)
0
(+ i 1))
i
(- N 1))))
(if (not (eq? r #f))
(if (= previous-i -1)
(vector-set! vect i r)
(vector-set! vect i (vector-ref vect previous-i))))
r))))
(let ((r (find-and-bubble index -1 inuse)))
(if (eq? r #f)
#f
(cdr r))))))
Info
Author(s): Hans Oesterholt-Dijkema (hansatelementalprogrammingdotorgextension).
Copyright: (c) 2005.
License : Elemental Programming License.
File : fifo.scm $Revision: 1.2 $