Utils: update memoize-ttl

src/taoensso/timbre/utils.clj

@@ -10,20 +10,28 @@
   (let [[name [expr]] (macro/name-with-attributes name sigs)]
     `(clojure.core/defonce ~name ~expr)))
 
-(defn memoize-ttl
+(defn memoize-ttl "Low-overhead, common-case `memoize*`."
-  "Like `memoize` but invalidates the cache for a set of arguments after TTL
-  msecs has elapsed."
   [ttl-ms f]
   (let [cache (atom {})]
     (fn [& args]
-      (let [{:keys [time-cached d-result]} (@cache args)
+      (when (<= (rand) 0.001) ; GC
-            now (System/currentTimeMillis)]
+        (let [now (System/currentTimeMillis)]
-
+          (->> @cache
-        (if (and time-cached (< (- now time-cached) ttl-ms))
+               (reduce-kv (fn [exp-ks k [dv ms :as cv]]
-          @d-result
+                            (if (< (- now ms) ttl-ms) exp-ks
-          (let [d-result (delay (apply f args))]
+                                (conj exp-ks k))) [])
-            (swap! cache assoc args {:time-cached now :d-result d-result})
+               (apply swap! cache dissoc))))
-            @d-result))))))
+      (let [[dv ms] (@cache args)]
+        (if (and dv (< (- (System/currentTimeMillis) ms) ttl-ms))
+          @dv
+          (locking cache ; For thread racing
+            (let [[dv ms] (@cache args)] ; Retry after lock acquisition!
+              (if (and dv (< (- (System/currentTimeMillis) ms) ttl-ms))
+                @dv
+                (let [dv (delay (apply f args))
+                      cv [dv (System/currentTimeMillis)]]
+                  (swap! cache assoc args cv)
+                  @dv)))))))))
 
 (defn merge-deep-with ; From clojure.contrib.map-utils
   "Like `merge-with` but merges maps recursively, applying the given fn