From 3130e54b74b888d06742c03f7f302226032d5827 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Marczyk?= Date: Mon, 16 Apr 2012 20:25:38 +0200 Subject: [PATCH] Transient support for PersistentHashMap ported from Clojure * New protocols: - IEditableCollection, - ITransientCollection, - ITransientAssociative. * PersistentHashMap now implements IEditableCollection. * TransientHashMap is the transient equivalent. * cljs.core.PersistentHashMap/fromArrays uses a transient map, * ...as does cljs.core/hash-map. --- src/cljs/cljs/core.cljs | 440 ++++++++++++++++++++++++++++++++++++++++++----- 1 files changed, 396 insertions(+), 44 deletions(-) diff --git a/src/cljs/cljs/core.cljs b/src/cljs/cljs/core.cljs index 06744dd..8064516 100644 --- a/src/cljs/cljs/core.cljs +++ b/src/cljs/cljs/core.cljs @@ -217,6 +217,17 @@ (-add-watch [this key f]) (-remove-watch [this key])) +(defprotocol IEditableCollection + (-as-transient [coll])) + +(defprotocol ITransientCollection + (-conj! [tcoll val]) + (-persistent! [tcoll])) + +(defprotocol ITransientAssociative + (-assoc! [tcoll key val]) + (-dissoc! [tcoll key])) + ;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;; (defn ^boolean identical? "Tests if 2 arguments are the same object" @@ -2716,6 +2727,23 @@ reduces them without incurring seq initialization" (recur (inc i) (assoc out (aget ks i) (aget vs i))) out))))) +;;; Transients + +(defn transient [coll] + (-as-transient coll)) + +(defn persistent! [tcoll] + (-persistent! tcoll)) + +(defn conj! [tcoll val] + (-conj! tcoll val)) + +(defn assoc! [tcoll key val] + (-assoc! tcoll key val)) + +(defn dissoc! [tcoll key] + (-dissoc! tcoll key)) + ;;; PersistentHashMap (declare create-inode-seq create-array-node-seq reset! create-node atom deref) @@ -2735,10 +2763,10 @@ reduces them without incurring seq initialization" (defn- array-copy ([from i to j len] (loop [i i j j len len] - (when-not (zero? len) - (aset to j (aget from i)) - (recur (inc i) (inc j) (dec len)))) - to)) + (if (zero? len) + to + (do (aset to j (aget from i)) + (recur (inc i) (inc j) (dec len))))))) (defn- array-copy-downward ([from i to j len] @@ -2760,9 +2788,20 @@ reduces them without incurring seq initialization" (defn- bitpos [hash shift] (bit-shift-left 1 (mask hash shift))) +(defn- edit-and-set + ([inode edit i a] + (let [editable (.ensure-editable inode edit)] + (aset (.-arr editable) i a) + editable)) + ([inode edit i a j b] + (let [editable (.ensure-editable inode edit)] + (aset (.-arr editable) i a) + (aset (.-arr editable) j b) + editable))) + (declare ArrayNode) -(deftype BitmapIndexedNode [bitmap arr] +(deftype BitmapIndexedNode [edit ^:mutable bitmap ^:mutable arr] Object (inode-assoc [inode shift hash key val added-leaf?] (let [bit (bitpos hash shift) @@ -2783,30 +2822,30 @@ reduces them without incurring seq initialization" (+ shift 5) (cljs.core/hash (aget arr j)) (aget arr j) (aget arr (inc j)) added-leaf?) (aget arr (inc j)))) (recur (inc i) (+ j 2)))))) - (ArrayNode. (inc n) nodes)) + (ArrayNode. nil (inc n) nodes)) (let [new-arr (make-array (* 2 (inc n)))] (array-copy arr 0 new-arr 0 (* 2 idx)) (aset new-arr (* 2 idx) key) (aset added-leaf? 0 true) (aset new-arr (inc (* 2 idx)) val) (array-copy arr (* 2 idx) new-arr (* 2 (inc idx)) (* 2 (- n idx))) - (BitmapIndexedNode. (bit-or bitmap bit) new-arr)))) + (BitmapIndexedNode. nil (bit-or bitmap bit) new-arr)))) (let [key-or-nil (aget arr (* 2 idx)) val-or-node (aget arr (inc (* 2 idx)))] (cond (coercive-= nil key-or-nil) (let [n (.inode-assoc val-or-node (+ shift 5) hash key val added-leaf?)] (if (identical? n val-or-node) inode - (BitmapIndexedNode. bitmap (clone-and-set arr (inc (* 2 idx)) n)))) + (BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) n)))) (= key key-or-nil) (if (identical? val val-or-node) inode - (BitmapIndexedNode. bitmap (clone-and-set arr (inc (* 2 idx)) val))) + (BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) val))) :else (do (aset added-leaf? 0 true) - (BitmapIndexedNode. bitmap + (BitmapIndexedNode. nil bitmap (clone-and-set arr (* 2 idx) nil (inc (* 2 idx)) (create-node (+ shift 5) key-or-nil val-or-node hash key val))))))))) @@ -2820,11 +2859,11 @@ reduces them without incurring seq initialization" (cond (coercive-= nil key-or-nil) (let [n (.inode-without val-or-node (+ shift 5) hash key)] (cond (identical? n val-or-node) inode - (coercive-not= nil n) (BitmapIndexedNode. bitmap (clone-and-set arr (inc (* 2 idx)) n)) + (coercive-not= nil n) (BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) n)) (== bitmap bit) nil - :else (BitmapIndexedNode. (bit-xor bitmap bit) (remove-pair arr idx)))) + :else (BitmapIndexedNode. nil (bit-xor bitmap bit) (remove-pair arr idx)))) (= key key-or-nil) - (BitmapIndexedNode. (bit-xor bitmap bit) (remove-pair arr idx)) + (BitmapIndexedNode. nil (bit-xor bitmap bit) (remove-pair arr idx)) :else inode))))) (inode-find [inode shift hash key] @@ -2850,11 +2889,114 @@ reduces them without incurring seq initialization" :else not-found))))) (inode-seq [inode] - (create-inode-seq arr))) + (create-inode-seq arr)) + + (ensure-editable [inode e] + (if (identical? e edit) + inode + (let [n (bit-count bitmap) + new-arr (make-array (if (neg? n) 4 (* 2 (inc n))))] + (array-copy arr 0 new-arr 0 (* 2 n)) + (BitmapIndexedNode. e bitmap new-arr)))) + + (edit-and-remove-pair [inode e bit i] + (if (== bitmap bit) + nil + (let [editable (.ensure-editable inode e) + earr (.-arr editable) + len (.-length earr)] + (set! (.-bitmap editable) (bit-xor bit (.-bitmap editable))) + (array-copy earr (* 2 (inc i)) + earr (* 2 i) + (- len (* 2 (inc i)))) + (aset earr (- len 2) nil) + (aset earr (dec len) nil) + editable))) + + (inode-assoc! [inode edit shift hash key val added-leaf?] + (let [bit (bitpos hash shift) + idx (bitmap-indexed-node-index bitmap bit)] + (if (zero? (bit-and bitmap bit)) + (let [n (bit-count bitmap)] + (cond + (< (* 2 n) (.-length arr)) + (let [editable (.ensure-editable inode edit) + earr (.-arr editable)] + (aset added-leaf? 0 true) + (array-copy-downward earr (* 2 idx) + earr (* 2 (inc idx)) + (* 2 (- n idx))) + (aset earr (* 2 idx) key) + (aset earr (inc (* 2 idx)) val) + (set! (.-bitmap editable) (bit-or (.-bitmap editable) bit)) + editable) + + (>= n 16) + (let [nodes (make-array 32) + jdx (mask hash shift)] + (aset nodes jdx (.inode-assoc! cljs.core.BitmapIndexedNode/EMPTY edit (+ shift 5) hash key val added-leaf?)) + (loop [i 0 j 0] + (if (< i 32) + (if (zero? (bit-and (bit-shift-right-zero-fill bitmap i) 1)) + (recur (inc i) j) + (do (aset nodes i + (if (coercive-not= nil (aget arr j)) + (.inode-assoc! cljs.core.BitmapIndexedNode/EMPTY + edit (+ shift 5) (cljs.core/hash (aget arr j)) (aget arr j) (aget arr (inc j)) added-leaf?) + (aget arr (inc j)))) + (recur (inc i) (+ j 2)))))) + (ArrayNode. edit (inc n) nodes)) + + :else + (let [new-arr (make-array (* 2 (+ n 4)))] + (array-copy arr 0 new-arr 0 (* 2 idx)) + (aset new-arr (* 2 idx) key) + (aset added-leaf? 0 true) + (aset new-arr (inc (* 2 idx)) val) + (array-copy arr (* 2 idx) new-arr (* 2 (inc idx)) (* 2 (- n idx))) + (let [editable (.ensure-editable inode edit)] + (set! (.-arr editable) new-arr) + (set! (.-bitmap editable) (bit-or (.-bitmap editable) bit)) + editable)))) + (let [key-or-nil (aget arr (* 2 idx)) + val-or-node (aget arr (inc (* 2 idx)))] + (cond (coercive-= nil key-or-nil) + (let [n (.inode-assoc! val-or-node edit (+ shift 5) hash key val added-leaf?)] + (if (identical? n val-or-node) + inode + (edit-and-set inode edit (inc (* 2 idx)) val))) -(set! cljs.core.BitmapIndexedNode/EMPTY (BitmapIndexedNode. 0 (make-array 0))) + (= key key-or-nil) + (if (identical? val val-or-node) + inode + (edit-and-set inode edit (inc (* 2 idx)) val)) + + :else + (do (aset added-leaf? 0 true) + (edit-and-set inode edit (* 2 idx) nil (inc (* 2 idx)) + (create-node edit (+ shift 5) key-or-nil val-or-node hash key val)))))))) -(defn- pack-array-node [array-node idx] + (inode-without! [inode edit shift hash key removed-leaf?] + (let [bit (bitpos hash shift)] + (if (zero? (bit-and bitmap bit)) + inode + (let [idx (bitmap-indexed-node-index bitmap bit) + key-or-nil (aget arr (* 2 idx)) + val-or-node (aget arr (inc (* 2 idx)))] + (cond (coercive-= nil key-or-nil) + (let [n (.inode-without! val-or-node edit (+ shift 5) hash key removed-leaf?)] + (cond (identical? n val-or-node) inode + (coercive-not= nil n) (edit-and-set inode edit (inc (* 2 idx)) n) + (== bitmap bit) nil + :else (.edit-and-remove-pair inode edit bit idx))) + (= key key-or-nil) + (do (aset removed-leaf? 0 true) + (.edit-and-remove-pair inode edit bit idx)) + :else inode)))))) + +(set! cljs.core.BitmapIndexedNode/EMPTY (BitmapIndexedNode. nil 0 (make-array 0))) + +(defn- pack-array-node [array-node edit idx] (let [arr (.-arr array-node) len (* 2 (dec (.-cnt array-node))) new-arr (make-array len)] @@ -2865,19 +3007,19 @@ reduces them without incurring seq initialization" (do (aset new-arr j (aget arr i)) (recur (inc i) (+ j 2) (bit-or bitmap (bit-shift-left 1 i)))) (recur (inc i) j bitmap)) - (BitmapIndexedNode. bitmap new-arr))))) + (BitmapIndexedNode. edit bitmap new-arr))))) -(deftype ArrayNode [cnt arr] +(deftype ArrayNode [edit ^:mutable cnt ^:mutable arr] Object (inode-assoc [inode shift hash key val added-leaf?] (let [idx (mask hash shift) node (aget arr idx)] (if (coercive-= nil node) - (ArrayNode. (inc cnt) (clone-and-set arr idx (.inode-assoc cljs.core.BitmapIndexedNode/EMPTY (+ shift 5) hash key val added-leaf?))) + (ArrayNode. nil (inc cnt) (clone-and-set arr idx (.inode-assoc cljs.core.BitmapIndexedNode/EMPTY (+ shift 5) hash key val added-leaf?))) (let [n (.inode-assoc node (+ shift 5) hash key val added-leaf?)] (if (identical? n node) inode - (ArrayNode. cnt (clone-and-set arr idx n))))))) + (ArrayNode. nil cnt (clone-and-set arr idx n))))))) (inode-without [inode shift hash key] (let [idx (mask hash shift) @@ -2891,10 +3033,10 @@ reduces them without incurring seq initialization" (nil? n) (if (<= cnt 8) (pack-array-node inode idx) - (ArrayNode. (dec cnt) (clone-and-set arr idx n))) + (ArrayNode. nil (dec cnt) (clone-and-set arr idx n))) :else - (ArrayNode. cnt (clone-and-set arr idx n)))) + (ArrayNode. nil cnt (clone-and-set arr idx n)))) inode))) (inode-find [inode shift hash key] @@ -2912,7 +3054,44 @@ reduces them without incurring seq initialization" not-found))) (inode-seq [inode] - (create-array-node-seq arr))) + (create-array-node-seq arr)) + + (ensure-editable [inode e] + (if (identical? e edit) + inode + (ArrayNode. e cnt (aclone arr)))) + + (inode-assoc! [inode edit shift hash key val added-leaf?] + (let [idx (mask hash shift) + node (aget arr idx)] + (if (coercive-= nil node) + (let [editable (edit-and-set inode edit idx (.inode-assoc! cljs.core.BitmapIndexedNode/EMPTY edit (+ shift 5) hash key val added-leaf?))] + (set! (.-cnt editable) (inc (.-cnt editable))) + editable) + (let [n (.inode-assoc! node edit (+ shift 5) hash key val added-leaf?)] + (if (identical? n node) + inode + (edit-and-set inode edit idx n)))))) + + (inode-without! [inode edit shift hash key removed-leaf?] + (let [idx (mask hash shift) + node (aget arr idx)] + (if (coercive-= nil node) + inode + (let [n (.inode-without! node edit (+ shift 5) hash key removed-leaf?)] + (cond + (identical? n node) + inode + + (coercive-= nil n) + (if (<= cnt 8) + (pack-array-node inode edit idx) + (let [editable (edit-and-set inode edit idx n)] + (set! (.-cnt editable) (dec (.-cnt editable))) + editable)) + + :else + (edit-and-set inode edit idx n))))))) (defn- hash-collision-node-find-index [arr cnt key] (let [lim (* 2 cnt)] @@ -2923,7 +3102,10 @@ reduces them without incurring seq initialization" (recur (+ i 2))) -1)))) -(deftype HashCollisionNode [__hash cnt arr] +(deftype HashCollisionNode [edit + ^:mutable __hash + ^:mutable cnt + ^:mutable arr] Object (inode-assoc [inode shift hash key val added-leaf?] (if (== hash __hash) @@ -2935,18 +3117,18 @@ reduces them without incurring seq initialization" (aset new-arr len key) (aset new-arr (inc len) val) (aset added-leaf? 0 true) - (HashCollisionNode. __hash (inc cnt) new-arr)) + (HashCollisionNode. nil __hash (inc cnt) new-arr)) (if (= (aget arr idx) val) inode - (HashCollisionNode. __hash cnt (clone-and-set arr (inc idx) val))))) - (.inode-assoc (BitmapIndexedNode. (bitpos __hash shift) (array nil inode)) + (HashCollisionNode. nil __hash cnt (clone-and-set arr (inc idx) val))))) + (.inode-assoc (BitmapIndexedNode. nil (bitpos __hash shift) (array nil inode)) shift hash key val added-leaf?))) (inode-without [inode shift hash key] (let [idx (hash-collision-node-find-index arr cnt key)] (cond (== idx -1) inode (== cnt 1) nil - :else (HashCollisionNode. __hash (dec cnt) (remove-pair arr (quot idx 2)))))) + :else (HashCollisionNode. nil __hash (dec cnt) (remove-pair arr (quot idx 2)))))) (inode-find [inode shift hash key] (let [idx (hash-collision-node-find-index arr cnt key)] @@ -2961,16 +3143,77 @@ reduces them without incurring seq initialization" :else not-found))) (inode-seq [inode] - (create-inode-seq arr))) + (create-inode-seq arr)) + + (ensure-editable [inode e] + (if (identical? e edit) + inode + (let [new-arr (make-array (* 2 (inc cnt)))] + (array-copy arr 0 new-arr 0 (* 2 cnt)) + (HashCollisionNode. e __hash cnt new-arr)))) + + (ensure-editable [inode e count array] + (if (identical? e edit) + (do (set! arr array) + (set! cnt count) + inode) + (HashCollisionNode. edit __hash count array))) + + (inode-assoc! [inode edit shift hash key val added-leaf?] + (if (== hash __hash) + (let [idx (hash-collision-node-find-index arr cnt key)] + (if (== idx -1) + (if (> (.-length arr) (* 2 cnt)) + (let [editable (edit-and-set inode edit (* 2 cnt) key (inc (* 2 cnt)) val)] + (aset added-leaf? 0 true) + (set! (.-cnt editable) (inc (.-cnt editable))) + editable) + (let [len (.-length arr) + new-arr (make-array (+ len 2))] + (array-copy arr 0 new-arr 0 len) + (aset new-arr len key) + (aset new-arr (inc len) val) + (aset added-leaf? 0 true) + (.ensure-editable inode edit (inc cnt) new-arr))) + (if (= (aget arr (inc idx)) val) + inode + (edit-and-set inode edit (inc idx) val)))) + (.inode-assoc! (BitmapIndexedNode. edit (bitpos __hash shift) (array nil inode nil nil)) + edit shift hash key val added-leaf?))) -(defn- create-node [shift key1 val1 key2hash key2 val2] - (let [key1hash (hash key1)] - (if (== key1hash key2hash) - (HashCollisionNode. key1hash 2 (array key1 val1 key2 val2)) - (let [added-leaf? (array false)] - (-> cljs.core.BitmapIndexedNode/EMPTY - (.inode-assoc shift key1hash key1 val1 added-leaf?) - (.inode-assoc shift key2hash key2 val2 added-leaf?)))))) + (inode-without! [inode edit shift hash key removed-leaf?] + (let [idx (hash-collision-node-find-index arr cnt key)] + (if (== idx -1) + inode + (do (aset removed-leaf? 0 true) + (if (== cnt 1) + nil + (let [editable (.ensure-editable inode edit) + earr (.-arr editable)] + (aset earr idx (aget earr (- (* 2 cnt) 2))) + (aset earr (inc idx) (aget earr (dec (* 2 cnt)))) + (aset earr (dec (* 2 cnt)) nil) + (aset earr (- (* 2 cnt) 2) nil) + (set! (.-cnt editable) (dec (.-cnt editable))) + editable))))))) + +(defn- create-node + ([shift key1 val1 key2hash key2 val2] + (let [key1hash (hash key1)] + (if (== key1hash key2hash) + (HashCollisionNode. nil key1hash 2 (array key1 val1 key2 val2)) + (let [added-leaf? (array false)] + (-> cljs.core.BitmapIndexedNode/EMPTY + (.inode-assoc shift key1hash key1 val1 added-leaf?) + (.inode-assoc shift key2hash key2 val2 added-leaf?)))))) + ([edit shift key1 val1 key2hash key2 val2] + (let [key1hash (hash key1)] + (if (== key1hash key2hash) + (HashCollisionNode. nil key1hash 2 (array key1 val1 key2 val2)) + (let [added-leaf? (array false)] + (-> cljs.core.BitmapIndexedNode/EMPTY + (.inode-assoc! edit shift key1hash key1 val1 added-leaf?) + (.inode-assoc! edit shift key2hash key2 val2 added-leaf?))))))) (deftype NodeSeq [meta nodes i s] IMeta @@ -3046,6 +3289,8 @@ reduces them without incurring seq initialization" (recur (inc j)))))) (ArrayNodeSeq. meta nodes i s)))) +(declare TransientHashMap) + (deftype PersistentHashMap [meta cnt root has-nil? nil-val] Object (toString [this] @@ -3132,26 +3377,133 @@ reduces them without incurring seq initialization" (-lookup coll k)) (-invoke [coll k not-found] - (-lookup coll k not-found))) + (-lookup coll k not-found)) + + IEditableCollection + (-as-transient [coll] + (TransientHashMap. (js-obj) root cnt has-nil? nil-val))) (set! cljs.core.PersistentHashMap/EMPTY (PersistentHashMap. nil 0 nil false nil)) (set! cljs.core.PersistentHashMap/fromArrays (fn [ks vs] (let [len (.-length ks)] - (loop [i 0 out cljs.core.PersistentHashMap/EMPTY] + (loop [i 0 out (transient cljs.core.PersistentHashMap/EMPTY)] (if (< i len) - (recur (inc i) (assoc out (aget ks i) (aget vs i))) - out))))) + (recur (inc i) (assoc! out (aget ks i) (aget vs i))) + (persistent! out)))))) + +(deftype TransientHashMap [^:mutable edit + ^:mutable root + ^:mutable count + ^:mutable has-nil? + ^:mutable nil-val] + Object + (conj! [tcoll o] + (if edit + (if (vector? o) + (if (== 2 (count o)) + (.assoc! tcoll (nth o 0) (nth o 1)) + (throw (js/Error. "Vector arg to map conj must be a pair"))) + (loop [es (seq o) tcoll tcoll] + (if-let [e (first es)] + (recur (next es) + (.assoc! tcoll (nth e 0) (nth e 1))) + tcoll))) + (throw (js/Error. "conj! after persistent")))) + + (assoc! [tcoll k v] + (if edit + (if (nil? k) + (do (if (identical? nil-val v) + nil + (set! nil-val v)) + (if has-nil? + nil + (do (set! count (inc count)) + (set! has-nil? true))) + tcoll) + (let [added-leaf? (array false) + node (-> (if (nil? root) + cljs.core.BitmapIndexedNode/EMPTY + root) + (.inode-assoc! edit 0 (hash k) k v added-leaf?))] + (if (identical? node root) + nil + (set! root node)) + (if (aget added-leaf? 0) + (set! count (inc count))) + tcoll)) + (throw (js/Error. "assoc! after persistent!")))) + + (without! [tcoll k] + (if edit + (if (nil? k) + (if has-nil? + (do (set! has-nil? false) + (set! nil-val nil) + (set! count (dec count)) + tcoll) + tcoll) + (if (nil? root) + tcoll + (let [removed-leaf? (array false) + node (.inode-without! root edit 0 (hash k) k removed-leaf?)] + (if (identical? node root) + (set! root node)) + (if (aget removed-leaf? 0) + (set! count (dec count))) + tcoll))) + (throw (js/Error. "dissoc! after persistent!")))) + + (persistent! [tcoll] + (if edit + (do (set! edit nil) + (PersistentHashMap. nil count root has-nil? nil-val)) + (throw (js/Error. "persistent! called twice")))) + + ICounted + (-count [coll] + (if edit + count + (throw (js/Error. "count after persistent!")))) + + ILookup + (-lookup [tcoll k] + (if (nil? k) + (if has-nil? + nil-val) + (if (nil? root) + nil + (aget (.inode-find root 0 (hash k) k) 1)))) + + (-lookup [tcoll k not-found] + (if (nil? k) + (if has-nil? + nil-val + not-found) + (if (nil? root) + not-found + (aget (.inode-find root 0 (hash k) k not-found) 1)))) + + ITransientCollection + (-conj! [tcoll val] (.conj! tcoll val)) + + (-persistent! [tcoll] (.persistent! tcoll)) + + ITransientAssociative + (-assoc! [tcoll key val] (.assoc! tcoll key val)) + + (-dissoc! [tcoll key] (.without! tcoll key))) (defn hash-map "keyval => key val Returns a new hash map with supplied mappings." [& keyvals] - (loop [in (seq keyvals), out cljs.core.PersistentHashMap/EMPTY] + (loop [in (seq keyvals), out (transient cljs.core.PersistentHashMap/EMPTY)] (if in - (recur (nnext in) (assoc out (first in) (second in))) - out))) + (recur (nnext in) (assoc! out (first in) (second in))) + (persistent! out)))) (defn keys "Returns a sequence of the map's keys." -- 1.7.1