Thread-safe memoize function

Hello,


I've been implementing thread-safe caching function. And I would like to 
know your opinion how this implementation is safe.

It uses mutexes to lock cache hash-table, but cache is not locked for 
the whole time of function call. If the result was not found in cache, 
then new mutex is put into cache. Than cache table is unlocked and 
result of function of given arguments is evaluated, result then is put 
into table without locking the table. If some other thread wants a 
result of the same arguments, then it receives mutex from cache and 
waits for it being unlocked.


I'm sorry, if the given description unclear because of my poor English. 
But I hope the code will be easier to understand.

(import threading)
(require-library 'sisc/libs/srfi/srfi-19) ;call-with-values
(import srfi-19)

(require-library 'sisc/libs/srfi/srfi-69) ;hash-table
(import srfi-69)
(define (memoize fn)
  (let* ((cache (make-hash-table 'equal))
         (nothing "nothing")
         (cache-mutex (mutex-of cache)))
    (define memoized
      (lambda args
        ;; lock table for the time when we get cached result.
        (mutex/lock! cache-mutex)
        (let ((result (hash-table-ref cache
                                      args
                                      (lambda () nothing))))
          (cond ((eq? result nothing)
                 (let ((mutex (mutex/new)))
                   (mutex/synchronize mutex
                     (lambda ()
                       (hash-table-set! cache args mutex)
                       ;; unlock the table for the time of evaluation,
                       ;; threads which will try to get result of the same
                       ;; arguments will get mutex and will be waiting
                       ;; for its lock to be released (see the next cond 
case)
                       (mutex/unlock! cache-mutex)
                       (call-with-values (lambda () (apply fn args))
                                         (lambda result
                                           (hash-table-set! cache args 
result)
                                           (apply values result)))))))
                ;; If we have got a mutex as a result then it means 
function now is being evaluated
                ;; in another thread. In this case we just wait 
patiently for mutex to be unlocked
                ;; and try to get the result once again
                ((mutex? result)
                 (mutex/unlock! cache-mutex)
                 ;;(display (format "waiting for the result of ~a to be 
computed in another thread\n" args))
                 (mutex/synchronize result
                   (lambda ()
                     ;;(display "lock acquired, which means that the 
result has been computed in the other thread, trying again\n")
                     (void)))
                 (apply memoized args))
                (else
                 (mutex/unlock! cache-mutex)
                 ;;(display (format "value for args: ~a was found in 
cache: ~a\n" args result))
                 (apply values result))))))
    memoized))


Here is also code to test this function:

(define (fun arg)
  (display (format "(fun ~a) is called\n" arg))
  (sleep 500)
  arg)

(define memo-fun (memoize fun))

(define (count max call-back)
  (define (loop i)
    (when (< i max)
      (call-back i)
      (loop (+ i 1))))
  (loop 0))

(count 3 (lambda (i)
            (thread/spawn (lambda ()
                            (display (format "thread ~a started\n" i))
                            (count 3 (lambda (j)
                                        (display (format "thread ~a 
(memo-fun ~a) = ~a\n" i j (memo-fun j)))))
                            (display (format "thread ~a finished\n" i))))))


To get more output of how it works uncomment calls to display in the 
definition of memoize.


So, what do you think about this implementation? Is it really 
thread-safe? Is it optimal?






PS: In the code above I used 'count' function instead of 'do' because I 
had problems with it. When I tried simple example of how to use 'do' 
from R5RS I got the following:

W;>(do ((vec (make-vector 5))
     (i 0 (+ i 1)))
    ((= i 5) vec)
  (vector-set! vec i i))
Error: undefined variable '|\u00a0\u00a0|'.

Guile also produces an error, while plt-scheme


Best regards,
 Nikita

-------------------------------------------------------------------------
This SF.net email is sponsored by: Splunk Inc.
Still grepping through log files to find problems?  Stop.
Now Search log events and configuration files using AJAX and a browser.
Download your FREE copy of Splunk now >>  http://get.splunk.com/