luciano/nippy
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Experimental: add cache metadata support

Browse source
This commit is contained in:
Peter Taoussanis 2016-07-17 15:21:26 +07:00
parent 773180ef65
commit 3d8bc0eee1
2 changed files with 40 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
src/taoensso/nippy.clj
View file

@ -745,9 +745,8 @@
(deftype CacheWrapped [val]) (deftype CacheWrapped [val])
(defn cache (defn cache
"Experimental! Wraps value so that future writes of the same wrapped "Experimental! Wraps value so that future writes of the same wrapped
value will be efficiently encoded as references to this one. value with same metadata will be efficiently encoded as references to
this one.
**NB**: Ignores metadata!
(freeze [(cache \"foo\") (cache \"foo\") (cache \"foo\")]) (freeze [(cache \"foo\") (cache \"foo\") (cache \"foo\")])
will incl. a single \"foo\", plus 2x single-byte references to \"foo\"." will incl. a single \"foo\", plus 2x single-byte references to \"foo\"."
@ -760,10 +759,11 @@
(let [x-val (.-val x)] (let [x-val (.-val x)]
(if-let [cache_ (.get -cache-proxy)] (if-let [cache_ (.get -cache-proxy)]
(let [cache @cache_ (let [cache @cache_
?idx (get cache x-val) k #_x-val [x-val (meta x-val)]
?idx (get cache k)
^int idx (or ?idx ^int idx (or ?idx
(let [idx (count cache)] (let [idx (count cache)]
(enc/-vol-swap! cache_ assoc x-val idx) (enc/-vol-swap! cache_ assoc k idx)
idx)) idx))
first-occurance? (nil? ?idx)] first-occurance? (nil? ?idx)]
@ -772,31 +772,31 @@
(sm-count? idx) (sm-count? idx)
(case (int idx) (case (int idx)
0 (do (write-id out id-cached-0) 0 (do (write-id out id-cached-0)
(when first-occurance? (-freeze-without-meta! x-val out))) (when first-occurance? (-freeze-with-meta! x-val out)))
1 (do (write-id out id-cached-1) 1 (do (write-id out id-cached-1)
(when first-occurance? (-freeze-without-meta! x-val out))) (when first-occurance? (-freeze-with-meta! x-val out)))
2 (do (write-id out id-cached-2) 2 (do (write-id out id-cached-2)
(when first-occurance? (-freeze-without-meta! x-val out))) (when first-occurance? (-freeze-with-meta! x-val out)))
3 (do (write-id out id-cached-3) 3 (do (write-id out id-cached-3)
(when first-occurance? (-freeze-without-meta! x-val out))) (when first-occurance? (-freeze-with-meta! x-val out)))
4 (do (write-id out id-cached-4) 4 (do (write-id out id-cached-4)
(when first-occurance? (-freeze-without-meta! x-val out))) (when first-occurance? (-freeze-with-meta! x-val out)))
(do (write-id out id-cached-sm) (do (write-id out id-cached-sm)
(write-sm-count out idx) (write-sm-count out idx)
(when first-occurance? (-freeze-without-meta! x-val out)))) (when first-occurance? (-freeze-with-meta! x-val out))))
(md-count? idx) (md-count? idx)
(do (write-id out id-cached-md) (do (write-id out id-cached-md)
(write-md-count out idx) (write-md-count out idx)
(when first-occurance? (-freeze-without-meta! x-val out))) (when first-occurance? (-freeze-with-meta! x-val out)))
:else :else
;; (throw (ex-info "Max cache size exceeded" {:idx idx})) ;; (throw (ex-info "Max cache size exceeded" {:idx idx}))
(-freeze-without-meta! x-val out) ; Just freeze uncached (-freeze-with-meta! x-val out) ; Just freeze uncached
)) ))
(-freeze-without-meta! x-val out)))) (-freeze-with-meta! x-val out))))
(declare thaw-from-in!) (declare thaw-from-in!)
(def ^:private thaw-cached (def ^:private thaw-cached
@ -812,7 +812,12 @@
(throw (ex-info "No cache_ established, can't thaw. See `with-cache`." (throw (ex-info "No cache_ established, can't thaw. See `with-cache`."
{})))))) {}))))))
(comment (thaw (freeze [(cache "foo") (cache "foo") (cache "foo")]))) (comment
(thaw (freeze [(cache "foo") (cache "foo") (cache "foo")]))
(let [v1 (with-meta [] {:id :v1})
v2 (with-meta [] {:id :v2})]
(mapv meta
(thaw (freeze [(cache v1) (cache v2) (cache v1) (cache v2)])))))
;;;; ;;;;

20
test/taoensso/nippy/tests/main.clj
View file

@ -120,6 +120,26 @@
(is (>= size-stress (* 3 size-cached))) (is (>= size-stress (* 3 size-cached)))
(is (< size-stress (* 4 size-cached)))))) (is (< size-stress (* 4 size-cached))))))
(deftest _caching-metadata
(let [v1 (with-meta [] {:id :v1})
v2 (with-meta [] {:id :v2})
frozen-without-caching (freeze [v1 v2 v1 v2])
frozen-with-caching
(freeze [(nippy/cache v1)
(nippy/cache v2)
(nippy/cache v1)
(nippy/cache v2)])]
(is (> (count frozen-without-caching)
(count frozen-with-caching)))
(is (= (thaw frozen-without-caching)
(thaw frozen-with-caching)))
(is (= (mapv meta (thaw frozen-with-caching))
[{:id :v1} {:id :v2} {:id :v1} {:id :v2}]))))
;;;; Stable binary representation of vals ;;;; Stable binary representation of vals
(deftest _stable-bin (deftest _stable-bin