redblack.clj

(set! *warn-on-reflection* true)

(defmacro asets [a vs]
  `(do
     ~@(map (fn [a b c] (concat a (list b c)))
         (repeat `(aset ~a)) (range (count vs)) vs)
     ~a))

(defn B [l v r]
  (let [^objects o (make-array Object 4)]
    (asets o [:black l v r])))

(defn R [l v r]
  (let [^objects o (make-array Object 4)]
    (asets o [:red l v r])))

(defn balance-array [^objects node]
  (match [node]
    [(:or [:black [:red [:red a x b] y c] z d]
          [:black [:red a x [:red b y c]] z d]
          [:black a x [:red [:red b y c] z d]]
          [:black a x [:red b y [:red c z d]]])] :balance
    :else :balanced))

;; ~330ms on 1.7ghz MBA
(let [^objects node (B nil nil (R nil nil (R nil nil nil)))]
  (dotimes [_ 10]
    (time
      (dotimes [_ 1e7]
        (balance-array node)))))