Improve internal impl of objects-map

This commit is contained in:
Andrey Antukh 2022-11-03 14:22:18 +01:00 committed by Andrés Moya
parent fa93e5a1a7
commit 16afa90b9c

View file

@ -34,9 +34,10 @@
(declare create) (declare create)
(defprotocol IObjectsMap (defprotocol IObjectsMap
(-initialize! [_]) (load! [_])
(-compact! [_]) (modified? [_])
(-get-byte-array [_]) (compact! [_])
(clone [_])
(-get-key-hash [_ key]) (-get-key-hash [_ key])
(-force-modified! [_])) (-force-modified! [_]))
@ -70,7 +71,7 @@
^:unsynchronized-mutable blob ^:unsynchronized-mutable blob
^:unsynchronized-mutable header ^:unsynchronized-mutable header
^:unsynchronized-mutable content ^:unsynchronized-mutable content
^:unsynchronized-mutable initialized? ^:unsynchronized-mutable loaded?
^:unsynchronized-mutable modified?] ^:unsynchronized-mutable modified?]
IHashEq IHashEq
@ -84,47 +85,54 @@
(.hasheq ^IHashEq this)) (.hasheq ^IHashEq this))
IObjectsMap IObjectsMap
(-initialize! [_] (modified? [_] modified?)
(when-not initialized?
;; (l/trace :fn "-initialize!" :blob blob ::l/async false)
(let [hsize (.getInt ^ByteBuffer blob 0)
header' (.slice ^ByteBuffer blob 4 hsize)
content' (.slice ^ByteBuffer blob
(int (+ 4 hsize))
(int (- (.remaining ^ByteBuffer blob)
(+ 4 hsize))))
nitems (long (/ (.remaining ^ByteBuffer header') RECORD-SIZE)) (load! [this]
positions' (reduce (fn [positions i] (let [hsize (.getInt ^ByteBuffer blob 0)
(let [hb (.slice ^ByteBuffer header' header' (.slice ^ByteBuffer blob 4 hsize)
(int (* i RECORD-SIZE)) content' (.slice ^ByteBuffer blob
(int RECORD-SIZE)) (int (+ 4 hsize))
msb (.getLong ^ByteBuffer hb) (int (- (.remaining ^ByteBuffer blob)
lsb (.getLong ^ByteBuffer hb) (+ 4 hsize))))
size (.getInt ^ByteBuffer hb)
pos (.getInt ^ByteBuffer hb)
key (uuid/custom msb lsb)
val [size pos]]
(assoc! positions key val)))
(transient {})
(range nitems))]
(set! positions (persistent! positions'))
(if *lazy*
(set! cache {})
(loop [cache' (transient {})
entries (seq positions)]
(if-let [[key [size pos]] (first entries)]
(let [tmp (byte-array (- size 4))]
(.get ^ByteBuffer content' (int (+ pos 4)) ^bytes tmp (int 0) (int (- size 4)))
;; (l/trace :fn "-initialize!" :step "preload" :key key :size size :pos pos ::l/async false)
(recur (assoc! cache' key (fres/decode tmp))
(rest entries)))
(set! cache (persistent! cache'))))) nitems (long (/ (.remaining ^ByteBuffer header') RECORD-SIZE))
positions' (reduce (fn [positions i]
(let [hb (.slice ^ByteBuffer header'
(int (* i RECORD-SIZE))
(int RECORD-SIZE))
msb (.getLong ^ByteBuffer hb)
lsb (.getLong ^ByteBuffer hb)
size (.getInt ^ByteBuffer hb)
pos (.getInt ^ByteBuffer hb)
key (uuid/custom msb lsb)
val [size pos]]
(assoc! positions key val)))
(transient {})
(range nitems))]
(set! positions (persistent! positions'))
(if *lazy*
(set! cache {})
(loop [cache' (transient {})
entries (seq positions)]
(if-let [[key [size pos]] (first entries)]
(let [tmp (byte-array (- size 4))]
(.get ^ByteBuffer content' (int (+ pos 4)) ^bytes tmp (int 0) (int (- size 4)))
(recur (assoc! cache' key (fres/decode tmp))
(rest entries)))
(set! header header') (set! cache (persistent! cache')))))
(set! content content')
(set! initialized? true)))) (set! header header')
(set! content content')
(set! loaded? true))
this)
(-get-key-hash [this key]
(when-not loaded? (load! this))
(if (contains? cache key)
(c/hash (get cache key))
(let [[_ pos] (get positions key)]
(.getInt ^ByteBuffer content (int pos)))))
(-force-modified! [this] (-force-modified! [this]
(set! modified? true) (set! modified? true)
@ -133,7 +141,7 @@
(set! positions (assoc positions key nil)) (set! positions (assoc positions key nil))
(set! cache (assoc cache key val))))) (set! cache (assoc cache key val)))))
(-compact! [_] (compact! [this]
(when modified? (when modified?
(let [[total-items total-size new-items new-hashes] (let [[total-items total-size new-items new-hashes]
(loop [entries (seq positions) (loop [entries (seq positions)
@ -181,8 +189,6 @@
hval (get new-hashes key) hval (get new-hashes key)
size (+ (alength ^bytes bval) 4)] size (+ (alength ^bytes bval) 4)]
;; (l/trace :fn "-compact!" :cache "miss" :key key :size size :pos position ::l/async false)
(.putInt ^ByteBuffer rbuf (int size)) (.putInt ^ByteBuffer rbuf (int size))
(.putInt ^ByteBuffer rbuf (int position)) (.putInt ^ByteBuffer rbuf (int position))
(.rewind ^ByteBuffer rbuf) (.rewind ^ByteBuffer rbuf)
@ -199,7 +205,6 @@
(.putInt ^ByteBuffer rbuf (int position)) (.putInt ^ByteBuffer rbuf (int position))
(.rewind ^ByteBuffer rbuf) (.rewind ^ByteBuffer rbuf)
;; (l/trace :fn "-compact!" :cache "hit" :key key :size size :pos position ::l/async false)
(.put ^ByteBuffer header' ^ByteBuffer rbuf) (.put ^ByteBuffer header' ^ByteBuffer rbuf)
(.put ^ByteBuffer content' ^ByteBuffer cbuf) (.put ^ByteBuffer content' ^ByteBuffer cbuf)
(recur (long (+ position size)) (recur (long (+ position size))
@ -212,112 +217,82 @@
(.rewind ^ByteBuffer content') (.rewind ^ByteBuffer content')
(.rewind ^ByteBuffer blob') (.rewind ^ByteBuffer blob')
;; (l/trace :fn "-compact!" :step "end" ::l/async false)
(set! positions positions') (set! positions positions')
(set! modified? false) (set! modified? false)
(set! blob blob') (set! blob blob')
(set! header header') (set! header header')
(set! content content')))) (set! content content')))
this)
(-get-byte-array [this] (clone [_]
;; (l/trace :fn "-get-byte-array" :this (.getHashCode this) :blob blob ::l/async false) (if loaded?
(-compact! this) (ObjectsMap. metadata hash positions cache blob header content loaded? modified?)
(.array ^ByteBuffer blob)) (ObjectsMap. metadata nil nil nil blob nil nil false false)))
(-get-key-hash [this key]
(-initialize! this)
(if (contains? cache key)
(c/hash (get cache key))
(let [[_ pos] (get positions key)]
(.getInt ^ByteBuffer content (int pos)))))
clojure.lang.IDeref clojure.lang.IDeref
(deref [_] (deref [this]
{:positions positions (compact! this)
:cache cache (.array ^ByteBuffer blob))
:blob blob
:header header
:content content
:initialized? initialized?
:modified? modified?})
Cloneable
(clone [_]
(if initialized?
(ObjectsMap. metadata hash positions cache blob header content initialized? modified?)
(ObjectsMap. metadata nil nil nil blob nil nil false false)))
IObj IObj
(meta [_] metadata) (meta [_] metadata)
(withMeta [this meta] (withMeta [_ metadata]
(set! metadata meta) (ObjectsMap. metadata hash positions cache blob header content loaded? modified?))
this)
Seqable Seqable
(seq [this] (seq [this]
(-initialize! this) (when-not loaded? (load! this))
(RT/chunkIteratorSeq (.iterator ^Iterable this))) (RT/chunkIteratorSeq (.iterator ^Iterable this)))
IPersistentCollection IPersistentCollection
(equiv [_ _] (equiv [this other]
(throw (UnsupportedOperationException. "not implemented"))) (identical? this other))
IPersistentMap IPersistentMap
(cons [this o] (cons [this o]
(-initialize! this) (when-not loaded? (load! this))
(if (map-entry? o) (if (map-entry? o)
(do (assoc this (key o) (val o))
;; (l/trace :fn "cons" :key (key o))
(assoc this (key o) (val o)))
(if (vector? o) (if (vector? o)
(do (assoc this (nth o 0) (nth o 1))
;; (l/trace :fn "cons" :key (nth o 0))
(assoc this (nth o 0) (nth o 1)))
(throw (UnsupportedOperationException. "invalid arguments to cons"))))) (throw (UnsupportedOperationException. "invalid arguments to cons")))))
(empty [_] (empty [_]
(create)) (create))
(containsKey [this key] (containsKey [this key]
(-initialize! this) (when-not loaded? (load! this))
(contains? positions key)) (contains? positions key))
(entryAt [this key] (entryAt [this key]
(-initialize! this) (when-not loaded? (load! this))
(ObjectsMapEntry. this key)) (ObjectsMapEntry. this key))
(valAt [this key] (valAt [this key]
(-initialize! this) (when-not loaded? (load! this))
;; (strace/print-stack-trace (ex-info "" {}))
(if (contains? cache key) (if (contains? cache key)
(do (get cache key)
;; (l/trace :fn "valAt" :key key :cache "hit") (if (contains? positions key)
(get cache key)) (let [[size pos] (get positions key)
(do tmp (byte-array (- size 4))]
(if (contains? positions key) (.get ^ByteBuffer content (int (+ pos 4)) ^bytes tmp (int 0) (int (- size 4)))
(let [[size pos] (get positions key) (let [val (fres/decode tmp)]
tmp (byte-array (- size 4))] (set! cache (assoc cache key val))
(.get ^ByteBuffer content (int (+ pos 4)) ^bytes tmp (int 0) (int (- size 4))) val))
;; (l/trace :fn "valAt" :key key :cache "miss" :size size :pos pos) (do
(set! cache (assoc cache key nil))
(let [val (fres/decode tmp)] nil))))
(set! cache (assoc cache key val))
val))
(do
;; (l/trace :fn "valAt" :key key :cache "miss" :val nil)
(set! cache (assoc cache key nil))
nil)))))
(valAt [this key not-found] (valAt [this key not-found]
(-initialize! this) (when-not loaded? (load! this))
(if (.containsKey ^IPersistentMap positions key) (if (.containsKey ^IPersistentMap positions key)
(.valAt this key) (.valAt this key)
not-found)) not-found))
(assoc [this key val] (assoc [this key val]
(-initialize! this) (when-not loaded? (load! this))
;; (l/trace :fn "assoc" :key key ::l/async false) (when-not (instance? UUID key)
(throw (IllegalArgumentException. "key should be an instance of UUID")))
(ObjectsMap. metadata (ObjectsMap. metadata
nil nil
(assoc positions key nil) (assoc positions key nil)
@ -325,15 +300,14 @@
blob blob
header header
content content
initialized? loaded?
true)) true))
(assocEx [_ _ _] (assocEx [_ _ _]
(throw (UnsupportedOperationException. "method not implemented"))) (throw (UnsupportedOperationException. "method not implemented")))
(without [this key] (without [this key]
(-initialize! this) (when-not loaded? (load! this))
;; (l/trace :fn "without" :key key ::l/async false)
(ObjectsMap. metadata (ObjectsMap. metadata
nil nil
(dissoc positions key) (dissoc positions key)
@ -341,16 +315,17 @@
blob blob
header header
content content
initialized? loaded?
true)) true))
Counted Counted
(count [_] (count [this]
(when-not loaded? (load! this))
(count positions)) (count positions))
Iterable Iterable
(iterator [this] (iterator [this]
(-initialize! this) (when-not loaded? (load! this))
(ObjectsMapIterator. (.iterator ^Iterable positions) this)) (ObjectsMapIterator. (.iterator ^Iterable positions) this))
) )
@ -376,12 +351,16 @@
objects objects
(into (create) objects))) (into (create) objects)))
(defn objects-map?
[o]
(instance? ObjectsMap o))
(fres/add-handlers! (fres/add-handlers!
{:name "penpot/experimental/objects-map" {:name "penpot/experimental/objects-map"
:class ObjectsMap :class ObjectsMap
:wfn (fn [n w o] :wfn (fn [n w o]
(fres/write-tag! w n) (fres/write-tag! w n)
(fres/write-bytes! w (-get-byte-array o))) (fres/write-bytes! w (deref o)))
:rfn (fn [r] :rfn (fn [r]
(-> r fres/read-object! create))}) (-> r fres/read-object! create))})