Experimental support for signed counts

This commit is contained in:
Peter Taoussanis 2016-04-13 11:57:50 +07:00
parent 2028f80854
commit 699bb7cb51
2 changed files with 258 additions and 206 deletions

View file

@ -28,11 +28,6 @@
(set! *unchecked-math* false) (set! *unchecked-math* false)
(thaw (freeze stress-data))) (thaw (freeze stress-data)))
;; TODO NB For all sizes, we should be doing:
;; (- n 128) on freeze, (+ n 128) on thaw (for -sm)
;; (- n 32768) on freeze, (+ n 32768) on thaw (for -md)
;; etc.
;;;; Nippy data format ;;;; Nippy data format
;; * 4-byte header (Nippy v2.x+) (may be disabled but incl. by default) [1] ;; * 4-byte header (Nippy v2.x+) (may be disabled but incl. by default) [1]
;; { * 1-byte type id ;; { * 1-byte type id
@ -176,11 +171,11 @@
90 :date 90 :date
91 :uuid 91 :uuid
59 :cached-1 59 :cached-0
63 :cached-2 63 :cached-1
64 :cached-3 64 :cached-2
65 :cached-4 65 :cached-3
66 :cached-5 66 :cached-4
67 :cached-sm 67 :cached-sm
68 :cached-md 68 :cached-md
@ -192,7 +187,6 @@
27 :map-depr2 ; v2.11+ for count/2 27 :map-depr2 ; v2.11+ for count/2
29 :sorted-map-depr1 ; v2.11+ for count/2 29 :sorted-map-depr1 ; v2.11+ for count/2
4 :boolean-depr1 ; v2.12+ for switch to true/false ids 4 :boolean-depr1 ; v2.12+ for switch to true/false ids
6 :serializable-depr1 ; v2.12+ = serializable-lg -> sm, md 6 :serializable-depr1 ; v2.12+ = serializable-lg -> sm, md
5 :reader-depr2 ; v2.12+ = reader-lg -> sm, md, lg 5 :reader-depr2 ; v2.12+ = reader-lg -> sm, md, lg
80 :record-depr1 ; v2.12+ = record-lg -> sm, md 80 :record-depr1 ; v2.12+ = record-lg -> sm, md
@ -257,41 +251,86 @@
Ref. http://goo.gl/6gGRlU." Ref. http://goo.gl/6gGRlU."
(-freeze-to-out! [this out])) (-freeze-to-out! [this out]))
(defmacro ^:private byte-sized? [n] `(<= ~n 127 #_Byte/MAX_VALUE)) #_(do
(defmacro ^:private short-sized? [n] `(<= ~n 32767 #_Short/MAX_VALUE)) (defmacro write-id [out id] `(.writeByte ~out ~id))
(defmacro ^:private sm-count? [n] `(<= ~n 255)) #_(- Byte/MAX_VALUE Byte/MIN_VALUE)
(defmacro ^:private md-count? [n] `(<= ~n 65535)) #_(- Short/MAX_VALUE Short/MIN_VALUE)
(defmacro ^:private write-sm-count [out n]
`(if (<= ~n 127)
(.writeByte ~out ~n)
(.writeByte ~out (unchecked-subtract 127 ~n))))
(defmacro ^:private write-md-count [out n]
`(if (<= ~n 32767)
(.writeShort ~out ~n)
(.writeShort ~out (unchecked-subtract 32767 ~n))))
(defmacro ^:private write-lg-count [out n] `(.writeInt ~out ~n))
(defmacro ^:private read-sm-count [in]
`(let [n# (.readByte ~in)]
(if (pos? n#)
n#
(unchecked-subtract 127 n#))))
(defmacro ^:private read-md-count [in]
`(let [n# (.readShort ~in)]
(if (pos? n#)
n#
(unchecked-subtract 32767 n#))))
(defmacro ^:private read-lg-count [in] `(.readInt ~in)))
(do
(defmacro write-id [out id] `(.writeByte ~out ~id))
(defmacro ^:private sm-count? [n] `(<= ~n 127))
(defmacro ^:private md-count? [n] `(<= ~n 32767))
(defmacro ^:private write-sm-count [out n] `(.writeByte ~out ~n))
(defmacro ^:private write-md-count [out n] `(.writeShort ~out ~n))
(defmacro ^:private write-lg-count [out n] `(.writeInt ~out ~n))
(defmacro ^:private read-sm-count [in] `(.readByte ~in))
(defmacro ^:private read-md-count [in] `(.readShort ~in))
(defmacro ^:private read-lg-count [in] `(.readInt ~in)))
(defn- write-bytes-sm [^DataOutput out ^bytes ba] (defn- write-bytes-sm [^DataOutput out ^bytes ba]
(let [len (alength ba)] (let [len (alength ba)]
(.writeByte out (byte len)) ;; (byte len)
(.write out ba 0 len))) (write-sm-count out len)
(.write out ba 0 len)))
(defn- write-bytes-md [^DataOutput out ^bytes ba] (defn- write-bytes-md [^DataOutput out ^bytes ba]
(let [len (alength ba)] (let [len (alength ba)]
(.writeShort out (short len)) ;; (short len)
(.write out ba 0 len))) (write-md-count out len)
(.write out ba 0 len)))
(defn- write-bytes-lg [^DataOutput out ^bytes ba] (defn- write-bytes-lg [^DataOutput out ^bytes ba]
(let [len (alength ba)] (let [len (alength ba)]
(.writeInt out (int len)) (write-lg-count out len)
(.write out ba 0 len))) (.write out ba 0 len)))
(defn- write-bytes [^DataOutput out ^bytes ba] (defn- write-bytes [^DataOutput out ^bytes ba]
(let [len (alength ba)] (let [len (alength ba)]
(if (zero? len) (if (zero? len)
(.writeByte out id-bytes-0) (write-id out id-bytes-0)
(do (do
(cond (cond
(byte-sized? len) (sm-count? len)
(do (.writeByte out id-bytes-sm) (do (write-id out id-bytes-sm)
(.writeByte out len)) (write-sm-count out len))
(short-sized? len) (md-count? len)
(do (.writeByte out id-bytes-md) (do (write-id out id-bytes-md)
(.writeShort out len)) (write-md-count out len))
:else :else
(do (.writeByte out id-bytes-lg) (do (write-id out id-bytes-lg)
(.writeInt out (int len)))) (write-lg-count out len)))
(.write out ba 0 len))))) (.write out ba 0 len)))))
@ -304,21 +343,21 @@
(defn- write-str [^DataOutput out ^String s] (defn- write-str [^DataOutput out ^String s]
(if (identical? s "") (if (identical? s "")
(.writeByte out id-str-0) (write-id out id-str-0)
(let [ba (.getBytes s "UTF-8") (let [ba (.getBytes s "UTF-8")
len (alength ba)] len (alength ba)]
(cond (cond
(byte-sized? len) (sm-count? len)
(do (.writeByte out id-str-sm) (do (write-id out id-str-sm)
(.writeByte out len)) (write-sm-count out len))
(short-sized? len) (md-count? len)
(do (.writeByte out id-str-md) (do (write-id out id-str-md)
(.writeShort out len)) (write-md-count out len))
:else :else
(do (.writeByte out id-str-lg) (do (write-id out id-str-lg)
(.writeInt out (int len)))) (write-lg-count out len)))
(.write out ba 0 len)))) (.write out ba 0 len))))
@ -327,13 +366,13 @@
ba (.getBytes s "UTF-8") ba (.getBytes s "UTF-8")
len (alength ba)] len (alength ba)]
(cond (cond
(byte-sized? len) (sm-count? len)
(do (.writeByte out id-kw-sm) (do (write-id out id-kw-sm)
(.writeByte out len)) (write-sm-count out len))
:else ; Rare! :else ; Rare!
(do (.writeByte out id-kw-lg) (do (write-id out id-kw-lg)
(.writeInt out (int len)))) (write-lg-count out len)))
(.write out ba 0 len))) (.write out ba 0 len)))
@ -342,55 +381,55 @@
ba (.getBytes s "UTF-8") ba (.getBytes s "UTF-8")
len (alength ba)] len (alength ba)]
(cond (cond
(byte-sized? len) (sm-count? len)
(do (.writeByte out id-sym-sm) (do (write-id out id-sym-sm)
(.writeByte out len)) (write-sm-count out len))
:else ; Rare! :else ; Rare!
(do (.writeByte out id-sym-lg) (do (write-id out id-sym-lg)
(.writeInt out (int len)))) (write-lg-count out len)))
(.write out ba 0 len))) (.write out ba 0 len)))
(defn- write-long [^DataOutput out ^long n] (defn- write-long [^DataOutput out ^long n]
(cond (cond
(zero? n) (zero? n)
(.writeByte out id-long-zero) (write-id out id-long-zero)
(> n 0) (> n 0)
(cond (cond
(<= n 127 #_Byte/MAX_VALUE) (<= n 127 #_Byte/MAX_VALUE)
(do (.writeByte out id-long-sm) (do (write-id out id-long-sm)
(.writeByte out n)) (.writeByte out n))
(<= n 32767 #_Short/MAX_VALUE) (<= n 32767 #_Short/MAX_VALUE)
(do (.writeByte out id-long-md) (do (write-id out id-long-md)
(.writeShort out n)) (.writeShort out n))
(<= n 2147483647 #_Integer/MAX_VALUE) (<= n 2147483647 #_Integer/MAX_VALUE)
(do (.writeByte out id-long-lg) (do (write-id out id-long-lg)
(.writeInt out n)) (.writeInt out n))
:else :else
(do (.writeByte out id-long-xl) (do (write-id out id-long-xl)
(.writeLong out n))) (.writeLong out n)))
:else :else
(cond (cond
(>= n -128 #_Byte/MIN_VALUE) (>= n -128 #_Byte/MIN_VALUE)
(do (.writeByte out id-long-sm) (do (write-id out id-long-sm)
(.writeByte out n)) (.writeByte out n))
(>= n -32768 #_Short/MIN_VALUE) (>= n -32768 #_Short/MIN_VALUE)
(do (.writeByte out id-long-md) (do (write-id out id-long-md)
(.writeShort out n)) (.writeShort out n))
(>= n -2147483648 #_Integer/MIN_VALUE) (>= n -2147483648 #_Integer/MIN_VALUE)
(do (.writeByte out id-long-lg) (do (write-id out id-long-lg)
(.writeInt out n)) (.writeInt out n))
:else :else
(do (.writeByte out id-long-xl) (do (write-id out id-long-xl)
(.writeLong out n))))) (.writeLong out n)))))
(defmacro ^:private -run! [proc coll] `(do (reduce #(~proc %2) nil ~coll) nil)) (defmacro ^:private -run! [proc coll] `(do (reduce #(~proc %2) nil ~coll) nil))
@ -401,32 +440,32 @@
(defn- write-vec [^DataOutput out v] (defn- write-vec [^DataOutput out v]
(let [cnt (count v)] (let [cnt (count v)]
(if (zero? cnt) (if (zero? cnt)
(.writeByte out id-vec-0) (write-id out id-vec-0)
(do (do
(cond (cond
(byte-sized? cnt) (sm-count? cnt)
(cond (cond
(== cnt 2) (.writeByte out id-vec-2) (== cnt 2) (write-id out id-vec-2)
(== cnt 3) (.writeByte out id-vec-3) (== cnt 3) (write-id out id-vec-3)
:else :else
(do (.writeByte out id-vec-sm) (do (write-id out id-vec-sm)
(.writeByte out cnt))) (write-sm-count out cnt)))
(short-sized? cnt) (md-count? cnt)
(do (.writeByte out id-vec-md) (do (write-id out id-vec-md)
(.writeShort out cnt)) (write-md-count out cnt))
:else :else
(do (.writeByte out id-vec-lg) (do (write-id out id-vec-lg)
(.writeInt out (int cnt)))) (write-lg-count out cnt)))
(-run! (fn [in] (freeze-to-out! out in)) v))))) (-run! (fn [in] (freeze-to-out! out in)) v)))))
(defn- write-kvs (defn- write-kvs
([^DataOutput out id-lg coll] ([^DataOutput out id-lg coll]
(let [cnt (count coll)] (let [cnt (count coll)]
(.writeByte out id-lg) (write-id out id-lg)
(.writeInt out (int cnt)) (write-lg-count out cnt)
(-run-kv! (-run-kv!
(fn [k v] (fn [k v]
(freeze-to-out! out k) (freeze-to-out! out k)
@ -436,20 +475,20 @@
([^DataOutput out id-empty id-sm id-md id-lg coll] ([^DataOutput out id-empty id-sm id-md id-lg coll]
(let [cnt (count coll)] (let [cnt (count coll)]
(if (zero? cnt) (if (zero? cnt)
(.writeByte out id-empty) (write-id out id-empty)
(do (do
(cond (cond
(byte-sized? cnt) (sm-count? cnt)
(do (.writeByte out id-sm) (do (write-id out id-sm)
(.writeByte out cnt)) (write-sm-count out cnt))
(short-sized? cnt) (md-count? cnt)
(do (.writeByte out id-md) (do (write-id out id-md)
(.writeShort out cnt)) (write-md-count out cnt))
:else :else
(do (.writeByte out id-lg) (do (write-id out id-lg)
(.writeInt out (int cnt)))) (write-lg-count out cnt)))
(-run-kv! (-run-kv!
(fn [k v] (fn [k v]
@ -461,28 +500,28 @@
([^DataOutput out id-lg coll] ([^DataOutput out id-lg coll]
(let [cnt (count coll)] (let [cnt (count coll)]
;; (assert (counted? coll)) ;; (assert (counted? coll))
(.writeByte out id-lg) (write-id out id-lg)
(.writeInt out (int cnt)) (write-lg-count out cnt)
(-run! (fn [in] (freeze-to-out! out in)) coll))) (-run! (fn [in] (freeze-to-out! out in)) coll)))
([^DataOutput out id-empty id-sm id-md id-lg coll] ([^DataOutput out id-empty id-sm id-md id-lg coll]
(let [cnt (count coll)] (let [cnt (count coll)]
;; (assert (counted? coll)) ;; (assert (counted? coll))
(if (zero? cnt) (if (zero? cnt)
(.writeByte out id-empty) (write-id out id-empty)
(do (do
(cond (cond
(byte-sized? cnt) (sm-count? cnt)
(do (.writeByte out id-sm) (do (write-id out id-sm)
(.writeByte out cnt)) (write-sm-count out cnt))
(short-sized? cnt) (md-count? cnt)
(do (.writeByte out id-md) (do (write-id out id-md)
(.writeShort out cnt)) (write-md-count out cnt))
:else :else
(do (.writeByte out id-lg) (do (write-id out id-lg)
(.writeInt out (int cnt)))) (write-lg-count out cnt)))
(-run! (fn [in] (freeze-to-out! out in)) coll)))))) (-run! (fn [in] (freeze-to-out! out in)) coll))))))
@ -494,9 +533,9 @@
^long cnt (reduce (fn [^long cnt in] (freeze-to-out! sout in) (unchecked-inc cnt)) 0 coll) ^long cnt (reduce (fn [^long cnt in] (freeze-to-out! sout in) (unchecked-inc cnt)) 0 coll)
ba (.toByteArray bas)] ba (.toByteArray bas)]
(.writeByte out id-lg) (write-id out id-lg)
(.writeInt out (int cnt)) (write-lg-count out cnt)
(.write out ba))) (.write out ba)))
([^DataOutput out id-empty id-sm id-md id-lg coll] ([^DataOutput out id-empty id-sm id-md id-lg coll]
(let [bas (ByteArrayOutputStream. 32) (let [bas (ByteArrayOutputStream. 32)
@ -505,20 +544,20 @@
ba (.toByteArray bas)] ba (.toByteArray bas)]
(if (zero? cnt) (if (zero? cnt)
(.writeByte out id-empty) (write-id out id-empty)
(do (do
(cond (cond
(byte-sized? cnt) (sm-count? cnt)
(do (.writeByte out id-sm) (do (write-id out id-sm)
(.writeByte out cnt)) (write-sm-count out cnt))
(short-sized? cnt) (md-count? cnt)
(do (.writeByte out id-md) (do (write-id out id-md)
(.writeShort out cnt)) (write-md-count out cnt))
:else :else
(do (.writeByte out id-lg) (do (write-id out id-lg)
(.writeInt out (int cnt)))) (write-lg-count out cnt)))
(.write out ba)))))) (.write out ba))))))
@ -538,20 +577,20 @@
(defn- write-map [^DataOutput out m] (defn- write-map [^DataOutput out m]
(let [cnt (count m)] (let [cnt (count m)]
(if (zero? cnt) (if (zero? cnt)
(.writeByte out id-map-0) (write-id out id-map-0)
(do (do
(cond (cond
(byte-sized? cnt) (sm-count? cnt)
(do (.writeByte out id-map-sm) (do (write-id out id-map-sm)
(.writeByte out cnt)) (write-sm-count out cnt))
(short-sized? cnt) (md-count? cnt)
(do (.writeByte out id-map-md) (do (write-id out id-map-md)
(.writeShort out cnt)) (write-md-count out cnt))
:else :else
(do (.writeByte out id-map-lg) (do (write-id out id-map-lg)
(.writeInt out (int cnt)))) (write-lg-count out cnt)))
(-run-kv! (-run-kv!
(fn [k v] (fn [k v]
@ -564,20 +603,20 @@
(defn- write-set [^DataOutput out s] (defn- write-set [^DataOutput out s]
(let [cnt (count s)] (let [cnt (count s)]
(if (zero? cnt) (if (zero? cnt)
(.writeByte out id-set-0) (write-id out id-set-0)
(do (do
(cond (cond
(byte-sized? cnt) (sm-count? cnt)
(do (.writeByte out id-set-sm) (do (write-id out id-set-sm)
(.writeByte out cnt)) (write-sm-count out cnt))
(short-sized? cnt) (md-count? cnt)
(do (.writeByte out id-set-md) (do (write-id out id-set-md)
(.writeShort out cnt)) (write-md-count out cnt))
:else :else
(do (.writeByte out id-set-lg) (do (write-id out id-set-lg)
(.writeInt out (int cnt)))) (write-lg-count out cnt)))
(-run! (fn [in] (freeze-to-out! out in)) s))))) (-run! (fn [in] (freeze-to-out! out in)) s)))))
@ -587,12 +626,12 @@
cname-ba (.getBytes cname "UTF-8") cname-ba (.getBytes cname "UTF-8")
len (alength cname-ba)] len (alength cname-ba)]
(cond (cond
(byte-sized? len) (sm-count? len)
(do (.writeByte out id-serializable-sm) (do (write-id out id-serializable-sm)
(write-bytes-sm out cname-ba)) (write-bytes-sm out cname-ba))
:else :else
(do (.writeByte out id-serializable-md) (do (write-id out id-serializable-md)
(write-bytes-md out cname-ba))) (write-bytes-md out cname-ba)))
(.writeObject (ObjectOutputStream. out) x))) (.writeObject (ObjectOutputStream. out) x)))
@ -603,16 +642,16 @@
edn-ba (.getBytes ^String edn "UTF-8") edn-ba (.getBytes ^String edn "UTF-8")
len (alength edn-ba)] len (alength edn-ba)]
(cond (cond
(byte-sized? len) (sm-count? len)
(do (.writeByte out id-reader-sm) (do (write-id out id-reader-sm)
(write-bytes-sm out edn-ba)) (write-bytes-sm out edn-ba))
(short-sized? len) (md-count? len)
(do (.writeByte out id-reader-md) (do (write-id out id-reader-md)
(write-bytes-md out edn-ba)) (write-bytes-md out edn-ba))
:else :else
(do (.writeByte out id-reader-lg) (do (write-id out id-reader-lg)
(write-bytes-lg out edn-ba))))) (write-bytes-lg out edn-ba)))))
(defn try-write-serializable [out x] (defn try-write-serializable [out x]
@ -652,7 +691,7 @@
[^DataOutput data-output x] [^DataOutput data-output x]
(when (.isInstance clojure.lang.IMeta x) ; Rare (when (.isInstance clojure.lang.IMeta x) ; Rare
(when-let [m (meta x)] (when-let [m (meta x)]
(.writeByte data-output id-meta) (write-id data-output id-meta)
(-freeze-to-out! m data-output))) (-freeze-to-out! m data-output)))
(-freeze-to-out! x data-output)) (-freeze-to-out! x data-output))
@ -664,54 +703,58 @@
(defmacro ^:private id-freezer [type id & body] (defmacro ^:private id-freezer [type id & body]
`(extend-type ~type Freezable `(extend-type ~type Freezable
(~'-freeze-to-out! [~'x ~(with-meta 'out {:tag 'DataOutput})] (~'-freeze-to-out! [~'x ~(with-meta 'out {:tag 'DataOutput})]
(.writeByte ~'out ~id) (write-id ~'out ~id)
~@body))) ~@body)))
;;;; Caching ; Experimental ;;;; Caching ; Experimental
(def ^:dynamic ^:private *cache_* "{<x> <cache-idx>}" nil) (def ^:dynamic ^:private *cache_* "{<x> <cache-idx>}" nil)
(defmacro ^:private with-cache [& body] `(binding [*cache_* (atom nil)] ~@body)) (defmacro ^:private with-cache [& body]
`(binding [*cache_* (atom nil)] ~@body))
;; (defmacro ^:private with-cache [& body] `(do ~@body)) ; Disable
(defrecord CacheWrapped [value]) (defrecord CacheWrapped [value])
(defn cache [x] (if (instance? CacheWrapped x) x (CacheWrapped. x))) (defn cache "Experimental!" [x]
(if (instance? CacheWrapped x) x (CacheWrapped. x)))
(comment (cache "foo")) (comment (cache "foo"))
(freezer CacheWrapped (freezer CacheWrapped
(let [x-val (:value x)] (let [x-val (:value x)]
(if-let [cache_ *cache_*] (if-let [cache_ *cache_*]
(let [[first-occ? idx] (let [[first-occ? ^long idx]
(enc/swap-in! cache_ (enc/swap-in! cache_
(fn [m] (fn [m]
(if-let [idx (get m x-val)] (if-let [idx (get m x-val)]
(enc/swapped m [false idx]) (enc/swapped m [false idx])
(let [idx (inc (count m))] (let [idx (count m)]
(enc/swapped (assoc m x-val idx) [true idx])))))] (enc/swapped (assoc m x-val idx) [true idx])))))]
(cond (cond
(byte-sized? idx) (sm-count? idx)
(cond (cond
(== idx 1) (do (.writeByte out id-cached-1) (== idx 0) (do (write-id out id-cached-0)
(when first-occ? (-freeze-to-out! x-val out))) (when first-occ? (-freeze-to-out! x-val out)))
(== idx 2) (do (.writeByte out id-cached-2) (== idx 1) (do (write-id out id-cached-1)
(when first-occ? (-freeze-to-out! x-val out))) (when first-occ? (-freeze-to-out! x-val out)))
(== idx 3) (do (.writeByte out id-cached-3) (== idx 2) (do (write-id out id-cached-2)
(when first-occ? (-freeze-to-out! x-val out))) (when first-occ? (-freeze-to-out! x-val out)))
(== idx 4) (do (.writeByte out id-cached-4) (== idx 3) (do (write-id out id-cached-3)
(when first-occ? (-freeze-to-out! x-val out))) (when first-occ? (-freeze-to-out! x-val out)))
(== idx 5) (do (.writeByte out id-cached-5) (== idx 4) (do (write-id out id-cached-4)
(when first-occ? (-freeze-to-out! x-val out))) (when first-occ? (-freeze-to-out! x-val out)))
:else :else
(do (.writeByte out id-cached-sm) (do (write-id out id-cached-sm)
(.writeByte out (+ idx Byte/MIN_VALUE)) (write-sm-count out idx)
(when first-occ? (-freeze-to-out! x-val out)))) (when first-occ? (-freeze-to-out! x-val out))))
(short-sized? idx) (md-count? idx)
(do (.writeByte out id-cached-md) (do (write-id out id-cached-md)
(.writeShort out (+ idx Short/MIN_VALUE)) (write-md-count out idx)
(when first-occ? (-freeze-to-out! x-val out))) (when first-occ? (-freeze-to-out! x-val out)))
:else (throw (ex-info "Maximum cache size exceeded" {:idx idx})))) :else (throw (ex-info "Max cache size exceeded" {:idx idx}))))
(-freeze-to-out! x-val out)))) (-freeze-to-out! x-val out))))
@ -750,16 +793,16 @@
(.writeLong out (.getMostSignificantBits x)) (.writeLong out (.getMostSignificantBits x))
(.writeLong out (.getLeastSignificantBits x))) (.writeLong out (.getLeastSignificantBits x)))
(freezer Boolean (if x (.writeByte out id-true) (.writeByte out id-false))) (freezer Boolean (if x (write-id out id-true) (write-id out id-false)))
(freezer (Class/forName "[B") (write-bytes out x)) (freezer (Class/forName "[B") (write-bytes out x))
(freezer String (write-str out x)) (freezer String (write-str out x))
(freezer Keyword (write-kw out x)) (freezer Keyword (write-kw out x))
(freezer Symbol (write-sym out x)) (freezer Symbol (write-sym out x))
(freezer Long (write-long out x)) (freezer Long (write-long out x))
(freezer Double (freezer Double
(if (zero? x) (if (zero? ^double x)
(.writeByte out id-double-zero) (write-id out id-double-zero)
(do (.writeByte out id-double) (do (write-id out id-double)
(.writeDouble out x)))) (.writeDouble out x))))
(freezer PersistentQueue (write-counted-coll out id-queue x)) (freezer PersistentQueue (write-counted-coll out id-queue x))
@ -776,12 +819,12 @@
cname-ba (.getBytes cname "UTF-8") cname-ba (.getBytes cname "UTF-8")
len (alength cname-ba)] len (alength cname-ba)]
(cond (cond
(byte-sized? len) (sm-count? len)
(do (.writeByte out id-record-sm) (do (write-id out id-record-sm)
(write-bytes-sm out cname-ba)) (write-bytes-sm out cname-ba))
:else :else
(do (.writeByte out id-record-md) (do (write-id out id-record-md)
(write-bytes-md out cname-ba))) (write-bytes-md out cname-ba)))
(-freeze-to-out! (into {} x) out))) (-freeze-to-out! (into {} x) out)))
@ -853,6 +896,7 @@
;; Intelligently enable compression only if benefit ;; Intelligently enable compression only if benefit
;; is likely to outweigh cost: ;; is likely to outweigh cost:
(when (> (alength ba) 8192) lz4-compressor))) (when (> (alength ba) 8192) lz4-compressor)))
(if (fn? compressor) (if (fn? compressor)
(compressor ba) ; Assume compressor selector fn (compressor ba) ; Assume compressor selector fn
compressor ; Assume compressor compressor ; Assume compressor
@ -883,7 +927,14 @@
(.readFully in ba 0 len) (.readFully in ba 0 len)
ba)) ba))
(defn- read-utf8 [in len] (String. (read-bytes in len))) (defn- read-bytes-sm ^bytes [^DataInput in] (read-bytes (read-sm-count in)))
(defn- read-bytes-md ^bytes [^DataInput in] (read-bytes (read-md-count in)))
(defn- read-bytes-lg ^bytes [^DataInput in] (read-bytes (read-lg-count in)))
(defn- read-utf8 [in len] (String. (read-bytes in len)))
(defn- read-utf8-sm [^DataInput in] (String. (read-bytes in (read-sm-count in))))
(defn- read-utf8-md [^DataInput in] (String. (read-bytes in (read-md-count in))))
(defn- read-utf8-lg [^DataInput in] (String. (read-bytes in (read-lg-count in))))
(defn- read-biginteger ^BigInteger [^DataInput in] (defn- read-biginteger ^BigInteger [^DataInput in]
(BigInteger. (read-bytes in (.readInt in)))) (BigInteger. (read-bytes in (.readInt in))))
@ -970,13 +1021,13 @@
(try (try
(enc/case-eval type-id (enc/case-eval type-id
id-reader-sm (read-edn (read-utf8 in (.readByte in))) id-reader-sm (read-edn (read-utf8 in (read-sm-count in)))
id-reader-md (read-edn (read-utf8 in (.readShort in))) id-reader-md (read-edn (read-utf8 in (read-md-count in)))
id-reader-lg (read-edn (read-utf8 in (.readInt in))) id-reader-lg (read-edn (read-utf8 in (read-lg-count in)))
id-serializable-sm (read-serializable in (read-utf8 in (.readByte in))) id-serializable-sm (read-serializable in (read-utf8 in (read-sm-count in)))
id-serializable-md (read-serializable in (read-utf8 in (.readShort in))) id-serializable-md (read-serializable in (read-utf8 in (read-md-count in)))
id-record-sm (read-record in (read-utf8 in (.readByte in))) id-record-sm (read-record in (read-utf8 in (read-sm-count in)))
id-record-md (read-record in (read-utf8 in (.readShort in))) id-record-md (read-record in (read-utf8 in (read-md-count in)))
id-nil nil id-nil nil
id-true true id-true true
@ -985,59 +1036,59 @@
id-meta (let [m (thaw-from-in! in)] id-meta (let [m (thaw-from-in! in)]
(with-meta (thaw-from-in! in) m)) (with-meta (thaw-from-in! in) m))
id-cached-0 (thaw-cached 0 in)
id-cached-1 (thaw-cached 1 in) id-cached-1 (thaw-cached 1 in)
id-cached-2 (thaw-cached 2 in) id-cached-2 (thaw-cached 2 in)
id-cached-3 (thaw-cached 3 in) id-cached-3 (thaw-cached 3 in)
id-cached-4 (thaw-cached 4 in) id-cached-4 (thaw-cached 4 in)
id-cached-5 (thaw-cached 5 in) id-cached-sm (thaw-cached (read-sm-count in) in)
id-cached-sm (thaw-cached (- (.readByte in) Byte/MIN_VALUE) in) id-cached-md (thaw-cached (read-md-count in) in)
id-cached-md (thaw-cached (- (.readShort in) Short/MIN_VALUE) in)
id-bytes-0 (byte-array 0) id-bytes-0 (byte-array 0)
id-bytes-sm (read-bytes in (.readByte in)) id-bytes-sm (read-bytes in (read-sm-count in))
id-bytes-md (read-bytes in (.readShort in)) id-bytes-md (read-bytes in (read-md-count in))
id-bytes-lg (read-bytes in (.readInt in)) id-bytes-lg (read-bytes in (read-lg-count in))
id-str-0 "" id-str-0 ""
id-str-sm (read-utf8 in (.readByte in)) id-str-sm (read-utf8 in (read-sm-count in))
id-str-md (read-utf8 in (.readShort in)) id-str-md (read-utf8 in (read-md-count in))
id-str-lg (read-utf8 in (.readInt in)) id-str-lg (read-utf8 in (read-lg-count in))
id-kw-sm (keyword (read-utf8 in (.readByte in))) id-kw-sm (keyword (read-utf8 in (read-sm-count in)))
id-kw-lg (keyword (read-utf8 in (.readShort in))) id-kw-lg (keyword (read-utf8 in (read-lg-count in)))
id-sym-sm (symbol (read-utf8 in (.readByte in))) id-sym-sm (symbol (read-utf8 in (read-sm-count in)))
id-sym-lg (symbol (read-utf8 in (.readInt in))) id-sym-lg (symbol (read-utf8 in (read-lg-count in)))
id-regex (re-pattern (thaw-from-in! in)) id-regex (re-pattern (thaw-from-in! in))
id-vec-0 [] id-vec-0 []
id-vec-2 [(thaw-from-in! in) (thaw-from-in! in)] id-vec-2 [(thaw-from-in! in) (thaw-from-in! in)]
id-vec-3 [(thaw-from-in! in) (thaw-from-in! in) (thaw-from-in! in)] id-vec-3 [(thaw-from-in! in) (thaw-from-in! in) (thaw-from-in! in)]
id-vec-sm (read-into [] in (.readByte in)) id-vec-sm (read-into [] in (read-sm-count in))
id-vec-md (read-into [] in (.readShort in)) id-vec-md (read-into [] in (read-md-count in))
id-vec-lg (read-into [] in (.readInt in)) id-vec-lg (read-into [] in (read-lg-count in))
id-set-0 #{} id-set-0 #{}
id-set-sm (read-into #{} in (.readByte in)) id-set-sm (read-into #{} in (read-sm-count in))
id-set-md (read-into #{} in (.readShort in)) id-set-md (read-into #{} in (read-md-count in))
id-set-lg (read-into #{} in (.readInt in)) id-set-lg (read-into #{} in (read-lg-count in))
id-map-0 {} id-map-0 {}
id-map-sm (read-kvs-into {} in (.readByte in)) id-map-sm (read-kvs-into {} in (read-sm-count in))
id-map-md (read-kvs-into {} in (.readShort in)) id-map-md (read-kvs-into {} in (read-md-count in))
id-map-lg (read-kvs-into {} in (.readInt in)) id-map-lg (read-kvs-into {} in (read-lg-count in))
id-queue (read-into (PersistentQueue/EMPTY) in (.readInt in)) id-queue (read-into (PersistentQueue/EMPTY) in (read-lg-count in))
id-sorted-set (read-into (sorted-set) in (.readInt in)) id-sorted-set (read-into (sorted-set) in (read-lg-count in))
id-sorted-map (read-kvs-into (sorted-map) in (.readInt in)) id-sorted-map (read-kvs-into (sorted-map) in (read-lg-count in))
id-list-0 '() id-list-0 '()
id-list-sm (into '() (rseq (read-into [] in (.readByte in)))) id-list-sm (into '() (rseq (read-into [] in (read-sm-count in))))
id-list-md (into '() (rseq (read-into [] in (.readShort in)))) id-list-md (into '() (rseq (read-into [] in (read-md-count in))))
id-list-lg (into '() (rseq (read-into [] in (.readInt in)))) id-list-lg (into '() (rseq (read-into [] in (read-lg-count in))))
id-seq-0 (lazy-seq nil) id-seq-0 (lazy-seq nil)
id-seq-sm (or (seq (read-into [] in (.readByte in))) (lazy-seq nil)) id-seq-sm (or (seq (read-into [] in (read-sm-count in))) (lazy-seq nil))
id-seq-md (or (seq (read-into [] in (.readShort in))) (lazy-seq nil)) id-seq-md (or (seq (read-into [] in (read-md-count in))) (lazy-seq nil))
id-seq-lg (or (seq (read-into [] in (.readInt in))) (lazy-seq nil)) id-seq-lg (or (seq (read-into [] in (read-lg-count in))) (lazy-seq nil))
id-byte (.readByte in) id-byte (.readByte in)
id-short (.readShort in) id-short (.readShort in)
@ -1259,9 +1310,9 @@
(~'-freeze-to-out! [~x ~(with-meta out {:tag 'java.io.DataOutput})] (~'-freeze-to-out! [~x ~(with-meta out {:tag 'java.io.DataOutput})]
(if-not ~(keyword? custom-type-id) (if-not ~(keyword? custom-type-id)
;; Unprefixed [cust byte id][payload]: ;; Unprefixed [cust byte id][payload]:
(.writeByte ~out ~(coerce-custom-type-id custom-type-id)) (write-id ~out ~(coerce-custom-type-id custom-type-id))
;; Prefixed [const byte id][cust hash id][payload]: ;; Prefixed [const byte id][cust hash id][payload]:
(do (.writeByte ~out ~id-prefixed-custom) (do (write-id ~out ~id-prefixed-custom)
(.writeShort ~out ~(coerce-custom-type-id custom-type-id)))) (.writeShort ~out ~(coerce-custom-type-id custom-type-id))))
~@body))) ~@body)))
@ -1366,8 +1417,9 @@
(def stress-data-benchable (def stress-data-benchable
"Reference data with stuff removed that breaks reader or other utils we'll "Reference data with stuff removed that breaks reader or other utils we'll
be benching against" be benching against"
(dissoc stress-data :bytes :throwable :exception :ex-info :queue :queue-empty (dissoc stress-data
:byte :stress-record)) :bytes :throwable :exception :ex-info :queue :queue-empty
:byte :stress-record :regex))
;;;; Tools ;;;; Tools

View file

@ -18,7 +18,7 @@
(comment (fressian-thaw (fressian-freeze data))) (comment (fressian-thaw (fressian-freeze data)))
(defmacro bench* [& body] `(enc/bench 10000 {:warmup-laps 20000} ~@body)) (defmacro bench* [& body] `(enc/bench 10000 {:warmup-laps 25000} ~@body))
(defn bench1 [freezer thawer & [sizer]] (defn bench1 [freezer thawer & [sizer]]
(let [data-frozen (freezer data) (let [data-frozen (freezer data)
time-freeze (bench* (freezer data)) time-freeze (bench* (freezer data))
@ -68,15 +68,15 @@
;; (bench {:reader? true :lzma2? true :fressian? true :laps 2}) ;; (bench {:reader? true :lzma2? true :fressian? true :laps 2})
;; (bench {:laps 2}) ;; (bench {:laps 2})
;;; 2016 Apr 12, v2.12.0-SNAPSHOT, refactor + larger data + new hardware ;;; 2016 Apr 13, v2.12.0-SNAPSHOT, refactor + larger data + new hardware
{:reader {:round 52734, :freeze 18066, :thaw 34668, :size 27839}} {:reader {:round 52105, :freeze 17678, :thaw 34427, :size 27831}}
{:lzma2 {:round 42746, :freeze 27586, :thaw 15160, :size 11252}} {:lzma2 {:round 43436, :freeze 28518, :thaw 14918, :size 11272}}
{:fressian {:round 6700, :freeze 4968, :thaw 1732, :size 17074}} {:fressian {:round 6875, :freeze 5035, :thaw 1840, :size 17105}}
{:encrypted {:round 4819, :freeze 3024, :thaw 1795, :size 16164}} {:encrypted {:round 4718, :freeze 2872, :thaw 1846, :size 16420}}
{:default {:round 4362, :freeze 2695, :thaw 1667, :size 16134}} {:default {:round 4250, :freeze 2547, :thaw 1703, :size 16400}}
{:fast1 {:round 3754, :freeze 2149, :thaw 1605, :size 17052}} {:fast1 {:round 3777, :freeze 2118, :thaw 1659, :size 17070}}
{:fast2 {:round 3730, :freeze 2156, :thaw 1574, :size 17048}} {:fast2 {:round 3753, :freeze 2119, :thaw 1634, :size 17066}}
;; :reader/:default ratio: ~12.09 ;; 12.26
;;; 2015 Oct 6, v2.11.0-alpha4 ;;; 2015 Oct 6, v2.11.0-alpha4
{:reader {:round 73409, :freeze 21823, :thaw 51586, :size 27672}} {:reader {:round 73409, :freeze 21823, :thaw 51586, :size 27672}}