2
0
mirror of https://github.com/status-im/timbre.git synced 2025-02-16 05:36:28 +00:00

Utils: update memoize-ttl

This commit is contained in:
Peter Taoussanis 2013-11-08 21:54:12 +07:00
parent 7cff8b7b96
commit 1f15c046e0

@ -10,20 +10,28 @@
(let [[name [expr]] (macro/name-with-attributes name sigs)]
`(clojure.core/defonce ~name ~expr)))
(defn memoize-ttl
"Like `memoize` but invalidates the cache for a set of arguments after TTL
msecs has elapsed."
(defn memoize-ttl "Low-overhead, common-case `memoize*`."
[ttl-ms f]
(let [cache (atom {})]
(fn [& args]
(let [{:keys [time-cached d-result]} (@cache args)
now (System/currentTimeMillis)]
(if (and time-cached (< (- now time-cached) ttl-ms))
@d-result
(let [d-result (delay (apply f args))]
(swap! cache assoc args {:time-cached now :d-result d-result})
@d-result))))))
(when (<= (rand) 0.001) ; GC
(let [now (System/currentTimeMillis)]
(->> @cache
(reduce-kv (fn [exp-ks k [dv ms :as cv]]
(if (< (- now ms) ttl-ms) exp-ks
(conj exp-ks k))) [])
(apply swap! cache dissoc))))
(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