Commits

Michał Marczyk committed bd6f50d

Initial commit

  • Participants

Comments (0)

Files changed (10)

+/target
+/lib
+/classes
+/checkouts
+pom.xml
+*.jar
+*.class
+.lein-deps-sum
+.lein-failures
+.lein-plugins
+.lein-repl-history
+# flexvec
+
+An implementation of the confluently persistent vector data structure
+introduced in Bagwell, Rompf, "RRB-Trees: Efficient Immutable
+Vectors", EPFL-REPORT-169879, September, 2011.
+
+RRB-Trees build upon Clojure's PersistentVectors, adding logarithmic
+time concatenation and slicing.
+
+The main API entry points are `flexvec.core/catvec`, performing vector
+concatenation, and `flexvec.core/subvec`, which produces a new vector
+containing the appropriate subrange of the input vector (in contrast
+to `clojure.core/subvec`, which returns a view on the input vector).
+
+flexvec's vectors can store objects or unboxed primitives. The
+implementation allows for seamless interoperability with
+`clojure.lang.PersistentVector`, `clojure.core.Vec` (more commonly
+known as gvec) and `clojure.lang.APersistentVector$SubVector`
+instances: `flexvec.core/catvec` and `flexvec.core/subvec` convert
+their inputs to `flexvec.rrbt.Vector` instances whenever necessary
+(this is a very fast constant time operation for PersistentVector and
+gvec; for SubVector it is O(log n), where n is the size of the
+underlying vector).
+
+`flexvec.core` also exports its own versions of `vector`, `vector-of`
+and `vec` which always produce `flexvec.rrbt.Vector` instances. Note
+that `vector-of` accepts `:object` as one of the possible type
+arguments, in addition to keywords naming primitive types.
+
+## Usage
+
+    (require '[flexvec.core :as fv])
+
+    ;; read the overview at the REPL
+    (doc flexvec.core)
+
+    ;; functions meant for public consumption
+    (doc fv/subvec)
+    (doc fv/catvec)
+    (doc fv/vector)
+    (doc fv/vector-of)
+    (doc fv/vec)
+
+    ;; apply catvec and subvec to regular Clojure vectors
+    (fv/catvec (vec (range 1234)) (vec (range 8765)))
+    (fv/subvec (vec (range 1024)) 123 456)
+
+    ;; for peeking under the hood
+    (require '[flexvec.debug :as dv])
+    (dv/dbg-vec (fv/catvec (vec (range 1234)) (vec (range 8765))))
+
+## Future development
+
+Please note that patches will only be accepted from developers who
+have submitted the Clojure CA and would be happy with the code they
+submit to flexvec becoming part of the Clojure project.
+
+Current TODO list:
+
+ 1. features: chunked seqs, transients;
+
+ 2. performance: general perf tuning, efficient `catvec`
+    implementation (to replace current seq-ops-based impl);
+
+ 3. benchmarks;
+
+ 4. tests;
+ 
+ 5. ClojureScript version.
+
+## Clojure(Script) code reuse
+
+flexvec's vectors support the same basic functionality regular
+Clojure's vectors do (with the omissions listed above). Where
+possible, this is achieved by reusing code from Clojure's gvec and
+ClojureScript's PersistentVector implementations. The Clojure(Script)
+source files containing the relevant code carry the following
+copyright notice:
+
+    Copyright (c) Rich Hickey. All rights reserved.
+    The use and distribution terms for this software are covered by the
+    Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+    which can be found in the file epl-v10.html at the root of this distribution.
+    By using this software in any fashion, you are agreeing to be bound by
+      the terms of this license.
+    You must not remove this notice, or any other, from this software.
+
+## Licence
+
+Copyright © 2012 Michał Marczyk
+
+Distributed under the Eclipse Public License, the same as Clojure.
+(defproject flexvec "0.0.1"
+  :description "RRB-Trees for Clojure(Script) -- see Bagwell & Rompf"
+  :url "https://github.com/michalmarczyk/flexvec"
+  :license {:name "Eclipse Public License"
+            :url "http://www.eclipse.org/legal/epl-v10.html"}
+  :dependencies [[org.clojure/clojure "1.5.0-RC2"]]
+  :warn-on-reflection true)

File src/flexvec/core.clj

+(ns flexvec.core
+
+  "An implementation of the confluently persistent vector data
+  structure introduced in Bagwell, Rompf, \"RRB-Trees: Efficient
+  Immutable Vectors\", EPFL-REPORT-169879, September, 2011.
+
+  RRB-Trees build upon Clojure's PersistentVectors, adding logarithmic
+  time concatenation and slicing.
+
+  The main API entry points are flexvec.core/catvec, performing vector
+  concatenation, and flexvec.core/subvec, which produces a new vector
+  containing the appropriate subrange of the input vector (in contrast
+  to clojure.core/subvec, which returns a view on the input vector).
+
+  flexvec's vectors can store objects or unboxed primitives. The
+  implementation allows for seamless interoperability with
+  clojure.lang.PersistentVector, clojure.core.Vec (more commonly known
+  as gvec) and clojure.lang.APersistentVector$SubVector instances:
+  flexvec.core/catvec and flexvec.core/subvec convert their inputs to
+  flexvec.rrbt.Vector instances whenever necessary (this is a very
+  fast constant time operation for PersistentVector and gvec; for
+  SubVector it is O(log n), where n is the size of the underlying
+  vector).
+
+  flexvec.core also exports its own versions of vector, vector-of and
+  vec which always produce flexvec.rrbt.Vector instances. Note that
+  vector-of accepts :object as one of the possible type arguments, in
+  addition to keywords naming primitive types."
+
+  {:author "Michał Marczyk"}
+
+  (:refer-clojure :exclude [vector vector-of vec subvec])
+  (:require [flexvec.protocols :refer [slicev splicev]]
+            [flexvec.nodes :refer [ams object-am object-nm primitive-nm
+                                   empty-pv-node empty-gvec-node]]
+            flexvec.rrbt
+            flexvec.interop)
+  (:import (flexvec.rrbt Vector)
+           (flexvec.nodes NodeManager)
+           (clojure.core ArrayManager)))
+
+(defn catvec
+  "Concatenates the given vectors in logarithmic time."
+  ([]
+     [])
+  ([v1]
+     v1)
+  ([v1 v2]
+     (splicev v1 v2))
+  ([v1 v2 v3]
+     (splicev (splicev v1 v2) v3))
+  ([v1 v2 v3 v4]
+     (splicev (splicev v1 v2) (splicev v3 v4)))
+  ([v1 v2 v3 v4 & vn]
+     (splicev (splicev (splicev v1 v2) (splicev v3 v4))
+              (apply catvec vn))))
+
+(defn subvec
+  "Returns a new vector containing the elements of the given vector v
+  lying between the start (inclusive) and end (exclusive) indices in
+  logarithmic time. end defaults to end of vector."
+  ([v start]
+     (slicev v start (count v)))
+  ([v start end]
+     (slicev v start end)))
+
+(defmacro ^:private gen-vector-method [& params]
+  (let [arr (with-meta (gensym "arr__") {:tag 'objects})]
+    `(let [~arr (object-array ~(count params))]
+       ~@(map-indexed (fn [i param]
+                        `(aset ~arr ~i ~param))
+                      params)
+       (Vector. ^NodeManager object-nm ^ArrayManager object-am
+                ~(count params) 5 empty-pv-node ~arr nil
+                ~(if params -1 1)
+                ~(if params -1 1)))))
+
+(defn vector
+  "Creates a new vector containing the args."
+  ([]
+     (gen-vector-method))
+  ([x1]
+     (gen-vector-method x1))
+  ([x1 x2]
+     (gen-vector-method x1 x2))
+  ([x1 x2 x3]
+     (gen-vector-method x1 x2 x3))
+  ([x1 x2 x3 x4]
+     (gen-vector-method x1 x2 x3 x4))
+  ([x1 x2 x3 x4 & xn]
+     (loop [v  (vector x1 x2 x3 x4)
+            xn xn]
+       (if xn
+         (recur (.cons ^clojure.lang.IPersistentCollection v (first xn))
+                (next xn))
+         v))))
+
+(defn vec [coll]
+  (apply vector coll))
+
+(defmacro ^:private gen-vector-of-method [t & params]
+  (let [am  (gensym "am__")
+        nm  (gensym "nm__")
+        arr (gensym "arr__")]
+    `(let [~am ^ArrayManager (ams ~t)
+           ~nm ^NodeManager (if (identical? ~t :object) object-nm primitive-nm)
+           ~arr (.array ~am ~(count params))]
+       ~@(map-indexed (fn [i param]
+                        `(.aset ~am ~arr ~i ~param))
+                      params)
+       (Vector. ~nm ~am ~(count params) 5
+                (if (identical? ~t :object) empty-pv-node empty-gvec-node)
+                ~arr nil
+                ~(if params -1 1)
+                ~(if params -1 1)))))
+
+(defn vector-of
+  "Creates a new vector capable of storing homogenous items of type t,
+  which should be one of :object, :int, :long, :float, :double, :byte,
+  :short, :char, :boolean. Primitives are stored unboxed.
+
+  Optionally takes one or more elements to populate the vector."
+  ([t]
+     (gen-vector-of-method t))
+  ([t x1]
+     (gen-vector-of-method t x1))
+  ([t x1 x2]
+     (gen-vector-of-method t x1 x2))
+  ([t x1 x2 x3]
+     (gen-vector-of-method t x1 x2 x3))
+  ([t x1 x2 x3 x4]
+     (gen-vector-of-method t x1 x2 x3 x4))
+  ([t x1 x2 x3 x4 & xn]
+     (loop [v  (vector-of t x1 x2 x3 x4)
+            xn xn]
+       (if xn
+         (recur (.cons ^clojure.lang.IPersistentCollection v (first xn))
+                (next xn))
+         v))))

