Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
package clojure.lang;
public interface ISetNode {
public static class Utils {
static public int bitpos(int hash, int shift){
return 1 << mask(hash, shift);
}
static public int index(int bit, int bitmap){
return Integer.bitCount(bitmap & (bit - 1));
}
static public int mask(int hash, int shift){
return (hash >>> shift) & 0x01f;
}
}
public ISetNode assoc(int hash, int shift, Object key);
public ISetNode dissoc(int hash, int shift, Object key);
public Object find(int hash, int shift, Object key, Object notFound);
}
(import '[clojure.lang ISetNode ISetNode$Utils])
(set! *warn-on-reflection* true)
(defmacro bitpos [hash shift] `(ISetNode$Utils/bitpos ~hash ~shift))
(defmacro mask [hash shift] `(ISetNode$Utils/mask ~hash ~shift))
(defmacro idx [bit bitmap] `(ISetNode$Utils/index ~bit ~bitmap))
(declare collision-node array-node bitmap-node #^ISetNode empty-bitmap-node)
(defmacro if-update [[node update] then else]
`(let [new-node# (-> ~node ~update)]
(if (identical? new-node# ~node)
~else
(let [~node new-node#]
~then))))
(defmacro if-instance? [[class var] then else]
`(if (instance? ~class ~var)
(let [~(vary-meta var assoc :tag class) ~var]
~then)
~else))
(defn- deep-assoc [val-or-node h shift val]
(cond
(nil? val-or-node)
val
(= val val-or-node)
val-or-node
:else
(let [new-shift (int (+ shift 5))]
(if (< new-shift 27)
(if-instance? [ISetNode val-or-node]
(.assoc val-or-node h new-shift val)
(-> empty-bitmap-node
(.assoc (hash val-or-node) new-shift val-or-node)
(.assoc h new-shift val)))
(if-instance? [ISetNode val-or-node]
(.assoc val-or-node h new-shift val)
(collision-node val-or-node val))))))
(defn- deep-dissoc [val-or-node h shift val]
(if-instance? [ISetNode val-or-node]
(.dissoc val-or-node h (+ shift 5) val)
(if (= val val-or-node)
nil
val-or-node)))
(defn- aassoc [#^"[Ljava.lang.Object;" array i val]
(doto (aclone array)
(aset (int i) val)))
(defn- bitmap-rm [bitmap bit #^"[Ljava.lang.Object;" nodes idx]
(let [n (dec (alength nodes))]
(cond
(zero? n)
nil
(== 1 n)
(aget nodes (int (- 1 (int idx))))
:else
(let [new-nodes (make-array Object n)]
(System/arraycopy nodes 0 new-nodes 0 idx)
(System/arraycopy nodes (inc idx) new-nodes idx (- n idx))
(bitmap-node (bit-xor bitmap bit) new-nodes)))))
(defn- bitmap-splice [bitmap bit #^"[Ljava.lang.Object;" nodes idx val]
(let [new-nodes (make-array Object (inc (alength nodes)))]
(System/arraycopy nodes 0 new-nodes 0 idx)
(aset new-nodes (int idx) val)
(System/arraycopy nodes idx new-nodes (inc idx) (- (alength nodes) idx))
(bitmap-node (bit-or bitmap bit) new-nodes)))
(defmacro if-in-bitmap [[[bit idx val-or-node] h shift bitmap nodes] found not-found]
`(let [~bit (bitpos ~h ~shift)
~idx (idx ~bit ~bitmap)]
(if (zero? (bit-and ~bitmap ~bit))
~not-found
(let [~val-or-node (aget ~nodes ~idx)]
~found))))
(defn bitmap-node [bitmap #^"[Ljava.lang.Object;" nodes]
(let [bitmap (int bitmap)]
(new [clojure.lang.ISetNode] this
(assoc [h shift val]
(if-in-bitmap [[bit idx val-or-node] h shift bitmap nodes]
(if-update [val-or-node (deep-assoc h shift val)]
(bitmap-node bitmap (aassoc nodes idx val-or-node))
this)
(bitmap-splice bitmap bit nodes idx val)))
(dissoc [h shift val]
(if-in-bitmap [[bit idx val-or-node] h shift bitmap nodes]
(if-update [val-or-node (deep-dissoc h shift val)]
(if (nil? val-or-node)
(bitmap-rm bitmap bit nodes idx)
(bitmap-node bitmap (aassoc nodes idx val-or-node)))
this)
this))
(find [h shift val not-found]
(if-in-bitmap [[bit idx val-or-node] h shift bitmap nodes]
(if-instance? [ISetNode val-or-node]
(.find val-or-node h (+ shift 5) val not-found)
(if (= val val-or-node) val not-found))
not-found)))))
(def #^ISetNode empty-bitmap-node (bitmap-node 0 (make-array Object 0)))
(defn- array-rm [nodes count idx]
(let [count (int count)]
(if (< 16 count)
(array-node (aassoc nodes idx nil) (dec count))
(let [count (dec count)
new-nodes (make-array Object count)]
(loop [bitmap 0 i (int 31) j (dec count)]
(if (neg? j)
(bitmap-node bitmap new-nodes)
(if-let [node (when-not (== idx i) (aget nodes i))]
(do
(aset new-nodes j node)
(recur (bit-or bitmap (int (bit-shift-left 1 i))) (dec i) (dec j)))
(recur bitmap (dec i) j))))))))
(defmacro if-in-array [[[idx val-or-node] h shift nodes] then else]
`(let [~idx (mask ~h ~shift)
~val-or-node (aget ~nodes ~idx)]
(if (nil? ~val-or-node)
~else
~then)))
(defn array-node [#^"[Ljava.lang.Object;" nodes count]
(let [count (int count)]
(new [clojure.lang.ISetNode] this
(assoc [h shift val]
(if-in-array [[idx val-or-node] h shift nodes]
(if-update [val-or-node (deep-assoc h shift val)]
(array-node (aassoc nodes idx val-or-node) (inc count))
this)
(array-node (aassoc nodes idx val) (inc count))))
(dissoc [h shift val]
(if-in-array [[idx val-or-node] h shift nodes]
(if-update [val-or-node (deep-dissoc h shift val)]
(if (nil? val-or-node)
(array-rm nodes count idx)
(array-node (aassoc nodes idx val-or-node) count))
this)
this))
(find [h shift val not-found]
(if-in-array [[idx val-or-node] h shift nodes]
(if-instance? [ISetNode val-or-node]
(.find val-or-node h (+ shift 5) val not-found)
val-or-node)
not-found)))))
(def empty-set
(letfn [(new-set [root has-nil]
(new [clojure.lang.AFn clojure.lang.IPersistentSet] this
(cons [val]
(if (nil? val)
(if has-nil
this
(new-set root true))
(if-update [root (deep-assoc (hash val) -5 val)]
(new-set root has-nil)
this)))
(get [val]
(when-not (nil? val)
(if-instance? [ISetNode root]
(.find root (hash val) 0 val nil)
(when (= root val) val))))))]
(new-set nil false)))
(comment
(-> empty-set (conj :a) (get :b))
(dotimes [i 10]
(let [n (int (Math/pow 2 (+ 10 i)))
_ (println "n=" n)
a (do
(print "clojure\t")
(time (doall (let [s (reduce conj empty-set (range 0 n 2))] (map #(get s %) (range n))))))
b (do
(print "java\t")
(time (doall (let [s (reduce conj #{} (range 0 n 2))] (map #(get s %) (range n))))))]
(println (= a b))))
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment