ISetNode.java

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);
}

new-set.clj

(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))))
)