File src/flexvec/debug.clj

+(ns flexvec.debug
+  (:require flexvec.rrbt
+            [flexvec.nodes :refer [ranges object-nm primitive-nm
+                                   pv-root pv-shift pv-tail]]
+            [flexvec.core :as fv])
+  (:import (clojure.lang PersistentVector)
+           (clojure.core Vec)
+           (flexvec.rrbt Vector)
+           (flexvec.nodes NodeManager)))
+
+(defn dbg-vec [v]
+  (let [[extract-root extract-shift extract-tail ^NodeManager nm]
+        (condp identical? (class v)
+          PersistentVector [pv-root pv-shift pv-tail object-nm]
+          Vec              [#(.-root ^Vec %)
+                            #(.-shift ^Vec %)
+                            #(.-tail ^Vec %)
+                            primitive-nm]
+          Vector           [#(.-root ^Vector %)
+                            #(.-shift ^Vector %)
+                            #(.-tail ^Vector %)
+                            (.-nm ^Vector v)])
+        root  (extract-root v)
+        shift (extract-shift v)
+        tail  (extract-tail v)]
+    (letfn [(go [indent shift i node]
+              (when node
+                (dotimes [_ indent]
+                  (print "  "))
+                (printf "%02d:%02d %s" shift i
+                        (let [cn (.getName (class node))
+                              d  (.lastIndexOf cn ".")]
+                          (subs cn (inc d))))
+                (if-not (or (zero? shift) (.regular nm node))
+                  (print ":" (seq (ranges nm node))))
+                (if (zero? shift)
+                  (print ":" (vec (.array nm node))))
+                (println)
+                (if-not (zero? shift)
+                  (dorun
+                   (map-indexed (partial go (inc indent) (- shift 5))
+                                (let [arr (.array nm node)]
+                                  (if (.regular nm node)
+                                    arr
+                                    (butlast arr))))))))]
+      (printf "%s (%d elements):\n" (.getName (class v)) (count v))
+      (go 0 shift 0 root)
+      (println "tail:" (vec tail)))))
+
+(defn first-diff [xs ys]
+  (loop [i 0 xs (seq xs) ys (seq ys)]
+    (if (try (and xs ys (= (first xs) (first ys)))
+             (catch Exception e
+               (.printStackTrace e)
+               i))
+      (let [xs (try (next xs)
+                    (catch Exception e
+                      (prn :xs i)
+                      (throw e)))
+            ys (try (next ys)
+                    (catch Exception e
+                      (prn :ys i)
+                      (throw e)))]
+        (recur (inc i) xs ys))
+      (if (or xs ys)
+        i
+        -1))))
+
+(defn check-subvec [init & starts-and-ends]
+  (let [v1 (loop [v   (vec (range init))
+                  ses (seq starts-and-ends)]
+             (if ses
+               (let [[s e] ses]
+                 (recur (subvec v s e) (nnext ses)))
+               v))
+        v2 (loop [v   (fv/vec (range init))
+                  ses (seq starts-and-ends)]
+             (if ses
+               (let [[s e] ses]
+                 (recur (fv/subvec v s e) (nnext ses)))
+               v))]
+    (= v1 v2)))
+
+(defn check-catvec [& counts]
+  (let [ranges (map range counts)
+        v1 (apply concat ranges)
+        v2 (apply fv/catvec (map fv/vec ranges))]
+    (= v1 v2)))

File src/flexvec/interop.clj

+(ns flexvec.interop
+  (:require [flexvec.protocols :refer [PSliceableVector slicev
+                                       PSpliceableVector splicev]]
+            [flexvec.rrbt :refer [as-rrbt]])
+  (:import (clojure.core Vec)
+           (clojure.lang PersistentVector APersistentVector$SubVector)
+           (flexvec.rrbt Vector)))
+
+(extend-protocol PSliceableVector
+  Vec
+  (slicev [v start end]
+    (slicev (as-rrbt v) start end))
+
+  PersistentVector
+  (slicev [v start end]
+    (slicev (as-rrbt v) start end))
+
+  APersistentVector$SubVector
+  (slicev [v start end]
+    (slicev (as-rrbt v) start end)))
+
+(extend-protocol PSpliceableVector
+  Vec
+  (splicev [v1 v2]
+    (splicev (as-rrbt v1) v2))
+
+  PersistentVector
+  (splicev [v1 v2]
+    (splicev (as-rrbt v1) v2))
+
+  APersistentVector$SubVector
+  (splicev [v1 v2]
+    (splicev (as-rrbt v1) v2)))

File src/flexvec/nodes.clj

