-

private/lru-cache.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
-(require racket/contract)
+(require racket/contract
+         )
 
 (provide make-lru
          lru?
@@ -25,6 +26,7 @@
    compare
    [max-count #:mutable]
    [expire-in-seconds #:mutable]
+   sem
    )
   )
 
@@ -100,72 +102,96 @@
     (set-box! (lru*-cache lru) (cons (list el (current-seconds)) ncache)))
   lru)
 
+(define-syntax with-lock
+  (syntax-rules ()
+    ((_ lru code ...)
+     (dynamic-wind
+      (λ () (semaphore-wait (lru*-sem lru)))
+      (λ () (begin code ...))
+      (λ () (semaphore-post (lru*-sem lru)))
+      )
+     )
+    )
+  )
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Supporting functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define/contract (make-lru max-count #:cmp [compare equal?] #:expire [expire-in-seconds #f])
   (->* (max-count?) (#:cmp cmp-procedure? #:expire expire?) lru*?)
-  (make-lru* (box '()) compare max-count expire-in-seconds))
+  (let ((sem (make-semaphore 1)))
+    (make-lru* (box '()) compare max-count expire-in-seconds sem)))
 
 (define/contract (lru-has? lru el)
   (-> lru*? any/c boolean?)
-  (cleanup-expired lru)
+  (with-lock lru
-  (find (unbox (lru*-cache lru)) (lru*-compare lru) el)
+    (cleanup-expired lru)
+    (find (unbox (lru*-cache lru)) (lru*-compare lru) el)
+    )
   )
 
 (define/contract (lru-add! lru el)
   (-> lru*? any/c lru*?)
-  (find-and/or-add lru el)
+  (with-lock lru
-  lru)
+    (find-and/or-add lru el)
+    lru))
 
 (define/contract (lru-clear lru)
   (-> lru*? lru*?)
-  (set-box! (lru*-cache lru) '())
+  (with-lock lru
-  lru)
+    (set-box! (lru*-cache lru) '())
+    lru))
 
 (define/contract (lru->list lru #:with-expire [we #f])
   (->* (lru*?) (#:with-expire boolean?) list?)
-  (cleanup-expired lru)
+  (with-lock lru
-  (let ((c (current-seconds)))
+    (cleanup-expired lru)
-    (map (λ (e)
+    (let ((c (current-seconds)))
-           (if we
+      (map (λ (e)
-               (list (car e) (- c (cadr e)))
+             (if we
-               (car e))) (unbox (lru*-cache lru))))
+                 (list (car e) (- c (cadr e)))
+                 (car e))) (unbox (lru*-cache lru))))
+    )
   )
 
 (define/contract (lru-count lru)
   (-> lru*? larger-equal0?)
-  (cleanup-expired lru)
+  (with-lock lru
-  (length (unbox (lru*-cache lru))))
+    (cleanup-expired lru)
+    (length (unbox (lru*-cache lru))))
+  )
 
 (define (lru? l)
   (lru*? l))
 
 (define/contract (lru-max-count l)
   (-> lru*? max-count?)
-  (lru*-max-count l))
+  (with-lock l (lru*-max-count l)))
 
 (define/contract (lru-expire l)
   (-> lru*? expire?)
-  (lru*-expire-in-seconds l))
+  (with-lock l (lru*-expire-in-seconds l)))
 
 (define/contract (set-lru-max-count! l c)
   (-> lru*? max-count? lru*?)
-  (set-lru*-max-count! l c)
+  (with-lock l
-  l)
+        (set-lru*-max-count! l c)
+        l))
 
 (define/contract (set-lru-expire! l e)
   (-> lru*? expire? lru*?)
-  (set-lru*-expire-in-seconds! l e)
+  (with-lock l
-  l)
+    (set-lru*-expire-in-seconds! l e)
+    l))
 
 (define/contract (lru-expires? l)
   (-> lru*? boolean?)
-  (let ((e (lru*-expire-in-seconds l)))
+  (with-lock l
-    (if e
+    (let ((e (lru*-expire-in-seconds l)))
-        (and (integer? e) (> e 0))
+      (if e
-        #f)))
+          (and (integer? e) (> e 0))
+          #f))))
    
    
 

scribblings/lru-cache.scrbl

@@ -27,8 +27,7 @@ The cache stores @emph{items} (values) and uses a comparison function to decide
 whether an item is already present. Each item is associated with a last-access
 timestamp that drives recency; on insert or hit, the item is bubbled to the front.
 
-@bold{Thread-safety:} The implementation uses a @racket[box] internally and is
+@bold{Thread-safety:} The implementation is thread-safe, but not reentrant. 
-@emph{not} intrinsically thread-safe. Use external synchronization for concurrent access.
 
 @section{Data Types}
 
@@ -188,7 +187,7 @@ Invalid inputs raise contract violations with descriptive error messages.
 
 @section{Notes}
 @itemlist[
-  @item{The implementation is not thread-safe; use locks for concurrent access.}
+  @item{The implementation is thread-safe but not reentrant.}
   @item{Expiration cleanup is lazy. If you need stricter guarantees, trigger
         periodic queries (e.g., @racket[lru-count]) or add an explicit cleanup function.}
 ]