40 lines
1.2 KiB
Scheme
40 lines
1.2 KiB
Scheme
(module cache-table mzscheme
|
|
(require (lib "contract.ss"))
|
|
|
|
(define-struct cache-table (hash semaphore))
|
|
|
|
(define (new-cache-table)
|
|
; Only eq? tables are not locked
|
|
(make-cache-table (make-hash-table)
|
|
(make-semaphore 1)))
|
|
|
|
(define (cache-table-clear! ct)
|
|
(call-with-semaphore
|
|
(cache-table-semaphore ct)
|
|
(lambda ()
|
|
(set-cache-table-hash! ct (make-hash-table)))))
|
|
|
|
(define (cache-table-lookup! ct entry-id entry-thunk)
|
|
(let ([ht (cache-table-hash ct)]
|
|
[sema (cache-table-semaphore ct)])
|
|
; Fast lookup
|
|
(hash-table-get
|
|
ht entry-id
|
|
(lambda ()
|
|
; Now lock for relookup and computation
|
|
(call-with-semaphore
|
|
sema
|
|
(lambda ()
|
|
(hash-table-get
|
|
ht entry-id
|
|
(lambda ()
|
|
(let ([entry (entry-thunk)])
|
|
(hash-table-put! ht entry-id entry)
|
|
entry)))))))))
|
|
|
|
(provide/contract
|
|
[rename new-cache-table make-cache-table
|
|
(-> cache-table?)]
|
|
[cache-table-lookup! (cache-table? symbol? (-> any/c) . -> . any/c)]
|
|
[cache-table-clear! (cache-table? . -> . void?)])
|
|
(provide cache-table?)) |