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)
       (semaphore-wait (%lru-cache-sem cache))
       (let ((r body))
         (semaphore-post (%lru-cache-sem cache))


(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)
                  (if (eq? (car args) 'eq)
                      (if (eq? (car args) '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))

(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)
                     (+ inuse 1)))
     (vector-set! vect index (cons key element))
     (set-%lru-cache-index! cache index)
     (set-%lru-cache-inuse! cache inuse)

(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)
     (define (find-and-bubble i previous-i N)
       (if (<= N 0)
           (if (cmp (car (vector-ref vect i)) key)
               (let ((elem (vector-ref vect i)))
                 (if (= previous-i -1) 
                       (vector-set! vect i (vector-ref vect previous-i))
               (let ((r (find-and-bubble (if (= i size) 
                                             (+ i 1))
                                         (- 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))))

     (let ((r (find-and-bubble index -1 inuse)))
       (if (eq? r #f)
           (cdr r))))))


Author(s): Hans Oesterholt-Dijkema (hansatelementalprogrammingdotorgextension).
Copyright: (c) 2005.
License  : Elemental Programming License.
File     : fifo.scm $Revision: 1.2 $