Experimental: optimize common case of small maps, sets, vectors

This commit is contained in:
Peter Taoussanis 2015-09-28 16:38:48 +07:00
parent b298d690c7
commit 327a800d80

View file

@ -120,9 +120,11 @@
(def ^:const id-sm-string (int 105)) ; 1 vs 4 byte length prefix (def ^:const id-sm-string (int 105)) ; 1 vs 4 byte length prefix
(def ^:const id-sm-keyword (int 106)) ; '' (def ^:const id-sm-keyword (int 106)) ; ''
;; ;;
;; (def ^:const id-sm-vector (int 110)) ; '' (def ^:const id-sm-vector (int 110)) ; ''
;; (def ^:const id-sm-set (int 111)) ; '' (def ^:const id-sm-set (int 111)) ; ''
;; (def ^:const id-sm-map (int 112)) ; '' (def ^:const id-sm-map (int 112)) ; ''
;;
;; TODO Additional optimizations (types) for 2-vecs and 3-vecs?
;;; DEPRECATED (old types will be supported only for thawing) ;;; DEPRECATED (old types will be supported only for thawing)
(def ^:const id-reader-depr1 (int 1)) ; v0.9.2+ for +64k support (def ^:const id-reader-depr1 (int 1)) ; v0.9.2+ for +64k support
@ -154,19 +156,17 @@
"Be careful about extending to interfaces, Ref. http://goo.gl/6gGRlU" "Be careful about extending to interfaces, Ref. http://goo.gl/6gGRlU"
(freeze-to-out* [this out])) (freeze-to-out* [this out]))
(defn small-count? [n] (<= (long n) 127 #_Byte/MAX_VALUE))
(defmacro write-id [out id] `(.writeByte ~out ~id)) (defmacro write-id [out id] `(.writeByte ~out ~id))
(defmacro write-bytes [out ba & [small?]] (defmacro write-bytes [out ba & [small?]]
(let [out (with-meta out {:tag 'java.io.DataOutput}) (let [wc (if small? 'writeByte 'writeInt)
out (with-meta out {:tag 'java.io.DataOutput})
ba (with-meta ba {:tag 'bytes})] ba (with-meta ba {:tag 'bytes})]
(if small? ; Optimization, must be known before id's written `(let [out# ~out
`(let [out# ~out, ba# ~ba ba# ~ba
size# (alength ba#)] size# (alength ba#)]
(.writeByte out# (byte size#)) (. out# ~wc size#)
(.write out# ba# 0 size#)) (.write out# ba# 0 size#))))
`(let [out# ~out, ba# ~ba
size# (alength ba#)]
(.writeInt out# (int size#))
(.write out# ba# 0 size#)))))
(defmacro write-biginteger [out x] (defmacro write-biginteger [out x]
(let [x (with-meta x {:tag 'java.math.BigInteger})] (let [x (with-meta x {:tag 'java.math.BigInteger})]
@ -185,6 +185,32 @@
(freeze-to-out* m# out#)) (freeze-to-out* m# out#))
(freeze-to-out* x# out#))) (freeze-to-out* x# out#)))
(defmacro write-coll [out x & [small?]]
(let [wc (if small? 'writeByte 'writeInt)]
`(if (counted? ~'x)
(do
(. ~'out ~wc (count ~'x))
(encore/run!* (fn [i#] (freeze-to-out ~'out i#)) ~'x))
(let [bas# (ByteArrayOutputStream. 64)
sout# (DataOutputStream. bas#)
cnt# (reduce (fn [^long cnt# i#]
(freeze-to-out sout# i#)
(unchecked-inc cnt#))
0 ~'x)
ba# (.toByteArray bas#)]
(. ~'out ~wc cnt#)
(.write ~'out ba# 0 (alength ba#))))))
(defmacro write-kvs [out x & [small?]]
(let [wc (if small? 'writeByte 'writeInt)]
`(do
(. ~'out ~wc (count ~'x))
(encore/run-kv!
(fn [k# v#]
(freeze-to-out ~'out k#)
(freeze-to-out ~'out v#))
~'x))))
(defmacro ^:private freezer [type id & body] (defmacro ^:private freezer [type id & body]
`(extend-type ~type `(extend-type ~type
Freezable Freezable
@ -192,63 +218,57 @@
(write-id ~'out ~id) (write-id ~'out ~id)
~@body))) ~@body)))
(defmacro ^:private freezer-coll [type id & body] (defmacro ^:private freezer-coll [type id & [id-sm]]
`(freezer ~type ~id (if-not id-sm
(when-debug-mode `(freezer ~type ~id (write-coll ~'out ~'x))
(when (instance? ISeq ~type) `(extend-type ~type
(println (format "DEBUG - freezer-coll: %s for %s" ~type (type ~'x))))) Freezable
(if (counted? ~'x) (~'freeze-to-out* [~'x ~(with-meta 'out {:tag 'DataOutput})]
(do (.writeInt ~'out (count ~'x)) (if (small-count? (count ~'x))
(encore/run!* (fn [i#] (freeze-to-out ~'out i#)) ~'x)) (do
(let [bas# (ByteArrayOutputStream. 64) (write-id ~'out ~id-sm)
sout# (DataOutputStream. bas#) (write-coll ~'out ~'x :small))
cnt# (reduce (fn [^long cnt# i#] (do
(freeze-to-out sout# i#) (write-id ~'out ~id)
(unchecked-inc cnt#)) (write-coll ~'out ~'x)))))))
0 ~'x)
ba# (.toByteArray bas#)]
(.writeInt ~'out cnt#)
(.write ~'out ba# 0 (alength ba#))))))
(defmacro ^:private freezer-kvs [type id & body] (defmacro ^:private freezer-kvs [type id & [id-sm]]
`(freezer ~type ~id (if-not id-sm
(.writeInt ~'out (count ~'x)) `(freezer ~type ~id (write-kvs ~'out ~'x))
(encore/run-kv! `(extend-type ~type
(fn [k# v#] Freezable
(freeze-to-out ~'out k#) (~'freeze-to-out* [~'x ~(with-meta 'out {:tag 'DataOutput})]
(freeze-to-out ~'out v#)) (if (small-count? (count ~'x))
~'x))) (do
(write-id ~'out ~id-sm)
(write-kvs ~'out ~'x :small))
(do
(write-id ~'out ~id)
(write-kvs ~'out ~'x)))))))
(freezer (Class/forName "[B") id-bytes (write-bytes out ^bytes x)) (freezer (Class/forName "[B") id-bytes (write-bytes out ^bytes x))
(freezer nil id-nil) (freezer nil id-nil)
(freezer Boolean id-boolean (.writeBoolean out x)) (freezer Boolean id-boolean (.writeBoolean out x))
(freezer Character id-char (.writeChar out (int x)))
(freezer Character id-char (.writeChar out (int x))) (extend-type String
;; (freezer String id-string (write-utf8 out x))
(extend-type String ; Optimized common-case type
Freezable Freezable
(freeze-to-out* [x ^DataOutput out] (freeze-to-out* [x ^DataOutput out]
(let [ba (.getBytes x "UTF-8")] (let [ba (.getBytes x "UTF-8")]
(if (<= (alength ^bytes ba) Byte/MAX_VALUE) (if (small-count? (alength ^bytes ba))
(do (write-id out id-sm-string) (do (write-id out id-sm-string)
(write-bytes out ba :small)) (write-bytes out ba :small))
(do (write-id out id-string) (do (write-id out id-string)
(write-bytes out ba)))))) (write-bytes out ba))))))
(extend-type Keyword ; Optimized common-case type (extend-type Keyword
Freezable Freezable
(freeze-to-out* [x ^DataOutput out] (freeze-to-out* [x ^DataOutput out]
(let [s (if-let [ns (namespace x)] (let [s (if-let [ns (namespace x)] (str ns "/" (name x)) (name x))
(str ns "/" (name x))
(name x))
ba (.getBytes s "UTF-8")] ba (.getBytes s "UTF-8")]
(if (small-count? Byte/MAX_VALUE)
(if (<= (alength ^bytes ba) Byte/MAX_VALUE)
(do (write-id out id-sm-keyword) (do (write-id out id-sm-keyword)
(write-bytes out ba :small)) (write-bytes out ba :small))
(do (write-id out id-keyword) (do (write-id out id-keyword)
(write-bytes out ba)))))) (write-bytes out ba))))))
@ -256,9 +276,9 @@
(freezer-coll PersistentTreeSet id-sorted-set) (freezer-coll PersistentTreeSet id-sorted-set)
(freezer-kvs PersistentTreeMap id-sorted-map) (freezer-kvs PersistentTreeMap id-sorted-map)
(freezer-kvs APersistentMap id-map) (freezer-kvs APersistentMap id-map id-sm-map)
(freezer-coll APersistentVector id-vector) (freezer-coll APersistentVector id-vector id-sm-vector)
(freezer-coll APersistentSet id-set) (freezer-coll APersistentSet id-set id-sm-set)
(freezer-coll PersistentList id-list) ; No APersistentList (freezer-coll PersistentList id-list) ; No APersistentList
(freezer-coll (type '()) id-list) (freezer-coll (type '()) id-list)
@ -270,11 +290,11 @@
(write-utf8 out (.getName (class x))) ; Reflect (write-utf8 out (.getName (class x))) ; Reflect
(freeze-to-out out (into {} x))) (freeze-to-out out (into {} x)))
(freezer Byte id-byte (.writeByte out x)) (freezer Byte id-byte (.writeByte out x))
(freezer Short id-short (.writeShort out x)) (freezer Short id-short (.writeShort out x))
(freezer Integer id-integer (.writeInt out x)) (freezer Integer id-integer (.writeInt out x))
;;(freezer Long id-long (.writeLong out x)) ;;(freezer Long id-long (.writeLong out x))
(extend-type Long ; Optimized common-case type (extend-type Long
Freezable Freezable
(freeze-to-out* [x ^DataOutput out] (freeze-to-out* [x ^DataOutput out]
(let [^long x x] (let [^long x x]
@ -297,8 +317,6 @@
:else (do (write-id out id-long) :else (do (write-id out id-long)
(.writeLong out x)))))) (.writeLong out x))))))
;;
(freezer BigInt id-bigint (write-biginteger out (.toBigInteger x))) (freezer BigInt id-bigint (write-biginteger out (.toBigInteger x)))
(freezer BigInteger id-biginteger (write-biginteger out x)) (freezer BigInteger id-biginteger (write-biginteger out x))
@ -439,14 +457,9 @@
(declare thaw-from-in) (declare thaw-from-in)
(defmacro read-bytes [in & [small?]] (defmacro read-bytes [in & [small?]]
(if small? ; Optimization, must be known before id's written (let [rc (if small? 'readByte 'readInt)]
`(let [in# ~in `(let [in# ~in
size# (.readByte in#) size# (. in# ~rc)
ba# (byte-array size#)]
(.readFully in# ba# 0 size#)
ba#)
`(let [in# ~in
size# (.readInt in#)
ba# (byte-array size#)] ba# (byte-array size#)]
(.readFully in# ba# 0 size#) (.readFully in# ba# 0 size#)
ba#))) ba#)))
@ -455,14 +468,17 @@
(defmacro read-utf8 [in & [small?]] (defmacro read-utf8 [in & [small?]]
`(String. (read-bytes ~in ~small?) "UTF-8")) `(String. (read-bytes ~in ~small?) "UTF-8"))
(defmacro ^:private read-coll [in coll] (defmacro ^:private read-coll [in coll & [small?]]
`(let [in# ~in] (encore/repeatedly-into ~coll (.readInt in#) (let [rc (if small? 'readByte 'readInt)]
(fn [] (thaw-from-in in#))))) `(let [in# ~in]
(encore/repeatedly-into ~coll (. in# ~rc)
(fn [] (thaw-from-in in#))))))
(defmacro ^:private read-kvs [in coll] (defmacro ^:private read-kvs [in coll & [small?]]
`(let [in# ~in] (let [rc (if small? 'readByte 'readInt)]
(encore/repeatedly-into ~coll (.readInt in#) `(let [in# ~in]
(fn [] [(thaw-from-in in#) (thaw-from-in in#)])))) (encore/repeatedly-into ~coll (. in# ~rc)
(fn [] [(thaw-from-in in#) (thaw-from-in in#)])))))
(defmacro ^:private read-kvs-depr1 [in coll] (defmacro ^:private read-kvs-depr1 [in coll]
`(let [in# ~in] `(let [in# ~in]
@ -551,13 +567,17 @@
id-sorted-set (read-coll in (sorted-set)) id-sorted-set (read-coll in (sorted-set))
id-sorted-map (read-kvs in (sorted-map)) id-sorted-map (read-kvs in (sorted-map))
id-list (into '() (rseq (read-coll in []))) id-vector (read-coll in [])
id-vector (read-coll in []) id-sm-vector (read-coll in [] :small)
id-set (read-coll in #{}) id-set (read-coll in #{})
id-map (read-kvs in {}) id-sm-set (read-coll in #{} :small)
id-seq (or (seq (read-coll in [])) id-map (read-kvs in {})
(lazy-seq nil) ; Empty coll id-sm-map (read-kvs in {} :small)
)
id-list (into '() (rseq (read-coll in [])))
id-seq (or (seq (read-coll in []))
(lazy-seq nil) ; Empty coll
)
id-meta (let [m (thaw-from-in in)] (with-meta (thaw-from-in in) m)) id-meta (let [m (thaw-from-in in)] (with-meta (thaw-from-in in) m))