From c85329fe05699b3e0501ac1061f30fc5cd11679f Mon Sep 17 00:00:00 2001 From: Peter Taoussanis Date: Thu, 14 Apr 2016 11:23:31 +0700 Subject: [PATCH] Cache housekeeping (incl. tests, switch to volatiles) --- src/taoensso/nippy.clj | 85 +++++++++++++++++++----------- test/taoensso/nippy/tests/main.clj | 18 +++++++ 2 files changed, 71 insertions(+), 32 deletions(-) diff --git a/src/taoensso/nippy.clj b/src/taoensso/nippy.clj index aaa24a0..185cb33 100644 --- a/src/taoensso/nippy.clj +++ b/src/taoensso/nippy.clj @@ -707,15 +707,20 @@ ~@body))) ;;;; Caching ; Experimental +;; How much point is there in offering this feature if we already have LZ4? (def ^:dynamic ^:private *cache_* "{ }" nil) -;; (defmacro ^:private with-cache [& body] -;; `(binding [*cache_* (atom nil)] ~@body)) - -(defmacro ^:private with-cache [& body] `(do ~@body)) ; Disable +(defmacro ^:private with-cache [& body] + `(binding [*cache_* (enc/-vol! nil)] ~@body)) (defrecord CacheWrapped [value]) -(defn cache "Experimental!" [x] +(defn cache + "Experimental! Wraps value so that future writes of the same wrapped + value will be efficiently encoded as references to this one. + + (freeze [(cache \"foo\") (cache \"foo\") (cache \"foo\")]) + will incl. a single \"foo\", plus 2x single-byte references to \"foo\"." + [x] (if (instance? CacheWrapped x) x (CacheWrapped. x))) (comment (cache "foo")) @@ -723,48 +728,64 @@ (freezer CacheWrapped (let [x-val (:value x)] (if-let [cache_ *cache_*] - (let [[first-occ? ^long idx] - (enc/swap-in! cache_ - (fn [m] - (if-let [idx (get m x-val)] - (enc/swapped m [false idx]) - (let [idx (count m)] - (enc/swapped (assoc m x-val idx) [true idx])))))] + (let [cache @cache_ + ?idx (get cache x-val) + idx (or ?idx + (let [idx (count cache)] + (enc/-vol-swap! cache_ assoc x-val idx) + idx)) + + first-occurance? (nil? ?idx)] (cond (sm-count? idx) (cond - (== idx 0) (do (write-id out id-cached-0) - (when first-occ? (-freeze-to-out! x-val out))) - (== idx 1) (do (write-id out id-cached-1) - (when first-occ? (-freeze-to-out! x-val out))) - (== idx 2) (do (write-id out id-cached-2) - (when first-occ? (-freeze-to-out! x-val out))) - (== idx 3) (do (write-id out id-cached-3) - (when first-occ? (-freeze-to-out! x-val out))) - (== idx 4) (do (write-id out id-cached-4) - (when first-occ? (-freeze-to-out! x-val out))) + (== idx 0) + (do (write-id out id-cached-0) + (when first-occurance? (-freeze-to-out! x-val out))) + + (== idx 1) + (do (write-id out id-cached-1) + (when first-occurance? (-freeze-to-out! x-val out))) + + (== idx 2) + (do (write-id out id-cached-2) + (when first-occurance? (-freeze-to-out! x-val out))) + + (== idx 3) + (do (write-id out id-cached-3) + (when first-occurance? (-freeze-to-out! x-val out))) + + (== idx 4) + (do (write-id out id-cached-4) + (when first-occurance? (-freeze-to-out! x-val out))) + :else (do (write-id out id-cached-sm) (write-sm-count out idx) - (when first-occ? (-freeze-to-out! x-val out)))) + (when first-occurance? (-freeze-to-out! x-val out)))) (md-count? idx) (do (write-id out id-cached-md) (write-md-count out idx) - (when first-occ? (-freeze-to-out! x-val out))) + (when first-occurance? (-freeze-to-out! x-val out))) - :else (throw (ex-info "Max cache size exceeded" {:idx idx})))) + :else + ;; (throw (ex-info "Max cache size exceeded" {:idx idx})) + (-freeze-to-out! x-val out) ; Just freeze uncached + )) (-freeze-to-out! x-val out)))) (declare thaw-from-in!) (defn- thaw-cached [idx in] - (if-let [e (find @*cache_* idx)] - (val e) - (let [x (thaw-from-in! in)] - (swap! *cache_* assoc idx x) - x))) + (if-let [cache_ *cache_*] + (if-let [e (find @cache_ idx)] + (val e) + (let [x (thaw-from-in! in)] + (enc/-vol-swap! cache_ assoc idx x) + x)) + (throw (ex-info "No *cache_* binding established, can't thaw" {})))) (comment (thaw (freeze [(cache "foo") (cache "foo") (cache "foo")]))) @@ -872,7 +893,7 @@ ^bytes [x] (let [baos (ByteArrayOutputStream. 64) dos (DataOutputStream. baos)] - (freeze-to-out! dos x) + (with-cache (freeze-to-out! dos x)) (.toByteArray baos))) (defn freeze @@ -1200,7 +1221,7 @@ `(thaw x {:compressor nil :encryptor nil :no-header? true})" [^bytes ba] (let [dis (DataInputStream. (ByteArrayInputStream. ba))] - (thaw-from-in! dis))) + (with-cache (thaw-from-in! dis)))) (defn thaw "Deserializes a frozen Nippy byte array to its original Clojure data type. diff --git a/test/taoensso/nippy/tests/main.clj b/test/taoensso/nippy/tests/main.clj index 906d174..63d90ae 100644 --- a/test/taoensso/nippy/tests/main.clj +++ b/test/taoensso/nippy/tests/main.clj @@ -102,6 +102,24 @@ (nippy/extend-thaw :nippy-tests/MyRec [s] (->MyRec (.readUTF s))) (let [mr (->MyRec "val")] (= mr (thaw (freeze mr))))))) +;;;; Caching + +(deftest _caching + (let [stress [nippy/stress-data-comparable + nippy/stress-data-comparable + nippy/stress-data-comparable + nippy/stress-data-comparable] + cached (mapv nippy/cache stress) + cached (mapv nippy/cache stress) ; <=1 wrap auto-enforced + ] + + (is (= stress (thaw (freeze stress {:compressor nil})))) + (is (= stress (thaw (freeze cached {:compressor nil})))) + (let [size-stress (count (freeze stress {:compressor nil})) + size-cached (count (freeze cached {:compressor nil}))] + (is (>= size-stress (* 3 size-cached))) + (is (< size-stress (* 4 size-cached)))))) + ;;;; Stable binary representation of vals (deftest _stable-bin