+(ns flexvec.nodes
+  (:import (clojure.core VecNode ArrayManager)
+           (clojure.lang PersistentVector PersistentVector$Node)
+           (java.util.concurrent.atomic AtomicReference)))
+
+;;; array managers
+
+(defmacro mk-am [t]
+  (#'clojure.core/mk-am &env &form t))
+
+(definline object [x] x)
+
+(def ams
+  (assoc @#'clojure.core/ams :object (mk-am object)))
+
+(def object-am
+  (ams :object))
+
+;;; empty nodes
+
+(let [empty-node-field (.getDeclaredField PersistentVector "EMPTY_NODE")]
+  (.setAccessible empty-node-field true)
+  (def empty-pv-node (.get empty-node-field nil)))
+
+(def empty-gvec-node clojure.core/EMPTY-NODE)
+
+;;; node managers
+
+(let [root-field (doto (.getDeclaredField PersistentVector "root")
+                   (.setAccessible true))]
+  (defn ^clojure.lang.PersistentVector$Node pv-root [^PersistentVector v]
+    (.get root-field v)))
+
+(let [tail-field (doto (.getDeclaredField PersistentVector "tail")
+                   (.setAccessible true))]
+  (defn pv-tail [^PersistentVector v]
+    (.get tail-field v)))
+
+(let [shift-field (doto (.getDeclaredField PersistentVector "shift")
+                    (.setAccessible true))]
+  (defn pv-shift [^PersistentVector v]
+    (.get shift-field v)))
+
+(let [array-field (doto (.getDeclaredField PersistentVector$Node "array")
+                    (.setAccessible true))]
+  (defn pv-node-array [^PersistentVector$Node node]
+    (.get array-field node)))
+
+(let [edit-field (doto (.getDeclaredField PersistentVector$Node "edit")
+                   (.setAccessible true))]
+  (defn ^AtomicReference pv-node-edit [^PersistentVector$Node node]
+    (.get edit-field node)))
+
+(let [node-ctor (.getDeclaredConstructor
+                 PersistentVector$Node
+                 (into-array Class [AtomicReference (class (object-array 0))]))]
+  (.setAccessible node-ctor true)
+  (defn make-pv-node [^AtomicReference edit ^objects arr]
+    (.newInstance node-ctor (object-array (list edit arr)))))
+
+(definterface NodeManager
+  (node [^java.util.concurrent.atomic.AtomicReference edit arr])
+  (empty [])
+  (array [node])
+  (^java.util.concurrent.atomic.AtomicReference edit [node])
+  (^boolean regular [node])
+  (clone [^clojure.core.ArrayManager am ^int shift node]))
+
+(def object-nm
+  (reify NodeManager
+    (node [_ edit arr]
+      (make-pv-node edit arr))
+    (empty [_]
+      empty-pv-node)
+    (array [_ node]
+      (pv-node-array node))
+    (edit [_ node]
+      (pv-node-edit node))
+    (regular [_ node]
+      (not (== (alength ^objects (pv-node-array node)) (int 33))))
+    (clone [_ am shift node]
+      (make-pv-node (pv-node-edit node)
+                    (aclone ^objects (pv-node-array node))))))
+
+(def primitive-nm
+  (reify NodeManager
+    (node [_ edit arr]
+      (VecNode. edit arr))
+    (empty [_]
+      empty-gvec-node)
+    (array [_ node]
+      (.-arr ^VecNode node))
+    (edit [_ node]
+      (.-edit ^VecNode node))
+    (regular [_ node]
+      (not (== (alength ^objects (.-arr ^VecNode node)) (int 33))))
+    (clone [_ am shift node]
+      (if (zero? shift)
+        (VecNode. (.-edit ^VecNode node)
+                  (.aclone am (.-arr ^VecNode node)))
+        (VecNode. (.-edit ^VecNode node)
+                  (aclone ^objects (.-arr ^VecNode node)))))))
+
+;;; ranges
+
+(defmacro ranges [nm node]
+  `(ints (aget ~(with-meta `(.array ~nm ~node) {:tag 'objects}) 32)))
+
+(defn last-range [^NodeManager nm node]
+  (let [rngs (ranges nm node)
+        i    (unchecked-dec-int (aget rngs 32))]
+    (aget rngs i)))
+
+(defn regular-ranges [shift cnt]
+  (let [step (bit-shift-left (int 1) (int shift))
+        rngs (int-array 33)]
+    (loop [i (int 0) r step]
+      (if (< r cnt)
+        (do (aset rngs i r)
+            (recur (unchecked-inc-int i) (unchecked-add-int r step)))
+        (do (aset rngs i (int cnt))
+            (aset rngs 32 (unchecked-inc-int i))
+            rngs)))))
+
+;;; root overflow
+
+(defn overflow? [^NodeManager nm root shift cnt]
+  (if (.regular nm root)
+    (> (bit-shift-right (unchecked-inc-int (int cnt)) (int 5))
+       (bit-shift-left (int 1) (int shift)))
+    (let [rngs (ranges nm root)
+          slc  (aget rngs 32)]
+      (and (== slc (int 32))
+           (or (== (int shift) (int 5))
+               (recur nm
+                      (aget ^objects (.array nm root) (unchecked-dec-int slc))
+                      (unchecked-subtract-int (int shift) (int 5))
+                      (unchecked-subtract-int (aget rngs 31) (aget rngs 30))))))))
+
+;;; find nil / 0
+
+(defn index-of-0 ^long [arr]
+  (let [arr (ints arr)]
+    (loop [l 0 h 31]
+      (if (>= l (unchecked-dec h))
+        (if (zero? (aget arr l))
+          l
+          (if (zero? (aget arr h))
+            h
+            32))
+        (let [mid (unchecked-add l (bit-shift-right (unchecked-subtract h l) 1))]
+          (if (zero? (aget arr mid))
+            (recur l mid)
+            (recur (unchecked-inc-int mid) h)))))))
+
+(defn index-of-nil ^long [arr]
+  (loop [l 0 h 31]
+    (if (>= l (unchecked-dec h))
+      (if (nil? (aget ^objects arr l))
+        l
+        (if (nil? (aget ^objects arr h))
+          h
+          32))
+      (let [mid (unchecked-add l (bit-shift-right (unchecked-subtract h l) 1))]
+        (if (nil? (aget ^objects arr mid))
+          (recur l mid)
+          (recur (unchecked-inc-int mid) h))))))
+
+;;; children
+
+(defn first-child [^NodeManager nm node]
+  (aget ^objects (.array nm node) 0))
+
+(defn last-child [^NodeManager nm node]
+  (let [arr (.array nm node)]
+    (if (.regular nm node)
+      (aget ^objects arr (dec (index-of-nil arr)))
+      (aget ^objects arr (unchecked-dec-int (aget (ranges nm node) 32))))))
+
+(defn remove-leftmost-child [^NodeManager nm shift parent]
+  (let [arr (.array nm parent)]
+    (if (nil? (aget ^objects arr 1))
+      nil
+      (let [regular? (.regular nm parent)
+            new-arr  (object-array (if regular? 32 33))]
+        (System/arraycopy arr 1 new-arr 0 31)
+        (if-not regular?
+          (let [rngs     (ranges nm parent)
+                new-rngs (aclone rngs)]
+            (System/arraycopy rngs 1 new-rngs 0 (dec (aget rngs 32)))
+            (aset new-rngs 32 (dec (aget rngs 32)))
+            (aset ^objects new-arr 32 new-rngs)))
+        (.node nm (.edit nm parent) new-arr)))))
+
+(defn replace-leftmost-child [^NodeManager nm shift parent pcnt child d]
+  (if (.regular nm parent)
+    (let [step (bit-shift-left 1 shift)
+          rng0 (- step d)
+          ncnt (- pcnt d)
+          li   (bit-and (bit-shift-right shift (dec pcnt)) 0x1f)]
+      (let [arr      (.array nm parent)
+            new-arr  (object-array 33)
+            new-rngs (int-array 33)]
+        (aset ^objects arr 0 child)
+        (System/arraycopy arr 1 new-arr 1 li)
+        (aset ^objects arr 32 new-rngs)
+        (aset new-rngs 0 (int rng0))
+        (aset new-rngs li (int ncnt))
+        (aset new-rngs 32 (int (inc li)))
+        (loop [i 1]
+          (when (< i li)
+            (aset new-rngs i (+ (aget new-rngs (dec i)) step))
+            (recur (inc i))))
+        (.node nm nil new-arr)))
+    (let [new-arr  (aclone ^objects (.array nm parent))
+          new-rngs (aclone (ranges nm parent))
+          li       (dec (index-of-0 new-rngs))]
+      (aset ^objects new-arr 32 new-rngs)
+      (aset ^objects new-arr li child)
+      (aset new-rngs li (int (- (aget new-rngs li) d)))
+      (.node nm nil new-arr))))
+
+(defn replace-rightmost-child [^NodeManager nm shift parent child d]
+  (if (.regular nm parent)
+    (let [arr (.array nm parent)
+          i   (unchecked-dec (index-of-nil arr))]
+      (if (.regular nm child)
+        (let [new-arr (aclone ^objects arr)]
+          (aset ^objects new-arr i child)
+          (.node nm nil new-arr))
+        (let [arr     (.array nm parent)
+              new-arr (object-array 33)
+              step    (bit-shift-left 1 shift)
+              rngs    (int-array 33)]
+          (aset rngs 32 (inc i))
+          (aset ^objects new-arr 32 rngs)
+          (System/arraycopy arr 0 new-arr 0 i)
+          (aset ^objects new-arr i child)
+          (loop [j 0 r step]
+            (when (<= j i)
+              (aset rngs j r)
+              (recur (inc j) (+ r step))))
+          (aset rngs i (int (last-range nm child)))
+          (.node nm nil arr))))
+    (let [rngs     (ranges nm parent)
+          new-rngs (aclone rngs)
+          i        (dec (aget rngs 32))
+          new-arr  (aclone ^objects (.array nm parent))]
+      (aset ^objects new-arr i child)
+      (aset ^objects new-arr 32 new-rngs)
+      (aset new-rngs i (int (+ (aget rngs i) d)))
+      (.node nm nil new-arr))))
+
+;;; fold-tail
+
+(defn new-path [^NodeManager nm ^ArrayManager am shift node]
+  (let [reg? (== 32 (.alength am (.array nm node)))
+        len  (if reg? 32 33)
+        arr  (object-array len)
+        rngs (if-not reg?
+               (doto (int-array 33)
+                 (aset 0 (.alength am (.array nm node)))
+                 (aset 32 1)))
+        ret  (.node nm nil arr)]
+    (loop [arr arr shift shift]
+      (if (== shift 5)
+        (do (if-not reg?
+              (aset arr 32 rngs))
+            (aset arr 0 node))
+        (let [a (object-array len)
+              e (.node nm nil a)]
+          (aset arr 0 e)
+          (if-not reg?
+            (aset arr 32 rngs))
+          (recur a (- shift 5)))))
+    ret))
+
+(defn fold-tail [^NodeManager nm ^ArrayManager am node shift cnt tail]
+  (let [tlen     (.alength am tail)
+        reg?     (and (.regular nm node) (== tlen 32))
+        arr      (.array nm node)
+        li       (index-of-nil arr)
+        new-arr  (object-array (if reg? 32 33))
+        rngs     (if-not (.regular nm node) (ranges nm node))
+        cret     (if (== shift 5)
+                   (.node nm nil tail)
+                   (fold-tail nm am
+                              (aget ^objects arr (dec li))
+                              (- shift 5)
+                              (if (.regular nm node)
+                                (mod cnt (bit-shift-left 1 shift))
+                                (let [li (aget rngs 32)]
+                                  (if (pos? li)
+                                    (unchecked-subtract-int
+                                     (aget rngs (unchecked-dec-int li))
+                                     (aget rngs (unchecked-subtract-int
+                                                 li (int 2))))
+                                    (aget rngs (unchecked-dec-int li)))))
+                              tail))
+        new-rngs (ints (if-not reg?
+                         (if rngs
+                           (aclone rngs)
+                           (regular-ranges shift cnt))))]
+    (when-not (and (== shift 5) (== li 32))
+      (System/arraycopy arr 0 new-arr 0 li)
+      (when-not reg?
+        (if (or (nil? cret) (== shift 5))
+          (do (aset new-rngs li
+                    (+ (if (pos? li)
+                         (aget new-rngs (dec li))
+                         (int 0))
+                       tlen))
+              (aset new-rngs 32 (inc li)))
+          (do (when (pos? li)
+                (aset new-rngs (dec li)
+                      (+ (aget new-rngs (dec li)) tlen)))
+              (aset new-rngs 32 li))))
+      (if-not reg?
+        (aset new-arr 32 new-rngs))
+      (if (nil? cret)
+        (aset new-arr li
+              (new-path nm am
+                        (unchecked-subtract-int shift 5)
+                        (.node nm nil tail)))
+        (aset new-arr (if (== shift 5) li (dec li)) cret))
+      (.node nm nil new-arr))))

File src/flexvec/protocols.clj

+(ns flexvec.protocols)
+
+(defprotocol PSpliceableVector
+  (splicev [v1 v2]))
+
+(defprotocol PSliceableVector
+  (slicev [v start end]))

File src/flexvec/rrbt.clj

+(ns flexvec.rrbt
+  (:refer-clojure :exclude [assert])
+  (:require [flexvec.protocols :refer [PSliceableVector slicev
+                                       PSpliceableVector splicev]]
+            [flexvec.nodes :refer [ranges overflow? last-range regular-ranges
+                                   first-child last-child
+                                   remove-leftmost-child
+                                   replace-leftmost-child
+                                   replace-rightmost-child
+                                   fold-tail new-path index-of-nil
+                                   object-am object-nm primitive-nm
+                                   pv-shift pv-root pv-tail]])
+  (:import (clojure.core ArrayManager Vec)
+           (clojure.lang Util Box PersistentVector APersistentVector$SubVector)
+           (flexvec.nodes NodeManager)))
+
+(def ^:const rrbt-concat-threshold 33)
+(def ^:const max-extra-search-steps 2)
+
+(def ^:const elide-assertions? true)
+(def ^:const elide-debug-printouts? true)
+
+(defmacro assert [& args]
+  (if-not elide-assertions?
+    (apply #'clojure.core/assert &form &env args)))
+
+(defmacro dbg [& args]
+  (if-not elide-debug-printouts?
+    `(prn ~@args)))
+
+(defmacro dbg- [& args])
+
+(definterface IVecImpl
+  (^int tailoff [])
+  (arrayFor [^int i])
+  (pushTail [^int shift ^int cnt parent tailnode])
+  (popTail [^int shift ^int cnt node])
+  (newPath [^java.util.concurrent.atomic.AtomicReference edit ^int shift node])
+  (doAssoc [^int shift node ^int i val]))
+
+(defprotocol AsRRBT
+  (as-rrbt [v]))
+
+(defn slice-right [^NodeManager nm ^ArrayManager am node shift end]
+  (let [shift (int shift)
+        end   (int end)]
+    (if (zero? shift)
+      ;; potentially return a short node, although it would be better to
+      ;; make sure a regular leaf is always left at the right, with any
+      ;; items over the final 32 moved into tail (and then potentially
+      ;; back into the tree should the tail become too long...)
+      (let [arr     (.array nm node)
+            new-arr (.array am end)]
+        (System/arraycopy arr 0 new-arr 0 end)
+        (.node nm nil new-arr))
+      (let [regular?  (.regular nm node)
+            rngs      (if-not regular? (ranges nm node))
+            i         (bit-and (bit-shift-right (unchecked-dec-int end) shift)
+                               (int 0x1f))
+            i         (if regular?
+                        i
+                        (loop [j i]
+                          (if (<= end (aget rngs j))
+                            j
+                            (recur (unchecked-inc-int j)))))
+            child-end (if regular?
+                        (let [ce (unchecked-remainder-int
+                                  end (bit-shift-left (int 1) shift))]
+                          (if (zero? ce) (bit-shift-left (int 1) shift) ce))
+                        (if (pos? i)
+                          (unchecked-subtract-int
+                           end (aget rngs (unchecked-dec-int i)))
+                          end))
+            arr       (.array nm node)
+            new-child (slice-right nm am (aget ^objects arr i)
+                                   (unchecked-subtract-int shift (int 5))
+                                   child-end)
+            regular-child? (if (== shift (int 5))
+                             (== (int 32) (.alength am (.array nm new-child)))
+                             (.regular nm new-child))
+            new-arr   (object-array (if (and regular? regular-child?) 32 33))
+            new-child-rng  (if regular-child?
+                             -1
+                             (if (== shift (int 5))
+                               (.alength am (.array nm new-child))
+                               (last-range nm new-child)))]
+        (System/arraycopy arr 0 new-arr 0 i)
+        (aset ^objects new-arr i new-child)
+        (if-not (and regular? regular-child?)
+          (let [new-rngs (int-array 33)
+                step     (bit-shift-left (int 1) shift)]
+            (if regular?
+              (dotimes [j i]
+                (aset new-rngs j (unchecked-multiply-int (inc j) step)))
+              (dotimes [j i]
+                (aset new-rngs j (aget rngs j))))
+            (aset new-rngs i (unchecked-add-int
+                              (if (pos? i)
+                                (aget new-rngs (unchecked-dec-int i))
+                                (int 0))
+                              new-child-rng))
+            (aset new-rngs 32 (unchecked-inc-int i))
+            (aset new-arr 32 new-rngs)))
+        (.node nm nil new-arr)))))
+
+(defn slice-left [^NodeManager nm ^ArrayManager am node shift start end]
+  (let [shift (int shift)
+        start (int start)
+        end   (int end)]
+    (if (zero? shift)
+      ;; potentially return a short node
+      (let [arr     (.array nm node)
+            new-len (unchecked-subtract-int (.alength am arr) start)
+            new-arr (.array am new-len)]
+        (System/arraycopy arr start new-arr 0 new-len)
+        (.node nm nil new-arr))
+      (let [regular? (.regular nm node)
+            arr      (.array nm node)
+            rngs     (if-not regular? (ranges nm node))
+            i        (bit-and (bit-shift-right start shift) (int 0x1f))
+            i        (if regular?
+                       i
+                       (loop [j i]
+                         (if (<= start (aget rngs j))
+                           j
+                           (recur (unchecked-inc-int j)))))
+            len      (if regular?
+                       (loop [i i]
+                         (if (or (== i (int 32))
+                                 (nil? (aget ^objects arr i)))
+                           i
+                           (recur (unchecked-inc-int i))))
+                       (aget rngs 32))
+            child-start (if (pos? i)
+                          (unchecked-subtract-int
+                           start (if regular?
+                                   (unchecked-multiply-int
+                                    i (bit-shift-left (int 1) shift))
+                                   (aget rngs (unchecked-dec-int i))))
+                          start)
+            child-end   (int (min end (if regular?
+                                        (unchecked-multiply-int
+                                         i (bit-shift-left (int 1) shift))
+                                        (if (pos? i)
+                                          (aget rngs (unchecked-dec-int i))
+                                          end))))
+            new-child   (slice-left nm am
+                                    (aget ^objects arr i)
+                                    (unchecked-subtract-int shift (int 5))
+                                    child-start
+                                    child-end)
+            new-len     (unchecked-subtract-int len i)
+            new-len     (if (nil? new-child) (unchecked-dec-int new-len) new-len)]
+        (cond
+          (zero? new-len)
+          nil
+
+          regular?
+          (let [new-arr (object-array 33)
+                rngs    (int-array 33)
+                rng0    (if (or (nil? new-child)
+                                (== shift (int 5))
+                                (.regular nm new-child))
+                          (unchecked-subtract-int
+                           (bit-shift-left (int 1) shift)
+                           (bit-and (bit-shift-right
+                                     start (unchecked-subtract-int shift (int 5)))
+                                    (int 0x1f)))
+                          (int (last-range nm new-child)))
+                step    (bit-shift-left (int 1) shift)]
+            (loop [j (int 0)
+                   r rng0]
+              (when (< j new-len)
+                (aset rngs j r)
+                (recur (unchecked-inc-int j) (unchecked-add-int r step))))
+            (aset rngs 32 new-len)
+            (System/arraycopy arr (if (nil? new-child) (unchecked-inc-int i) i)
+                              new-arr 0
+                              new-len)
+            (if-not (nil? new-child)
+              (aset new-arr 0 new-child))
+            (aset new-arr 32 rngs)
+            (.node nm (.edit nm node) new-arr))
+
+          :else
+          (let [new-arr  (object-array 33)
+                new-rngs (int-array 33)]
+            (loop [j (int 0) i i]
+              (when (< j new-len)
+                (aset new-rngs j (unchecked-subtract-int (aget rngs i) start))
+                (recur (unchecked-inc-int j) (unchecked-inc-int i))))
+            (aset new-rngs 32 new-len)
+            (System/arraycopy arr (if (nil? new-child) (unchecked-inc-int i) i)
+                              new-arr 0
+                              new-len)
+            (if-not (nil? new-child)
+              (aset new-arr 0 new-child))
+            (aset new-arr 32 new-rngs)
+            (.node nm (.edit nm node) new-arr)))))))
+
+(declare splice-rrbts)
+
+(deftype Vector [^NodeManager nm ^ArrayManager am ^int cnt ^int shift root tail
+                 ^clojure.lang.IPersistentMap _meta
+                 ^:unsynchronized-mutable ^int _hash
+                 ^:unsynchronized-mutable ^int _hasheq]
+  Object
+  (equals [this that]
+    (cond
+      (identical? this that) true
+
+      (or (instance? clojure.lang.IPersistentVector that)
+          (instance? java.util.RandomAccess that))
+      (and (== cnt (count that))
+           (loop [i (int 0)]
+             (cond
+               (== i cnt) true
+               (.equals (.nth this i) (nth that i)) (recur (unchecked-inc-int i))
+               :else false)))
+
+      (or (instance? clojure.lang.Sequential that)
+          (instance? java.util.List that))
+      (.equals (seq this) (seq that))
+
+      :else false))
+
+  (hashCode [this]
+    (if (== _hash (int -1))
+      (loop [h (int 1) i (int 0)]
+        (if (== i cnt)
+          (do (set! _hash (int h))
+              h)
+          (let [val (.nth this i)]
+            (recur (unchecked-add-int (unchecked-multiply-int (int 31) h)
+                                      (Util/hash val))
+                   (unchecked-inc-int i)))))
+      _hash))
+
+  (toString [this]
+    (pr-str this))
+
+  clojure.lang.IHashEq
+  (hasheq [this]
+    (if (== _hasheq (int -1))
+      (loop [h (int 1) xs (seq this)]
+        (if xs
+          (recur (unchecked-add-int (unchecked-multiply-int (int 31) h)
+                                    (Util/hasheq (first xs)))
+                 (next xs))
+          (do (set! _hasheq (int h))
+              h)))
+      _hasheq))
+
+  clojure.lang.Counted
+  (count [_] cnt)
+
+  clojure.lang.IMeta
+  (meta [_] _meta)
+
+  clojure.lang.IObj
+  (withMeta [_ m]
+    (Vector. nm am cnt shift root tail m _hash _hasheq))
+
+  clojure.lang.Indexed
+  (nth [this i]
+    (if (and (<= (int 0) i) (< i cnt))
+      (let [tail-off (unchecked-subtract-int cnt (.alength am tail))]
+        (if (<= tail-off i)
+          (.aget am tail (unchecked-subtract-int i tail-off))
+          (loop [i i node root shift shift]
+            (if (zero? shift)
+              (let [arr (.array nm node)]
+                (.aget am arr (bit-and (bit-shift-right i shift) (int 0x1f))))
+              (if (.regular nm node)
+                (let [arr (.array nm node)
+                      idx (bit-and (bit-shift-right i shift) (int 0x1f))]
+                  (loop [i     i
+                         node  (aget ^objects arr idx)
+                         shift (unchecked-subtract-int shift (int 5))]
+                    (let [arr (.array nm node)
+                          idx (bit-and (bit-shift-right i shift) (int 0x1f))]
+                      (if (zero? shift)
+                        (.aget am arr idx)
+                        (recur i
+                               (aget ^objects arr idx)
+                               (unchecked-subtract-int shift (int 5)))))))
+                (let [arr  (.array nm node)
+                      rngs (ranges nm node)
+                      idx  (loop [j (bit-and (bit-shift-right i shift) (int 0x1f))]
+                             (if (< i (aget rngs j))
+                               j
+                               (recur (unchecked-inc-int j))))
+                      i    (if (zero? idx)
+                             (int i)
+                             (unchecked-subtract-int
+                              (int i) (aget rngs (unchecked-dec-int idx))))]
+                  (recur i
+                         (aget ^objects arr idx)
+                         (unchecked-subtract-int shift (int 5)))))))))
+      (throw (IndexOutOfBoundsException.))))
+
+  (nth [this i not-found]
+    (if (and (>= i (int 0)) (< i cnt))
+      (.nth this i)
+      not-found))
+
+  clojure.lang.IPersistentCollection
+  (cons [this val]
+    (if (< (.alength am tail) (int 32))
+      (let [tail-len (.alength am tail)
+            new-tail (.array am (unchecked-inc-int tail-len))]
+        (System/arraycopy tail 0 new-tail 0 tail-len)
+        (.aset am new-tail tail-len val)
+        (Vector. nm am (unchecked-inc-int cnt) shift root new-tail _meta -1 -1))
+      (let [tail-node (.node nm (.edit nm root) tail)
+            new-tail  (let [new-arr (.array am 1)]
+                        (.aset am new-arr 0 val)
+                        new-arr)]
+        (if (overflow? nm root shift cnt)
+          (if (.regular nm root)
+            (let [new-arr  (object-array 32)
+                  new-root (.node nm (.edit nm root) new-arr)]
+              (doto new-arr
+                (aset (int 0) root)
+                (aset (int 1) (.newPath this (.edit nm root) shift tail-node)))
+              (Vector. nm
+                       am
+                       (unchecked-inc-int cnt)
+                       (unchecked-add-int shift (int 5))
+                       new-root
+                       new-tail
+                       _meta
+                       -1
+                       -1))
+            (let [new-arr  (object-array 33)
+                  new-rngs (ints (int-array 33))
+                  new-root (.node nm (.edit nm root) new-arr)
+                  root-total-range (aget (ranges nm root) (int 31))]
+              (doto new-arr
+                (aset (int 0)  root)
+                (aset (int 1)  (.newPath this (.edit nm root) shift tail-node))
+                (aset (int 32) new-rngs))
+              (doto new-rngs
+                (aset (int 0)  root-total-range)
+                (aset (int 1)  (unchecked-add-int root-total-range (int 32)))
+                (aset (int 32) (int 2)))
+              (Vector. nm
+                       am
+                       (unchecked-inc-int cnt)
+                       (unchecked-add-int shift (int 5))
+                       new-root
+                       new-tail
+                       _meta
+                       -1
+                       -1)))
+          (Vector. nm am (unchecked-inc-int cnt) shift
+                   (.pushTail this shift cnt root tail-node)
+                   new-tail
+                   _meta
+                   -1
+                   -1)))))
+
+  (empty [_]
+    (Vector. nm am 0 5 (.empty nm) (.array am 0) _meta -1 -1))
+
+  (equiv [this that]
+    (cond
+      (or (instance? clojure.lang.IPersistentVector that)
+          (instance? java.util.RandomAccess that))
+      (and (== cnt (count that))
+           (loop [i (int 0)]
+             (cond
+               (== i cnt) true
+               (= (.nth this i) (nth that i)) (recur (unchecked-inc-int i))
+               :else false)))
+
+      (or (instance? clojure.lang.Sequential that)
+          (instance? java.util.List that))
+      (Util/equiv (seq this) (seq that))
+
+      :else false))
+
+  clojure.lang.IPersistentStack
+  (peek [this]
+    (when (pos? cnt)
+      (.nth this (unchecked-dec-int cnt))))
+
+  (pop [this]
+    (cond
+      (zero? cnt)
+      (throw (IllegalStateException. "Can't pop empty vector"))
+
+      (== 1 cnt)
+      (Vector. nm am 0 5 (.empty nm) (.array am 0) _meta -1 -1)
+
+      (> (.alength am tail) (int 1))
+      (let [new-tail (.array am (unchecked-dec-int (.alength am tail)))]
+        (System/arraycopy tail 0 new-tail 0 (.alength am new-tail))
+        (Vector. nm am (unchecked-dec-int cnt) shift root new-tail _meta -1 -1))
+
+      :else
+      (let [new-tail (.arrayFor this (unchecked-subtract-int cnt (int 2)))
+            root-cnt (.tailoff this)
+            new-root (.popTail this shift root-cnt root)]
+        (cond
+          (nil? new-root)
+          (Vector. nm am (unchecked-dec-int cnt) shift (.empty nm) new-tail
+                   _meta -1 -1)
+
+          (and (> shift (int 5))
+               (nil? (aget ^objects (.array nm new-root) 1)))
+          (Vector. nm
+                   am
+                   (unchecked-dec-int cnt)
+                   (unchecked-subtract-int shift (int 5))
+                   (aget ^objects (.array nm new-root) 0)
+                   new-tail
+                   _meta
+                   -1
+                   -1)
+
+          :else
+          (Vector. nm am (unchecked-dec-int cnt) shift new-root new-tail
+                   _meta -1 -1)))))
+
+  clojure.lang.IPersistentVector
+  (assocN [this i val]
+    (cond
+      (and (<= (int 0) i) (< i cnt))
+      (let [tail-off (.tailoff this)]
+        (if (>= i tail-off)
+          (let [new-tail (.array am (.alength am tail))
+                idx (unchecked-subtract-int i tail-off)]
+            (System/arraycopy tail 0 new-tail 0 (.alength am tail))
+            (.aset am new-tail idx val)
+            (Vector. nm am cnt shift root new-tail _meta -1 -1))
+          (Vector. nm am cnt shift (.doAssoc this shift root i val) tail
+                   _meta -1 -1)))
+
+      (== i cnt) (.cons this val)
+      :else (throw (IndexOutOfBoundsException.))))
+
+  clojure.lang.Reversible
+  (rseq [this]
+    (if (pos? cnt)
+      (clojure.lang.APersistentVector$RSeq. this (unchecked-dec-int cnt))
+      nil))
+
+  clojure.lang.Associative
+  (assoc [this k v]
+    (if (Util/isInteger k)
+      (.assocN this k v)
+      (throw (IllegalArgumentException. "Key must be integer"))))
+
+  (containsKey [this k]
+    (and (Util/isInteger k)
+         (<= (int 0) (int k))
+         (< (int k) cnt)))
+
+  (entryAt [this k]
+    (if (.containsKey this k)
+      (clojure.lang.MapEntry. k (.nth this (int k)))
+      nil))
+
+  clojure.lang.ILookup
+  (valAt [this k not-found]
+    (if (Util/isInteger k)
+      (let [i (int k)]
+        (if (and (>= i (int 0)) (< i cnt))
+          (.nth this i)
+          not-found))
+      not-found))
+
+  (valAt [this k]
+    (.valAt this k nil))
+
+  clojure.lang.IFn
+  (invoke [this k]
+    (if (Util/isInteger k)
+      (let [i (int k)]
+        (if (and (>= i (int 0)) (< i cnt))
+          (.nth this i)
+          (throw (IndexOutOfBoundsException.))))
+      (throw (IllegalArgumentException. "Key must be integer"))))
+
+  clojure.lang.Seqable
+  (seq [this]
+    (iterator-seq (.iterator this)))
+
+  clojure.lang.Sequential
+
+  IVecImpl
+  (tailoff [_]
+    (unchecked-subtract-int cnt (.alength am tail)))
+
+  (arrayFor [this i]
+    (if (and (<= (int 0) i) (< i cnt))
+      (if (>= i (.tailoff this))
+        tail
+        (loop [i (int i) node root shift shift]
+          (if (zero? shift)
+            (.array nm node)
+            (if (.regular nm node)
+              (loop [node  (aget ^objects (.array nm node)
+                                 (bit-and (bit-shift-right i shift) (int 0x1f)))
+                     shift (unchecked-subtract-int shift (int 5))]
+                (if (zero? shift)
+                  (.array nm node)
+                  (recur (aget ^objects (.array nm node)
+                               (bit-and (bit-shift-right i shift) (int 0x1f)))
+                         (unchecked-subtract-int shift (int 5)))))
+              (let [rngs (ranges nm node)
+                    j    (loop [j (bit-and (bit-shift-right i shift) (int 0x1f))]
+                           (if (< i (aget rngs j))
+                             j
+                             (recur (unchecked-inc-int j))))
+                    i    (if (pos? j)
+                           (unchecked-subtract-int
+                            i (aget rngs (unchecked-dec-int j)))
+                           i)]
+                (recur (int i)
+                       (aget ^objects (.array nm node) j)
+                       (unchecked-subtract-int shift (int 5)))))))) 
+      (throw (IndexOutOfBoundsException.))))
+
+  (pushTail [this shift cnt node tail-node]
+    (if (.regular nm node)
+      (let [arr (aclone ^objects (.array nm node))
+            ret (.node nm (.edit nm node) arr)]
+        (loop [node ret shift (int shift)]
+          (let [arr    (.array nm node)
+                subidx (bit-and (bit-shift-right (unchecked-dec-int cnt) shift)
+                                (int 0x1f))]
+            (if (== shift (int 5))
+              (aset ^objects arr subidx tail-node)
+              (if-let [child (aget ^objects arr subidx)]
+                (let [new-carr  (aclone ^objects (.array nm child))
+                      new-child (.node nm (.edit nm root) new-carr)]
+                  (aset ^objects arr subidx new-child)
+                  (recur new-child (unchecked-subtract-int shift (int 5))))
+                (aset ^objects arr subidx
+                      (.newPath this (.edit nm root)
+                                (unchecked-subtract-int
+                                 shift (int 5))
+                                tail-node))))))
+        ret)
+      (let [arr  (aclone ^objects (.array nm node))
+            rngs (ranges nm node)
+            li   (unchecked-dec-int (aget rngs 32))
+            ret  (.node nm (.edit nm node) arr)
+            cret (if (== shift (int 5))
+                   (if (< li 31)
+                     tail-node)
+                   (let [child (aget ^objects arr li)
+                         ccnt  (if (pos? li)
+                                 (unchecked-subtract-int
+                                  (aget rngs li)
+                                  (aget rngs (unchecked-dec-int li)))
+                                 (aget rngs 0))]
+                     (if-not (== ccnt (bit-shift-left 1 shift))
+                       (.pushTail this
+                                  (unchecked-subtract-int shift (int 5))
+                                  ccnt
+                                  (aget ^objects arr li)
+                                  tail-node))))]
+        (if cret
+          (do (aset ^objects arr li cret)
+              (aset rngs li (unchecked-add-int (aget rngs li) (int 32)))
+              ret)
+          (do (aset ^objects arr (unchecked-inc-int li)
+                    (.newPath this (.edit nm root)
+                              (unchecked-subtract-int shift (int 5))
+                              tail-node))
+              (aset rngs (unchecked-inc-int li)
+                    (unchecked-add-int (aget rngs li) (int 32)))
+              ret)))))
+
+  (popTail [this shift cnt node]
+    (if (.regular nm node)
+      (let [subidx (bit-and
+                    (bit-shift-right (unchecked-dec-int cnt) (int shift))
+                    (int 0x1f))]
+        (cond
+          (> (int shift) (int 5))
+          (let [new-child (.popTail this
+                                    (unchecked-subtract-int (int shift) (int 5))
+                                    cnt
+                                    (aget ^objects (.array nm node) subidx))]
+            (if (and (nil? new-child) (zero? subidx))
+              nil
+              (let [arr (aclone ^objects (.array nm node))]
+                (aset arr subidx new-child)
+                (.node nm (.edit nm root) arr))))
+
+          (zero? subidx)
+          nil
+
+          :else
+          (let [arr (aclone ^objects (.array nm node))]
+            (aset arr subidx nil)
+            (.node nm (.edit nm root) arr))))
+      (let [subidx (int (bit-and
+                         (bit-shift-right (unchecked-dec-int cnt) (int shift))
+                         (int 0x1f)))
+            rngs   (ranges nm node)
+            subidx (int (loop [subidx subidx]
+                          (if (or (zero? (aget rngs (unchecked-inc-int subidx)))
+                                  (== subidx (int 31)))
+                            subidx
+                            (recur (unchecked-inc-int subidx)))))
+            new-rngs (aclone rngs)]
+        (cond
+          (> (int shift) (int 5))
+          (let [child     (aget ^objects (.array nm node) subidx)
+                child-cnt (if (zero? subidx)
+                            (aget rngs 0)
+                            (unchecked-subtract-int
+                             (aget rngs subidx)
+                             (aget rngs (unchecked-dec-int subidx))))
+                new-child (.popTail this
+                                    (unchecked-subtract-int (int shift) (int 5))
+                                    child-cnt
+                                    child)]
+            (cond
+              (and (nil? new-child) (zero? subidx))
+              nil
+
+              (.regular nm child)
+              (let [arr (aclone ^objects (.array nm node))]
+                (aset new-rngs subidx
+                      (unchecked-subtract-int (aget new-rngs subidx) (int 32)))
+                (aset arr subidx new-child)
+                (aset arr (int 32) new-rngs)
+                (if (nil? new-child)
+                  (aset new-rngs 32 (unchecked-dec-int (aget new-rngs 32))))
+                (.node nm (.edit nm root) arr))
+
+              :else
+              (let [rng  (int (last-range nm child))
+                    diff (unchecked-subtract-int
+                          rng
+                          (last-range nm new-child))
+                    arr  (aclone ^objects (.array nm node))]
+                (aset new-rngs subidx
+                      (unchecked-subtract-int (aget new-rngs subidx) diff))
+                (aset arr subidx new-child)
+                (aset arr (int 32) new-rngs)
+                (if (nil? new-child)
+                  (aset new-rngs 32 (unchecked-dec-int (aget new-rngs 32))))
+                (.node nm (.edit nm root) arr))))
+
+          (zero? subidx)
+          nil
+
+          :else
+          (let [arr      (aclone ^objects (.array nm node))
+                child    (aget arr subidx)
+                new-rngs (aclone rngs)]
+            (aset arr subidx nil)
+            (aset arr (int 32) new-rngs)
+            (aset new-rngs subidx 0)
+            (aset new-rngs 32 (unchecked-dec-int (aget new-rngs (int 32))))
+            (.node nm (.edit nm root) arr))))))
+
+  (newPath [this edit shift node]
+    (if (== (.alength am tail) (int 32))
+      (let [shift (int shift)]
+        (loop [s (int 0) node node]
+          (if (== s shift)
+            node
+            (let [arr (object-array 32)
+                  ret (.node nm edit arr)]
+              (aset arr 0 node)
+              (recur (unchecked-add-int s (int 5)) ret)))))
+      (let [shift (int shift)]
+        (loop [s (int 0) node node]
+          (if (== s shift)
+            node
+            (let [arr  (object-array 33)
+                  rngs (int-array 33)
+                  ret  (.node nm edit arr)]
+              (aset arr 0 node)
+              (aset arr 32 rngs)
+              (recur (unchecked-add-int s (int 5)) ret)))))))
+
+  (doAssoc [this shift node i val]
+    (if (.regular nm node)
+      (let [node (.clone nm am shift node)]
+        (loop [shift (int shift)
+               node  node]
+          (if (zero? shift)
+            (let [arr (.array nm node)]
+              (.aset am arr (bit-and i (int 0x1f)) val))
+            (let [arr    (.array nm node)
+                  subidx (bit-and (bit-shift-right i shift) (int 0x1f))
+                  child  (.clone nm am shift (aget ^objects arr subidx))]
+              (aset ^objects arr subidx child)
+              (recur (unchecked-subtract-int shift (int 5)) child))))
+        node)
+      (if (zero? shift)
+        (let [arr  (.aclone am (.array nm node))
+              rngs (ranges nm node)
+              i    (loop [i i]
+                     (if (or (zero? (aget rngs (unchecked-inc-int i)))
+                             (== i (int 31)))
+                       i
+                       (recur (unchecked-inc-int i))))]
+          (.aset am arr (bit-and i (int 0x1f)) val)
+          (.node nm (.edit nm node) arr))
+        (let [arr    (aclone ^objects (.array nm node))
+              rngs   (ranges nm node)
+              subidx (bit-and (bit-shift-right i shift) (int 0x1f))
+              subidx (loop [subidx subidx]
+                       (if (or (zero? (aget rngs (unchecked-inc-int subidx)))
+                               (== subidx (int 31)))
+                         subidx
+                         (recur (unchecked-inc-int subidx))))]
+          (aset arr subidx
+                (.doAssoc this
+                          (unchecked-subtract-int (int shift) (int 5))
+                          (aget arr subidx)
+                          i
+                          val))
+          (.node nm (.edit nm node) arr)))))
+
+  PSliceableVector
+  (slicev [this start end]
+    (let [start   (int start)
+          end     (int end)
+          new-cnt (unchecked-subtract-int end start)]
+      (cond
+        (or (neg? start) (> end cnt))
+        (throw (IndexOutOfBoundsException.))
+
+        (== start end)
+        ;; NB. preserves metadata
+        (empty this)
+
+        (> start end)
+        (throw (IllegalStateException. "start index greater than end index"))
+
+        :else
+        (let [tail-off (.tailoff this)]
+          (if (>= start tail-off)
+            (let [new-tail (.array am new-cnt)]
+              (System/arraycopy tail (unchecked-subtract-int start tail-off)
+                                new-tail 0
+                                new-cnt)
+              (Vector. nm am new-cnt (int 5) (.empty nm) new-tail _meta -1 -1))
+            (let [tail-cut? (> end tail-off)
+                  new-root  (if tail-cut?
+                              root
+                              (slice-right nm am root shift end))
+                  new-root  (if (zero? start)
+                              new-root
+                              (slice-left nm am new-root shift start
+                                          (min end tail-off)))
+                  new-tail  (if tail-cut?
+                              (let [new-len  (unchecked-subtract-int end tail-off)
+                                    new-tail (.array am new-len)]
+                                (System/arraycopy tail 0 new-tail 0 new-len)
+                                new-tail)
+                              (.arrayFor (Vector. nm am new-cnt shift new-root
+                                                  (.array am 0) nil -1 -1)
+                                         (unchecked-dec-int new-cnt)))
+                  new-root  (if tail-cut?
+                              new-root
+                              (.popTail (Vector. nm am
+                                                 new-cnt
+                                                 shift new-root
+                                                 (.array am 0) nil -1 -1)
+                                        shift new-cnt new-root))
+                  new-root  (if (nil? new-root) (.empty nm) new-root)]
+              (loop [r new-root
+                     s (int shift)]
+                (if (and (> s (int 5))
+                         (nil? (aget ^objects (.array nm r) 1)))
+                  (recur (aget ^objects (.array nm r) 0)
+                         (unchecked-subtract-int s (int 5)))
+                  (Vector. nm am new-cnt s r new-tail _meta -1 -1)))))))))
+
+  PSpliceableVector
+  (splicev [this that]
+    (splice-rrbts nm am this (as-rrbt that)))
+
+  AsRRBT
+  (as-rrbt [this]
+    this)
+
+  java.lang.Comparable
+  (compareTo [this that]
+    (if (identical? this that)
+      0
+      (let [^clojure.lang.IPersistentVector v
+            (cast clojure.lang.IPersistentVector that)
+            vcnt (.count v)]
+        (cond
+          (< cnt vcnt) -1
+          (> cnt vcnt) 1
+          :else
+          (loop [i (int 0)]
+            (if (== i cnt)
+              0
+              (let [comp (Util/compare (.nth this i) (.nth v i))]
+                (if (zero? comp)
+                  (recur (unchecked-inc-int i))
+                  comp))))))))
+
+  java.lang.Iterable
+  (iterator [this]
+    (let [i (java.util.concurrent.atomic.AtomicInteger. 0)]
+      (reify java.util.Iterator
+        (hasNext [_] (< (.get i) cnt))
+        (next [_] (.nth this (unchecked-dec-int (.incrementAndGet i))))
+        (remove [_] (throw (UnsupportedOperationException.))))))
+
+  java.util.Collection
+  (contains [this o]
+    (boolean (some #(= % o) this)))
+
+  (containsAll [this c]
+    (every? #(.contains this %) c))
+
+  (isEmpty [_]
+    (zero? cnt))
+
+  (toArray [this]
+    (into-array Object this))
+
+  (toArray [this arr]
+    (if (>= (count arr) cnt)
+      (do (dotimes [i cnt]
+            (aset arr i (.nth this i)))
+          arr)
+      (into-array Object this)))
+
+  (size [_] cnt)
+
+  (add [_ o] (throw (UnsupportedOperationException.)))
+  (addAll [_ c] (throw (UnsupportedOperationException.)))
+  (clear [_] (throw (UnsupportedOperationException.)))
+  (^boolean remove [_ o] (throw (UnsupportedOperationException.)))
+  (removeAll [_ c] (throw (UnsupportedOperationException.)))
+  (retainAll [_ c] (throw (UnsupportedOperationException.)))
+
+  java.util.List
+  (get [this i] (.nth this i))
+
+  (indexOf [this o]
+    (loop [i (int 0)]
+      (cond
+        (== i cnt) -1
+        (= o (.nth this i)) i
+        :else (recur (unchecked-inc-int i)))))
+
+  (lastIndexOf [this o]
+    (loop [i (unchecked-dec-int cnt)]
+      (cond
+        (neg? i) -1
+        (= o (.nth this i)) i
+        :else (recur (unchecked-dec-int i)))))
+
+  (listIterator [this]
+    (.listIterator this 0))
+
+  (listIterator [this i]
+    (let [i (java.util.concurrent.atomic.AtomicInteger. i)]
+      (reify java.util.ListIterator
+        (hasNext [_] (< (.get i) cnt))
+        (hasPrevious [_] (pos? i))
+        (next [_] (.nth this (unchecked-dec-int (.incrementAndGet i))))
+        (nextIndex [_] (.get i))
+        (previous [_] (.nth this (.decrementAndGet i)))
+        (previousIndex [_] (unchecked-dec-int (.get i)))
+        (add [_ e] (throw (UnsupportedOperationException.)))
+        (remove [_] (throw (UnsupportedOperationException.)))
+        (set [_ e] (throw (UnsupportedOperationException.))))))
+
+  (subList [this a z]
+    (slicev this a z))
+
+  (add [_ i o] (throw (UnsupportedOperationException.)))
+  (addAll [_ i c] (throw (UnsupportedOperationException.)))
+  (^Object remove [_ ^int i] (throw (UnsupportedOperationException.)))
+  (set [_ i e] (throw (UnsupportedOperationException.))))
+
+(defmethod print-method ::Vector [v w]
+  ((get (methods print-method) clojure.lang.IPersistentVector) v w))
+
+(let [vector-field (.getDeclaredField APersistentVector$SubVector "v")]
+  (.setAccessible vector-field true)
+  (defn sv-vector [^APersistentVector$SubVector sv]
+    (.get vector-field sv)))
+
+(let [start-field (.getDeclaredField APersistentVector$SubVector "start")]
+  (.setAccessible start-field true)
+  (defn sv-start [^APersistentVector$SubVector sv]
+    (.get start-field sv)))
+
+(let [end-field (.getDeclaredField APersistentVector$SubVector "end")]
+  (.setAccessible end-field true)
+  (defn sv-end [^APersistentVector$SubVector sv]
+    (.get end-field sv)))
+
+(extend-protocol AsRRBT
+  Vec
+  (as-rrbt [^Vec this]
+    (Vector. primitive-nm (.-am this)
+             (.-cnt this) (.-shift this) (.-root this) (.-tail this)
+             (.-_meta this) -1 -1))
+
+  PersistentVector
+  (as-rrbt [^PersistentVector this]
+    (Vector. object-nm object-am
+             (count this) (pv-shift this) (pv-root this) (pv-tail this)
+             (meta this) -1 -1))
+
+  APersistentVector$SubVector
+  (as-rrbt [^APersistentVector$SubVector this]
+    (let [v     (sv-vector this)
+          start (sv-start this)
+          end   (sv-end this)]
+      (slicev (as-rrbt v) start end))))
+
+(defn shift-from-to [^NodeManager nm node from to]
+  (cond
+    (== from to)
+    node
+
+    (.regular nm node)
+    (recur nm
+           (.node nm (.edit nm node) (doto (object-array 32) (aset 0 node)))
+           (unchecked-add-int (int 5) (int from))
+           to)
+
+    :else
+    (recur nm
+           (.node nm
+                  (.edit nm node)
+                  (doto (object-array 33)
+                    (aset 0 node)
+                    (aset 32
+                          (ints (doto (int-array 33)
+                                  (aset 0  (int (last-range nm node)))
+                                  (aset 32 (int 1)))))))
+           (unchecked-add-int (int 5) (int from))
+           to)))
+
+(defn slot-count [^NodeManager nm ^ArrayManager am node shift]
+  (let [arr (.array nm node)]
+    (if (zero? shift)
+      (.alength am arr)
+      (if (.regular nm node)
+        (index-of-nil arr)
+        (let [rngs (ranges nm node)]
+          (aget rngs 32))))))
+
+(defn subtree-branch-count [^NodeManager nm ^ArrayManager am node shift]
+  ;; NB. positive shifts only
+  (let [arr (.array nm node)
+        cs  (- shift 5)]
+    (if (.regular nm node)
+      (loop [i 0 sbc 0]
+        (if (== i 32)
+          sbc
+          (if-let [child (aget ^objects arr i)]
+            (recur (inc i) (+ sbc (long (slot-count nm am child cs))))
+            sbc)))
+      (let [lim (aget (ranges nm node) 32)]
+        (loop [i 0 sbc 0]
+          (if (== i lim)
+            sbc
+            (let [child (aget ^objects arr i)]
+              (recur (inc i) (+ sbc (long (slot-count nm am child cs)))))))))))
+
+(defn leaf-seq [^NodeManager nm arr]
+  (mapcat #(.array nm %) (take (index-of-nil arr) arr)))
+
+(defn rebalance-leaves
+  [^NodeManager nm ^ArrayManager am n1 cnt1 n2 cnt2 ^Box transferred-leaves]
+  (let [slc1 (slot-count nm am n1 5)
+        slc2 (slot-count nm am n2 5)
+        a    (+ slc1 slc2)
+        sbc1 (subtree-branch-count nm am n1 5)
+        sbc2 (subtree-branch-count nm am n2 5)
+        p    (+ sbc1 sbc2)
+        e    (- a (inc (quot (dec p) 32)))]
+    (cond
+      (<= e max-extra-search-steps)
+      (object-array (list n1 n2))
+
+      (<= (+ sbc1 sbc2) 1024)
+      (let [reg?    (zero? (mod p 32))
+            new-arr (object-array (if reg? 32 33))
+            new-n1  (.node nm nil new-arr)]
+        (loop [i  0
+               bs (partition-all 32
+                                 (concat (leaf-seq nm (.array nm n1))
+                                         (leaf-seq nm (.array nm n2))))]
+          (when-first [block bs]
+            (let [a (.array am (count block))]
+              (loop [i 0 xs (seq block)]
+                (when xs
+                  (.aset am a i (first xs))
+                  (recur (inc i) (next xs))))
+              (aset new-arr i (.node nm nil a))
+              (recur (inc i) (next bs)))))
+        (if-not reg?
+          (aset new-arr 32 (regular-ranges 5 p)))
+        (set! (.-val transferred-leaves) sbc2)
+        (object-array (list new-n1 nil)))
+
+      :else
+      (let [reg?     (zero? (mod p 32))
+            new-arr1 (object-array 32)
+            new-arr2 (object-array (if reg? 32 33))
+            new-n1   (.node nm nil new-arr1)
+            new-n2   (.node nm nil new-arr2)]
+        (loop [i  0
+               bs (partition-all 32
+                                 (concat (leaf-seq nm (.array nm n1))
+                                         (leaf-seq nm (.array nm n2))))]
+          (when-first [block bs]
+            (let [a (.array am (count block))]
+              (loop [i 0 xs (seq block)]
+                (when xs
+                  (.aset am a i (first xs))
+                  (recur (inc i) (next xs))))
+              (if (< i 32)
+                (aset new-arr1 i (.node nm nil a))
+                (aset new-arr2 (- i 32) (.node nm nil a)))
+              (recur (inc i) (next bs)))))
+        (if-not reg?
+          (aset new-arr2 32 (regular-ranges 5 (- p 1024))))
+        (set! (.-val transferred-leaves) (- 1024 sbc1))
+        (object-array (list new-n1 new-n2))))))
+
+(defn child-seq [^NodeManager nm node shift cnt]
+  (let [arr  (.array nm node)
+        rngs (if (.regular nm node)
+               (ints (regular-ranges shift cnt))
+               (ranges nm node))
+        cs   (if rngs (aget rngs 32) (index-of-nil arr))
+        cseq (fn cseq [c r]
+               (let [arr  (.array nm c)
+                     rngs (if (.regular nm c)
+                            (ints (regular-ranges (- shift 5) r))
+                            (ranges nm c))
+                     gcs  (if rngs (aget rngs 32) (index-of-nil arr))]
+                 (map list (take gcs arr) (take gcs rngs))))]
+    (mapcat cseq (take cs arr) (take cs rngs))))
+
+(defn rebalance
+  [^NodeManager nm ^ArrayManager am shift n1 cnt1 n2 cnt2 ^Box transferred-leaves]
+  (let [slc1 (slot-count nm am n1 shift)
+        slc2 (slot-count nm am n2 shift)
+        a    (+ slc1 slc2)
+        sbc1 (subtree-branch-count nm am n1 shift)
+        sbc2 (subtree-branch-count nm am n2 shift)
+        p    (+ sbc1 sbc2)
+        e    (- a (inc (quot (dec p) 32)))]
+    (cond
+      (<= e max-extra-search-steps)
+      (object-array (list n1 n2))
+
+      (<= (+ sbc1 sbc2) 1024)
+      (let [new-arr  (object-array 33)
+            new-rngs (int-array 33)
+            new-n1   (.node nm nil new-arr)]
+        (loop [i  0
+               bs (partition-all 32
+                                 (concat (child-seq nm n1 shift cnt1)
+                                         (child-seq nm n2 shift cnt2)))]
+          (when-first [block bs]
+            (let [a (object-array 33)
+                  r (int-array 33)]
+              (aset a 32 r)
+              (aset r 32 (count block))
+              (loop [i 0 gcs (seq block)]
+                (when-first [[gc gcr] gcs]
+                  (aset ^objects a i gc)
+                  (aset r i (int gcr))
+                  (recur (inc i) (next gcs))))
+              (aset ^objects new-arr i (.node nm nil a))
+              (aset new-rngs i (int (second (last block))))
+              (aset new-rngs 32 (inc i))
+              (recur (inc i) (next bs)))))
+        (aset new-arr 32 new-rngs)
+        (set! (.-val transferred-leaves) cnt2)
+        (object-array (list new-n1 nil)))
+
+      :else
+      (let [new-arr1  (object-array 33)
+            new-arr2  (object-array 33)
+            new-rngs1 (int-array 33)
+            new-rngs2 (int-array 33)
+            new-n1    (.node nm nil new-arr1)
+            new-n2    (.node nm nil new-arr2)]
+        (set! (.-val transferred-leaves) (- cnt1))
+        (loop [i  0
+               bs (partition-all 32
+                                 (concat (child-seq nm n1 shift cnt1)
+                                         (child-seq nm n2 shift cnt2)))]
+          (when-first [block bs]
+            (let [a (object-array 33)
+                  r (int-array 33)]
+              (aset a 32 r)
+              (aset r 32 (count block))
+              (loop [i 0 gcs (seq block)]
+                (when-first [[gc gcr] gcs]
+                  (aset a i gc)
+                  (aset r i (int gcr))
+                  (recur (inc i) (next gcs))))
+              (let [new-arr  (if (< i 32) new-arr1 new-arr2)
+                    new-rngs (if (< i 32) new-rngs1 new-rngs2)
+                    i        (mod i 32)]
+                (if (< i 32)
+                  (set! (.-val transferred-leaves)
+                        (+ (.-val transferred-leaves) (second (last block)))))
+                (aset ^objects new-arr i (.node nm nil a))
+                (aset new-rngs i (int (second (last block))))
+                (aset new-rngs 32 (int (inc i))))
+              (recur (inc i) (next bs)))))
+        (aset new-arr1 32 new-rngs1)
+        (aset new-arr2 32 new-rngs2)
+        (object-array (list new-n1 new-n2))))))
+
+(defn zippath
+  [^NodeManager nm ^ArrayManager am shift n1 cnt1 n2 cnt2 ^Box transferred-leaves]
+  (if (== shift 5)
+    (rebalance-leaves nm am n1 cnt1 n2 cnt2 transferred-leaves)
+    (let [c1 (last-child nm n1)
+          c2 (first-child nm n2)
+          ccnt1 (if (.regular nm n1)
+                  (mod cnt1 (bit-shift-left 1 shift))
+                  (last-range nm n1))
+          ccnt2 (if (.regular nm n2)
+                  (mod cnt2 (bit-shift-left 1 shift))
+                  (last-range nm n2))
+          next-transferred-leaves (Box. 0)
+          [new-c1 new-c2] (zippath nm am (- shift 5) c1 ccnt1 c2 ccnt2
+                                   next-transferred-leaves)
+          d (.-val next-transferred-leaves)]
+      (set! (.-val transferred-leaves) (+ (.-val transferred-leaves) d))
+      (rebalance nm am shift
+                 (if (identical? c1 new-c1)
+                   n1
+                   (replace-rightmost-child nm shift n1 new-c1 d))
+                 (+ cnt1 d)
+                 (if new-c2
+                   (if (identical? c2 new-c2)
+                     n2
+                     (replace-leftmost-child nm shift n2 cnt2 new-c2 d))
+                   (remove-leftmost-child nm shift n2))
+                 (- cnt2 d)
+                 transferred-leaves))))
+
+(defn squash-nodes [^NodeManager nm shift n1 cnt1 n2 cnt2]
+  (let [arr1  (.array nm n1)
+        arr2  (.array nm n2)
+        li1   (index-of-nil arr1)
+        li2   (index-of-nil arr2)
+        slots (concat (take li1 arr1) (take li2 arr2))]
+    (if (> (count slots) 32)
+      (object-array (list n1 n2))
+      (let [new-rngs (int-array 33)
+            new-arr  (object-array 33)
+            rngs1    (take li1 (if (.regular nm n1)
+                                 (regular-ranges shift cnt1)
+                                 (ranges nm n1)))
+            rngs2    (take li2 (if (.regular nm n2)
+                                 (regular-ranges shift cnt2)
+                                 (ranges nm n2)))
+            rngs2    (let [r (last rngs1)]
+                       (map #(+ % r) rngs2))
+            rngs     (concat rngs1 rngs2)]
+        (aset new-arr 32 new-rngs)
+        (loop [i 0 cs (seq slots)]
+          (when cs
+            (aset new-arr i (first cs))
+            (recur (inc i) (next cs))))
+        (loop [i 0 rngs (seq rngs)]
+          (if rngs
+            (do (aset new-rngs i (int (first rngs)))
+                (recur (inc i) (next rngs)))
+            (aset new-rngs 32 i)))
+        (object-array (list (.node nm nil new-arr) nil))))))
+
+(defn splice-rrbts [^NodeManager nm ^ArrayManager am ^Vector v1 ^Vector v2]
+  (cond
+    (zero? (count v1)) v2
+    (< (count v2) rrbt-concat-threshold) (into v1 v2)
+    :else
+    (let [s1 (.-shift v1)
+          s2 (.-shift v2)
+          r1 (.-root v1)
+          o? (overflow? nm r1 s1 (+ (count v1) (- 32 (.alength am (.-tail v1)))))
+          r1 (if o?
+                 (let [tail      (.-tail v1)
+                       tail-node (.node nm nil tail)
+                       reg?      (and (.regular nm r1) (== (.alength am tail) 32))
+                       arr       (object-array (if reg? 32 33))]
+                   (aset arr 0 r1)
+                   (aset arr 1 (new-path nm am s1 tail-node))
+                   (if-not reg?
+                     (let [rngs (int-array 33)]
+                       (aset rngs 32 2)
+                       (aset rngs 0 (- (count v1) (.alength am tail)))
+                       (aset rngs 1 (count v1))
+                       (aset arr 32 rngs)))
+                   (.node nm nil arr))
+                 (fold-tail nm am r1 s1 (.tailoff v1) (.-tail v1)))
+          s1 (if o? (+ s1 5) s1)
+          r2 (.-root v2)
+          s  (max s1 s2)
+          r1 (shift-from-to nm r1 s1 s)
+          r2 (shift-from-to nm r2 s2 s)
+          transferred-leaves (Box. 0)
+          [n1 n2] (zippath nm am
+                           s
+                           r1 (count v1)
+                           r2 (- (count v2) (.alength am (.-tail v2)))
+                           transferred-leaves)
+          d (.-val transferred-leaves)
+          ncnt1   (+ (count v1) d)
+          ncnt2   (- (count v2) (.alength am (.-tail v2)) d)
+          [n1 n2] (if (identical? n2 r2)
+                    (squash-nodes nm s n1 ncnt1 n2 ncnt2)
+                    (object-array (list n1 n2)))]
+      (if n2
+        (let [arr      (object-array 33)
+              new-root (.node nm nil arr)]
+          (aset arr 0 n1)
+          (aset arr 1 n2)
+          (aset arr 32 (doto (int-array 33)
+                         (aset 0 (count v1))
+                         (aset 1 (+ (count v1)
+                                    (- (count v2) (.alength am (.-tail v2)))))
+                         (aset 32 2)))
+          (Vector. nm am (+ (count v1) (count v2)) (+ s 5) new-root (.-tail v2)
+                   nil -1 -1))
+        (loop [r n1
+               s (int s)]
+          (if (and (> s (int 5))
+                   (nil? (aget ^objects (.array nm r) 1)))
+            (recur (aget ^objects (.array nm r) 0)
+                   (unchecked-subtract-int s (int 5)))
+            (Vector. nm am (+ (count v1) (count v2)) s r (.-tail v2)
+                     nil -1 -1)))))))

File test/flexvec/core_test.clj

+(ns flexvec.core-test
+  (:require [flexvec.core :as fv]
+            [flexvec.debug :as dv])
+  (:use clojure.test))
+
+(defn rangev [& args]
+  (vec (apply range args)))
+
+(defn rangevs [& args]
+  (mapv rangev args))
+
+(deftest test-slicing
+  (testing "slicing"
+    (is (dv/check-subvec 32000 10 29999 1234 18048 10123 10191))))
+
+(deftest test-splicing
+  (testing "splicing"
+    (is (dv/check-catvec 1025 1025 3245 1025 32768 1025 1025 10123 1025 1025))
+    (is (apply dv/check-catvec (repeat 30 33)))))